Re: Test for composite digit
- To: mathgroup at smc.vnet.net
- Subject: [mg94972] Re: [mg94930] Test for composite digit
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Thu, 1 Jan 2009 07:27:57 -0500 (EST)
- References: <200812311106.GAA13449@smc.vnet.net>
- Reply-to: drmajorbob at longhorns.com
Something like this (naive but effective): Clear[ok1, composite, next1] composite[n_] := n > 1 && ! PrimeQ@n SetAttributes[composite, Listable] ok1[n_] /; 1000 <= n <= 9999 := Module[{digits = IntegerDigits[n]}, {True, False, True, False} == composite@digits] ok1[n_] /; 100 <= n <= 999 := Module[{digits = IntegerDigits[n]}, {True, False, True} == composite@digits] next1[n_Integer] /; n < 10^4 := Module[{k = n + 1}, While[k < 10^4 && ! ok1@k, k++]; k] test1 = Rest@NestList[next1, 844, 100] {854, 856, 858, 859, 874, 876, 878, 879, 904, 906, 908, 909, 914, \ 916, 918, 919, 924, 926, 928, 929, 934, 936, 938, 939, 954, 956, 958, \ 959, 974, 976, 978, 979, 4040, 4041, 4042, 4043, 4045, 4047, 4060, \ 4061, 4062, 4063, 4065, 4067, 4080, 4081, 4082, 4083, 4085, 4087, \ 4090, 4091, 4092, 4093, 4095, 4097, 4140, 4141, 4142, 4143, 4145, \ 4147, 4160, 4161, 4162, 4163, 4165, 4167, 4180, 4181, 4182, 4183, \ 4185, 4187, 4190, 4191, 4192, 4193, 4195, 4197, 4240, 4241, 4242, \ 4243, 4245, 4247, 4260, 4261, 4262, 4263, 4265, 4267, 4280, 4281, \ 4282, 4283, 4285, 4287, 4290, 4291} If you ALWAYS want to start with a composite digit and alternate, you could generalize to Clear[composite, ok2] composite[n_] := MemberQ[{4, 6, 8, 9}, n] SetAttributes[composite, Listable] ok2[digits_List] := MatchQ[composite@ digits, {PatternSequence[True, False] ..} | {PatternSequence[True, False] .., True} | {True}] ok2[n_Integer] := ok2@IntegerDigits@n ok2[other_] = False; next2[n_Integer] := Module[{k = n + 1}, While[! ok2@k, k++]; k] test2 = Rest@NestList[next2, 844, 100] {854, 856, 858, 859, 874, 876, 878, 879, 904, 906, 908, 909, 914, \ 916, 918, 919, 924, 926, 928, 929, 934, 936, 938, 939, 954, 956, 958, \ 959, 974, 976, 978, 979, 4040, 4041, 4042, 4043, 4045, 4047, 4060, \ 4061, 4062, 4063, 4065, 4067, 4080, 4081, 4082, 4083, 4085, 4087, \ 4090, 4091, 4092, 4093, 4095, 4097, 4140, 4141, 4142, 4143, 4145, \ 4147, 4160, 4161, 4162, 4163, 4165, 4167, 4180, 4181, 4182, 4183, \ 4185, 4187, 4190, 4191, 4192, 4193, 4195, 4197, 4240, 4241, 4242, \ 4243, 4245, 4247, 4260, 4261, 4262, 4263, 4265, 4267, 4280, 4281, \ 4282, 4283, 4285, 4287, 4290, 4291} test1 == test2 True All that gets very slow for large n, however, so (slightly awkward)... Clear[allowed, ok3, better, stick, next3] allowed[n_Integer? Positive] := {{4, 6, 8, 9}, {0, 1, 2, 3, 5, 7}}[[Mod[n, 2, 1]]] ok3[k_, {j_}] := MemberQ[allowed[j], k] better[k_, j_] := {Min@Complement[allowed[j], Range[0, k]]} stick[d_List] /; VectorQ[d, IntegerQ] := Module[{k, firstBad = Position[MapIndexed[ok3, d], False, 1, 1]}, Which[ firstBad == {}, d, firstBad == {{1}}, If[(k = d[[1]]) > Max@allowed@1, Min /@ allowed /@ Range[1 + Length@d], Join[better[k, 1], Min /@ allowed /@ Range[2, Length@d]] ], firstBad == {{2}}, If[ (k = d[[2]]) > Max@allowed@2, Join[{1 + d[[1]]}, Table[Min@allowed@k, {k, 2, Length@d}]], Join[{d[[1]]}, better[k, 2], Min /@ allowed /@ Range[3, Length@d]] ], True, firstBad = firstBad[[1, 1]]; If[ (k = d[[firstBad]]) > Max@allowed@firstBad, Join[Take[d, firstBad - 2], {1 + d[[firstBad + 1]]}, Table[Min@allowed@k, {k, firstBad, Length@d}]], Join[Take[d, firstBad - 1], better[k, firstBad], Min /@ allowed /@ Range[firstBad + 1, Length@d]] ] ] ] next3[n_Integer] := FromDigits@FixedPoint[stick, IntegerDigits[n + 1]] RandomInteger[{1, 7*10^5}] next2@% // Timing next3@%% // Timing 194872 {5.74494, 404040} {0.000277, 404040} Bobby On Wed, 31 Dec 2008 05:06:40 -0600, Diana <diana.mecum at gmail.com> wrote: > Math folks, > > I am trying to write an algorithm which will test for a digit within a > number being composite, i.e. {4, 6, 8, or 9} > > For example: > > Let's say I start with the number 844. The next number in my sequence > will be the smallest number greater than 844 which satisfies: > > 1) a three digit number with first and third digits composite, and the > second digit not composite, or a > 2) a four digit number with first and third digits composite, and the > second and fourth digits not composite. > > The answer will be 854, and I want the algorithm to be able to find > this. > > I may then want to find a number of any specified arbitrary length > with digits composite or not composite as desired. > > Thanks, > > Diana > -- DrMajorBob at longhorns.com