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

63
Task/Fraction-reduction/Mathematica/fraction-reduction.math Normal file
View file

@ -0,0 +1,63 @@
ClearAll[AnomalousCancellationQ2]
AnomalousCancellationQ2[frac : {i_?Positive, j_?Positive}] :=
Module[{samedigits, idig, jdig, ff, p, q, r, tmp},
idig = IntegerDigits[i];
jdig = IntegerDigits[j];
samedigits = Intersection[idig, jdig];
ff = i/j;
If[samedigits != {},
r = {};
Do[
p = Flatten[Position[idig, s]];
q = Flatten[Position[jdig, s]];
p = FromDigits[Delete[idig, #]] & /@ p;
q = FromDigits[Delete[jdig, #]] & /@ q;
tmp = Select[Tuples[{p, q}], #[[1]]/#[[2]] == ff &];
If[Length[tmp] > 0,
r = Join[r, Join[#, {i, j, s}] & /@ tmp];
];
,
{s, samedigits}
];
r
,
{}
]
]
ijs = Select[Select[Range[1, 9999], IntegerDigits /* FreeQ[0]], IntegerDigits /* DuplicateFreeQ];
res = Reap[
Do[
Do[
num = ijs[[i]];
den = ijs[[j]];
out = AnomalousCancellationQ2[{num, den}];
If[Length[out] > 0,
Sow[out]
]
,
{i, 1, j - 1}
]
,
{j, Length[ijs]}
]
][[2, 1]];
tmp = Catenate[res];
sel = Sort@Select[tmp, IntegerLength[#[[3]]] == IntegerLength[#[[4]]] == 2 &];
Length[sel]
t = Take[sel, UpTo[12]];
Column[Row[{#3, "/", #4, " = ", #1, "/", #2, " by removing ", #5}] & @@@ t]
SortBy[Tally[sel[[All, -1]]], First]
sel = Sort@Select[tmp, IntegerLength[#[[3]]] == IntegerLength[#[[4]]] == 3 &];
Length[sel]
t = Take[sel, UpTo[12]];
Column[Row[{#3, "/", #4, " = ", #1, "/", #2, " by removing ", #5}] & @@@ t]
SortBy[Tally[sel[[All, -1]]], First]
sel = Sort@Select[tmp, IntegerLength[#[[3]]] == IntegerLength[#[[4]]] == 4 &];
Length[sel]
t = Take[sel, UpTo[12]];
Column[Row[{#3, "/", #4, " = ", #1, "/", #2, " by removing ", #5}] & @@@ t]
SortBy[Tally[sel[[All, -1]]], First]