(拋磚引玉)Ugly Number

Question

Ugly Number(醜數)的定義就是指一個數值,其質因數只能有 2 或 3 或 5 ,若還含有其他之質因數就不是Ugly Number如:12 = 2 × 2 × 3 →成立14 = 2 × 7 →不成立15 = 3 × 5 →成立1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15，這些就是前11個醜數,請設計出能求出第N個醜數的程式:如輸入20,輸出36此題若使用暴力法解題,要求出第1500個醜數(859963392)可能要跑個10~30分鐘,因此我朝Ugly=2^X × 3^Y × 5^Z,(X>=0,Y>=0,Z>=0)方向著手,以下是我的程式碼:Dim N%, K#()Private Sub Command1_Click()    N = Int(Val(InputBox("請輸入大於零之整數", "", 2000)))    If N < 1 Then Exit Sub    Cls    D = Timer    Ugly    Text1 = K(N)    Print "費時 : "; Timer - D; " 秒"End SubSub Ugly()    Dim I%, J%, L%, V%, T#, M#, B As Boolean, Y%(), S()        V = 1: ReDim K(V): K(V) = V    Do        ReDim S(L), Y(L)        For I = 0 To L            S(I) = Array(2, 3, 5)        Next        B = True        Do          T = 1          For I = 0 To L              T = T * S(I)(Y(I))          Next          If V > N Then             If T < M Then                V = V + 1: ReDim Preserve K(V): K(V) = T: B = False             Else                Exit Do             End If          Else             V = V + 1: ReDim Preserve K(V): K(V) = T: B = False             If T > M Then M = T          End If          For J = L To 0 Step -1              If Y(J) < 2 Then: Y(J) = Y(J) + 1: Exit For          Next          If J < 0 Then Exit Do          For I = J + 1 To L              Y(I) = Y(I - 1)          Next        Loop        L = L + 1    Loop Until B    For I = 1 To V - 1        For J = I To V            If K(I) > K(J) Then T = K(I): K(I) = K(J): K(J) = T        Next    NextEnd Sub執行結果:第N個使用時間(秒)答案10000.275120000020000.98062156800600010.34081466880000001000027.9(科學記號跑出來了)2.883251953125E+17雖說時間上已進步不少但在Ugly=2^X × 3^Y × 5^Z這運算式中XYZ的安排我還無法抓到規則,導致必須多算出更多的醜數再經過排序後才能找到答案,由於一直無法突破此癥結,所以把問題提出來,望各位先進賜教。PS:第1000個跟第2000個的答案應該沒錯,其他的由於無從求證故不肯定是正確XD;執行環境:P4 3.2G RAM:1G

Answer 1

Private Sub Command1_Click()
　Dim 陣列#(100000), 第N個&, 因數個數&, 乘5&, 乘3&, 乘2&, 指標&, 最大排列&, 醜數#
　第N個 = InputBox("輸入要找第幾個", , 1000)
　時間 = GetTickCount
　Do
　　For 乘5 = 0 To 因數個數
　　　For 乘3 = 0 To 因數個數 - 乘5
　　　　乘2 = 因數個數 - 乘5 - 乘3: 醜數 = 5# ^ 乘5 * 3 ^ 乘3 * 2 ^ 乘2
　　　　最大排列 = 最大排列 + 1: 指標 = 最大排列
　　　　Do Until 醜數 > 陣列(指標 - 1)
　　　　　陣列(指標) = 陣列(指標 - 1): 指標 = 指標 - 1
　　　　Loop
　　　　陣列(指標) = 醜數
　　　　If 乘5 = 0 And 乘3 = 0 And 指標 >= 第N個 Then Exit Do
　　　Next
　　Next
　　因數個數 = 因數個數 + 1
　Loop
　Label1 = (GetTickCount - 時間) / 1000 & " 秒"
　MsgBox (陣列(第N個))
End Sub

2006-11-20 16:09:39 補充：
W.J.S. 大你好
之前有位網有發問醜數問題,我攪錯他的題意,實在抱歉!
看了你的解說才了解,此題不簡單
而看了 looping 題供的資料,了解有更快的方法
我正想再寫一個程式
我是"零"的爸爸,也是"零",當初出我用孩子的帳號

