置換（Permutation）の計算

　　置換（Permutation）の計算 山中和義 2007/10/30 11:38:21  (修正1回)
　　└つづき 山中和義 2007/10/30 11:39:25  (修正1回)
　　　├サンプル（あみだくじ、カードのシャッフル... 山中和義 2007/10/30 11:42:06  (修正2回)
　　　│└!置換行列 山中和義 2007/10/31 19:32:35 
　　　├!１５パズルをつくる 山中和義 2007/10/30 21:46:16  (修正3回)
　　　└!ルービックキューブ（Rubik'scube、magicc... 山中和義 2007/11/01 21:07:01  (修正1回)
　　　　└つづき 山中和義 2007/11/01 21:10:06  (修正1回)

　　置換（Permutation）の計算 山中和義 2007/10/30 11:38:21  (修正1回) ツリーへ

置換（Permutation）の計算 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/10/30 11:38:21 ** この記事は1回修正されてます

!補助ルーチン
SUB PermPrintOut(A()) !表示する　※標準形（２行ｎ列の行列表記する）
PRINT "┌";
FOR i=1 TO UBOUND(A)
PRINT USING "###": i;
NEXT i
PRINT " ┐"
PRINT "└";
FOR i=1 TO UBOUND(A)
PRINT USING "###": A(i);
NEXT i
PRINT " ┘"
END SUB

SUB PermCyclicPrintOut(A()) !巡回表示する　※(,,…,)
PRINT "(";
FOR i=1 TO UBOUND(A)
PRINT USING "###": A(i);
NEXT i
PRINT " )"
END SUB
SUB PermCyclicMultiplyPrintOut(n,A(,)) !巡回置換の積の表示する　※(,,…,)(,,…,)…(,,…,)
FOR i=1 TO n
IF A(i,2)<0 THEN !終端記号なら（長さ１の置換）、表示しない
ELSE
PRINT "(";
FOR j=1 TO UBOUND(A,2)
IF A(i,j)<0 THEN EXIT FOR !終端記号なら
PRINT USING "###": A(i,j);
NEXT j
PRINT " )";
END IF
NEXT i
PRINT
END SUB

!置換
SUB PermCyclicForm(A(), C(,),n) !巡回置換の積の形へ　※C(n,)…C(2,)C(1,)
DIM flg(100) !作業用
FOR i=1 TO UBOUND(A)
LET flg(i)=i
NEXT i

LET n=0
FOR i=1 TO UBOUND(A)
IF flg(i)>0 THEN !含まれないなら
LET j=1 !長さ

LET k=i !最初の値
DO !リストを作成する　※(4 4)などの長さ１の置換も含む
LET C(n+1,j)=k
LET j=j+1

LET flg(k)=-1 !巡回に含まれる

LET k=A(k) !次をトレースする
LOOP UNTIL k=i !１周するまで
LET C(n+1,j)=-1 !終端記号を付加する

LET n=n+1 !次の組へ
END IF
NEXT i
END SUB
SUB PermIdentity(A()) !恒等置換
FOR i=1 TO UBOUND(A)
LET A(i)=i
NEXT i
END SUB
SUB PermInverse(A(), C()) !逆置換
FOR i=1 TO UBOUND(A)
LET C(A(i))=i
NEXT i
END SUB
FUNCTION PermIsIdentity(A()) !恒等置換か確認する
LET PermIsIdentity=0 !false
FOR i=1 TO UBOUND(A)
IF A(i)<>i THEN EXIT FUNCTION
NEXT i
LET PermIsIdentity=-1 !true
END FUNCTION
SUB PermMultiply(A(),B(), C()) !積AB　※AB≠BA、A(BC)=(AB)C
LET ua=UBOUND(A)
LET ub=UBOUND(B)
IF ua=ub THEN
FOR i=1 TO ua
LET C(i)=A(B(i)) !※合成写像(AB)(i)=A(B(i))
NEXT i
ELSE
PRINT "次元が違います。A=";ua;" B=";ub
STOP
END IF
END SUB
FUNCTION PermSign(A()) !符号を得る　※Π(A(i)-A(j))/(i-j)　1≦i＜j≦n
LET cnt=0 !反転数
FOR i=1 TO UBOUND(A)-1
FOR j=i+1 TO UBOUND(A)
IF A(i)>A(j) THEN LET cnt=cnt+1 !転位なら
NEXT j
NEXT i
IF MOD(cnt,2)=0 THEN LET PermSign=1 ELSE LET PermSign=-1
END FUNCTION

　　└つづき 山中和義 2007/10/30 11:39:25  (修正1回) ツリーへ

Re: 置換（Permutation）の計算 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/10/30 11:39:25 ** この記事は1回修正されてます

つづき

SUB PermTranspositionForm(A(), C(,),n) !互換の積の形へ　※C(n,)…C(2,)C(1,)
DIM tmpA(100)
FOR i=1 TO UBOUND(A) !作業変数へ
LET tmpA(i)=A(i)
NEXT i
LET n=0
FOR i=1 TO UBOUND(A)
FOR j=1 TO UBOUND(A)-1
IF tmpA(j)>tmpA(j+1) THEN !隣接交換
LET tmp=tmpA(j)
LET tmpA(j)=tmpA(j+1)
LET tmpA(j+1)=tmp

