Ugly數字

Question

Ugly 數字的定義為：該數之質因數必須為 2, 3 或 5。當然了，依照慣例，1 也算是 Ugly 數字。在此列舉一串數列：1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15這些就是前 11 個 Ugly 數字。 輸入檔說明讀入某一數字 N ，並且列印出第 N'th 個 Ugly 數字。限制：此 N 為整數，1 < =N < =1500以0代表檔案結束輸出檔說明列印出第 N'th 個 Ugly 數字範例輸入505001500 0範例輸出243937500859963392

可以說明一下原理嗎

Answer 1

'質因數必須【僅有】為 2, 3 或 5
Function TestUgly(n as long) as boolean
ugly=true
do While (n>1 and ugly)
if n mod 2=0 then
n =n/2
ugly=true
elseif n mod 3=0 then
n =n/3
ugly=true
elseif n mod 5=0 then
n =n/5
ugly=true
else
ugly=false
end if
Testugly=ugly
End Function

Function NthofUgly(n as integer) as long
Dim i as long,k as integer
k=0
i=0
while k i=i+1
if (i=1) or testugly(i) then
k=k+1 '這是第k個Ugly-數字為i
end if
Wend
NthofUgly=i '傳出第n個Ugly
End Function

'Start 程式主體，輸出入的檔案開啟部分不確定VB是否如此撰寫
Open "InputFile" for input as #1
Open "OutputFile" for output as #2
While not eof(1)
n=Input(#1)
if n=0 then
close #1
close #2
else
Print #2,NthUgly(n)
end if
Wend

'===============================
'第二種解法，速度快，需要陣列
n=1500 '要求第幾個的
Dim a()
c2=int(n^0.5)+1
c3=int(c2*(log(2)/log(3)))
c5=int(c2*(log(2)/log(5)))
x=(c5+1)*(c3+1)*(c2+1)
Redim a(x)
i=0
for f5=0 to c5
for f3=0 to c3-f5
for f2=0 to c2-f5*2-f3
a(i)= 2^f2*3^f3*5^f5 '用產生的方法紀錄到陣列中
i=i+1
next
next
next
x=i
'因為紀錄是預測值，沒有依照順序，所以要排序
for i=1 to x
for j=i to 1 step -1
if a(j) k=a(j)
a(j)=a(j-1)
a(j-1)=k
else
exit for
end if
next
next
'a(n) 就是第n個ugly

2005-12-05 13:12:15 補充：
我沒用遞迴，程式修改過了，
再看看

2005-12-06 12:35:17 補充：
我的方法也是從1開始測試，如果是ugly則k=k+1，testugly則是測試一個數字是否為ugly：基本上把2,3,5的因數去掉如果是1就是ugly。

2005-12-06 12:45:04 補充：
我再給一個解答，這一次的速度較快，我測試過第1500個ugly,不到30秒就可以得到。原理則是將可能是的ugly全部放入陣列，排序後就得到了。ugly序列=2^i*3^j*5^k,不同的i,j,k就可以得到不同的ugly，程式碼一開始探索可能的範圍。

Answer 2

從1跑到859963392時間會很久,應該有更快的方法吧?

2005-12-05 16:56:13 補充：
修改下來1500個大約2秒就完成了!!
Dim Str As String, S() As String, Y() As Integer, K() As Double, V As Integer, N() As Integer, Max As Integer
Private Sub Command1_Click()
Dim X As Integer, S1 As String
ReDim N(0): Max = 0
Do
S1 = InputBox("輸入1~1500")
If IsNumeric(S1) Then
S1 = Int(S1)
If Int(S1) > 0 And Int(S1) < 1501 Then
If Max < Int(S1) Then Max = Int(S1)
ReDim Preserve N(X)
N(X) = Val(S1)
X = X + 1
End If
End If
Loop Until S1 = "0"
If N(0) = 0 Then Exit Sub
Str = "235": V = 1: ReDim K(V): K(V) = 1
Max = Max * (Len(Str) + 0.5)
RaArr 0
For X = 0 To UBound(N)
Print N(X); K(N(X))
Next
End Sub

Sub RaArr(L As Integer)
Dim I As Integer, J As Integer, Tm As Double
ReDim S(L): ReDim Y(L)
For I = 0 To L
S(I) = Str: Y(I) = 1
Next
RaCal
If V < Max Then
L = L + 1
RaArr L
Else
For I = 1 To UBound(K)
For J = I To 1 Step -1
If K(J) < K(J - 1) Then
Tm = K(J)
K(J) = K(J - 1)
K(J - 1) = Tm
Else
Exit For
End If
Next
Next
End If
End Sub

Sub RaCal()
Dim I As Integer, T As Double, R As Integer, U As Integer
U = UBound(S)
Do
T = 1
For I = 0 To U
T = T * CInt(Mid(S(I), Y(I), 1))
Next
V = V + 1
ReDim Preserve K(V)
K(V) = T
If I > U Then I = U
For R = I To 0 Step -1
If Y(R) < Len(S(R)) Then
Y(R) = Y(R) + 1
Exit For
End If
Next
If R < 0 Then Exit Sub
For I = R + 1 To U
Y(I) = Y(I - 1)
Next
Loop
End Sub

Answer 3

目前沒時間回答
就給個小方向
這題很明顯的就是遞迴
要用遞迴深度去求出第幾個ugly數的樣子
其它
等趕工期結束再來想 XD

Answer 4

這題我不太清楚意思所以...
這題也是用地回喔

2005-12-05 11:26:34 補充：
這個程式不對優

Answer 5

你都問演算法的精典題
有空看一下前一篇我回答你的遞廻吧