黄金四角形を描くプログラム

DECLARE EXTERNAL PICTURE polygon
OPTION ANGLE DEGREES
SUB circle1(a,b,r)
FOR t=90 TO 180
PLOT LINES: a+r*COS(t),b+r*SIN(t);
NEXT t
PLOT LINES
END SUB
SUB circle2(a,b,r)
FOR t=0 TO 90
PLOT LINES: a+r*COS(t),b+r*SIN(t);
NEXT t
PLOT LINES
END SUB
SUB circle3(a,b,r)
FOR t=-90 TO 0
PLOT LINES: a+r*COS(t),b+r*SIN(t);
NEXT t
PLOT LINES
END SUB
SUB circle4(a,b,r)
FOR t=-180 TO -90
PLOT LINES: a+r*COS(t),b+r*SIN(t);
NEXT t
PLOT LINES
END SUB
SET WINDOW -0.1,1.7,-0.1,1.7
DRAW GRID
LET φ=(1+SQR(5))/2
DRAW polygon(4) WITH ROTATE(-45)*SCALE(SQR(2)/2)*SHIFT(0.5,0.5)
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ)*SQR(2))/2)*SHIFT(1+((1/φ)/2),1-((1/φ)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^2)*SQR(2))/2)*SHIFT(φ-((1/φ^2)/2),(1/φ^2)/2)
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^3)*SQR(2))/2)*SHIFT(1+((1/φ^3)/2),(1/φ^3)/2)
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^4)*SQR(2))/2)*SHIFT(1+((1/φ^4)/2),(1/φ^3)+((1/φ^4)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^5)*SQR(2))/2)*SHIFT(1+(1/φ^4)+((1/φ^5)/2),(1/φ^2)-((1/φ^5)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^6)*SQR(2))/2)*SHIFT(φ-(1/φ^2)-((1/φ^6)/2),(1/φ^3)+((1/φ^6)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^7)*SQR(2))/2)*SHIFT(1+(1/φ^4)+((1/φ^7)/2),(1/φ^3)+((1/φ^7)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^8)*SQR(2))/2)*SHIFT(1+(1/φ^4)+((1/φ^8)/2),(1/φ^3)+(1/φ^7)+((1/φ^8)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^9)*SQR(2))/2)*SHIFT(1+(1/φ^4)+(1/φ^8)+((1/φ^9)/2),(1/φ^3)+(1/φ^6)-((1/φ^9)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^10)*SQR(2))/2)*SHIFT(1+(1/φ^4)+(1/φ^7)-((1/φ^10)/2),(1/φ^3)+(1/φ^7)+((1/φ^10)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^11)*SQR(2))/2)*SHIFT(1+(1/φ^4)+(1/φ^8)+((1/φ^11)/2),(1/φ^3)+(1/φ^7)+((1/φ^11)/2))
DRAW polygon(4) WITH ROTATE(-45)*SCALE(((1/φ^12)*SQR(2))/2)*SHIFT(1+(1/φ^4)+(1/φ^8)+((1/φ^12)/2),(1/φ^3)+(1/φ^7)+(1/φ^11)+((1/φ^12)/2))
CALL circle1(1,0,1)
CALL circle2(1,1/φ^2,1/φ)
CALL circle3(1+(1/φ^3),1/φ^2,1/φ^2)
CALL circle4(1+(1/φ^3),1/φ^3,1/φ^3)
CALL circle1(1+(1/φ^4),1/φ^3,1/φ^4)
CALL circle2(1+(1/φ^4),(1/φ^2)-(1/φ^5),(1/φ^5))
CALL circle3(1+(1/φ^3)-(1/φ^6),(1/φ^3)+(1/φ^6),(1/φ^6))
CALL circle4(1+(1/φ^4)+(1/φ^7),(1/φ^3)+(1/φ^7),(1/φ^7))
CALL circle1(1+(1/φ^4)+(1/φ^8),(1/φ^3)+(1/φ^7),(1/φ^8))
CALL circle2(1+(1/φ^4)+(1/φ^8),(1/φ^3)+(1/φ^6)-(1/φ^9),(1/φ^9))
CALL circle3(1+(1/φ^4)+(1/φ^7)-(1/φ^10),(1/φ^3)+(1/φ^7)+(1/φ^10),(1/φ^10))
CALL circle4(1+(1/φ^4)+(1/φ^8)+(1/φ^11),(1/φ^3)+(1/φ^7)+(1/φ^11),(1/φ^11))
CALL circle1(1+(1/φ^4)+(1/φ^8)+(1/φ^12),(1/φ^3)+(1/φ^7)+(1/φ^11),(1/φ^12))
END
EXTERNAL PICTURE polygon(n)
OPTION ANGLE DEGREES
FOR i=0 TO n
PLOT LINES:COS(i*360/n),SIN(i*360/n);
NEXT i
END PICTURE

