Re: なんでそうなるの？投稿者：山中和義 投稿日：2012年 2月13日(月)12時34分50秒 |
|
> No.1762[元記事へ] ＧＡＩさんへのお返事です。 > 面白いセル・オートマトンの現象が紹介されていました。（ラングトンの蟻） タートルグラフィックスを使って実装してみました。 ライントレース・ロボットの制御（仮想シミュレーション）、正ｎ角形などの作図などに向いています。 !ラングトンの蟻（Langton's ant） DECLARE EXTERNAL NUMERIC tg.COLOR, tg.STYLE DECLARE EXTERNAL SUB tg.move, tg.moveTo, tg.turn, tg.direction, tg.current LET w=500 !画面の大きさ ※ LET h=400 SET bitmap SIZE w,h !第1象限（整数座標） SET WINDOW 0,w-1,0,h-1 CALL home SUB home !ホームポジション CALL moveTo(INT(w/2),INT(h/2)) !画面中央 CALL direction(0) !右向き 0° END SUB !----------------------- ここまでがサブルーチン DIM Ax(3),Ay(3),Aa(3) !3匹の蟻 A(1),A(2),A(3) LET Ax(1)=INT(w/4) !(x,y) LET Ay(1)=INT(h/4) LET Ax(2)=INT(3*w/4) !(x,y) LET Ay(2)=INT(h/4) LET Ax(3)=INT(w/2) !(x,y) LET Ay(3)=INT(3*h/4) MAT Aa=ZER !右向き 0° LET tg.COLOR=-1 !軌跡を描かない FOR i=1 TO 50000 !試行回数 FOR c=1 TO 3 LET x=Ax(c) LET y=Ay(c) CALL moveTo(x,y) !restore it CALL direction(Aa(c)) ASK PIXEL VALUE (x,y) d !ピクセル（ドット）の色を読み込む IF d>0 THEN !黒点の場合 CALL turn(-90) !右へ SET AREA COLOR 0 !点の色を変更する ELSE !白点 CALL turn(90) !左へ SET AREA COLOR c+1 END IF PLOT AREA: x-1,y-1; x+1,y-1; x+1,y+1; x-1,y+1 !矩形を描く ※3ピクセル CALL move(3) !移動する ※3ピクセル CALL current(x,y,a) !画面からはみ出した場合、向こう側に折り返す LET x=MOD(x,w) LET y=MOD(y,h) LET Ax(c)=x !save it LET Ay(c)=y LET Aa(c)=a NEXT c NEXT i END !タートルグラフィックス（極座標による線画システム） MODULE tg PUBLIC NUMERIC COLOR,STYLE !線色、線種 LET COLOR=1 !黒色 LET STYLE=1 !実線 SHARE NUMERIC CPX,CPY,CA LET CPX=0 !現在位置を原点、現在の向きを０°とする LET CPY=0 LET CA=0 PUBLIC SUB move EXTERNAL SUB move(L) !前に進む (x+L*cosθ,y+L*sinθ) LET x=CPX !現在位置 LET y=CPY LET CPX=CPX+L*COS(RAD(CA)) !移動先を算出する LET CPY=CPY+L*SIN(RAD(CA)) IF COLOR>=0 THEN !色番号が負なら、線は書かない（ペンを上げる） SET LINE COLOR COLOR SET LINE STYLE STYLE PLOT LINES: x,y; CPX,CPY !線を描く END IF END SUB PUBLIC SUB moveTo EXTERNAL SUB moveTo(x,y) !現在位置を(x,y)とする LET CPX=x LET CPY=y END SUB PUBLIC SUB turn EXTERNAL SUB turn(a) !角度aだけ回転する LET CA=MOD(CA+a,360) 
|