String Rewriting System

 投稿者:しばっち  投稿日:2015年10月28日(水)22時10分30秒
  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
 
 

戻る