遊び tokidoki 仕事

数学と音楽と教育と遊び

Top | おしごと | ゼミ | がくせい | すうがく | かがく | きょういく | おんがく | おきにー | Tips | Photo | イベント | ものもう | あれこれ | About

4独のCayley graphを描いてみた by Scratch

数独をテーマにしているゼミ生がいる.
当初は数独の難易度を測定する尺度を作れないか,
などといったことを夢見ていたが,
当人がそもそも数独を趣味にしていないようなので
そういった食指は動かなかったようだ.

じゃぁ何する,ってことになって,
そもそも数独は何通りあるのかをテーマにしようとなった.
もちろん参考書は↓

「数独」を数学する -世界中を魅了するパズルの奥深い世界-

「数独」を数学する -世界中を魅了するパズルの奥深い世界-

けれど,数の並べ替えだけで9!=362880あり,
更に盤の9色色分けの方法を考えると...と,ちょっと想像しただけでも手作業は無理.
しかし当人にプログラミング力があるわけでもなく,
そうすると人力でできるよう問題を簡単にするわけで,
数独likeなものとして4×4盤の4独を考えよう,となった.
実は4独盤は288通りだということが分かっていて,
4独盤集合を不変にする変換群(4独群と呼ぶことにしようか)
の位数も128と知られている.
(実際下に載せるBASICでしらみつぶしに調べたら128個だったし.)

これなら何とか形になるかも,と変換群の生成元をまずは固定して,
4独盤集合内の4独群の軌道を調べる,といったことを始めた.
で当人,手作業で盤を書いては試し書いては試しを繰り返していて,
何だかとても知的作業のように思えない.
いや,こうして泥臭い経験をする中から見えてくるものがあるわけだけど,
そして実際当人にも何か感覚的に見えてくるものがあったとのことだけど,
それにしても卒論提出間近にやる作業には思えない.

で,学生の卒論に託けて,4独群のシミュレーターをScratchで作ってみた.
4独変換群は3つの生成元で生成されることまでは卒論で示してあるので,
その3つの作用が動的に見えるようにしたものだ.

[4DOKU Group Simulator]
↓大変重いので,Turbo mode(Shiftキー押しながら緑の旗をクリック)で実行を.

そして,当然のことながら4DOKU Groupの「形」を見たいと思い,
幸い3つの元で生成されているからそのCayley Graphを3Dで表示してみた.
[Cayley Graph of 4DOKU Group]
↓大変重いので,Turbo mode(Shiftキー押しながら緑の旗をクリック)で実行を.

しかし,下地となるCayley graphの接続状況などすべてScratchで行うのはちょいと厳しい.
ってことで,10進BASICでそのあたりはゴニョゴニョっと.
f:id:okiraku894:20161228135159p:plain

REM
REM [4doku group calculator]
REM ver. 2016/12/23
REM

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 IFIF 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 IFIF 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]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

REM -----------------------------------------------
REM 呼び出し関数
REM -----------------------------------------------

! 一致する盤を探す
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