Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Fast List-Selection

• To: mathgroup at smc.vnet.net
• Subject: [mg19903] Re: [mg19880] Fast List-Selection
• From: Hans Havermann <haver at total.net>
• Date: Tue, 21 Sep 1999 02:22:42 -0400
• Sender: owner-wri-mathgroup at wolfram.com

A few comments...

I decided to tackle this in an effort to find more of Mike Keith's
"Maris-McGwire-Sosa Numbers" <http://users.aol.com/s6sj7gt/maris.htm>,
specifically MMS 7-tuples - of which he knew only two.

My coding for the sum of the decimal digits in a number's prime factors and
in the number itself is:

g[n_] := Apply[Plus,
    Join[Flatten[
        IntegerDigits[First[Transpose[FactorInteger[n]]]]*
          Last[Transpose[FactorInteger[n]]]], IntegerDigits[n]]]

To generate a given list of g[n], say between 10^10 and 10^10 + 10^5, takes
time:

s = Table[g[n], {n, 10^10, 10^10 + 10^5}];

(about 325 seconds, on my machine)

P.J. Hinton suggests:

searchForRuns[lst_List, runlen_Integer] :=
  Map[Flatten[First[#]] &,
    Select[Split[
        MapIndexed[{#1, #2} &,
          lst], (First[#1] === First[#2]) &], (Length[#] == runlen) &]]

searchForRuns[s, 7];

(about 29 seconds)

Ted Ersek:

t = Split[s];

(about 19 seconds, plus time for "Cases", etc.)

My own:

Do[If[Count[t = Take[s, {i, i + 6}], t[[1]]] == 7, Print[s[[i]]]], {i, 1,
    Length[s] - 6}]

(about 9 seconds)

Before I'd even seen any responses, I decided to re-write this thing on my
own. I took an entirely different approach, generating g[s] only as needed:

c = 10^10; s = Table[g[c + i], {i, 0, 6}];
While[c < 10^10 + 10^5,
  If[s[[-1]] == s[[-2]],
    If[s[[-1]] == s[[-3]],
      If[s[[-1]] == s[[-4]],
        If[s[[-1]] == s[[-5]],
          If[s[[-1]] == s[[-6]], If[s[[-1]] == s[[-7]], Print[c]]; c = c + 1;
            s = Join[Take[s, -6], Table[g[c + i], {i, 6, 6}]], c = c + 2;
            s = Join[Take[s, -5], Table[g[c + i], {i, 5, 6}]]], c = c + 3;
          s = Join[Take[s, -4], Table[g[c + i], {i, 4, 6}]]], c = c + 4;
        s = Join[Take[s, -3], Table[g[c + i], {i, 3, 6}]]], c = c + 5;
      s = Join[Take[s, -2], Table[g[c + i], {i, 2, 6}]]], c = c + 6;
    s = Join[Take[s, -1], Table[g[c + i], {i, 1, 6}]]]]

(about 330 seconds; so, ~5 seconds for the excess)

Rob Pratt:

Flatten[Position[Partition[s,7,1],Table[x_,{7}]]]

(< 4 seconds; very nice)

Thank you all.