NetaTaneMenu >>>> [[羊歯]] >>>> L-system
*L-system
----
:L-system: 「Lindenmayer system」の略称。リンデンマイヤーさんが考えたらしい。ルールに従って成長するあらゆるモデルを扱うための文法体系みたいな感じです。画像は視覚化するため，あるいはこれを利用して造形するために行うだけでL-systemの本質ではありません。下のソースにも幾つか紹介したように，ルールによって数列など様々な物が定義・作成できます。
#ref(Lsystem3.png,center)
図は下の十進ベーシックのソースで描いたもの。
ここで見ている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)" ! 少々複雑な木
こんな風になります。
#ref(Lsystem31.png,center)
少しは自然に観えますか？
COLOR(red){なかなか理解は追いつかないのですけれど，本当に素晴らしい!!どのようにしてこの財産を使って生かそうか・・・。思案しています。でも，ここまでよくぞ見事に描けるものなんですね・・・。}
COLOR(red){なかなか理解は追いつかないのですけれど，本当に素晴らしい!!どのようにして生徒に生かそうかと少々思案しています。でも，ここまでよくぞ見事に描けるものなんですね・・・。唖然}
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
