|
|
複素関数のグラフ(色関数)
https://ja.wikipedia.org/wiki/定義域の着色
(※クリックではなくマウスで選択コピーしてブラウザのアドレスバーに貼り付け移動してください)
※残念ながら上記URLのサンプルと同じ画像にはなりません。
OPTION ARITHMETIC COMPLEX
SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
LET XS,YS=-10
LET XE,YE=10
ASK BITMAP SIZE XSIZE,YSIZE
LET ZMIN=1E+10
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET XX=WORLDX(X)
LET YY=WORLDY(Y)
LET Z=F(COMPLEX(XX,YY))
IF ABS(Z)<>0 THEN LET ZZ=LOG10(ABS(Z)) ELSE LET ZZ=0
LET ZMAX=MAX(ZMAX,ZZ)
LET ZMIN=MIN(ZMIN,ZZ)
NEXT X
NEXT Y
DO
SET WINDOW XS,XE,YS,YE
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET XX=WORLDX(X)
LET YY=WORLDY(Y)
LET Z=F(COMPLEX(XX,YY))
IF RE(Z)<>0 OR IM(Z)<>0 THEN LET ARG=ANGLE(RE(Z),IM(Z)) ELSE LET ARG=0
IF ABS(Z)=0 THEN LET ZZ=0 ELSE LET ZZ=LOG10(ABS(Z))
LET ZZ=(ZZ-ZMIN)/(ZMAX-ZMIN)
CALL HSL2RGB(DEG(ARG),255,(1-2^(-ZZ))*255,R,G,B)
CALL PSET(XX,YY,R,G,B)
NEXT X
NEXT Y
PAUSE "拡大する範囲を指定してください"
CALL GETSQUARE(XS,YS,XE,YE)
IF XS=XE THEN EXIT DO
IF XS>XE THEN SWAP XS,XE
IF YS>YE THEN SWAP YS,YE
LOOP
END
EXTERNAL FUNCTION F(X)
OPTION ARITHMETIC COMPLEX
LET I=SQR(-1)
LET F=(X^2-1)*(X-2-I)^2/(X^2+2+2*I)
END FUNCTION
EXTERNAL SUB HSL2RGB(H,S,L,R,G,B)
OPTION ARITHMETIC COMPLEX
IF S<0 THEN LET S=0
IF S>255 THEN LET S=255
IF L<0 THEN LET L=0
IF L>255 THEN LET L=255
LET SS=S/255
LET LL=L/255
LET H=MOD(INT(H),360)
IF H<0 THEN LET H=H+360
IF LL<=.5 THEN
LET CMIN=LL*(1-SS)
LET CMAX=2*LL-CMIN
ELSE
LET CMAX=LL*(1-SS)+SS
LET CMIN=2*LL-CMAX
END IF
LET R=H2V(H+120,CMIN,CMAX)*255
LET G=H2V(H,CMIN,CMAX)*255
LET B=H2V(H-120,CMIN,CMAX)*255
LET R=INT(R+.5)
LET B=INT(B+.5)
LET G=INT(G+.5)
IF R<0 THEN LET R=0
IF G<0 THEN LET G=0
IF B<0 THEN LET B=0
IF R>255 THEN LET R=255
IF G>255 THEN LET G=255
IF B>255 THEN LET B=255
END SUB
EXTERNAL FUNCTION H2V(H,CMIN,CMAX)
OPTION ARITHMETIC COMPLEX
IF H<0 THEN LET H=H+360
LET H=MOD(H,360)
IF H<60 THEN
LET H2V=CMIN+(CMAX-CMIN)*H/60
EXIT FUNCTION
END IF
IF H>=60 AND H<180 THEN
LET H2V=CMAX
EXIT FUNCTION
END IF
IF H>=180 AND H<240 THEN
LET H2V=CMIN+(CMAX-CMIN)*(240-H)/60
EXIT FUNCTION
END IF
IF H>=240 THEN LET H2V=CMIN
END FUNCTION
EXTERNAL SUB PSET(X,Y,R,G,B)
OPTION ARITHMETIC COMPLEX
LET RR=MIN(255,MAX(0,INT(R)))
LET GG=MIN(255,MAX(0,INT(G)))
LET BB=MIN(255,MAX(0,INT(B)))
SET COLOR COLORINDEX(RR/255,GG/255,BB/255)
PLOT POINTS:X,Y
END SUB
EXTERNAL SUB GETSQUARE(L,T,R,B)
OPTION ARITHMETIC COMPLEX
SET COLOR MODE "REGULAR"
ASK LINE STYLE LSTYLE
SET DRAW MODE NOTXOR
SET LINE STYLE 2
DO
MOUSE POLL L,T,I,J
LOOP WHILE I=0
LET L0=L
LET T0=T
LET R0=L0
LET B0=T0
PLOT LINES:L0,T0;L0,B0;R0,B0;R0,T0;L0,T0
DO WHILE I=1
MOUSE POLL R,B,I,J
LET W=R-L
LET H=T-B
IF ABS(H)<ABS(W) THEN
LET B=T-SGN(H)*ABS(W)
ELSE
LET R=L+SGN(W)*ABS(H)
END IF
IF L0<>L OR R0<>R OR B0<>B OR T0<>T THEN
PLOT LINES:L0,T0;L0,B0;R0,B0;R0,T0;L0,T0
PLOT LINES:L,T;L,B;R,B;R,T;L,T
LET L0=L
LET T0=T
LET R0=R
LET B0=B
END IF
LOOP
WAIT DELAY 1
PLOT LINES:L,T;L,B;R,B;R,T;L,T
SET DRAW MODE OVERWRITE
SET LINE STYLE LSTYLE
IF L>R THEN SWAP L,R
IF B>T THEN SWAP B,T
SET COLOR MODE "NATIVE"
END SUB
|
|