64 lines
1.7 KiB
Plaintext
64 lines
1.7 KiB
Plaintext
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]
|