LET n=n+1 !次の組へ
LET C(n,1)=j
LET C(n,2)=j+1
LET C(n,3)=-1 !終端記号
END IF
NEXT j
NEXT i
FOR i=1 TO INT(n/2) !反転
FOR j=1 TO 3 !UBOUND(C,2)
LET tmp=C(i,j)
LET C(i,j)=C(n-i+1,j)
LET C(n-i+1,j)=tmp
NEXT j
NEXT i
END SUB

!巡回置換
SUB PermCopy(n,Q(,),A()) !巡回置換の１組を得る
FOR j=1 TO UBOUND(A)
LET A(j)=Q(n,j)
NEXT j
IF Q(n,j)<0 THEN !終端記号なら
ELSE
PRINT "次元が違います。長さ=";j-1
STOP
END IF
END SUB
SUB PermCyclic(C(),A()) !巡回置換の標準形を得る
CALL PermIdentity(A)
FOR i=1 TO UBOUND(C)-1
LET A(C(i))=C(i+1)
NEXT i
LET A(C(i))=C(1)
END SUB
FUNCTION PermCyclicSign(C()) !巡回置換の符号を得る
LET PermCyclicSign=(-1)^(UBOUND(C)-1)
END FUNCTION

!互換
SUB PermTransposition(a,b, C()) !互換の標準形を得る
CALL PermIdentity(C)
LET C(a)=b
LET C(b)=a
END SUB
!-------------------- ここまでがサブルーチン

!main

!A=┌ 1 2 3 4 ┐=(1 2 4 3)　※１行目の順番は固定とする
!　└ 2 4 1 3 ┘
DATA 2,4,1,3 !配列変数の「添え字と値」に対応させる
DIM A(4)
MAT READ A

CALL PermPrintOut(A)
DIM Q5(5,5)
CALL PermCyclicForm(A, Q5,n) !巡回置換の積へ
CALL PermCyclicMultiplyPrintOut(n,Q5)
PRINT PermSign(A) !符号

!B=┌ 1 2 3 4 ┐=(1 2 3)
!　└ 2 3 1 4 ┘
DATA 2,3,1,4
DIM B(4)
MAT READ B

CALL PermPrintOut(B)
CALL PermCyclicForm(B, Q5,n) !巡回置換の積へ
CALL PermCyclicMultiplyPrintOut(n,Q5)
PRINT PermSign(B)

DIM C(4)
CALL PermMultiply(A,B,C) !積AB
CALL PermPrintOut(C)

DIM InvB(4)
CALL PermInverse(B,InvB) !逆置換b
CALL PermPrintOut(InvB)

CALL PermMultiply(B,InvB, C) !Bb=E
CALL PermPrintOut(C)

END

　　　├サンプル（あみだくじ、カードのシャッフル... 山中和義 2007/10/30 11:42:06  (修正2回) ツリーへ

Re: つづき 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/10/30 11:42:06 ** この記事は2回修正されてます

サンプル（あみだくじ、カードのシャッフル）

サブルーチン部分は省略

!main

!５本のあみだくじをつくる

!A=(2 3)(1 2)(3 4)(2 3)(4 5)(3 4)(2 3)

DIM A(5),B(5)
PRINT "1 2 3 4 5" !上から順に、
PRINT "│││││"
CALL PermIdentity(A)
PRINT "│├┤││" !２本目と３本目に横線を引く
CALL PermTransposition(2,3,B)
CALL PermMultiply(B,A, A)
PRINT "││├┤│" !３本目と４本目に
CALL PermTransposition(3,4,B)
CALL PermMultiply(B,A, A)
PRINT "│││├┤" !４本目と５本目に
CALL PermTransposition(4,5,B)
CALL PermMultiply(B,A, A)
PRINT "│├┤││" !２本目と３本目に
CALL PermTransposition(2,3,B)
CALL PermMultiply(B,A, A)
PRINT "││├┤│" !３本目と４本目に
CALL PermTransposition(3,4,B)
CALL PermMultiply(B,A, A)
PRINT "├┤│││" !１本目と２本目に
CALL PermTransposition(1,2,B)
CALL PermMultiply(B,A, A)
PRINT "│├┤││" !２本目と３本目に
CALL PermTransposition(2,3,B)
CALL PermMultiply(B,A, A)
PRINT "│││││"
CALL PermPrintOut(A)

DIM Q(20,20)
CALL PermCyclicForm(A, Q,n) !巡回置換の積へ
CALL PermCyclicMultiplyPrintOut(n,Q)

DIM T(20,3)
CALL PermTranspositionForm(A, T,n) !（隣接）互換の積へ
CALL PermCyclicMultiplyPrintOut(n,T)

!トランプカードのリフルシャッフル（左右のカードを１枚ずつ交互に重ねていく）

