順列生成（多段順列）問題（７）の考察２

　順列生成（多段順列）問題（７）の考察２を示します。

問題（７）の考察２

' << MC111.bas >>
' 問題（７）の考察２に基づくプログラム
' Tiny Basic
'
Public P(10,10) ' m段r組合せを保存する配列。
Public N        ' n×nのチェス盤。
Public R        ' r個。 
Public COUNT    ' m段r組合せの個数。
Public COL(10)  ' 列jに置かれている駒数。
Public DOWN(18) ' 左上から右下方向の斜め線。
                ' マス目(i,j)を通る斜め線は、DOWN(i-j+n)
                ' マス目(i,j)に置かれている駒数。
Public UP(19)   ' 左下から右上方向の斜め線。
                ' マス目(i,j)を通る斜め線は、UP(i+j)
                ' マス目(i,j)に置かれている駒数。
'
Do
  ' N,Rの読み込み。
  Read N,R
  If (N <= 0) or (N > 10) Then Exit Do
  Data 6,2
  Data 0,0
  '
  ' 配列Pの初期設定。
  For I=1 To N
    For J=0 To N: P(I,J)=J: Next J
  Next I
  '
  ' 配列COLの初期設定。
  For J=1 To N: COL(J)=0: Next J
  '
  ' 配列UPの初期設定。
  For K=2 To 2*N: UP(K)=0: Next K
  '
  ' 配列DOWNの初期設定。
  For K=1 To 2*N-1: DOWN(K)=0: Next K
  '
  ' 初期設定。
  COUNT=0
  '
  ' m段r組合せ生成。
  Call Mperm(1,0)
  '
  ' 結果の出力
  Print Using"N=## R=##";N;R
  Print "COUNT=";COUNT
Loop
End
'
' D:段数 K:深さ
Sub Mperm(D,K)
  Dim CH$(10,10)
  If D > N Then             
    ' n段r組合せの表示。
    COUNT=COUNT+1
    Print "[";COUNT;"]"
    For I=1 To N
      For J=1 To N: CH$(I,J)="□": Next J
    Next I
    For I=1 To N
      For J=1 To R: CH$(I,P(I,J))="●": Next J
    Next I
    For I=1 To N
      For J=1 To N: Print CH$(I,J);: Next J
      Print
    Next I
    Exit Sub                               
  End If 
  '
  If K = R Then
    '次の段に進む。   
    Call Mperm(D+1,0)
  Else
    ' D段目の組合せ中、
    ' 深さKの節点から深さK+1の子節点 N-K個を生成する。
    For I=K+1 To N  
      T=P(D,I)
      '
      ' 各段の要素は昇順。降順の場合、次の要素に進む。
      If P(D,K) > T Then Goto *LAB
      '
      ' 縦,横,斜めで指定された駒数を超えている場合、次の要素に進む。 
      If COL(T) >= R Then Goto *LAB
      If UP(D+T) >= R Then Goto *LAB
      If DOWN(D-T+N) >= R Then Goto *LAB
'
      COL(T)=COL(T)+1
      UP(D+T)=UP(D+T)+1
      DOWN(D-T+N)=DOWN(D-T+N)+1
'
      ' I番目とK+1番目の要素を交換する。
      W=P(D,I): P(D,I)=P(D,K+1): P(D,K+1)=W
      ' 深さK+1の子節点を作成する。
      Call Mperm(D,K+1) 
      ' 交換を戻す。          
      W=P(D,I): P(D,I)=P(D,K+1): P(D,K+1)=W
'
      COL(T)=COL(T)-1
      UP(D+T)=UP(D+T)-1
      DOWN(D-T+N)=DOWN(D-T+N)-1
'
    *LAB:
    Next I
  End If
End Sub