A superprime is an integer such that all its left-to-right initial segments are prime (e.g. 7331 whose segments are 7, 73, 733, and 7331, all prime).
There is a largest superprime.

Find it.

Source: USA Computing Olympiad, Feb 1995.

the algorithm for this is fairly simple,  start with a list of 1-digit primes, namely {2,3,5,7}.  At each iteration go through the current list and test if adding a 1,3,7, or 9 keeps it a prime, if so, it goes in the new list.  Keep this up until you are no longer able to add a new value.
for example, after the first step you get
{23,29,31,37,53,59,71,73,79}

The following code in Mathematica finds the complete list of
{2,3,5,7,23,29,31,37,53,59,71,73,79,233,239,
293,311,313,317,373,379,593,599,719,733,739,
797,2333,2339,2393,2399,2939,3119,3137,3733,
3739,3793,3797,5939,7193,7331,7333,7393,23333,
23339,23399,23993,29399,31193,31379,37337,
37339,37397,59393,59399,71933,73331,73939,
233993,239933,293999,373379,373393,593933,
593993,719333,739391,739393,739397,739399,
2339933,2399333,2939999,3733799,5939333,
7393913,7393931,7393933,23399339,29399999,
37337999,59393339,73939133}
largest of which is 73939133
Code follows:
digs={1,3,7,9};
lst={2,3,5,7};
biglst=lst;
cnt=1;
While[cnt>0,
cnt=0;
newlst={};
lng=Length[lst];
For[i=1,i„Tlng,++i,
p=lst[[i]];
For[j=1,j„T4,++j,
d=digs[[j]];
pn=10*p+d;
If[PrimeQ[pn],
++cnt;
AppendTo[newlst,pn];
];
];
];
If[cnt>0,
lst=newlst;
biglst=Flatten[Append[biglst,lst]];
];
];

Posted by Daniel on 2010-10-20 12:02:07