LET m=52 !枚数
!１枚目のカードは、１枚目へ
!２枚目のカードは、３枚目へ
!３枚目のカードは、５枚目へ
!　　：
!５２枚目のカードは、５２枚目へ
!のように、移動先を記述する。
DATA 1,3,5,7,9,11,13,15,17,19, 21,23,25,27,29,31,33,35,37,39, 41,43,45,47,49,51
DATA 2,4,6,8,10,12,14,16,18,20, 22,24,26,28,30,32,34,36,38,40, 42,44,46,48,50,52
!LET m=20
!DATA 1,3,5,7,9,11,13,15,17,19, 2,4,6,8,10,12,14,16,18,20
DIM s(m)
MAT READ s

DIM ss(m)
CALL PermIdentity(ss) !初期値

FOR k=1 TO 20 !回数
CALL PermMultiply(s,ss,ss) !シャッフル
PRINT "K=";k
CALL PermPrintOut(ss) !何回か実行すると元に戻る
NEXT k

END

　　　│└!置換行列 山中和義 2007/10/31 19:32:35  ツリーへ

Re: サンプル（あみだくじ、カードのシャッフル... 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/10/31 19:32:35

!置換行列
SUB PermToMatrix(A(), M(,)) !置換行列を得る
MAT M=ZER
FOR i=1 TO UBOUND(A)
LET M(i,A(i))=1
NEXT i
END SUB
SUB PermTranspositionToMatrix(i,j, M(,)) !基本変形を行う基本行列を得る
MAT M=IDN
LET M(i,i)=0
LET M(j,j)=0
LET M(i,j)=1
LET M(j,i)=1
END SUB

!main

!５本のあみだくじをつくる

!A=(2 3)(1 2)(3 4)(2 3)(4 5)(3 4)(2 3)

DIM A(5),B(5,5)
PRINT "1 2 3 4 5" !上から順に、
PRINT "│││││"
FOR i=1 TO UBOUND(A) !CALL PermIdentity(A)
LET A(i)=i
NEXT i
PRINT "│├┤││" !２本目と３本目に横線を引く
CALL PermTranspositionToMatrix(2,3,B) !CALL PermTransposition(2,3,B)
MAT A=B*A !CALL PermMultiply(B,A, A)
PRINT "││├┤│" !３本目と４本目に
CALL PermTranspositionToMatrix(3,4,B)
MAT A=B*A
PRINT "│││├┤" !４本目と５本目に
CALL PermTranspositionToMatrix(4,5,B)
MAT A=B*A
PRINT "│├┤││" !２本目と３本目に
CALL PermTranspositionToMatrix(2,3,B)
MAT A=B*A
PRINT "││├┤│" !３本目と４本目に
CALL PermTranspositionToMatrix(3,4,B)
MAT A=B*A
PRINT "├┤│││" !１本目と２本目に
CALL PermTranspositionToMatrix(1,2,B)
MAT A=B*A
PRINT "│├┤││" !２本目と３本目に
CALL PermTranspositionToMatrix(2,3,B)
MAT A=B*A
PRINT "│││││"
MAT PRINT USING REPEAT$("# ",52): A !CALL PermPrintOut(A)

!トランプカードのリフルシャッフル（左右のカードを１枚ずつ交互に重ねていく）

LET m=52 !枚数
!１枚目のカードは、１枚目へ移動先する
!２枚目のカードは、３枚目へ移動先する
!３枚目のカードは、５枚目へ移動先する
!　　：
!５２枚目のカードは、５２枚目へ移動先する
DATA 1,3,5,7,9,11,13,15,17,19, 21,23,25,27,29,31,33,35,37,39, 41,43,45,47,49,51
DATA 2,4,6,8,10,12,14,16,18,20, 22,24,26,28,30,32,34,36,38,40, 42,44,46,48,50,52
!LET m=20
!DATA 1,3,5,7,9,11,13,15,17,19, 2,4,6,8,10,12,14,16,18,20
DIM s(m)
MAT READ s

DIM x(m,m) !置換行列
CALL PermToMatrix(s,x)

DIM ss(m)
FOR i=1 TO UBOUND(ss) !整列したカードを用意する
LET ss(i)=i
NEXT i

FOR k=1 TO 20 !回数
MAT ss=x*ss !シャッフル
PRINT "K=";k
MAT PRINT USING REPEAT$("## ",m): ss !何回か実行すると元に戻る
NEXT k

END

　　　├!１５パズルをつくる 山中和義 2007/10/30 21:46:16  (修正3回) ツリーへ

Re: つづき 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/10/30 21:46:16 ** この記事は3回修正されてます

!１５パズルをつくる

!main

LET N=4 !縦横の数 N×N
LET N2=N*N !空白のピース番号

DATA 1, 2, 3, 4 !初期値
DATA 5, 6, 7, 8
DATA 9,10,11,12
DATA 15,13,14,16 !※16は空白の意、空白は最後に！
!DATA 13,15,14,16
DIM p(N2) !ピースの配置
MAT READ p

CALL PrintOut(p) !結果を表示する

IF PermSign(p)<0 THEN !パリティチェック
PRINT "解法不能です。"
STOP
END IF

DIM op(N2) !置換で表す
DO
DO
INPUT pNo !移動するピース番号を指定する

IF pNo>0 AND pNo<N2 THEN !ピース番号なら
FOR i=1 TO UBOUND(p) !配置位置へ変換する
IF pNo=p(i) THEN EXIT FOR
NEXT i
LET x=i