漸化式、再帰呼び出しで簡潔にする

第２象限の正方形と４分の１円を、φ縮小させ９０度右へ回転しながら配置させる。

漸化式（繰り返し）による例

!黄金四角形を描く
OPTION ANGLE DEGREES

PICTURE box_circle4div !正方形と４分の１円を描く
PLOT LINES: -1,0; 0,0; 0,1; -1,1; -1,0 !第２象限　正方形

FOR t=180 TO 90 STEP -1 !第２象限　４分の１円
PLOT LINES: COS(t),SIN(t);
WAIT DELAY 0.05 !!!!!
NEXT t
PLOT LINES
END PICTURE

SET WINDOW -0.1,1.7,-0.1,1.7
!SET WINDOW 1,1.5,0,0.5 !ズームイン！
DRAW GRID

LET φ=(1+SQR(5))/2 !黄金比

LET x=1 !配置位置
LET y=0
FOR n=0 TO 10
DRAW disk WITH SCALE(0.01)*SHIFT(x,y) !!!!!
LET k=-90*n !-90°回転
DRAW box_circle4div WITH SCALE(1/φ^n)*ROTATE(k)*SHIFT(x,y)
LET x=x-SIN(k)/φ^(n+2) !螺旋上に配置する
LET y=y+COS(k)/φ^(n+2)
NEXT n

END

正方形の辺の長さがフィボナッチ数列になるのを利用して、小さい図形から順に描く場合

!黄金四角形を描く
OPTION ANGLE DEGREES

PICTURE box_circle4div !正方形と４分の１円を描く
PLOT LINES: 0,0; 1,0; 1,1; 0,1; 0,0 !第１象限　正方形

FOR t=0 TO 90 !第１象限　４分の１円
PLOT LINES: COS(t),SIN(t);
WAIT DELAY 0.01 !!!!!
NEXT t
PLOT LINES
END PICTURE

SET WINDOW -100,100,-100,100
DRAW GRID(10,10)

LET x=0 !配置位置
LET y=0

DEF a(n)=MOD(n,3)+1 !３項間
DIM f(3)

LET f(a(0))=1 !第１項
DRAW box_circle4div WITH SCALE(f(a(0)))*ROTATE(90*0)*SHIFT(x,y)
LET f(a(1))=1 !第２項
DRAW box_circle4div WITH SCALE(f(a(1)))*ROTATE(90*1)*SHIFT(x,y)

FOR n=2 TO 11
LET k=90*n !90°回転
LET f(a(n))=f(a(n-1))+f(a(n-2)) !フィボナッチ数列　※正方形の辺の長さ
LET x=x-COS(k)*f(a(n-2)) !螺旋上に配置する
LET y=y-SIN(k)*f(a(n-2))
DRAW box_circle4div WITH SCALE(f(a(n)))*ROTATE(k)*SHIFT(x,y)
NEXT n

END

複素数による図形変換

!黄金四角形を描く
OPTION ARITHMETIC COMPLEX
OPTION ANGLE DEGREES
PICTURE box_circle4div !正方形と４分の１円を描く
PLOT LINES: -1,-1; 0,-1; 0,0; -1,0; -1,-1 !第３象限　正方形

FOR t=270 TO 180 STEP -1 !第３象限　４分の１円
PLOT LINES: COS(t),SIN(t);
WAIT DELAY 0.05 !!!!!
NEXT t
PLOT LINES
END PICTURE

SET WINDOW -0.1,1.7,-0.1,1.7
!SET WINDOW 0.5,1,1,1.5 !ズームイン！
DRAW GRID

LET φ=(1+SQR(5))/2 !黄金比

LET Zsr=complex(1,0) !大きさ、向きのベクトル
LET Zt=complex(1,1) !配置位置
LET z=complex(0,φ) !座標変換の複素数
FOR n=0 TO 10
DRAW disk WITH SCALE(0.01)*SHIFT(re(Zt),im(Zt)) !!!!!

DRAW box_circle4div WITH SCALE(ABS(Zsr))*ROTATE(arg(Zsr))*SHIFT(re(Zt),im(Zt))

LET Zsr=Zsr/z !縮小、-90°回転
LET Zt=(Zt+z*z)/z !螺旋上に配置する
NEXT n

END

