內容 ：
由於阿許吹的哨聲根本沒人聽懂，
所以到現在他還是迷失在深山中。
此時，
同樣在深山迷路的小綠跟阿波出現了！
小綠說：阿許！原來是你在吹哨！我還想說是什麼奇怪的聲音呢！
阿波說：哈哈你連哨子都不會吹，求救的哨音應該是幾個短音幾個長音吧 ... 順序我也忘了耶！
這時三個人拿著哨子不知如何是好，請你幫幫忙吧！
給你 n 個短音 m 個長音，輸出這個哨音的所有吹法。
輸入說明 ：
每組測試資料包含兩個整數 n, m 。( 0 ≤ n, m ≤ 10 )
輸出說明 ：
請輸出 n 個短音 m 個長音的所有排法，
每組輸出之間保留一空行。
範例輸入 ：
2 1
3 2
範例輸出 ：
SSL
SLS
LSS
SSSLL
SSLSL
SSLLS
SLSSL
SLSLS
SLLSS
LSSSL
LSSLS
LSLSS
LLSSS
挑了個看似簡單的題目
回覆刪除花了兩個晚上卻還是不知道如何一一列出...
想討教一下
佑好，
回覆刪除1.先找出可以做的題目，慢慢累積功力。
2.這類的排類組合的確是略難了些，但是，先做下列的題目:
.找出1000~9999中的不重複數字的4位數。
->這題可以用for-next迴圈來做，加上小小判斷就行。
.以abcd這樣四個字，找出所有的排列。
3.類似遞迴的功力，你們的學長-阿揚-很強的，可以找時間問他哦。
以abcd的排序為例，用兩個listbox來當輸出使用。
回覆刪除Private Sub Command1_Click()
x = "abcd"
List1.AddItem ""
For i = 1 To Len(x)
For j = 0 To List1.ListCount - 1
y = List1.List(j)
For k = 1 To Len(x)
p = Mid(x, k, 1)
If InStr(y, p) = 0 Then
List2.AddItem y & p
End If
Next k
Next j
' replace list1,list2
List1.Clear
'Print List2.ListCount
For j = 0 To List2.ListCount - 1
List1.AddItem List2.List(j)
Next j
List2.Clear
Next i
End Sub
寫了之後，就很難剎車。
回覆刪除小小改了之後，就是這題的解了，(不過，輸出入沒改)
Private Sub Command1_Click()
x = "LLLSS"
m = 3: n = 2
List1.AddItem ""
For i = 1 To Len(x)
For j = 0 To List1.ListCount - 1
y = List1.List(j)
For k = 1 To Len(x)
p = Mid(x, k, 1)
'If InStr(y, p) = 0 Then
List2.AddItem y & p
'End If
Next k
Next j
' replace list1,list2
List1.Clear
'Print List2.ListCount
For j = 0 To List2.ListCount - 1
y = List2.List(j)
rep = False
For k = 0 To List1.ListCount - 1
If y = List1.List(k) Then rep = True
Next k
If rep <> True Then List1.AddItem y
Next j
List2.Clear
Next i
'count m=3L, n= 2S
For j = 0 To List1.ListCount - 1
xm = 0: xn = 0
y = List1.List(j)
For k = 1 To Len(y)
If Mid(y, k, 1) = "L" Then xm = xm + 1
If Mid(y, k, 1) = "S" Then xn = xn + 1
Next k
If xm = m And xn = n Then List2.AddItem y
Next j
End Sub
在 list2裡的，就是答案的組合了
不易懂。
回覆刪除之後要返回來看這題。
再試看看。
一定會變簡單的:D
Dim s, mosts, K As String
回覆刪除Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Input #1, n1, n2
For i = 1 To n1
K = K & "S" & " "
Next
For i = 1 To n2
K = K & "L" & " "
Next
Do
If Right(K, 1) = " " Then K = Left(K, Len(K) - 1)
Loop While Right(K, 1) = " "
s = Split(K)
mosts = Val(n1) + Val(n2)
Call Re("", UBound(s), mosts, n1, n2)
Close #1
Close #2
End
End Sub
Function Re(a, b, c, x, y)
If Len(a) = c Then
Call Checks(a, x, y)
Else
For i = 0 To b
Call Re(a & s(i), UBound(s), c, x, y)
Next
End If
End Function
Function Checks(a, x, y)
Dim Sx, Lx, Gets
For i = 1 To Len(a)
Gets = Mid(a, i, 1)
If Gets = "S" Then Sx = Sx + 1
If Gets = "L" Then Lx = Lx + 1
Next
If Sx = x And Lx = y Then Call Myadd(a)
End Function
Function Myadd(a)
Dim ch As Boolean
ch = True
For i = 0 To List1.ListCount
If List1.List(i) = a Then ch = False: Exit For
Next
If ch = True Then List1.AddItem a: Print #2, a
End Function
Dim TS As Integer
回覆刪除Dim TL As Integer
Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Do While Not EOF(1)
List1.Clear
List2.Clear
N = ""
Input #1, TS, TL
For i = 1 To TS
List1.AddItem "S"
Next i
For i = 1 To TL
List1.AddItem "L"
Next i
For i = 0 To List1.ListCount
N = N & List1.List(i)
Next i
List2.AddItem N
Call Ch("", List2.List(0))
For i = 0 To List2.ListCount - 1
Print #2, List2.List(i)
Next i
Print #2,
Loop
Close #2
Close #1
End
End Sub
Function Ch(ans, st)
If Len(ans) = Len(st) Then
Call re(ans)
Else
For i = 0 To (List1.ListCount - 1)
Call Ch(ans & List1.List(i), st)
Next i
End If
End Function
Function re(B)
p = False
For i = 0 To List2.ListCount
If B = List2.List(i) Then p = True
Next i
S = 0
L = 0
For i = 1 To Len(B)
If Mid(B, i, 1) = "S" Then S = S + 1
If Mid(B, i, 1) = "L" Then L = L + 1
Next i
If S > TS Or L > TL Then p = True
If p = False Then List2.AddItem B
End Function
留言消失了=口=
arro，佑好，
回覆刪除兩個的程式應該是正確的，終於，經過幾個月後，這一題，會寫了。
佑，一個小習慣，你在最後的function re(b)中，特意用了一個boolean變數來記錄是不是重複，但是你想得到的是false，我覺得可以反過來，想得到的是個true，於是那一行
if not p then
就可以寫成
if p then
(好像寫的有些吹毛求疵，哈，算了，當我沒說好了)
Dim C, ans
回覆刪除Dim S(20)
Dim t1(9)
Dim t2(9)
Private Sub Form_Load()
Me.Hide
Open App.Path & "\out.txt" For Output As #2
Open App.Path & "\in.txt" For Input As #1
Input #1, m, n
t = Split("A B C D E F G H I J")
For i = 0 To 9
t1(i) = t(i)
Next i
t = Split("1 2 3 4 5 6 7 8 9 0")
For i = 0 To 9
t2(i) = t(i)
Next i
For i = 1 To m
ans = ans & t1(i - 1)
Next i
For i = 1 To n
ans = ans & t2(i - 1)
Next i
For i = 0 To Len(ans) - 1
S(i) = Mid(ans, i + 1, 1)
Next i
Call P("", ans)
For i = 0 To List1.ListCount
For j = i + 1 To List1.ListCount
If List1.List(j) <> "0" And List1.List(j) = List1.List(i) Then List1.List(j) = ""
Next j
If List1.List(i) <> "" Then print #2,List1.List(i)
Next i
Close #1
Close #2
End
End Sub
Function P(a, b)
lb = Len(b)
If Len(a) = lb Then
For i = 1 To Len(a)
x = Mid(a, i, 1)
If x <= "0" Or x >= "9" Then a = Replace(a, x, "L", 1, 1)
If x <= "A" Or x >= "J" Then a = Replace(a, x, "S", 1, 1)
Next i
List1.AddItem a
Else
For i = 0 To lb - 1
v = S(i)
If InStr(a, S(i)) = 0 Then Call P(a & S(i), b)
Next i
End If
End Function
---------------------------------
in.txt
4 2
---------------------------------
out.txt
LLSSSS
LSLSSS
LSSLSS
LSSSLS
LSSSSL
SLLSSS
SLSLSS
SLSSLS
SLSSSL
SSLLSS
SSLSLS
SSLSSL
SSSLLS
SSSLSL
SSSSLL
Dim S, L
回覆刪除Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Do While Not EOF(1)
List1.Clear
Input #1, S, L
Call A1(S, L)
Loop
Close
Close
End
End Sub
Sub A1(a, b)
Print #2, " "
Call A2(a + b, "")
For i = 0 To List1.ListCount - 1
Print #2, List1.List(i)
Next
End Sub
Sub A2(a, b)
Dim D(2), SS, LL
D(1) = "S": D(2) = "L"
If a = Len(b) Then
For i = 1 To a
m = Mid(b, i, 1)
If m = "S" Then SS = SS + 1
If m = "L" Then LL = LL + 1
Next
If SS = S Or LL = L Then
cc = 0
For x = 0 To List1.ListCount - 1
If List1.List(x) = b Then cc = 1
Next
If cc = 0 Then List1.AddItem b
End If
Else
For i = 1 To 2
Call A2(a, b & D(i))
Next
End If
End Sub
6:27