Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Combining Plots with Different Ordinate Axes in
  • Next by Date: Aspect Ratio
  • Previous by thread: Re: Test for composite digit
  • Next by thread: Re: Re: Test for composite digit