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