山中さん、はじめまして。yossyと申します。
簡潔なプログラムに直して頂き、ありがとうございました。
動画にしてみると、また違った味わいがあっていいですね。
軟化式、再帰呼び出しなど、いろいろと勉強になりました。
フィボナッチ数列の方も、ユニークで面白かったです。
それでは、またの機会によろしくお願いします。

!フラクタル風に、描く。

OPTION ANGLE DEGREES
SET WINDOW -1.1,0.7, -0.1,1.7
DRAW GRID
LET φ=(1+SQR(5))/2 ! 黄金比

PICTURE arc(m, r)
!-----
FOR t=90 TO 180
PLOT LINES: r*COS(t),r*SIN(t); ! 円弧
NEXT t
PLOT LINES: -r,r; 0,r; 0,0; -r,0 ! 正方形
!-----
IF 0<m THEN DRAW arc(m-1, r/φ) WITH ROTATE(-90)*SHIFT(0, r/φ^2) ! 再帰draw
END PICTURE

DRAW arc( 10, 1) ! 段数、開始の寸法

END

!もっと、シンプル。

OPTION ANGLE DEGREES
SET WINDOW -1.1,0.7, -0.4,1.4
DRAW GRID
LET φ=(1+SQR(5))/2 ! 黄金比

PICTURE arc(m)
!-----
FOR t=90 TO 180
PLOT LINES: COS(t),SIN(t); ! 円弧
NEXT t
PLOT LINES: -1,1; 0,1; 0,0; -1,0 ! 正方形
!-----
IF 0<m THEN DRAW arc(m-1) WITH ROTATE(-90)*SHIFT(0, 1/φ)*SCALE(1/φ) !再帰draw
END PICTURE

DRAW arc(10) ! 段数

END

SECONDさん、はじめまして。さらにシンプルにして頂き、ありがとうございました。
ここまでシンプルなプログラムで黄金四角形を描ける十進BASICは、やはり凄いですね！

黄金四角形を描くプログラム	返事を書くノートメニュー
yossy <cfdugezjff> 2007/05/10 21:55:49
DECLARE EXTERNAL PICTURE polygon OPTION ANGLE DEGREES SUB circle1(a,b,r) FOR t=90 TO 180 PLOT LINES: a+rCOS(t),b+rSIN(t); NEXT t PLOT LINES END SUB SUB circle2(a,b,r) FOR t=0 TO 90 PLOT LINES: a+rCOS(t),b+rSIN(t); NEXT t PLOT LINES END SUB SUB circle3(a,b,r) FOR t=-90 TO 0 PLOT LINES: a+rCOS(t),b+rSIN(t); NEXT t PLOT LINES END SUB SUB circle4(a,b,r) FOR t=-180 TO -90 PLOT LINES: a+rCOS(t),b+rSIN(t); NEXT t PLOT LINES END SUB SET WINDOW -0.1,1.7,-0.1,1.7 DRAW GRID LET φ=(1+SQR(5))/2 DRAW polygon(4) WITH ROTATE(-45)SCALE(SQR(2)/2)SHIFT(0.5,0.5) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ)SQR(2))/2)SHIFT(1+((1/φ)/2),1-((1/φ)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^2)SQR(2))/2)SHIFT(φ-((1/φ^2)/2),(1/φ^2)/2) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^3)SQR(2))/2)SHIFT(1+((1/φ^3)/2),(1/φ^3)/2) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^4)SQR(2))/2)SHIFT(1+((1/φ^4)/2),(1/φ^3)+((1/φ^4)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^5)SQR(2))/2)SHIFT(1+(1/φ^4)+((1/φ^5)/2),(1/φ^2)-((1/φ^5)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^6)SQR(2))/2)SHIFT(φ-(1/φ^2)-((1/φ^6)/2),(1/φ^3)+((1/φ^6)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^7)SQR(2))/2)SHIFT(1+(1/φ^4)+((1/φ^7)/2),(1/φ^3)+((1/φ^7)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^8)SQR(2))/2)SHIFT(1+(1/φ^4)+((1/φ^8)/2),(1/φ^3)+(1/φ^7)+((1/φ^8)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^9)SQR(2))/2)SHIFT(1+(1/φ^4)+(1/φ^8)+((1/φ^9)/2),(1/φ^3)+(1/φ^6)-((1/φ^9)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^10)SQR(2))/2)SHIFT(1+(1/φ^4)+(1/φ^7)-((1/φ^10)/2),(1/φ^3)+(1/φ^7)+((1/φ^10)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^11)SQR(2))/2)SHIFT(1+(1/φ^4)+(1/φ^8)+((1/φ^11)/2),(1/φ^3)+(1/φ^7)+((1/φ^11)/2)) DRAW polygon(4) WITH ROTATE(-45)SCALE(((1/φ^12)SQR(2))/2)SHIFT(1+(1/φ^4)+(1/φ^8)+((1/φ^12)/2),(1/φ^3)+(1/φ^7)+(1/φ^11)+((1/φ^12)/2)) CALL circle1(1,0,1) CALL circle2(1,1/φ^2,1/φ) CALL circle3(1+(1/φ^3),1/φ^2,1/φ^2) CALL circle4(1+(1/φ^3),1/φ^3,1/φ^3) CALL circle1(1+(1/φ^4),1/φ^3,1/φ^4) CALL circle2(1+(1/φ^4),(1/φ^2)-(1/φ^5),(1/φ^5)) CALL circle3(1+(1/φ^3)-(1/φ^6),(1/φ^3)+(1/φ^6),(1/φ^6)) CALL circle4(1+(1/φ^4)+(1/φ^7),(1/φ^3)+(1/φ^7),(1/φ^7)) CALL circle1(1+(1/φ^4)+(1/φ^8),(1/φ^3)+(1/φ^7),(1/φ^8)) CALL circle2(1+(1/φ^4)+(1/φ^8),(1/φ^3)+(1/φ^6)-(1/φ^9),(1/φ^9)) CALL circle3(1+(1/φ^4)+(1/φ^7)-(1/φ^10),(1/φ^3)+(1/φ^7)+(1/φ^10),(1/φ^10)) CALL circle4(1+(1/φ^4)+(1/φ^8)+(1/φ^11),(1/φ^3)+(1/φ^7)+(1/φ^11),(1/φ^11)) CALL circle1(1+(1/φ^4)+(1/φ^8)+(1/φ^12),(1/φ^3)+(1/φ^7)+(1/φ^11),(1/φ^12)) END EXTERNAL PICTURE polygon(n) OPTION ANGLE DEGREES FOR i=0 TO n PLOT LINES:COS(i360/n),SIN(i360/n); NEXT i END PICTURE