2006-11-21 21:57:41 補充：
Private Sub Command1_Click()　Dim 醜數#(20000), 倍2#(20000), 倍3#(20000), 倍5#(20000)　Dim 指標&, 比2#, 比3#, 比5#, 累2&, 累3&, 累5&, 記累&　醜數(0) = 1　For 指標 = 1 To InputBox("輸入要求第幾個", , 6000) - 1

2006-11-21 21:57:49 補充：
Private Sub Command1_Click()　Dim 醜數#(20000), 倍2#(20000), 倍3#(20000), 倍5#(20000)　Dim 指標&, 比2#, 比3#, 比5#, 累2&, 累3&, 累5&, 記累&　醜數(0) = 1　For 指標 = 1 To InputBox("輸入要求第幾個", , 6000) - 1

2006-11-21 21:59:04 補充：
　　比2 = 2 * 醜數(累2): 比3 = 3 * 醜數(累3): 比5 = 5 * 醜數(累5)　　Select Case -1　　　Case 比2 <= 比3 And 比2 <= 比5: 醜數(指標) = 比2: 記累 = 累2　　　Case 比3 <= 比2 And 比3 <= 比5: 醜數(指標) = 比3: 記累 = 累3　　　Case 比5 <= 比2 And 比5 <= 比3: 醜數(指標) = 比5: 記累 = 累5

2006-11-21 22:00:25 補充：
　　End Select　　If 比2 = 醜數(指標) Then 倍2(指標) = 1 Else 倍2(指標) = 倍2(記累)　　If 比3 = 醜數(指標) Then 倍3(指標) = 1 Else 倍3(指標) = 倍3(記累)　　If 比5 = 醜數(指標) Then 倍5(指標) = 1 Else 倍5(指標) = 倍5(記累)　　累2 = 累2 + 倍2(指標): 累3 = 累3 + 倍3(指標): 累5 = 累5 + 倍5(指標)　Next　Print 醜數(指標 - 1)End Sub

2006-11-21 22:13:17 補充：
W.J.S.大
多了一個補充
2006-11-21 21:57 補充
因我這臺電腦奇摩知識+很慢
所以不小心多按了一下
這次的程式速度及工功能應該可以滿足你的要求.
這次承蒙 looping 大及 愁 大的智慧,否則無法完成.看來我該謙虛一點了.

2006-11-22 18:26:24 補充：
我不敢說我的程式最好,
不過我感覺,集合眾人的智慧,總比一個人單打獨鬥還強
要回答 W 大的問題,要有心理準被備,
要生"不寫病"(不寫程式會難過病),否則很難達成任務
我第二個程式裡有looping 大及 愁 大的靈魂,否則只能停流在第一個程式,要執行好幾秒
以晴
我正再寫"串門子排列法"的說明(word檔)
我稱我的"完全排列"程式為"串門子排列法"程式

2006-11-24 03:42:06 補充：
以晴
"串門子排列法",你要的問題我會寫在檔案裡,但我看到這一題,"不寫病"又發作了,所以"串門子排列法",說明書可能會教較晚完成,完成後我會寄信給你
W.J.S 大,謝謝你,過獎了
我用的是"基因傳承法",但大家再研究看看有沒有更好的方法.

2006-11-24 03:43:11 補充：
TO "不寫病"病友
有好題目,被發問兩次
http://tw.knowledge.yahoo.com/question/?qid=1206112209855

http://tw.knowledge.yahoo.com/question/?qid=1206112302941

2006-11-25 23:58:20 補充：
各位網友:
我所謂的"串門子排列法","基因傳承法","樹狀搜尋法",及"智慧搜尋法"....等等
是我為了方便說明,所取的名詞,不是學術界的專有名詞
Dead‧Drek-Guilty‧Gear
好!,我寫好就給你們兩個.
Dead‧Drek-Guilty‧Gear
你要程式嗎?

2006-11-26 23:23:15 補充：
感謝 W 大採用我的答案.
looping 大及 愁 大,抱歉了,我是搭了你們的便車才奪標的,謝謝你們.
to Dead‧Drek-Guilty‧Gear
你的訊息我已收到,正在趕工中.

2006-11-27 02:18:47 補充：
以晴 ,Dead‧Drek-Guilty‧Gear
是"串門子排列法",不是『串門子排序法』

"串門子排列法"只完成一部份
我已發信給你們

Answer 2

路過看看.

Answer 3

何大 我也要!!
我是寫得出來
但是我的處理時間非常之久..

Answer 4

