數列 - 拼圖

※ 引述《EIORU ()》之銘言：
: 有一個正整數數列 規則如下 , 起始數字是 X , y*z=X , 且 y<=z
: 則第1個數字為 yz 並排
: 當數列的數字最接近但不足10000時結束
: 將最後一個數字 和 該數字是數列的第幾個 相乘 得出 S Q: 求S最大是多少
: Ex. 1,11,111,337,1337,7191,9799 end S = 9799 x 6 = 58794
: 0 1 2 3 4 5 6
: Ex. 2,12 -> (1)112 (2)26 (3)34 都可以
: (遇到多選時)

看到天使大的推文就想說這題有沒有可能光從條件就估計出最長的數列 (下簡稱鍊)

的上限。

先來看原題解答數列 (黑文於下, |表示把y z分開)

9|999 -> 8|991 -> 7|928 -> 6|496 -> 2|976 -> 19|52 ->
9|88 -> 7|92 -> 6|44 -> 2|64 -> 1|28 -> 2|8 -> 1|6 -> 6

看看趨勢，把每兩項的比寫出來是

1.11, 1.13, 1.22, 2.18, 1.52, 1.98, 1.25, 1.23, 2.44, 2.06, 4.57, 1.75, 2.67

如果順著算的話...鬼才知道第三步得選這個大飛躍的路走...

那倒著算呢，分支數極少、又不需要因數分解可以算很快吧

但是...例如說用紙筆算瘋狂的把9999~9900這一百個數中最長的那些鍊列舉出來

結果你只會找到 9999 (13步) 、9997 和 9992 (12步，12步的鍊還有25個QAQ)

更糟糕的是這一堆計算還是不能排除某個數98xx剛好有14步的鍊...


因此這題就只好就範圍內窮舉了(ie寫程式= =|||)

做法一樣有順著算(很慢)、倒著算(飛快)兩種



Mathematica碼: 傷眼注意 XD

(*空格為幫助閱讀，執行前全拿掉比較不會出錯*)
(*此為倒著算算法*)

Clear[LongestChain];
ID[x_Integer]:=IntegerDigits[x];
FD[x_List]:=FromDigits[x];

LongestChain[n_]:=
LongestChain[x]=
Module[{}, poss=Times@@@
Cases[
Table[
{FD[ID[n][[1;;i]], FD[ID[n][[i+1;;]]]},
{i,1,Quotient[Length@[ID@n],2]}
],
{a_Integer,b_Integer}/;a<=b
];
If[poss=={}, 0, 1 + Max@@(LongestChain/@poss)]
]

LongestChainTrace[n_]:=
LongestChainTrace[n]=
Module[{}, poss=Times@@@
Cases[
Table[
{FD[ID[n][[1;;i]], FD[ID[n][[i+1;;]]]},
{i,1,Quotient[Length@[ID@n],2]}
],
{a_Integer,b_Integer}/;a<=b
];
If[poss=={}, {n}, Prepend[LongestChainTrace[poss[[
Select[Ordering[LongestChain/@poss], #==1&,1][[1]]
]]],n]]
]

(*以100,000為例尋找*)
result = LongestChain/@ Range[100000];

(*列出前三長的chain開頭 (結尾) *)
show = Table[{Flatten@Position[result,Max[result]-i], Max[result]-i},{i,0,2}]

(*想看哪個鍊自行手動^^*)
LongestChainTrace[]


--