Re: 黄金四角形を描くプログラム	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/05/12 10:19:07 ** この記事は1回修正されてます
漸化式、再帰呼び出しで簡潔にする第２象限の正方形と４分の１円を、φ縮小させ９０度右へ回転しながら配置させる。漸化式（繰り返し）による例 !黄金四角形を描く OPTION ANGLE DEGREES PICTURE box_circle4div !正方形と４分の１円を描く PLOT LINES: -1,0; 0,0; 0,1; -1,1; -1,0 !第２象限　正方形 FOR t=180 TO 90 STEP -1 !第２象限　４分の１円 PLOT LINES: COS(t),SIN(t); WAIT DELAY 0.05 !!!!! NEXT t PLOT LINES END PICTURE SET WINDOW -0.1,1.7,-0.1,1.7 !SET WINDOW 1,1.5,0,0.5 !ズームイン！ DRAW GRID LET φ=(1+SQR(5))/2 !黄金比 LET x=1 !配置位置 LET y=0 FOR n=0 TO 10 DRAW disk WITH SCALE(0.01)SHIFT(x,y) !!!!! LET k=-90n !-90°回転 DRAW box_circle4div WITH SCALE(1/φ^n)ROTATE(k)SHIFT(x,y) LET x=x-SIN(k)/φ^(n+2) !螺旋上に配置する LET y=y+COS(k)/φ^(n+2) NEXT n END

Re: 漸化式、再帰呼び出しで簡潔にする	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/05/12 11:13:29 ** この記事は1回修正されてます
正方形の辺の長さがフィボナッチ数列になるのを利用して、小さい図形から順に描く場合 !黄金四角形を描く OPTION ANGLE DEGREES PICTURE box_circle4div !正方形と４分の１円を描く PLOT LINES: 0,0; 1,0; 1,1; 0,1; 0,0 !第１象限　正方形 FOR t=0 TO 90 !第１象限　４分の１円 PLOT LINES: COS(t),SIN(t); WAIT DELAY 0.01 !!!!! NEXT t PLOT LINES END PICTURE SET WINDOW -100,100,-100,100 DRAW GRID(10,10) LET x=0 !配置位置 LET y=0 DEF a(n)=MOD(n,3)+1 !３項間 DIM f(3) LET f(a(0))=1 !第１項 DRAW box_circle4div WITH SCALE(f(a(0)))ROTATE(900)SHIFT(x,y) LET f(a(1))=1 !第２項 DRAW box_circle4div WITH SCALE(f(a(1)))ROTATE(901)SHIFT(x,y) FOR n=2 TO 11 LET k=90n !90°回転 LET f(a(n))=f(a(n-1))+f(a(n-2)) !フィボナッチ数列　※正方形の辺の長さ LET x=x-COS(k)f(a(n-2)) !螺旋上に配置する LET y=y-SIN(k)f(a(n-2)) DRAW box_circle4div WITH SCALE(f(a(n)))ROTATE(k)*SHIFT(x,y) NEXT n END

