|
|
http://mathworld.wolfram.com/CantorDust.html
http://mathworld.wolfram.com/BoxFractal.html
http://mathworld.wolfram.com/StringRewritingSystem.html
!'String Rewriting System
INPUT PROMPT "LEVEL=":LEV !' (1<=LEV<=5)
DIM A(3^LEV,3^LEV),B(3^LEV,3^LEV),P(3,3),Q(3,3)
RESTORE 5
READ A(1,1) !'初期値
MAT READ P,Q
1 DATA 1 !'Cantor Dust
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,0,1
DATA 0,0,0
DATA 1,0,1
2 DATA 1
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0
3 DATA 0 !'Cantor Square Fractal
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0
!'
DATA 1,1,1
DATA 1,1,1
DATA 1,1,1
4 DATA 0 !'Haferman Carpet
DATA 1,1,1
DATA 1,1,1
DATA 1,1,1
!'
DATA 0,1,0
DATA 1,0,1
DATA 0,1,0
5 DATA 1 !'Box Fractal
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,0,1
DATA 0,1,0
DATA 1,0,1
6 DATA 1 !'格子
DATA 0,1,0
DATA 1,0,1
DATA 0,1,0
!'
DATA 1,0,1
DATA 0,1,0
DATA 1,0,1
7 DATA 1
DATA 1,1,1
DATA 0,0,0
DATA 1,1,1
!'
DATA 1,0,1
DATA 1,0,1
DATA 1,0,1
8 DATA 0
DATA 1,1,1
DATA 1,0,1
DATA 1,1,1
!'
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
9 DATA 1 !'Sierpinski Carpet
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,1,1
DATA 1,0,1
DATA 1,1,1
10 DATA 1
DATA 0,0,0
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,1,1
DATA 0,0,0
DATA 1,1,1
11 DATA 0
DATA 1,1,1
DATA 1,1,1
DATA 1,1,1
!'
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0
LET M=1
FOR N=1 TO LEV
FOR I=1 TO M
FOR J=1 TO M
SELECT CASE A(I,J)
CASE 0
FOR K=1 TO 3
FOR L=1 TO 3
LET B((I-1)*3+K,(J-1)*3+L)=P(K,L)
NEXT L
NEXT K
CASE 1
FOR K=1 TO 3
FOR L=1 TO 3
LET B((I-1)*3+K,(J-1)*3+L)=Q(K,L)
NEXT L
NEXT K
END SELECT
NEXT J
NEXT I
MAT A=B
LET M=M*3
NEXT N
SET WINDOW 0,1,1,0
MAT PLOT CELLS, IN 0 , 0 ; 1,1 : A
END
---------------------------------------------------------------------------------------------------
PUBLIC NUMERIC P(3,3),Q(3,3)
INPUT PROMPT "LEVEL=":LEV !' LEV=1～4
DIM A(3,3)
MAT READ P,Q
MAT A=Q !'初期値
DATA 0,0,0 !'Cantor Dust
DATA 0,0,0
DATA 0,0,0
!'
DATA 1,0,1
DATA 0,0,0
DATA 1,0,1
SET WINDOW 0,1,1,0
SET AREA COLOR 4
PLOT AREA :0,0;0,1;1,1;1,0
CALL RECURSIVE(LEV,A,0,0,1,1,1/3)
END
EXTERNAL SUB RECURSIVE(N,A(,),XS,YS,XE,YE,H)
IF N>0 THEN
FOR K=0 TO 2
FOR L=0 TO 2
IF A(K+1,L+1)=0 THEN
CALL RECURSIVE(N-1,P,XS+L*H,YS+K*H,XS+L*H+H,YS+K*H+H,H/3)
ELSE
CALL RECURSIVE(N-1,Q,XS+L*H,YS+K*H,XS+L*H+H,YS+K*H+H,H/3)
END IF
NEXT L
NEXT K
ELSE
MAT PLOT CELLS, IN XS,YS ; XE,YE : A
END IF
END SUB
|
|