IF x>N AND p(x-N)=N2 THEN EXIT DO !１つ上が空白なら移動させる
IF MOD(x,N)<>1 AND p(x-1)=N2 THEN EXIT DO !左
IF MOD(x,N)<>0 AND p(x+1)=N2 THEN EXIT DO !右
IF x<N2-N+1 AND p(x+N)=N2 THEN EXIT DO !下
END IF
LOOP

CALL PermTransposition(pNo,N2, op) !配置上での隣接交換
CALL PermMultiply(op,p,p)

CALL PrintOut(p) !結果を表示する

LOOP UNTIL PermIsIdentity(p)<0 !整列したら

PRINT "完成です！"

SUB PrintOut(p()) !配置を表示する
FOR i=1 TO N2
IF p(i)=N2 THEN PRINT " "; ELSE PRINT USING "###": p(i);
IF MOD(i,N)=0 THEN PRINT
NEXT i
END SUB

END

　　　└!ルービックキューブ（Rubik'scube、magicc... 山中和義 2007/11/01 21:07:01  (修正1回) ツリーへ

Re: つづき 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/11/01 21:07:01 ** この記事は1回修正されてます

!ルービックキューブ（Rubik's cube、magic cube）のシミュレーション

SUB PermIdentity(A()) !恒等置換
FOR i=1 TO UBOUND(A)
LET A(i)=i
NEXT i
END SUB
SUB PermCyclicToMatrix(C(), M(,)) !巡回置換の行列を得る
MAT M=IDN
FOR i=1 TO UBOUND(C)-1
LET M(C(i),C(i))=0
LET M(C(i),C(i+1))=1
NEXT i
LET M(C(i),C(i))=0
LET M(C(i),C(1))=1
END SUB

PICTURE PlotOut !展開図の表示（中央の配置を固定）
SET DRAW mode hidden !ちらつき防止(開始)
CLEAR
DRAW plane(1) WITH SHIFT(3,3) !正面
DRAW plane(9) WITH SHIFT(9,3) !裏面
DRAW plane(17) WITH SHIFT(3,6) !上面
DRAW plane(25) WITH SHIFT(3,0) !下面
DRAW plane(33) WITH SHIFT(0,3) !左面
DRAW plane(41) WITH SHIFT(6,3) !右面
SET DRAW mode explicit !ちらつき防止(終了)
END PICTURE
PICTURE plane(n) !ｎ番目から始まる１面（３×３）を表示する
FOR i=0 TO 3 !前半
SET AREA COLOR INT((B(n+i)-1)/8)+2 !色
DRAW block(STR$(B(n+i))) WITH SHIFT(MOD(i,3),INT(i/3))
NEXT i
SET AREA COLOR INT((n-1)/8)+2 !中央
DRAW block(s$(INT((n-1)/8)+1)) WITH SHIFT(MOD(4,3),INT(4/3))
FOR i=5 TO 8 !後半
SET AREA COLOR INT((B(n+i-1)-1)/8)+2 !色
DRAW block(STR$(B(n+i-1))) WITH SHIFT(MOD(i,3),INT(i/3))
NEXT i
END PICTURE
PICTURE block(n$) !ブロックの表示
PLOT AREA: 0,0; 1,0; 1,1; 0,1
PLOT LINES: 0,0; 1,0; 1,1; 0,1; 0,0 !縁
SET TEXT HEIGHT 0.5 !番号
PLOT TEXT ,AT 0.2,0.2: n$
END PICTURE

!main

SET WINDOW -0.1,1.3, -0.3,1.1!表示領域を設定する

DIM B(48),savB(48) !ブロックの配置
CALL PermIdentity(B) !整列させる
MAT savB=B

DIM s$(7) !メニュー項目
DATA "正","裏","上","下","左","右","１つ戻す"
MAT READ s$

DO
DRAW PlotOut WITH SCALE(0.1) !結果を表示する

LOCATE CHOICE(s$): p !メニューを選択する

IF p=7 THEN
MAT B=savB !戻す
ELSE
MAT savB=B
CALL op(p) !回転する
END IF
PRINT s$(p) !トレース
LOOP

SUB op(p) !操作
IF p=1 THEN RESTORE 100 !各面の回転
IF p=2 THEN RESTORE 200
IF p=3 THEN RESTORE 300
IF p=4 THEN RESTORE 400
IF p=5 THEN RESTORE 500
IF p=6 THEN RESTORE 600

DIM C(4),M(48,48) !巡回置換、置換行列
MAT M=IDN
FOR k=1 TO 5 !５つで１組
MAT READ C !巡回置換を読み込む
CALL PermCyclicToMatrix(C, M) !対応する行列へ
MAT B=M*B !置換
NEXT k
END SUB

　　　　└つづき 山中和義 2007/11/01 21:10:06  (修正1回) ツリーへ

Re: !ルービックキューブ（Rubik'scube、magicc... 返事を書くノートメニュー

山中和義 <drdlxujciw> 2007/11/01 21:10:06 ** この記事は1回修正されてます

つづき

