Re: Re: Re: Test for composite digit
- To: mathgroup at smc.vnet.net
- Subject: [mg95016] Re: [mg94991] Re: [mg94972] Re: [mg94930] Test for composite digit
- From: DrMajorBob <btreat1 at austin.rr.com>
- Date: Sat, 3 Jan 2009 05:54:57 -0500 (EST)
- References: <200812311106.GAA13449@smc.vnet.net>
- Reply-to: drmajorbob at longhorns.com
Correction. There was a case where FixedPoint did not converge, for
instance on next3[98304], where 9 is replaced by Infinity rather than
extending the digit-list.
Below is a code that works and is also simpler. Note that "stick" is so
named because it "sticks" with any legal digit string it reaches.
Part of the point was to generalize as much as I could. Redefine
"allowed", and you'll get entirely different results.
FixedPoint iterations are limited (I think) to the number of digits in the
input, and they're pretty FAST iterations.
Clear[allowed, minAllowed, ok3, better, stick, next4, take]
allowed[n_Integer?Positive] := {{4, 6, 8, 9}, {0, 1, 2, 3, 5, 7}}[[
Mod[n, 2, 1]]]
minAllowed[n_Integer?Positive] := Min@allowed@n
take[a_List, 0] = {minAllowed@1};
take[a_List, k_Integer] := Take[a, k]
ok3[k_, {j_}] := MemberQ[allowed[j], k]
better[9, _] = {Infinity};
better[k_, j_] :=
better[k, j] = {Min@Complement[allowed[j], Range[0, k]]}
stick[d : {Infinity, ___Integer}] :=
minAllowed /@ Range[1 + Length@d]
stick[d : {left___Integer, x_Integer, Infinity, right___Integer}] :=
Join[{left}, better[x, 1 + Length@{left}],
minAllowed /@ Range[2 + Length@{left}, Length@d]]
stick[d : {__Integer}] :=
Module[{k, bad = Position[MapIndexed[ok3, d], False, 1, 1]},
If[bad == {}, d,
bad = bad[[1, 1]]; k = d[[bad]];
Join[take[d, bad - 1], better[k, bad],
minAllowed /@ Range[bad + 1, Length@d]]
]
]
next4[n_Integer] := FromDigits@FixedPoint[stick, IntegerDigits[n + 1]]
test4 = Rest@NestList[next4, 98304, 100]; // Timing
{0.009854, Null}
test2 = Rest@NestList[next2, 98304, 100]; // Timing
{8.75782, Null}
test2 == test4
True
next5[n_Integer] :=
Length@Rest@FixedPointList[stick, IntegerDigits[n + 1]]
test[n_] := Tally[next5 /@ RandomInteger[{10^6, 10^7}, n]]
test[10000] // Timing
{2.10739, {{3, 5369}, {2, 3200}, {4, 1362}, {1, 58}, {7, 1}, {5,
9}, {6, 1}}}
Bobby
On Thu, 01 Jan 2009 19:30:13 -0600, DrMajorBob <btreat1 at austin.rr.com>
wrote:
> A less confusing version:
>
> Clear[allowed, ok3, better, stick, next3]
> allowed[n_Integer?
> Positive] := {{4, 6, 8, 9}, {0, 1, 2, 3, 5, 7}}[[Mod[n, 2, 1]]]
> minAllowed[n_Integer?Positive] := Min@allowed@n
> maxAllowed[n_Integer?Positive] := Max@allowed@n
> ok3[k_, {j_}] := MemberQ[allowed[j], k]
> better[k_, j_] :=
> better[k, j] = {Min@Complement[allowed[j], Range[0, k]]}
> stick[d : {one_Integer, ___Integer}] /; ! ok3[one, {1}] :=
>
> If[one > maxAllowed@1,
> minAllowed /@ Range[1 + Length@d],
> Join[better[one, 1], minAllowed /@ Range[2, Length@d]]
> ]
> stick[d : {one_Integer, two_Integer, ___Integer}] /; ! ok3[two, {2}] :=
>
> If[
> two > maxAllowed@2,
> Join[better[one, 1], minAllowed /@ Range[2, Length@d]],
> Join[{one}, better[two, 2], minAllowed /@ Range[3, Length@d]]
> ]
> stick[d : {__Integer}] /;
> Position[MapIndexed[ok3, d], False, 1, 1] == {} := d
> stick[d : {__Integer}] :=
> Module[{k, bad = Position[MapIndexed[ok3, d], False, 1, 1][[1, 1]]},
> k = d[[bad]];
> If[
> k > maxAllowed@bad,
> Join[Take[d, bad - 2], better[k, bad - 1],
> minAllowed /@ Range[bad, Length@d]],
> Join[Take[d, bad - 1], better[k, bad],
> minAllowed /@ Range[bad + 1, Length@d]]
> ]
> ]
> next3[n_Integer] := FromDigits@FixedPoint[stick, IntegerDigits[n + 1]]
>
> RandomInteger[{1, 7*10^5}]
> next2@% // Timing
> next3@%% // Timing
>
> 354808
>
> {1.39235, 404040}
>
> {0.000342, 404040}
>
> Bobby
>
> On Thu, 01 Jan 2009 06:27:57 -0600, DrMajorBob <btreat1 at austin.rr.com>
> wrote:
>
>> 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