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

209
Task/Minimal-steps-down-to-1/Mathematica/minimal-steps-down-to-1.math Normal file
View file

@ -0,0 +1,209 @@
$RecursionLimit = 3000;
ClearAll[MinimalStepToOne, MinimalStepToOneHelper]
MinimalStepToOne[n_Integer] := Module[{res},
res = Reap[MinimalStepToOneHelper[{n}]][[-1, 1]];
SortBy[res, Length]
]
MinimalStepToOneHelper[steps_List] := Module[{n, out},
n = Last[steps];
If[n == 1,
Sow[steps];
,
If[Divisible[n, 3],
out = steps~Join~{" /3=> ", n/3};
MinimalStepToOneHelper[out]
];
If[Divisible[n, 2],
out = steps~Join~{" /2=> ", n/2};
MinimalStepToOneHelper[out]
];
If[n > 1,
out = steps~Join~{" -1=> ", n - 1};
MinimalStepToOneHelper[out]
];
]
]
Do[
sel = First[MinimalStepToOne[i]];
Print[First[sel],
": (" <> ToString[(Length[sel] - 1)/2] <> " steps) ", sel // Row]
,
{i, 1, 10}
]
$RecursionLimit = 3000;
ClearAll[MinimalStepToOne2, MinimalStepToOneHelper2]
MinimalStepToOne2[nn_Integer] :=
Module[{res, done, solution, maxsteps},
done = False;
solution = {};
MinimalStepToOneHelper2[steps_List] := Module[{n, out},
n = Last[steps];
If[n == 1,
solution = steps;
,
If[solution === {},
If[Divisible[n, 3],
out = steps~Join~{" /3=> ", n/3};
MinimalStepToOneHelper2[out]
];
If[Divisible[n, 2],
out = steps~Join~{" /2=> ", n/2};
MinimalStepToOneHelper2[out]
];
If[n > 1,
out = steps~Join~{" -1=> ", n - 1};
MinimalStepToOneHelper2[out]
];
];
];
];
MinimalStepToOneHelper2[{nn}];
maxsteps = (Length[solution] - 1)/2;
maxsteps
]
$RecursionLimit = 3000;
ClearAll[MinimalStepToOneMaxSteps, MinimalStepToOneMaxStepsHelper]
MinimalStepToOneMaxSteps[n_Integer, maxsteps_Integer] :=
Module[{res},
res = Reap[MinimalStepToOneMaxStepsHelper[{n}, maxsteps]][[-1, 1]];
(Min[Length /@ res] - 1)/2
]
MinimalStepToOneMaxStepsHelper[steps_List, maxsteps_Integer] :=
Module[{n, out},
n = Last[steps];
If[n == 1,
Sow[steps];
,
If[maxsteps > 0,
If[Divisible[n, 3],
out = steps~Join~{" /3=> ", n/3};
MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
];
If[Divisible[n, 2],
out = steps~Join~{" /2=> ", n/2};
MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
];
If[n > 1,
out = steps~Join~{" -1=> ", n - 1};
MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
];
];
];
]
allsols = Table[
max = MinimalStepToOne2[i];
{i, MinimalStepToOneMaxSteps[i, max]}
,
{i, 1, 2000}
];
a = Last[SortBy[GatherBy[allsols, Last], First /* Last]];
{a[[1, 2]], a[[All, 1]]}
$RecursionLimit = 3000;
ClearAll[MinimalStepToOne, MinimalStepToOneHelper]
MinimalStepToOne[n_Integer] := Module[{res},
res = Reap[MinimalStepToOneHelper[{n}]][[-1, 1]];
SortBy[res, Length]
]
MinimalStepToOneHelper[steps_List] := Module[{n, out},
n = Last[steps];
If[n == 1,
Sow[steps];
,
If[Divisible[n, 3],
out = steps~Join~{" /3=> ", n/3};
MinimalStepToOneHelper[out]
];
If[Divisible[n, 2],
out = steps~Join~{" /2=> ", n/2};
MinimalStepToOneHelper[out]
];
If[n > 2,
out = steps~Join~{" -2=> ", n - 2};
MinimalStepToOneHelper[out]
];
]
]
Do[
sel = First[MinimalStepToOne[i]];
Print[First[sel],
": (" <> ToString[(Length[sel] - 1)/2] <> " steps) ", sel // Row]
,
{i, 1, 10}
]
$RecursionLimit = 3000;
ClearAll[MinimalStepToOne2, MinimalStepToOneHelper2]
MinimalStepToOne2[nn_Integer] :=
Module[{res, done, solution, maxsteps},
done = False;
solution = {};
MinimalStepToOneHelper2[steps_List] := Module[{n, out},
n = Last[steps];
If[n == 1,
solution = steps;
,
If[solution === {},
If[Divisible[n, 3],
out = steps~Join~{" /3=> ", n/3};
MinimalStepToOneHelper2[out]
];
If[Divisible[n, 2],
out = steps~Join~{" /2=> ", n/2};
MinimalStepToOneHelper2[out]
];
If[n > 2,
out = steps~Join~{" -2=> ", n - 2};
MinimalStepToOneHelper2[out]
];
];
];
];
MinimalStepToOneHelper2[{nn}];
maxsteps = (Length[solution] - 1)/2;
maxsteps
]
$RecursionLimit = 3000;
ClearAll[MinimalStepToOneMaxSteps, MinimalStepToOneMaxStepsHelper]
MinimalStepToOneMaxSteps[n_Integer, maxsteps_Integer] :=
Module[{res},
res = Reap[MinimalStepToOneMaxStepsHelper[{n}, maxsteps]][[-1, 1]];
(Min[Length /@ res] - 1)/2
]
MinimalStepToOneMaxStepsHelper[steps_List, maxsteps_Integer] :=
Module[{n, out},
n = Last[steps];
If[n == 1,
Sow[steps];
,
If[maxsteps > 0,
If[Divisible[n, 3],
out = steps~Join~{" /3=> ", n/3};
MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
];
If[Divisible[n, 2],
out = steps~Join~{" /2=> ", n/2};
MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
];
If[n > 2,
out = steps~Join~{" -2=> ", n - 2};
MinimalStepToOneMaxStepsHelper[out, maxsteps - 1]
];
];
];
]
allsols = Table[
max = MinimalStepToOne2[i];
{i, MinimalStepToOneMaxSteps[i, max]}
,
{i, 1, 2000}
];
a = Last[SortBy[GatherBy[allsols, Last], First /* Last]];
{a[[1, 2]], a[[All, 1]]}