aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Task/Fractran/Mathematica/fractran-1.math Normal file
View file

@ -0,0 +1,15 @@
fractionlist = {17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1};
n = 2;
steplimit = 20;
j = 0;
break = False;
While[break == False && j <= steplimit,
newlist = n fractionlist;
isintegerlist = IntegerQ[#] & /@ newlist;
truepositions = Position[isintegerlist, True];
If[Length[truepositions] == 0,
break = True,
Print[ToString[j] <> ": " <> ToString[n]];
n = newlist[[truepositions[[1, 1]]]]; j++;
]
]

13
Task/Fractran/Mathematica/fractran-2.math Normal file
View file

@ -0,0 +1,13 @@
fractran[
program : {__ ? (Element[#, PositiveRationals] &)}, (* list of positive fractions *)
n0_Integer, (* initial state *)
maxSteps : _Integer : Infinity] := (* max number of steps *)
NestWhileList[ (* Return a list representing the evolution of the state n *)
Function[n, SelectFirst[IntegerQ][program * n]], (* Select first integer in n*program, if none return Missing *)
n0,
Not @* MissingQ, (* continue while the state is not Missing *)
1,
maxSteps]
$PRIMEGAME = {17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1};
fractran[$PRIMEGAME, 2, 50]

1
Task/Fractran/Mathematica/fractran-3.math Normal file
View file

@ -0,0 +1 @@
Select[IntegerQ] @ Log2[fractran[$PRIMEGAME, 2, 500000]]