|
|
MATHEMATICA
|
L2 = N[ Log[ 10, 2 ], 50 ]; L5 = N[ Log[ 10, 5 ], 50 ]; k = 1; Do[ While[ Take[ RealDigits[ 10^FractionalPart[ L2*k ] ][[ 1 ] ], n ] != Take[ RealDigits[ 10^FractionalPart[ L5*k ] ][[ 1 ] ], n ], k++ ]; Print[ k ], {n, 1, 10} ]
L2 = N[ Log[ 10, 2 ], 50 ]; L5 = N[ Log[ 10, 5 ], 50 ]; k = 1; Do[ While[ Take[ RealDigits[ 10^FractionalPart[ L2*k ]][[ 1 ]], n ] != Take[ RealDigits[ 10^FractionalPart[ L5*k ]][[ 1 ]], n ], k++ ]; Print[ k ], {n, 1, 7} ]
f[n_, k_] := {Floor[ 10^(k - 1 + N[FractionalPart[n Log[5]/Log[10]], 20])], Floor[10^(k - 1 + N[FractionalPart[n Log[2]/Log[10]], 20])]} Flatten@Block[{$MaxExtraPrecision = \[Infinity]}, Block[{l = Denominator /@ Convergents[Log10[2], 1000]}, Array[k \[Function] l[[Flatten@Position[f[ #/2, k] & /@ l, {x_, x_}, {1}, 1]]]/2, 20]]] (* J. Mulder (jasper.mulder(AT)planet.nl), Feb 03 2010 *)
(* alternate program *)
n = 100; $MaxExtraPrecision = n; ans =
ContinuedFraction[Log10[5/2], n]; data =
Denominator /@
Flatten[Table[
FromContinuedFraction[Join[ans[[1 ;; p - 1]], {#}]] & /@
Range[1, ans[[p]]], {p, 2, n}]]; sol =
Select[Table[{k, a = N[FractionalPart[{k Log10[2], k Log10[5]}], n];
10^a, b = RealDigits[10^a][[All, 1]];
LengthWhile[Range[Length[b[[1]]]], b[[1, #]] == b[[2, #]] &],
10^a . {-1, 1}, RealDigits[10^a . {-1, 1}][[-1]]}, {k, data}],
Abs[#[[-2]]] < 1 &];
acc = Association[{}]; s = sol[[All, {1, 3}]]; For[i = 1,
i < Length[s], i++,
If[Lookup[acc, s[[i, 2]], 0] == 0,
acc[s[[i, 2]]] = s[[i, 1]]]]; final =
Rest[Sort[Normal[acc]]] /. Rule -> List;
bcc = Association[{}]; For[i = Max[Keys[acc]], i >= Min[Keys[acc]], i--,
j = i; While[Lookup[acc, j, 0] == 0 && j < Max[Keys[acc]], j++];
bcc[i] = acc[j]; j = i; While[bcc[j] >= bcc[j + 1], j++];
bcc[i] = Min[bcc[i], bcc[j]]]; bb =
Rest[Sort[Normal[Reverse[bcc]]]] /. Rule -> List (* Xianwen Wang, Jun 02 2023 *)
|