!「正面を右回転」の巡回置換を定義する。
100 DATA 1,3,8,6 !その面　※５つの巡回置換は互いに素のためどの順でもよい
DATA 2,5,7,4
DATA 17,35,32,46 !まわりの面
DATA 18,37,31,44
DATA 19,40,30,41

!「裏面を右回転」の場合
200 DATA 9,11,16,14, 10,13,15,12 !その面
DATA 22,48,27,33, 23,45,26,36, 24,43,25,38 !まわりの面

!「上面を右回転」の場合
300 DATA 17,19,24,22, 18,21,23,20 !その面
DATA 6,46,14,38, 7,47,15,39, 8,48,16,40 !まわりの面

!「下面を右回転」の場合
400 DATA 25,27,32,30, 26,29,31,28 !その面
DATA 1,33,9,41, 2,34,10,42, 3,35,11,43 !まわりの面

!「左側面を右回転」の場合
500 DATA 33,35,40,38, 34,37,39,36 !その面
DATA 1,17,16,25, 4,20,13,28, 6,22,11,30 !まわりの面

!「右側面を右回転」の場合
600 DATA 41,43,48,46, 42,45,47,44 !その面
DATA 3,27,14,19, 5,29,12,21, 8,32,9,24 !まわりの面

END

インデックスへ

EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。

置換（Permutation）の計算	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/30 11:38:21 ** この記事は1回修正されてます
!補助ルーチン SUB PermPrintOut(A()) !表示する　※標準形（２行ｎ列の行列表記する） PRINT "┌"; FOR i=1 TO UBOUND(A) PRINT USING "###": i; NEXT i PRINT " ┐" PRINT "└"; FOR i=1 TO UBOUND(A) PRINT USING "###": A(i); NEXT i PRINT " ┘" END SUB SUB PermCyclicPrintOut(A()) !巡回表示する　※(,,…,) PRINT "("; FOR i=1 TO UBOUND(A) PRINT USING "###": A(i); NEXT i PRINT " )" END SUB SUB PermCyclicMultiplyPrintOut(n,A(,)) !巡回置換の積の表示する　※(,,…,)(,,…,)…(,,…,) FOR i=1 TO n IF A(i,2)<0 THEN !終端記号なら（長さ１の置換）、表示しない ELSE PRINT "("; FOR j=1 TO UBOUND(A,2) IF A(i,j)<0 THEN EXIT FOR !終端記号なら PRINT USING "###": A(i,j); NEXT j PRINT " )"; END IF NEXT i PRINT END SUB !置換 SUB PermCyclicForm(A(), C(,),n) !巡回置換の積の形へ　※C(n,)…C(2,)C(1,) DIM flg(100) !作業用 FOR i=1 TO UBOUND(A) LET flg(i)=i NEXT i LET n=0 FOR i=1 TO UBOUND(A) IF flg(i)>0 THEN !含まれないなら LET j=1 !長さ LET k=i !最初の値 DO !リストを作成する　※(4 4)などの長さ１の置換も含む LET C(n+1,j)=k LET j=j+1 LET flg(k)=-1 !巡回に含まれる LET k=A(k) !次をトレースする LOOP UNTIL k=i !１周するまで LET C(n+1,j)=-1 !終端記号を付加する LET n=n+1 !次の組へ END IF NEXT i END SUB SUB PermIdentity(A()) !恒等置換 FOR i=1 TO UBOUND(A) LET A(i)=i NEXT i END SUB SUB PermInverse(A(), C()) !逆置換 FOR i=1 TO UBOUND(A) LET C(A(i))=i NEXT i END SUB FUNCTION PermIsIdentity(A()) !恒等置換か確認する LET PermIsIdentity=0 !false FOR i=1 TO UBOUND(A) IF A(i)<>i THEN EXIT FUNCTION NEXT i LET PermIsIdentity=-1 !true END FUNCTION SUB PermMultiply(A(),B(), C()) !積AB　※AB≠BA、A(BC)=(AB)C LET ua=UBOUND(A) LET ub=UBOUND(B) IF ua=ub THEN FOR i=1 TO ua LET C(i)=A(B(i)) !※合成写像(AB)(i)=A(B(i)) NEXT i ELSE PRINT "次元が違います。A=";ua;" B=";ub STOP END IF END SUB FUNCTION PermSign(A()) !符号を得る　※Π(A(i)-A(j))/(i-j)　1≦i＜j≦n LET cnt=0 !反転数 FOR i=1 TO UBOUND(A)-1 FOR j=i+1 TO UBOUND(A) IF A(i)>A(j) THEN LET cnt=cnt+1 !転位なら NEXT j NEXT i IF MOD(cnt,2)=0 THEN LET PermSign=1 ELSE LET PermSign=-1 END FUNCTION

