NetaTaneMenu >>>> 羊歯 >>>> L-system

L-system


:L-system: 「Lindenmayer system」の略称。リンデンマイヤーさんが考えたらしい。ルールに従って成長するあらゆるモデルを扱うための文法体系みたいな感じです。画像は視覚化するため,あるいはこれを利用して造形するために行うだけでL-systemの本質ではありません。下のソースにも幾つか紹介したように,ルールによって数列など様々な物が定義・作成できます。

Lsystem3.png

図は下の十進ベーシックのソースで描いたもの。

ここで見ているL-systemは :使用文字: A,B,C,D,F :定格文字: [.],{,} :初期設定: A :ルール: A→F[B]C,B→C,C→F{D}A,D→A です。

最初に

A

という文字列が与えられます。この文字列を走査しながらルールを適用すれば,

F[B]C

となります。 再度得られた文字列を走査しながらルールを適用すれば,

FはF [も[  Bはルールが適用されてC Cもルールが適用されてF{D}A

となり,(変換のルールに無い文字,ここでは「F」や定格文字は変化しません)

F[C]F{D}A

となります。これを繰り返すわけです。

これを十数回?繰り返したものを「適当な数値を設定して図形的に解釈したら」 上のように見ることもできるっていうわけです。 あくまでもL-system自体は記号の変換体系というわけです。

! L-system program
! L-system structure G=(V,S,O,P)
! V:variables 所謂構成用文字。増やしてもらって結構です。
LET  V$="ABCDEF"
! S:constants 
LET  S$="+-[]{}"
! O:initiator ルールに依存します。
LET  O$="A"
! P:rules 幾つかのルールとその書式です。
!LET  P$="(A->AB)(B->CA)(C->BA)"
!LET  P$="(A->AB)(B->A)" ! Algae
!LET  P$="(A->B)(B->AB)" ! Fibonacci
!LET  P$="(A->ABA)(B->BBB)" ! Cantor Set
!
!LET  O$="F"              ! Koch
!LET  P$="(F->F+F-F-F+F)" ! Koch
!LET  P$="(A->B-A-B)(B->A+B+A)" ! Sierpinski triangle
!LET  P$="(A->F[A]{A})(B->A)(C->F{D}A)(D->A)" ! 単純な二分木
LET  P$="(A->F[B]C)(B->C)(C->F{D}A)(D->A)" ! 少々複雑な木
! main
PRINT O$ ! とりあえず最初の形を「テキスト出力」に出力
FOR i=1 TO 12 ! ルールを何回適用するか
   LET  L$=Lsystem$(V$,S$,O$,P$,i) ! ルールを適用する関数
   PRINT L$ ! 「テキスト出力」に出力
NEXT i
! 以下はグラフィック出力用の設定と実行
SET WINDOW -4,4,-1,7
RANDOMIZE
! グラフィック出力のサブルーチン
!CALL GLsystem(l$,V$,S$,0,0,90,1,32,0.5,0,0.1,3,60,0.8,55,65)
CALL GLsystem(l$,V$,S$,0,0,90,1,32,0.5,0,0.1,3,60,0.75,1.1,0.9,55,45)
! EXTERNAL  SUB glsystem(x$,v$,s$,x,y,d,l,w,cR,cG,cB,s,t,tr,tl,r,rr,rl)
! (x,y)は描き始めるポイント dは方向 lは長さ wは太さ
! (cR,cG,cB)はRGB色
! sはターンの角度
! tは(+-での)ターンの角度
! tr,tlは右枝,左枝の出る角度
! rは1つ深く入った時の長さの比率
! rrは右枝のrlは左枝の長さの比率
END
!
! 以上がメインプログラム。以下が外部関数及びルーチン
!==============
! L-system関数
!==============
EXTERNAL  FUNCTION Lsystem$(v$,s$,o$,p$,n)
! L-system G=(v$,s$,o$,p$) を n 回変換します。再帰呼び出し?
IF n=0 THEN ! n=0 なら終了条件
   LET  Lsystem$=o$
ELSE
   LET  l=LEN(o$) !                    元の文字列の長さを測り
   LET  no$="" !                       空の文字列 no$を用意してここに答えを
   FOR i=1 TO l !                      文字列の先頭から順に
      LET  ox$=o$(i:i) !               一文字ずつ ox$に収めて
      IF POS(v$,ox$)>0 THEN !          変数なら
         LET  no$=no$&rule$(p$,ox$) !  ルールを適用したものを応えに付け加え
      ELSEIF POS(s$,ox$)>0 THEN !      定数なら
         LET  no$=no$&ox$ !            そのままを付け加え
      ELSE !                           ルールや変数指定の間違いがあれば
         PRINT "<";ox$;">   ***** L-SYSTEM ERROR *****   " ! エラー表示
      END IF !                         という場合分けを
   NEXT i !                            最後の一文字まで繰り返します。
   LET  Lsystem$=Lsystem$(v$,s$,no$,p$,n-1) !  で再帰します。
END  IF 
END FUNCTION
!==============
! L-system関数で呼ばれるルール適用関数
!==============
EXTERNAL  FUNCTION rule$(r$,x$)
LET  l=LEN(r$) !                       パターンマッチングです。
LET  p=POS(r$,"("&x$) !                "(X->Y・・・"の形で個別のルールが始まるので
IF p>0 THEN !                          マッチするルールがあれ ば                            
   LET  rr$=r$(p+4:l) !                適用部分の->以降のルール文字列を取り出し
   LET  p=POS(rr$,")") !               そのルールの終り")"の位置をみつけたら     
   !PRINT rr $
   LET rule$=rr$(1:p-1) !             そこまでが,ルールを適用した結 果              
ELSE !                                 なのでそれを返すわけです。
   LET  rule$=x$ !                     マッチしなければ変化無し
END IF
END FUNCTION
!==============
! グラフィックス用サブルーチン
!==============
EXTERNAL  SUB glsystem(x$,v$,s$,xx,yy,dd,ll,ww,ccR,ccG,ccB,s,t,r,rr,rl,tr,tl)
! (x,y)は描き始めるポイント dは方向 lは長さ
! sは1つ深くなったときのターンの角度
! tは(+-での)ターンの角度
! rは1つ深く入った時の長さの比率
! tr,tlは[]{}で枝分かれした時の,枝分かれの角度
OPTION ANGLE DEGREES
LET  x=xx
LET  y=yy
LET  d=dd
LET  l=ll
LET  cR=ccR
LET  cG=ccG
LET  cB=ccB
SET COLOR MIX(1) cR,cG,cB
LET  w=ww
SET LINE WIDTH w
PLOT LINES : x,y;
LET  xl=LEN(x$)
DO WHILE xl>0
   LET  ox$=x$(1:1)
   IF POS(v$,ox$)>0 THEN
      LET  x=x+l*COS(d)
      LET  y=y+l*SIN(d)
      SET LINE WIDTH w
      PLOT LINES : x,y;
      LET  l=l*r
      LET  w=w*r
      LET  d=d+s
      LET  tr=tr-ABS(s)
      LET  tl=tl-ABS(s)
      ASK COLOR MIX(1) cR,cG,cB
      LET  cR=cR*RND !cR/(1+RND)
      LET  cG=cG+(1-cG)/(5+RND*10)
      LET  cB=cB/(1+RND)
      SET COLOR MIX(1) cR,cG,cB
   ELSEIF POS("+-",ox$)>0 THEN
      IF ox$="+" THEN LET  d=d+t ELSE LET  d=d-t
   ELSEIF POS("[{",ox$)>0 THEN
      LET  hx$=head$(x$)
      LET  x$=" "&tail$(x$)
      IF ox$="[" THEN
         CALL glsystem(hx$,v$,s$,x,y,d+tl,l/r*rl,w,cR,cG,cB,-s,t,r,rr,rl,tr-ABS(s),tl-ABS(s))
      ELSE
         CALL glsystem(hx$,v$,s$,x,y,d-tr,l/r*rr,w,cR,cG,cB,s,t,r,rr,rl,tr-ABS (s),tl-ABS(s))
      END IF
      PLOT LINES
      PLOT LINES : x,y;
      SET COLOR MIX(1) cR,cG,cB
   END IF
   LET  x$=x$(2:xl)
   LET  xl=LEN(x$)
   IF xl=0 THEN
      SET AREA COLOR 4
      DRAW disk WITH SCALE(0.02)*SHIFT(x,y)
   END IF
LOOP
END SUB
!==============
! glsystemで呼ばれる文字列の枝を返す関数
!==============
EXTERNAL  FUNCTION head$(x$)
LET  ox$=x$(1:1)
IF ox$="[" THEN
   LET  ck1$="["
   LET  ck2$="]"
ELSE
   LET  ck1$="{"
   LET  ck2$="}"
END IF
LET  lx=LEN(x$)
LET  ax$=x$(2:lx)
LET  lx=lx-1
LET  ans$=""
LET  i=1
LET  k=1
DO WHILE k>0
   LET  ox$=ax$(i:i)
   IF ox$=ck1$ THEN
      LET  k=k+1
   ELSEIF ox$=ck2$ THEN
      LET  k=k-1
   END IF
   IF k>0 THEN LET  ans$=ans$&ox$
   LET  i=i+1
LOOP
!PRINT ans$
LET  head$=ans$
END FUNCTION 
!==============
! glsystemで呼ばれる文字列の本体の残りを返す関数
!==============
EXTERNAL  FUNCTION tail$(x$)
LET  ox$=x$(1:1)
IF ox$="[" THEN
   LET  ck1$="["
   LET  ck2$="]"
ELSE
   LET  ck1$="{"
   LET  ck2$="}"
END IF
LET  lx=LEN(x$)
LET  ax$=x$(2:lx)
LET  lx=lx-1
LET  i=1
LET  k=1
DO WHILE k>0
   LET  ox$=ax$(i:i)
   IF ox$=ck1$ THEN
      LET  k=k+1
   ELSEIF ox$=ck2$ THEN
      LET  k=k-1
   END IF
   LET  i=i+1
LOOP
LET  ans$=ax$(i:lx)
!PRINT ans$
LET  tail$=ans$
END FUNCTION  

rubyやproccessindg(?でしたっけ)で描けばもっとインタラクティブだったり コードが見易かったりするのだとは思うのですが, 現場ではまだまだベーシックなような気がするのとお手軽さで。


ルールの部分を次のように変えると

LET  P$="(A->F[B[A]]C)(B->C)(C->F{D}A)(D->A)" ! 少々複雑な木

こんな風になります。

Lsystem31.png

少しは自然に観えますか?

なかなか理解は追いつかないのですけれど,本当に素晴らしい!!どのようにして生徒に生かそうかと少々思案しています。でも,ここまでよくぞ見事に描けるものなんですね・・・。唖然


添付ファイル: fileLsystem31.png 622件 [詳細] fileLsystem3.png 625件 [詳細]

トップ   編集 凍結解除 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2007-12-26 (水) 02:53:58 (5024d)