LoginSignup
0
0

More than 1 year has passed since last update.

nCr:全組み合わせパターンを返すサブルーチン

Posted at

 VBAで「組み合わせ」つまりnCrの値を出そうとすればワークシート関数一発で出る。
 しかしながら組み合わせの全パターンを表示しようとすると?

 納得のゆくものが見つからなかったので自分で作ることにしました。
 何のためにこんなものを作ったかと申しますと、
データ分析をしていて、重回帰分析の際、目的変数に対してもっとも適合した説明変数の組み合わせを導き出す際に「考えられるパターンを全部適用」という力技をやることも必要だな、ということに気が付き、ならばそういうものをプログラムで導き出すことも必要だろう、とまあそういうことです。

 改良の余地はあるかもしれないけど、とりあえずできました。

メインのサブルーチンはこれ。

Function 詰石(マス数 As Long, 石数 As Long) As Variant

Dim arr_ans As Variant
Dim arr_work() As Boolean

Dim 組み合わせ数 As Long
Dim i As Long, j As Long
Dim p As Long, q As Long
Dim pos As Long
Dim t As Long
Dim ct As Long
Dim flg_右 As Boolean

    組み合わせ数 = WorksheetFunction.Combin(マス数, 石数)
    ReDim arr_ans(1 To 組み合わせ数, 1 To マス数)

    '一番右の列に石を置いて、ロジックを単純化するため、プラス1
    ReDim arr_work(1 To マス数 + 1)
    For t = 1 To マス数
        arr_work(t) = False
    Next t
    arr_work(マス数 + 1) = True
    
    '初期値、石を左に詰める
    For t = 1 To 石数
        arr_work(t) = True
    Next t
    
    For t = 1 To マス数
        arr_ans(1, t) = arr_work(t)
    Next t
    
    For i = 2 To 組み合わせ数
        ct = 0
        flg_右 = True
        For j = マス数 To 1 Step -1
            If arr_work(j) = True Then
                '一番右がTrue 右から詰まっている石の数を数える
                If flg_右 Then
                    ct = ct + 1
                End If
                
                'T,Fの並び
                If arr_work(j + 1) = False Then
                    '(F,Tに入れ替え)
                    arr_work(j) = False
                    arr_work(j + 1) = True
                    
                    'いまずらせた石の右がfalseで
                    If arr_work(j + 2) = False Then
                        '右側に石が詰まっていれば
                        If ct > 0 Then
                            For p = j + 2 To j + 2 + ct
                                arr_work(p) = True
                                pos = p
                            Next p
                            For q = pos To マス数
                                arr_work(q) = False
                            Next q
                    
                        End If
                    End If
                    
                    '少なくとも一回入れ替えたら次の行
                    Exit For
                End If

            Else
                flg_右 = False
                DoEvents

            End If
            DoEvents
        Next j
                    
        For t = 1 To マス数
            arr_ans(i, t) = arr_work(t)
        Next t

    Next i
    
    詰石 = arr_ans

End Function

ドライバはこれ。アクティブシートに石を置いてゆくイメージ

Sub 詰め語()

Const 総数 = 5
Const 抽出 = 2

Dim arr_表 As Variant
Dim i As Long, j As Long

    Cells.Select
    Selection.Clear
    
    arr_表 = 詰石(総数, 抽出)
    
    For i = 1 To UBound(arr_表, 1)
        For j = 1 To UBound(arr_表, 2)
            If arr_表(i, j) Then
                Cells(i, j).Value = "●"
            End If
        Next j
    Next i

End Sub

これを使って5から2つを選ぶ組み合わせを表に展開したらこうなります。
gobang.png

(なぜ5から2にこだわるか?2進法のコンピュータで10進法を表すのに、5から2を選ぶ組み合わせの数が使われたことがあるらしい、から、です。5ビットで数字一桁。)

 nの値+1の配列を作って、一番右をセレクトされた状態にするとアルゴリズムが楽になるかなと思ったけどそうでもないかな?

 これをもとにして、数を指定すれば、すべての説明変数の組み合わせで重回帰分析を実施し、R2値が最も大きいものを上から3つ残す、というマクロも完成しました。


 こんなの作って何やっているかというと「大学入試問題の英語、点を落とす要素はなにか」の探究だったりします。
 模試の問題と結果といった実例が集まれば、採点結果を入力すると「あなたはこの分野の実力が欠けている」というのがわかるようになる、のでは、と思っております。
 進路指導、学習指導にエポックメイキングな効果があるかもしれない。

 2021年の共通テストの自己採点結果、Z会と螢雪時代が出してくれていたので、差異が出ないかといじってみたところ、点数を落とす要因として大きいのはZ会では「カンマの数」と「使用単語レベル」。螢雪時代では「使用単語レベル」と「文の数」。

 比較しやすいように説明変数の標準偏差をとって計算し直すと、Z会と螢雪時代、共通要素である使用単語レベルが足を引っ張る力は、螢雪時代がZ会の(割り算していいのかしら)4.3倍。何となく頷ける結果と見ていいのだろうか。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0