Re: 置換（Permutation）の計算	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/30 11:39:25 ** この記事は1回修正されてます
つづき SUB PermTranspositionForm(A(), C(,),n) !互換の積の形へ　※C(n,)…C(2,)C(1,) DIM tmpA(100) FOR i=1 TO UBOUND(A) !作業変数へ LET tmpA(i)=A(i) NEXT i LET n=0 FOR i=1 TO UBOUND(A) FOR j=1 TO UBOUND(A)-1 IF tmpA(j)>tmpA(j+1) THEN !隣接交換 LET tmp=tmpA(j) LET tmpA(j)=tmpA(j+1) LET tmpA(j+1)=tmp LET n=n+1 !次の組へ LET C(n,1)=j LET C(n,2)=j+1 LET C(n,3)=-1 !終端記号 END IF NEXT j NEXT i FOR i=1 TO INT(n/2) !反転 FOR j=1 TO 3 !UBOUND(C,2) LET tmp=C(i,j) LET C(i,j)=C(n-i+1,j) LET C(n-i+1,j)=tmp NEXT j NEXT i END SUB !巡回置換 SUB PermCopy(n,Q(,),A()) !巡回置換の１組を得る FOR j=1 TO UBOUND(A) LET A(j)=Q(n,j) NEXT j IF Q(n,j)<0 THEN !終端記号なら ELSE PRINT "次元が違います。長さ=";j-1 STOP END IF END SUB SUB PermCyclic(C(),A()) !巡回置換の標準形を得る CALL PermIdentity(A) FOR i=1 TO UBOUND(C)-1 LET A(C(i))=C(i+1) NEXT i LET A(C(i))=C(1) END SUB FUNCTION PermCyclicSign(C()) !巡回置換の符号を得る LET PermCyclicSign=(-1)^(UBOUND(C)-1) END FUNCTION !互換 SUB PermTransposition(a,b, C()) !互換の標準形を得る CALL PermIdentity(C) LET C(a)=b LET C(b)=a END SUB !-------------------- ここまでがサブルーチン !main !A=┌ 1 2 3 4 ┐=(1 2 4 3)　※１行目の順番は固定とする !　└ 2 4 1 3 ┘ DATA 2,4,1,3 !配列変数の「添え字と値」に対応させる DIM A(4) MAT READ A CALL PermPrintOut(A) DIM Q5(5,5) CALL PermCyclicForm(A, Q5,n) !巡回置換の積へ CALL PermCyclicMultiplyPrintOut(n,Q5) PRINT PermSign(A) !符号 !B=┌ 1 2 3 4 ┐=(1 2 3) !　└ 2 3 1 4 ┘ DATA 2,3,1,4 DIM B(4) MAT READ B CALL PermPrintOut(B) CALL PermCyclicForm(B, Q5,n) !巡回置換の積へ CALL PermCyclicMultiplyPrintOut(n,Q5) PRINT PermSign(B) DIM C(4) CALL PermMultiply(A,B,C) !積AB CALL PermPrintOut(C) DIM InvB(4) CALL PermInverse(B,InvB) !逆置換b CALL PermPrintOut(InvB) CALL PermMultiply(B,InvB, C) !Bb=E CALL PermPrintOut(C) END

Re: つづき	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/30 11:42:06 ** この記事は2回修正されてます
サンプル（あみだくじ、カードのシャッフル）サブルーチン部分は省略 !main !５本のあみだくじをつくる !A=(2 3)(1 2)(3 4)(2 3)(4 5)(3 4)(2 3) DIM A(5),B(5) PRINT "1 2 3 4 5" !上から順に、 PRINT "│││││" CALL PermIdentity(A) PRINT "│├┤││" !２本目と３本目に横線を引く CALL PermTransposition(2,3,B) CALL PermMultiply(B,A, A) PRINT "││├┤│" !３本目と４本目に CALL PermTransposition(3,4,B) CALL PermMultiply(B,A, A) PRINT "│││├┤" !４本目と５本目に CALL PermTransposition(4,5,B) CALL PermMultiply(B,A, A) PRINT "│├┤││" !２本目と３本目に CALL PermTransposition(2,3,B) CALL PermMultiply(B,A, A) PRINT "││├┤│" !３本目と４本目に CALL PermTransposition(3,4,B) CALL PermMultiply(B,A, A) PRINT "├┤│││" !１本目と２本目に CALL PermTransposition(1,2,B) CALL PermMultiply(B,A, A) PRINT "│├┤││" !２本目と３本目に CALL PermTransposition(2,3,B) CALL PermMultiply(B,A, A) PRINT "│││││" CALL PermPrintOut(A) DIM Q(20,20) CALL PermCyclicForm(A, Q,n) !巡回置換の積へ CALL PermCyclicMultiplyPrintOut(n,Q) DIM T(20,3) CALL PermTranspositionForm(A, T,n) !（隣接）互換の積へ CALL PermCyclicMultiplyPrintOut(n,T) !トランプカードのリフルシャッフル（左右のカードを１枚ずつ交互に重ねていく） LET m=52 !枚数 !１枚目のカードは、１枚目へ !２枚目のカードは、３枚目へ !３枚目のカードは、５枚目へ !　　： !５２枚目のカードは、５２枚目へ !のように、移動先を記述する。 DATA 1,3,5,7,9,11,13,15,17,19, 21,23,25,27,29,31,33,35,37,39, 41,43,45,47,49,51 DATA 2,4,6,8,10,12,14,16,18,20, 22,24,26,28,30,32,34,36,38,40, 42,44,46,48,50,52 !LET m=20 !DATA 1,3,5,7,9,11,13,15,17,19, 2,4,6,8,10,12,14,16,18,20 DIM s(m) MAT READ s DIM ss(m) CALL PermIdentity(ss) !初期値 FOR k=1 TO 20 !回数 CALL PermMultiply(s,ss,ss) !シャッフル PRINT "K=";k CALL PermPrintOut(ss) !何回か実行すると元に戻る NEXT k END