TO:何
看到何大大寫的程式...
真的只能說五體投地了!!!
我也想了解『串門子排序法』
請問可以也記一份給我嗎??

2006-11-26 20:24:18 補充：
TO:何
原來是這樣子呀@@"
我還在詢問朋友有沒有聽過，
原來是何大的自稱專有詞，
如果可以的話希望可以程式與說明
可以一起傳給小弟@@"
最近因為yahoo信箱好像壞了
所以再麻煩何大
[e-mail] 與
[e-mail]
都傳一份。
最後還是先感謝何大^^。

Answer 5

小女子的能力極度不佳，
想這題想了兩天，
想不出要怎麼讓速度加快...
(我寫的N=1000就掛了=.=)
各位老大真的都很強!!

2006-11-23 08:00:43 補充：
我看了looping老大的解說圖，
很好懂~ 想程式ing!!
何爸~可以順便寫上「為什麼叫做『串門子排序法』嗎？」

Answer 6

小弟雖然能力不佳,亦想試著解題..
但只能安靜到現在...
各位大大不但能解,速度還不斷提昇..
實在了得呀!!

Answer 7

昨天晚上我亦有試著做此題，但做出來的結果卻無法求得所有的Ugly Number(醜數)，看來這個問題也不容易解決呀！

Answer 8

looping: 上啊~~交給你了

2006-11-19 14:48:57 補充：
目前可測到 N = 6465Private Sub Command1_Click()   bt = Timer   n = 6465    '最大極限   ReDim a#(n)   Dim i%, na%, nb%, nc%   Dim tmp$   For i = 0 To n - 1      a(i) = 1   Next   na = 0   nb = 0   nc = 0   For i = 1 To n - 1      a(i) = FindMin(2 * a(na), 3 * a(nb), 5 * a(nc))      tmp = Right(a(i), 1)      If Val(tmp) Mod 2 = 0 Then na = na + 1      If division3(a(i)) Then nb = nb + 1      If tmp = "5" Or tmp = "0" Then nc = nc + 1   Next   Me.Caption = Timer - bt   Print a(n - 1)End SubPublic Function FindMin(ByVal a#, ByVal b#, ByVal c#) As Double   Dim Min As Double   Min = a   If (b < a) Then Min = b   If (c < Min) Then Min = c   FindMin = MinEnd FunctionPublic Function division3(ByVal numstr As String) As Boolean   Dim cnt%, i%   cnt = 0   division3 = False   For i = 1 To Len(numstr)      cnt = cnt + Val(Mid(numstr, i, 1))   Next   If (cnt Mod 3 = 0) Then division3 = TrueEnd Function

Answer 9

6000的答案是對的!
10000的答案也是對的!
http://tw.knowledge.yahoo.com/question/?qid=1406090106085

2006-11-17 22:19:55 補充：
上面的DP法
Athlon 1.2G RAM:256M
第10000個1 sec內可跑完

2006-11-18 01:00:25 補充：
愁痕改寫後把這題收掉好了!因為我已經答過....XD

2006-11-18 07:57:14 補充：
to:W.J.S.
1, 2, 3, 4, 5,....

你對這Ugly Number數列的每一個數同乘上2,3,5得新序列

(2,3,5),(4,6,10),(6,9,15),(8,12,10),(10,15,25),....

它之所以可以如此省
(1)不會計算到非Ugly Number的部份
(2)算完的結果不用排序,儘量壓低重覆的計算部份

2006-11-18 07:57:35 補充：
(*2,#3,$5),(4,6,10),(6,9,15),(8,12,10),(10,15,25),....
get 2
(2,#3,$5),(*4,6,10),(6,9,15),(8,12,10),(10,15,25),....
get 3
(2,3,$5),(*4,#6,10),(6,9,15),(8,12,10),(10,15,25),....
get 4
(2,3,$5),(4,#6,10),(*6,9,15),(8,12,10),(10,15,25),....
get 5

2006-11-19 00:23:57 補充：
http://tw.knowledge.yahoo.com/question/?qid=1406090106085
這一篇就是我回的...XD

重點是由Ugly Number產生Ugly Number如有疑問.我再做圖解.

2006-11-19 01:01:50 補充：
http://paintedover.com/uploads/show.php?loc=0633&f=un001_1.jpg
解釋圖在此
這免費上傳圖檔的服務空間不知道能撐多久

Answer 10

一開始還以為是月島大@@
原來是WJS大@@