置換（Permutation）の計算

!補助ルーチン
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

置換（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