|
%I #53 Jul 15 2023 06:26:14
%S 5,98,1068,1068,127185,2728361,15917834,73482154,961700165,961700165,
%T 83322853582,1404948108914,7603192018819,167022179253602,
%U 3550275020220728,5729166542536373,106675272785875442
%N Least k > 0 such that the first n digits of 2^k and 5^k are identical.
%C The number of matching first digits of 2^n and 5^n increases with n and forms the sequence 3,1,6,2,2,7,7,6,6,... which approaches sqrt(10).
%C Numbers are half of the denominator of some convergent to log_10(2). - J. Mulder (jasper.mulder(AT)planet.nl), Feb 03 2010
%C _Xianwen Wang_ guesses that if the length of the continued fraction of m/k is h (where m is the difference between the numbers of digits of 2^k and 5^k), the first h-1 items of the continued fractions of m/k and log_10(2.5) agree. But this guess is not true for the similar sequence A359698. - _Zhao Hui Du_, Jun 06 2023
%H Zhao Hui Du, <a href="/A088995/b088995.txt">Table of n, a(n) for n = 1..1000</a>
%H Zhao Hui Du, <a href="https://zhuanlan.zhihu.com/p/634499178">Chinese page to introduce algorithm for a(n) to prove the guess of _Xianwen Wang_</a>
%H T. Sillke, <a href="http://www.mathematik.uni-bielefeld.de/~sillke/PUZZLES/powers-2-5">Powers of 2 and 5 Puzzle</a>
%e a(2) = 98: 2^98 = 316912650057057350374175801344 and 5^98 = 315544362088404722164691426113114491869282574043609201908111572265625.
%t 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} ]
%t 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} ]
%t 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 *)
%t (* alternate program *)
%t n = 100; $MaxExtraPrecision = n; ans =
%t ContinuedFraction[Log10[5/2], n]; data =
%t Denominator /@
%t Flatten[Table[
%t FromContinuedFraction[Join[ans[[1 ;; p - 1]], {#}]] & /@
%t Range[1, ans[[p]]], {p, 2, n}]]; sol =
%t Select[Table[{k, a = N[FractionalPart[{k Log10[2], k Log10[5]}], n];
%t 10^a, b = RealDigits[10^a][[All, 1]];
%t LengthWhile[Range[Length[b[[1]]]], b[[1, #]] == b[[2, #]] &],
%t 10^a . {-1, 1}, RealDigits[10^a . {-1, 1}][[-1]]}, {k, data}],
%t Abs[#[[-2]]] < 1 &];
%t acc = Association[{}]; s = sol[[All, {1, 3}]]; For[i = 1,
%t i < Length[s], i++,
%t If[Lookup[acc, s[[i, 2]], 0] == 0,
%t acc[s[[i, 2]]] = s[[i, 1]]]]; final =
%t Rest[Sort[Normal[acc]]] /. Rule -> List;
%t bcc = Association[{}]; For[i = Max[Keys[acc]], i >= Min[Keys[acc]], i--,
%t j = i; While[Lookup[acc, j, 0] == 0 && j < Max[Keys[acc]], j++];
%t bcc[i] = acc[j]; j = i; While[bcc[j] >= bcc[j + 1], j++];
%t bcc[i] = Min[bcc[i], bcc[j]]]; bb =
%t Rest[Sort[Normal[Reverse[bcc]]]] /. Rule -> List (* _Xianwen Wang_, Jun 02 2023 *)
%Y Cf. A088935, A010467.
%K base,nonn
%O 1,1
%A _Lekraj Beedassy_, Dec 01 2003
%E Edited by _Robert G. Wilson v_, Dec 02 2003
%E More terms from J. Mulder (jasper.mulder(AT)planet.nl), Feb 03 2010
%E a(6) and a(7) corrected by _Keith F. Lynch_, May 25 2023
%E a(11), a(13)-a(15), a(17) corrected by _Zhao Hui Du_, Jun 07 2023
|
