複素関数のグラフ

 投稿者:しばっち  投稿日:2020年 4月26日(日)19時02分16秒
  複素関数のグラフ(色関数)

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
 

戻る