Re: 正方形の辺の長さがフィボナッチ数列になる...	返事を書くノートメニュー
山中和義 <drdlxujciw> 2007/05/19 22:15:15
複素数による図形変換 !黄金四角形を描く OPTION ARITHMETIC COMPLEX OPTION ANGLE DEGREES PICTURE box_circle4div !正方形と４分の１円を描く PLOT LINES: -1,-1; 0,-1; 0,0; -1,0; -1,-1 !第３象限　正方形 FOR t=270 TO 180 STEP -1 !第３象限　４分の１円 PLOT LINES: COS(t),SIN(t); WAIT DELAY 0.05 !!!!! NEXT t PLOT LINES END PICTURE SET WINDOW -0.1,1.7,-0.1,1.7 !SET WINDOW 0.5,1,1,1.5 !ズームイン！ DRAW GRID LET φ=(1+SQR(5))/2 !黄金比 LET Zsr=complex(1,0) !大きさ、向きのベクトル LET Zt=complex(1,1) !配置位置 LET z=complex(0,φ) !座標変換の複素数 FOR n=0 TO 10 DRAW disk WITH SCALE(0.01)SHIFT(re(Zt),im(Zt)) !!!!! DRAW box_circle4div WITH SCALE(ABS(Zsr))ROTATE(arg(Zsr))SHIFT(re(Zt),im(Zt)) LET Zsr=Zsr/z !縮小、-90°回転 LET Zt=(Zt+zz)/z !螺旋上に配置する NEXT n END

Re: 漸化式、再帰呼び出しで簡潔にする	返事を書くノートメニュー
yossy <cfdugezjff> 2007/05/12 13:48:45
山中さん、はじめまして。yossyと申します。簡潔なプログラムに直して頂き、ありがとうございました。動画にしてみると、また違った味わいがあっていいですね。軟化式、再帰呼び出しなど、いろいろと勉強になりました。フィボナッチ数列の方も、ユニークで面白かったです。それでは、またの機会によろしくお願いします。

Re: 黄金四角形を描くプログラム	返事を書くノートメニュー
SECOND <cszcthjjdj> 2007/05/15 15:00:39
!フラクタル風に、描く。 OPTION ANGLE DEGREES SET WINDOW -1.1,0.7, -0.1,1.7 DRAW GRID LET φ=(1+SQR(5))/2 ! 黄金比 PICTURE arc(m, r) !----- FOR t=90 TO 180 PLOT LINES: rCOS(t),rSIN(t); ! 円弧 NEXT t PLOT LINES: -r,r; 0,r; 0,0; -r,0 ! 正方形 !----- IF 0<m THEN DRAW arc(m-1, r/φ) WITH ROTATE(-90)*SHIFT(0, r/φ^2) ! 再帰draw END PICTURE DRAW arc( 10, 1) ! 段数、開始の寸法 END

Re: !フラクタル風に、描く。	返事を書くノートメニュー
SECOND <cszcthjjdj> 2007/05/16 14:23:39
!もっと、シンプル。 OPTION ANGLE DEGREES SET WINDOW -1.1,0.7, -0.4,1.4 DRAW GRID LET φ=(1+SQR(5))/2 ! 黄金比 PICTURE arc(m) !----- FOR t=90 TO 180 PLOT LINES: COS(t),SIN(t); ! 円弧 NEXT t PLOT LINES: -1,1; 0,1; 0,0; -1,0 ! 正方形 !----- IF 0<m THEN DRAW arc(m-1) WITH ROTATE(-90)SHIFT(0, 1/φ)SCALE(1/φ) !再帰draw END PICTURE DRAW arc(10) ! 段数 END

Re: !もっと、シンプル。	返事を書くノートメニュー
yossy <cfdugezjff> 2007/05/18 03:45:06
SECONDさん、はじめまして。さらにシンプルにして頂き、ありがとうございました。ここまでシンプルなプログラムで黄金四角形を描ける十進BASICは、やはり凄いですね！