Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1999
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1999

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

Search the Archive

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.




  • Prev by Date: How to make Package?
  • Next by Date: Re: Real roots and other assumptions...
  • Previous by thread: RE: Fast List-Selection
  • Next by thread: Re: Fast List-Selection