数独をテーマにしているゼミ生がいる．
当初は数独の難易度を測定する尺度を作れないか，
などといったことを夢見ていたが，
当人がそもそも数独を趣味にしていないようなので
そういった食指は動かなかったようだ．
じゃぁ何する，ってことになって，
そもそも数独は何通りあるのかをテーマにしようとなった．
もちろん参考書は↓
けれど，数の並べ替えだけで9!＝362880あり，
更に盤の９色色分けの方法を考えると...と，ちょっと想像しただけでも手作業は無理．
しかし当人にプログラミング力があるわけでもなく，
そうすると人力でできるよう問題を簡単にするわけで，
数独likeなものとして４×４盤の４独を考えよう，となった．
実は４独盤は288通りだということが分かっていて，
４独盤集合を不変にする変換群（４独群と呼ぶことにしようか）
の位数も128と知られている．
（実際下に載せるBASICでしらみつぶしに調べたら128個だったし．）
これなら何とか形になるかも，と変換群の生成元をまずは固定して，
４独盤集合内の４独群の軌道を調べる，といったことを始めた．
で当人，手作業で盤を書いては試し書いては試しを繰り返していて，
何だかとても知的作業のように思えない．
いや，こうして泥臭い経験をする中から見えてくるものがあるわけだけど，
そして実際当人にも何か感覚的に見えてくるものがあったとのことだけど，
それにしても卒論提出間近にやる作業には思えない．
で，学生の卒論に託けて，４独群のシミュレーターをScratchで作ってみた．
４独変換群は３つの生成元で生成されることまでは卒論で示してあるので，
その３つの作用が動的に見えるようにしたものだ．
[4DOKU Group Simulator]
↓大変重いので，Turbo mode（Shiftキー押しながら緑の旗をクリック）で実行を．
そして，当然のことながら4DOKU Groupの「形」を見たいと思い，
幸い３つの元で生成されているからそのCayley Graphを3Dで表示してみた．
[Cayley Graph of 4DOKU Group]
↓大変重いので，Turbo mode（Shiftキー押しながら緑の旗をクリック）で実行を．
しかし，下地となるCayley graphの接続状況などすべてScratchで行うのはちょいと厳しい．
ってことで，10進BASICでそのあたりはゴニョゴニョっと．
DIM bd$(1 TO 4,1 TO 128),pm$(1 TO 23),typ$(1 TO 12),cg(1 TO 3,1 TO 128)
DATA "1243","1324","1342","1423","1432","2134","2143","2314","2341","2413","2431"
DATA "3124","3142","3214","3241","3412","3421","4123","4132","4213","4231","4312","4321"
FOR k=1 TO 23
READ pm$(k)
NEXT k
DATA "1234341221434321","1234342121434312","1234342143122143","1243341221344321"
DATA "1243342123144132","1243341243212134","1234341223414123","1234341241232341"
DATA "1234341243212143","1243342121344312","1243342141322314","1243342143122134"
FOR k=1 TO 12
READ typ$(k)
NEXT k
!LET bd$(1,1)="1234341221434321" !初期盤
LET bd$(1,1)="123456789abcdefg" !初期盤
LET bd$(2,1)="" !単位元
LET top=1
LET btm=1
LET idx=btm
PRINT USING "### [################] <#####################":idx,bd$(1,1),bd$(2,1)
DO
PRINT "----";top;" to ";btm;"----"
FOR k=top TO btm
LET a0$=bd$(1,k)
LET g$=bd$(2,k)
!σ
IF g$(1:1)<>"s" THEN
LET a$=sigma$(a0$)
LET ss=search(a$,idx)
IF ss=0 THEN
LET idx=idx+1
LET bd$(1,idx)=a$
LET bd$(2,idx)="s"&g$
PRINT USING "### [################] <#####################":idx,a$,bd$(2,idx)
LET bd$(3,k)=bd$(3,k)&"s"&STR$(idx)&","
ELSE
LET bd$(3,k)=bd$(3,k)&"s"&STR$(SS)&","
END IF
END IF
!μ
IF g$(1:1)<>"m" THEN
LET a$=mu$(a0$)
LET ss=search(a$,idx)
IF ss=0 THEN
LET idx=idx+1
LET bd$(1,idx)=a$
LET bd$(2,idx)="m"&g$
PRINT USING "### [################] <#####################":idx,a$,bd$(2,idx)
LET bd$(3,k)=bd$(3,k)&"m"&STR$(idx)&","
ELSE
LET bd$(3,k)=bd$(3,k)&"m"&STR$(SS)&","
END IF
END IF
!τ
IF g$(1:1)<>"t" THEN
LET a$=tau$(a0$)
LET ss=search(a$,idx)
IF ss=0 THEN
LET idx=idx+1
LET bd$(1,idx)=a$
LET bd$(2,idx)="t"&g$
PRINT USING "### [################] <#####################":idx,a$,bd$(2,idx)
LET bd$(3,k)=bd$(3,k)&"t"&STR$(idx)&","
ELSE
LET bd$(3,k)=bd$(3,k)&"t"&STR$(SS)&","
END IF
END IF
NEXT k
LET top=btm+1
LET btm=idx
LOOP UNTIL top>btm
PRINT
PRINT
! Cayleyグラフの為の接続状況一覧-----------------
FOR k=1 TO btm
PRINT USING "### [################] <########## <"&REPEAT$("#",40):k,bd$(1,k),bd$(2,k),bd$(3,k)
LET g$=bd$(2,k)
LET ln=1
DO
SELECT CASE g$(1:1)
CASE "s"
LET cg(1,k)=cg(1,k)+ln
CASE "m"
LET cg(2,k)=cg(2,k)+ln
CASE "t"
LET cg(3,k)=cg(3,k)+ln
CASE ELSE
END SELECT
LET g$(1:1)=""
LET ln=ln*1.2
LOOP UNTIL g$=""
NEXT k
PRINT
PRINT
! 各gの12typeへの作用の様子----------------------
FOR k=1 TO btm
LET g$=bd$(2,k)
PRINT USING "[### <"&REPEAT$("#",10)&"] ":k,g$;
LET cr$=""
LET ct=0
FOR t=1 TO 12
LET res$=typ$(t)
FOR l=1 TO LEN(g$)
SELECT CASE g$(l:l)
CASE "s"
LET res$=sigma$(res$)
CASE "m"
LET res$=mu$(res$)
CASE "t"
LET res$=tau$(res$)
CASE else
END SELECT
NEXT l
LET res$=std$(res$)
LET cr$=cr$&USING$("##",t)
IF res$=typ$(t) THEN
LET cr$=cr$&"=O,"
LET ct=ct+1
ELSE
LET cr$=cr$&"=X,"
END IF
NEXT t
LET bd$(4,k)=STR$(ct)
PRINT USING ">## ":bd$(4,k);
PRINT "(";cr$;")"
NEXT k
PRINT
! |X^g|=k となる g の表示--------------------------
FOR t=1 TO 12
LET cr$=""
LET ct=0
FOR k=1 TO btm
IF bd$(4,k)=STR$(t) THEN
LET ct=ct+1
LET cr$=cr$&bd$(2,k)&","
END IF
NEXT k
IF ct>0 THEN
PRINT "{g|X^g|=";t;"}=";ct;"{";cr$;"}"
END IF
NEXT t
!FOR k=1 TO btm
! PRINT bd$(2,k)
!NEXT k
!FOR k=1 TO btm
! PRINT bd$(3,k)
!NEXT k
! Cayleyグラフ描画---------------------------------
! [4]←→[6] [8]↑[5]↓ [a][z]ｚ方向
! [s] zoom in [x] zoom out
LET wmax=8
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 1,1,1
SET TEXT COLOR 8
SET WINDOW -wmax,wmax,-wmax,wmax
LET dt=0.01
LET QX=-0.6
LET QY=-3
LET QZ=1.8
LET OX=3.5
LET OY=7
LET sw=1
DO
mouse poll mx,my,left,right
LET ky$=""
CHARACTER INPUT nowait:ky$
SELECT CASE ky$
CASE "8"
LET dx=MIN(0.1,dx+dt)
CASE "5"
LET dx=MAX(-0.1,dx-dt)
CASE "4"
LET dy=MAX(-0.1,dy-dt)
CASE "6"
LET dy=MIN(0.1,dy+dt)
CASE "a"
LET dz=MIN(0.1,dz+dt)
CASE "z"
LET dz=MAX(-0.1,dz-dt)
CASE "s"
LET wmax=wmax/1.01
CASE "x"
LET wmax=wmax*1.01
CASE " "
LET sw=1-sw
CASE ELSE
END SELECT
SET WINDOW -wmax,wmax,-wmax,wmax
LET QX=QX+dx
LET QY=QY+dy
LET QZ=QZ+dz
LET dx=dx*0.95
LET dy=dy*0.95
LET dz=dz*0.95
IF left=1 THEN
LET OX=mx
LET OY=my
END IF
SET DRAW mode hidden
CLEAR
FOR k=1 TO 128
LET ed$=bd$(3,k)
LET X0=rotX(cg(1,k),cg(2,k),cg(3,k))
LET Y0=rotY(cg(1,k),cg(2,k),cg(3,k))
SET LINE COLOR 1
DRAW circle WITH SCALE(wmax/200)*SHIFT(X0,Y0)
IF sw=1 THEN
PLOT TEXT ,AT X0+wmax/100,Y0 ,USING"<##########":bd$(2,k)
END if
DO UNTIL ed$=""
LET l=POS(ed$,",")
LET idx=VAL(ed$(2:l-1))
IF idx>k THEN
SELECT CASE ed$(1:1)
CASE "s"
LET cl=4
CASE "m"
LET cl=2
CASE "t"
LET cl=3
END SELECT
SET LINE COLOR cl
LET X1=rotX(cg(1,idx),cg(2,idx),cg(3,idx))
LET Y1=rotY(cg(1,idx),cg(2,idx),cg(3,idx))
PLOT LINES: X0,Y0;X1,Y1
END IF
LET ed$(1:l)=""
LOOP
NEXT k
SET DRAW mode explicit
LOOP UNTIL left*right=1
! 一致する盤を探す
FUNCTION search(S$,midx)
LET kk=1
LET search=0
DO
IF bd$(1,kk)=S$ THEN
LET search=kk
LET kk=midx
END IF
LET kk=kk+1
LOOP UNTIL kk>midx
END FUNCTION
! 作用σ
FUNCTION sigma$(i$)
LET a$=i$
LET b$=a$(5:8)
LET a$(5:8)=""
LET sigma$=b$&a$
END FUNCTION
! 作用μ
FUNCTION mu$(i$)
LET a$=i$
LET b$=a$(9:16)
LET a$(9:16)=""
LET mu$=b$&a$
END FUNCTION
! 作用τ
FUNCTION tau$(i$)
LET a$=i$(1:1)&i$(5:5)&i$(9:9)&i$(13:13)
LET a$=a$&i$(2:2)&i$(6:6)&i$(10:10)&i$(14:14)
LET a$=a$&i$(3:3)&i$(7:7)&i$(11:11)&i$(15:15)
LET tau$=a$&i$(4:4)&i$(8:8)&i$(12:12)&i$(16:16)
END FUNCTION
! 盤の標準化
FUNCTION std$(i$)
LET s$="1234"
LET v=VAL(i$(1:1))
LET s$(v:v)=STR$(1)
LET v=VAL(i$(2:2))
LET s$(v:v)=STR$(2)
LET v=VAL(i$(5:5))
LET s$(v:v)=STR$(3)
LET v=VAL(i$(6:6))
LET s$(v:v)=STR$(4)
LET st$=""
FOR kk=1 TO 16
LET v=VAL(i$(kk:kk))
LET st$=st$&s$(v:v)
NEXT kk
LET std$=st$
END FUNCTION
FUNCTION rotX(X,Y,Z)
LET rotX=(X*COS(QZ)+Y*SIN(QZ))*COS(QY)+((X*SIN(QZ)-Y*COS(QZ))*SIN(QX)+Z*COS(QX))*SIN(QY)+OX
END FUNCTION
FUNCTION rotY(X,Y,Z)
LET rotY=(-X*SIN(QZ)+Y*COS(QZ))*COS(QX)+Z*SIN(QX)+OY
END FUNCTION
END