Re: サンプル（あみだくじ、カードのシャッフル...	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/31 19:32:35
!置換行列 SUB PermToMatrix(A(), M(,)) !置換行列を得る MAT M=ZER FOR i=1 TO UBOUND(A) LET M(i,A(i))=1 NEXT i END SUB SUB PermTranspositionToMatrix(i,j, M(,)) !基本変形を行う基本行列を得る MAT M=IDN LET M(i,i)=0 LET M(j,j)=0 LET M(i,j)=1 LET M(j,i)=1 END SUB !main !５本のあみだくじをつくる !A=(2 3)(1 2)(3 4)(2 3)(4 5)(3 4)(2 3) DIM A(5),B(5,5) PRINT "1 2 3 4 5" !上から順に、 PRINT "│││││" FOR i=1 TO UBOUND(A) !CALL PermIdentity(A) LET A(i)=i NEXT i PRINT "│├┤││" !２本目と３本目に横線を引く CALL PermTranspositionToMatrix(2,3,B) !CALL PermTransposition(2,3,B) MAT A=BA !CALL PermMultiply(B,A, A) PRINT "││├┤│" !３本目と４本目に CALL PermTranspositionToMatrix(3,4,B) MAT A=BA PRINT "│││├┤" !４本目と５本目に CALL PermTranspositionToMatrix(4,5,B) MAT A=BA PRINT "│├┤││" !２本目と３本目に CALL PermTranspositionToMatrix(2,3,B) MAT A=BA PRINT "││├┤│" !３本目と４本目に CALL PermTranspositionToMatrix(3,4,B) MAT A=BA PRINT "├┤│││" !１本目と２本目に CALL PermTranspositionToMatrix(1,2,B) MAT A=BA PRINT "│├┤││" !２本目と３本目に CALL PermTranspositionToMatrix(2,3,B) MAT A=BA PRINT "│││││" MAT PRINT USING REPEAT$("# ",52): A !CALL PermPrintOut(A) !トランプカードのリフルシャッフル（左右のカードを１枚ずつ交互に重ねていく） LET m=52 !枚数 !１枚目のカードは、１枚目へ移動先する !２枚目のカードは、３枚目へ移動先する !３枚目のカードは、５枚目へ移動先する !　　： !５２枚目のカードは、５２枚目へ移動先する DATA 1,3,5,7,9,11,13,15,17,19, 21,23,25,27,29,31,33,35,37,39, 41,43,45,47,49,51 DATA 2,4,6,8,10,12,14,16,18,20, 22,24,26,28,30,32,34,36,38,40, 42,44,46,48,50,52 !LET m=20 !DATA 1,3,5,7,9,11,13,15,17,19, 2,4,6,8,10,12,14,16,18,20 DIM s(m) MAT READ s DIM x(m,m) !置換行列 CALL PermToMatrix(s,x) DIM ss(m) FOR i=1 TO UBOUND(ss) !整列したカードを用意する LET ss(i)=i NEXT i FOR k=1 TO 20 !回数 MAT ss=xss !シャッフル PRINT "K=";k MAT PRINT USING REPEAT$("## ",m): ss !何回か実行すると元に戻る NEXT k END

Re: つづき	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/10/30 21:46:16 ** この記事は3回修正されてます
!１５パズルをつくる !main LET N=4 !縦横の数 N×N LET N2=N*N !空白のピース番号 DATA 1, 2, 3, 4 !初期値 DATA 5, 6, 7, 8 DATA 9,10,11,12 DATA 15,13,14,16 !※16は空白の意、空白は最後に！ !DATA 13,15,14,16 DIM p(N2) !ピースの配置 MAT READ p CALL PrintOut(p) !結果を表示する IF PermSign(p)<0 THEN !パリティチェック PRINT "解法不能です。" STOP END IF DIM op(N2) !置換で表す DO DO INPUT pNo !移動するピース番号を指定する IF pNo>0 AND pNo<N2 THEN !ピース番号なら FOR i=1 TO UBOUND(p) !配置位置へ変換する IF pNo=p(i) THEN EXIT FOR NEXT i LET x=i IF x>N AND p(x-N)=N2 THEN EXIT DO !１つ上が空白なら移動させる IF MOD(x,N)<>1 AND p(x-1)=N2 THEN EXIT DO !左 IF MOD(x,N)<>0 AND p(x+1)=N2 THEN EXIT DO !右 IF x<N2-N+1 AND p(x+N)=N2 THEN EXIT DO !下 END IF LOOP CALL PermTransposition(pNo,N2, op) !配置上での隣接交換 CALL PermMultiply(op,p,p) CALL PrintOut(p) !結果を表示する LOOP UNTIL PermIsIdentity(p)<0 !整列したら PRINT "完成です！" SUB PrintOut(p()) !配置を表示する FOR i=1 TO N2 IF p(i)=N2 THEN PRINT " "; ELSE PRINT USING "###": p(i); IF MOD(i,N)=0 THEN PRINT NEXT i END SUB END

