Fractran

Author

Eric W. Weisstein
March 27, 2002

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/Fractran.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Fractran.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Algorithm

FractranIt[f_List,n_Integer]:=Module[{i=1,l=Length[f]},
		While[i<=l && !IntegerQ[n f[[i]]],i++];
		If[i>l,0,n f[[i]]]
	]

Fractran[f_List,n0_Integer,nmax_:100]:=Module[{i=1,l={n0}},
		While[l[[-1]]>0 && i<=nmax,
			i++;
			l=Append[l,FractranIt[f,l[[-1]]]]
 	];
l
]

Prime Game

PrimeGame={17/91,78/85,19/51,23/38,29/33,77/29,95/23,77/19,1/17,11/13,13/11,15/2,1/7,55/1};

Fractran[PrimeGame,2,10]

(terms=Fractran[PrimeGame,2,10000]);//Timing

Select[terms,IntegerQ[Log[2,#]]&]

Log[2,#]&/@%

Prepend[Table[Prime[n],{n,7}],1]