Re: [問題] 能否有更快的寫法

看板Mathematica作者chungyuandye (養花種魚數月亮賞星星)時間12年前 (2012/02/12 21:06)推噓0(0推 0噓 0→)

留言0則, 0人參與討論串2/2 (看更多)

※ 引述《jurian0101 (Hysterisis)》之銘言： : 在puzzle板分享了問題「翻轉數列」: : : 如果一個數被轉180度後變成另一數，稱為「翻轉數」。例如169 <-> 691, 但 : : 146 就非翻轉數。特別允許翻過來時0在首位，然後將其移除取值。 : : 於是全由1,6,8,9,0組成的數就是翻轉數，記作rev(x) : : 例如 rev(1680) := 0891 := 891 : : 定義數列 <a(n)>, a(1)=1 : : { rev (a(n)) , 若rev(a(n)) 在前面不曾出現 : : a(n+1) = { : : { a(n) + 1 : : 根據定義， <a(n)> 的前幾項是: : : 1, 2, 3, 4, 5, 6, 9, 10, 11, 12, 13, 14, 15, 16, 91, 92, 93, 94, 95, 96, 97, : : 98, 86, 87, 88, 89, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 8, : : 9, 10, 11, 12, 13, ... : : 已知 a(10000) = 5168，求 a(1,000,000) : 我其實還是在借題磨利自己的Mathematica知識， : 最後這題我得到最快的算法是用BitSet作出「是否已經出現過」的判斷，這是速率 : 限制步驟! : - - : start = SessionTime[]; (*計時起點*) : goal = {10^4, 10^5, 10^6, 10^7, 10^8, 10^9}; (*計算目標*) : i = 1; bits = 0; count = 1; (*初始值*) : (*利用五進位原理表出全以0,1,6,8,9組成的數，以及計算其翻轉數*) : revi[i_] := FromDigits[Reverse[IntegerDigits[i, 5] /. {2->4, 4->2}], 5]; : vali[i_] := FromDigits[IntegerDigits[i, 5] /. {2->6, 3->8, 4->9}]; : While[True, (*這裡是個無窮迴圈，等待Break[]*) : (*主要計算只有兩行XD，超Trivial的*) : bits = BitSet[bits, i]; : If[BitGet[bits, revi[i]]==1, : count+=vali[i+1]-vali[i]; i+=1, : count+=1; i=revi[i]]; : (*以下code純做外觀功夫，一並輸出的有運行時間*) : If[count > goal[[1]], : Print[{HoldForm[a[n] = j] /. {n->goal[[1]], j->vali[i] + goal[[1]] - count}, : HoldForm[\[CapitalDelta]t = j] /. j -> (SessionTime[] - start)}]; : If[Length@goal > 1, goal = Drop[goal, {1}], Break[]]; : ] : ] : Output:= : {a[10000]=5168, Δt=0.1562500} : {a[100000]=11624, Δt=0.8593750} : {a[1000000]=610055, Δt=2.9687500} : {a[10000000]=5609228, Δt=16.5937500} : {a[100000000]=3928596, Δt=104.6093750} : {a[1000000000]=806838373, Δt=1541.3437500} : 算法大略是一個線性時間 : 但用C語言即使算到十億都只需數秒 (原文章推文)，那麼Mathematica能否有比 : 上面更快的辦法？ : 我很知道這是完全不同的運作環境，也不是想求Mathematica跑得跟C一樣速度 : (像我是先看到LPH66推BitSet，才發現Mathematica也有相似的做法和速度很快的優點) : 就是一個精益求精的態度^_^ 請大家不吝指教謝謝暴力法 goal={10^4,10^5,10^6,10^7,10^8,10^9}; revQ[x_Integer]:=If[Total@Boole[FreeQ[{1,6,8,9,0},#]&/@ IntegerDigits[x]]==0,1,0] rev[x_]:=FromDigits[Reverse[IntegerDigits[x]]/.{6->9,9->6}]; f[n_]:=Block[{s}, Clear[s];s[z_]=0;s[1]=1; NestList[{#[[2]],If[revQ[#[[2]]]==1, If[s[rev[#[[2]]]]==0,s[rev[#[[2]]]]=1;rev[#[[2]]], s[#[[2]]+1]=1;#[[2]]+1], s[#[[2]]+1]=1;#[[2]]+1]}&,{0,1},n-1][[All,2]][[-1]] ] AbsoluteTiming@f[#] & /@ goal[[1 ;; 3]] {{0.365993, 5168}, {3.666442, 11624}, {38.242167, 610055}} Table[AbsoluteTiming@(ans=( (* initial values *) i=1;bits=0;count=1; ans=NestWhile[(temp=BitSet[#[[1]],#[[2]]];Flatten@{temp, If[BitGet[temp,revi[#[[2]]]]==1, {#[[2]]+1,#[[3]]+vali[#[[2]]+1]-vali[#[[2]]]}, {revi[#[[2]]],#[[3]]+1}])&, {0,1,1},#[[3]]<goal[[z]]&]); vali[ans[[2]]]+goal[[z]]-ans[[3]]),{z,5}] {{0.0468750,5168},{0.2812500,11624},{1.0937500,610055}, {6.0781250,5609228},{36.8906250,3928596}} $Version "8.0 for Mac OS X x86 (64-bit) (November 6, 2010)" 時間節省一點～要更快的話，就要用Compile了 -- 養花種魚數月亮賞星星 http://chungyuandye.twbbs.org -- ※ 發信站: 批踢踢實業坊(ptt.cc) ◆ From: 218.173.128.75 ※ 編輯: chungyuandye 來自: 218.173.128.75 (02/12 21:41)