Re: つづき	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/11/01 21:07:01 ** この記事は1回修正されてます
!ルービックキューブ（Rubik's cube、magic cube）のシミュレーション SUB PermIdentity(A()) !恒等置換 FOR i=1 TO UBOUND(A) LET A(i)=i NEXT i END SUB SUB PermCyclicToMatrix(C(), M(,)) !巡回置換の行列を得る MAT M=IDN FOR i=1 TO UBOUND(C)-1 LET M(C(i),C(i))=0 LET M(C(i),C(i+1))=1 NEXT i LET M(C(i),C(i))=0 LET M(C(i),C(1))=1 END SUB PICTURE PlotOut !展開図の表示（中央の配置を固定） SET DRAW mode hidden !ちらつき防止(開始) CLEAR DRAW plane(1) WITH SHIFT(3,3) !正面 DRAW plane(9) WITH SHIFT(9,3) !裏面 DRAW plane(17) WITH SHIFT(3,6) !上面 DRAW plane(25) WITH SHIFT(3,0) !下面 DRAW plane(33) WITH SHIFT(0,3) !左面 DRAW plane(41) WITH SHIFT(6,3) !右面 SET DRAW mode explicit !ちらつき防止(終了) END PICTURE PICTURE plane(n) !ｎ番目から始まる１面（３×３）を表示する FOR i=0 TO 3 !前半 SET AREA COLOR INT((B(n+i)-1)/8)+2 !色 DRAW block(STR$(B(n+i))) WITH SHIFT(MOD(i,3),INT(i/3)) NEXT i SET AREA COLOR INT((n-1)/8)+2 !中央 DRAW block(s$(INT((n-1)/8)+1)) WITH SHIFT(MOD(4,3),INT(4/3)) FOR i=5 TO 8 !後半 SET AREA COLOR INT((B(n+i-1)-1)/8)+2 !色 DRAW block(STR$(B(n+i-1))) WITH SHIFT(MOD(i,3),INT(i/3)) NEXT i END PICTURE PICTURE block(n$) !ブロックの表示 PLOT AREA: 0,0; 1,0; 1,1; 0,1 PLOT LINES: 0,0; 1,0; 1,1; 0,1; 0,0 !縁 SET TEXT HEIGHT 0.5 !番号 PLOT TEXT ,AT 0.2,0.2: n$ END PICTURE !main SET WINDOW -0.1,1.3, -0.3,1.1!表示領域を設定する DIM B(48),savB(48) !ブロックの配置 CALL PermIdentity(B) !整列させる MAT savB=B DIM s$(7) !メニュー項目 DATA "正","裏","上","下","左","右","１つ戻す" MAT READ s$ DO DRAW PlotOut WITH SCALE(0.1) !結果を表示する LOCATE CHOICE(s$): p !メニューを選択する IF p=7 THEN MAT B=savB !戻す ELSE MAT savB=B CALL op(p) !回転する END IF PRINT s$(p) !トレース LOOP SUB op(p) !操作 IF p=1 THEN RESTORE 100 !各面の回転 IF p=2 THEN RESTORE 200 IF p=3 THEN RESTORE 300 IF p=4 THEN RESTORE 400 IF p=5 THEN RESTORE 500 IF p=6 THEN RESTORE 600 DIM C(4),M(48,48) !巡回置換、置換行列 MAT M=IDN FOR k=1 TO 5 !５つで１組 MAT READ C !巡回置換を読み込む CALL PermCyclicToMatrix(C, M) !対応する行列へ MAT B=M*B !置換 NEXT k END SUB

Re: !ルービックキューブ（Rubik'scube、magicc...	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/11/01 21:10:06 ** この記事は1回修正されてます
つづき !「正面を右回転」の巡回置換を定義する。 100 DATA 1,3,8,6 !その面　※５つの巡回置換は互いに素のためどの順でもよい DATA 2,5,7,4 DATA 17,35,32,46 !まわりの面 DATA 18,37,31,44 DATA 19,40,30,41 !「裏面を右回転」の場合 200 DATA 9,11,16,14, 10,13,15,12 !その面 DATA 22,48,27,33, 23,45,26,36, 24,43,25,38 !まわりの面 !「上面を右回転」の場合 300 DATA 17,19,24,22, 18,21,23,20 !その面 DATA 6,46,14,38, 7,47,15,39, 8,48,16,40 !まわりの面 !「下面を右回転」の場合 400 DATA 25,27,32,30, 26,29,31,28 !その面 DATA 1,33,9,41, 2,34,10,42, 3,35,11,43 !まわりの面 !「左側面を右回転」の場合 500 DATA 33,35,40,38, 34,37,39,36 !その面 DATA 1,17,16,25, 4,20,13,28, 6,22,11,30 !まわりの面 !「右側面を右回転」の場合 600 DATA 41,43,48,46, 42,45,47,44 !その面 DATA 3,27,14,19, 5,29,12,21, 8,32,9,24 !まわりの面 END