Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12647 / 76734 ←次へ | 前へ→

【69604】Re:再帰処理?について
発言  ichinose@気分は、夏休み  - 11/8/8(月) 11:31 -

引用なし
パスワード
   こんにちは。
私も組合せのコードは書いたことがありますが、私は、再帰にはしていません。
が、今回は再帰からはいりましょう。
但し、途中までしか記述しませんから後は、考えてみてください。


>いくつの数を取り出すのかが分かっていれば、for文を入れ子にすればできますが、いくつ取り出すかは実行する際に入力できるようにしたいので、再帰呼び出しになるのかと思いますが、調べても分かりません。
このFor文の入れ子というのは・・・・、

新規ブックにて、標準モジュールに

'=========================================
Sub test1()
  Dim g0 As Long
  Dim g1 As Long
  Dim aaa(1 To 6) As Variant
  Dim myarray As Variant
  Dim ans As Long
  Dim wk As Long
  aaa(1) = 20
  aaa(2) = 30
  aaa(3) = 2
  aaa(4) = 3
  aaa(5) = 5
  aaa(6) = 4
  myarray = get_combinlist_3(aaa())
  ans = 0
  For g0 = LBound(myarray, 2) To UBound(myarray, 2)
    wk = 0
    For g1 = LBound(myarray) To UBound(myarray)
     wk = wk + myarray(g1, g0)
    Next
    If wk > ans Then ans = wk
  Next
  MsgBox "Max = " & ans
  Erase aaa(), myarray
End Sub
'=====================================================
Function get_combinlist_3(ByVal myarray As Variant) As Variant
  Dim g0 As Long
  Dim g1 As Long
  Dim g2 As Long
  Dim g3 As Long
  Dim ans() As Variant
  For g0 = LBound(myarray) To UBound(myarray)
    For g1 = g0 + 1 To UBound(myarray)
     For g2 = g1 + 1 To UBound(myarray)
       On Error Resume Next
       g3 = UBound(ans(), 2)
       If Err.Number <> 0 Then
        g3 = 0
       End If
       On Error GoTo 0
       ReDim Preserve ans(1 To 3, 1 To g3 + 1)
       ans(1, UBound(ans, 2)) = myarray(g0)
       ans(2, UBound(ans, 2)) = myarray(g1)
       ans(3, UBound(ans, 2)) = myarray(g2)
     Next
    Next
  Next
  get_combinlist_3 = ans()
  Erase ans()
End Function

上記のget_combinlist_3は、nC3の数の組合せリストを配列として
返す Functionです。
test1でその中の最大値を調べています。
(標本数は、増えても大丈夫です)


これを nCr の抜取数rもパラメータで渡せるようにするとなると、
記述されたように再帰プログラムが考えられますね!!
一例ですが・・・、

新規ブックの標準モジュールに
'===================================================================
Sub test2()
  Dim g0 As Long
  Dim g1 As Long
  Dim aaa(1 To 6) As Variant
  Dim myarray As Variant
  Dim ans As Long
  Dim wk As Long
  Const 抜取数 = 3
  aaa(1) = 20
  aaa(2) = 30
  aaa(3) = 2
  aaa(4) = 3
  aaa(5) = 5
  aaa(6) = 4
  myarray = get_combinlist(aaa(), 抜取数)
  ans = 0
  For g0 = LBound(myarray, 2) To UBound(myarray, 2)
    wk = 0
    For g1 = LBound(myarray) To UBound(myarray)
     wk = wk + myarray(g1, g0)
    Next
    If wk > ans Then ans = wk
  Next
  MsgBox "Max = " & ans
  Erase aaa(), myarray
End Sub
'=========================================
Function get_combinlist(ByVal myarray As Variant, ByVal num As Long, Optional ByVal st As Long = 1, Optional ByVal nest As Long = 1) As Variant
  Dim g0 As Long
  Dim g1 As Long
  Static list() As Variant
  Static ans() As Variant
  If nest = 1 Then ReDim list(1 To num)
  For g0 = st To UBound(myarray)
    list(nest) = myarray(g0)
    If nest = num Then
     On Error Resume Next
     g1 = UBound(ans(), 2)
     If Err.Number <> 0 Then
       g1 = 0
     End If
     On Error GoTo 0
     ReDim Preserve ans(1 To num, 1 To g1 + 1)
     For g1 = 1 To num
       ans(g1, UBound(ans, 2)) = list(g1)
     Next
    End If
    If nest < num Then Call get_combinlist(myarray, num, g0 + 1, nest + 1)
  Next
  If nest = 1 Then
    get_combinlist = ans()
    Erase ans()
    Erase list()
  End If
End Function

get_combinlistは、再帰構造になっています。
Const 抜取数 = 3 の値を変更して(上記の標本配列だと、抜取数<=6)
試してみてください。


問題点
今回ご質問ののデータは、標本データとして100個の整数ですよね?

100C2で 4950通り
100C3で 161700
100C4で 3921225
100C5で 75287520
100C6で 1192052400

組合せのリストの配列をこんなに多く作成できるだろうか?
という問題があります。

上記のように
配列にすべての組合せリストを作成する方法ではなく、
別のアルゴリズムで別のインターフェースで対処したほうが
よさそうに思えます。

Get_Combinlistで一つずつ組合せのリストが取得できるようにする
(Line Inputステートメントでテキストファイルの行が順次取得できるような
イメージです)

これを再帰のロジックの変更で行うか?
まったく別のアルゴリズムで行うか?
検討してみてください。

3 hits

【69602】再帰処理?について mitsu 11/8/8(月) 0:48 質問
【69604】Re:再帰処理?について ichinose@気分は、夏休み 11/8/8(月) 11:31 発言
【69605】Re:再帰処理?について ichinose@気分は、夏休み 11/8/8(月) 11:49 発言
【69606】Re:再帰処理?について mitsu 11/8/8(月) 12:25 お礼

12647 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free