Yahoo奇摩知識+將於 2021 年 5 月 4 日 (美國東部時間) 終止服務。自 2021 年 4 月 20 日 (美國東部時間) 起，Yahoo奇摩知識+服務將會轉為唯讀模式。其他Yahoo奇摩產品與服務或您的Yahoo奇摩帳號都不會受影響。如需關於Yahoo奇摩知識+ 停止服務以及下載您個人資料的資訊，請參閱說明網頁。

W.J.S.
Lv 7
W.J.S. 發問時間： 電腦與網際網路程式設計 · 1 0 年前

(拋磚引玉)Ugly Number

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

12 個解答

評分
  • ?
    1 0 年前
    最佳解答

    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=120611...

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

    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

    是"串門子排列法",不是『串門子排序法』

    "串門子排列法"只完成一部份

    我已發信給你們

    參考資料： 只快一點點
  • 阿勇
    Lv 5
    1 0 年前

    路過看看.

  • ?
    1 0 年前

    何大 我也要!!

    我是寫得出來

    但是我的處理時間非常之久..

  • Dead‧Drek-Guilty‧Gear
    1 0 年前

    TO:何

    看到何大大寫的程式...

    真的只能說五體投地了!!!

    我也想了解『串門子排序法』

    請問可以也記一份給我嗎??

    2006-11-26 20:24:18 補充：

    TO:何

    原來是這樣子呀@@"

    我還在詢問朋友有沒有聽過，

    原來是何大的自稱專有詞，

    如果可以的話希望可以程式與說明

    可以一起傳給小弟@@"

    最近因為yahoo信箱好像壞了

    所以再麻煩何大

    g78974110@tp.edu.tw 與

    g78974110@yahoo.com.tw

    都傳一份。

    最後還是先感謝何大^^。

  • ?
    1 0 年前

    小女子的能力極度不佳，

    想這題想了兩天，

    想不出要怎麼讓速度加快...

    (我寫的N=1000就掛了=.=)

    各位老大真的都很強!!

    2006-11-23 08:00:43 補充：

    我看了looping老大的解說圖，

    很好懂~ 想程式ing!!

    何爸~可以順便寫上「為什麼叫做『串門子排序法』嗎？」

  • ?
    Lv 5
    1 0 年前

    小弟雖然能力不佳,亦想試著解題..

    但只能安靜到現在...

    各位大大不但能解,速度還不斷提昇..

    實在了得呀!!

  • 世賢
    Lv 7
    1 0 年前

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

  • ?
    Lv 6
    1 0 年前

    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

    參考資料： looping (IRA)
  • ?
    Lv 4
    1 0 年前

    6000的答案是對的!

    10000的答案也是對的!

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

    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=140609...

    這一篇就是我回的...XD

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

    2006-11-19 01:01:50 補充：

    http://paintedover.com/uploads/show.php?loc=0633&f...

    解釋圖在此

    這免費上傳圖檔的服務空間不知道能撐多久

  • Phoenix
    Lv 5
    1 0 年前

    一開始還以為是月島大@@

    原來是WJS大@@

  • 顯示更多回答 (還有 2 個)
還有問題？馬上發問，尋求解答。