パズル万華鏡

面白いパズルの紹介と解説をします。

順列生成(多段順列)問題(3)の考察2

 順列生成(多段順列)問題(3)の考察2を示します。

問題(3)の考察2
f:id:isemba:20200511184711p:plain

' << MP321.bas >>
' ナンバープレース問題の解を見つけるプログラム
' 集合{1,2,…,n}上のm段r部分順列の生成(非辞書式順序)
' Tiny Basic
'
Public P(10,10) ' m段r部分順列を保存する配列。
Public N        ' 集合の要素数。
Public R        ' 部分順列の長さ。 
Public M        ' 段数。
Public BI       ' ブロックの行方向の幅。
PublIc BJ       ' ブロックの列方向の幅。 
Public COUNT    ' 条件を満たす配置の個数。
Public X(10,10) ' 列jに要素yが出現しているとき、x[j][y]=1,
                ' 出現していないとき、x[j][y]=0
Public B(10,10) ' ブロックkに要素yが出現しているとき、b[k][y]=1,
                ' 出現していないとき、b[k][y]=0 
Public Q(10,10) ' 問題を保存する配列。
'
Do
  ' N,R,M,BI,BJの読み込み。
  Read N,R,M,BI,BJ
  If (N <= 0) or (N > 10) Then Exit Do
  '
  ' 問題の読み込み。
  For I=1 To N
    For J=1 To N: Read Q(I,J): Next J
  Next I
  '
  ' データ
  Data 9,9,9,3,3             
  Data 0,0,0,4,3,1,0,6,7     
  Data 7,1,5,2,0,0,9,0,0     
  Data 6,4,0,0,0,0,8,2,1     
  Data 0,5,0,3,0,0,0,0,0     
  Data 3,0,4,0,7,8,1,0,0     
  Data 9,7,8,1,0,0,0,3,0     
  Data 4,3,2,0,0,0,0,0,0     
  Data 0,0,0,0,5,3,0,1,2     
  Data 0,0,0,0,0,2,0,7,0     
  Data 0,0,0,0,0             
  '
  ' 問題の出力。
  Print"ナンバープレース問題"
  For I=1 To M
    For J=1 To R: Print Using"##";Q(I,J);: Next J   
    Print
  Next I
  Print
'
  ' 配列Pの初期設定。
  For I=1 To M
    For J=1 To N: P(I,J)=J: Next J
  Next I
  '
  ' 配列Xの初期設定。                    
  For J=1 To R                    
    For Y=1 To N: X(J,Y)=0: Next Y   
  Next J     
  '
  ' 配列Bの初期設定。                    
  For J=1 To N                    
    For Y=1 To N: B(J,Y)=0: Next Y   
  Next J     
  '
  ' 問題の情報を反映しておく。
  For I=1 To n                   
    For J=1 To N 
      If Q(I,J) > 0 Then
        X(J,Q(I,J))=1    
        S=Int((I-1)/BI)*BI + Int((J-1)/BJ) + 1
        B(S,Q(I,J))=1 
      End If
    Next J
  Next I
  '
  ' 初期設定。                       
  COUNT=0
  '
  ' m段r部分順列生成。
  Call Mperm(1,0)
  '
  ' 結果の出力
  Print Using"N=## R=## M=## BI=## BJ=##";N;R;M;BI;BJ
  Print "解の数=";COUNT
Loop
End
'
' D:段数 K:深さ
Sub Mperm(D,K)
  If D > M Then             
    ' 解の出力
    COUNT=COUNT+1
    Print "[";COUNT;"]"
    For I=1 To M
      For J=1 To R: Print Using"##";P(I,J);: Next J   
      Print
    Next I
    Print
    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)
      '
      ' D段目K+1列に問題の要素がある場合、次の列に進める。
      If Q(D,K+1) = T Then
        ' 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
        Exit Sub
      End If
      '
      ' D段目K+1列に要素Tが重複出現している場合,次の要素に進める。
      If X(K+1,T) = 1 Then Goto *LAB
      '
      S=Int((D-1)/BI)*BI + Int(K/BJ) + 1
      ' ブロックSに要素Tが重複出現している場合,次の要素に進める。
      If B(S,T) = 1 Then Goto *LAB      
      '
      X(K+1,T)=1                                        
      B(S,T)=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
      X(K+1,T)=0      
      B(S,T)=0                                        
    *LAB:
    Next I
  End If
End Sub 

f:id:isemba:20200511184800p:plain
f:id:isemba:20200511184811j:plain