画像スペクトル

 投稿者：しばっち  投稿日：2017年12月31日(日)16時37分44秒
  FFTを使って画像のスペクトルを表示します。
SAMPLEフォルダにあった「ZENKOUJI.JPG」の振幅スペクトルを
表示してみました。
真ん中(中心)が低域で、端にいくほど高域を表します。

また、dllを使用した画像処理プログラムやテストプログラム
をアップしました。下記よりダウンロードしてください。(bas.zip)
(dllファイルはVC++2015にてコンパイルしました)


ダウンロードパス:SHIBACCHI
なお、有効期限は本日より１ヶ月間です


OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM S$(1),SS$(7)
MAT READ S$
DATA "振幅スペクトル","位相スペクトル"
MAT READ SS$
DATA 2階調,4階調,8階調,16階調,32階調,64階調,128階調,256階調
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
LOCATE CHOICE(S$) :MODE
LET N1=2^INT(LOG2(XSIZE)+.999)
LET N2=2^INT(LOG2(YSIZE)+.999)
DIM RR(N1,N2),RI(N1,N2),GR(N1,N2),GI(N1,N2),BR(N1,N2),BI(N1,N2)
FOR Y=0 TO YSIZE-1
   FOR X=0 TO XSIZE-1
      CALL GETPOINT(X,Y,R,G,B)
      LET RR(X,Y)=R
      LET GR(X,Y)=G
      LET BR(X,Y)=B
   NEXT X
NEXT Y
CALL FFT2D(N1,N2,BR,BI,1,1)
CALL FFT2D(N1,N2,RR,RI,1,1)
CALL FFT2D(N1,N2,GR,GI,1,1)
CLEAR
LOCATE CHOICE(SS$) : L
LET L=2^L
SELECT CASE MODE
CASE 1
   LET MINR=10000000
   LET MING=10000000
   LET MINB=10000000
   FOR Y=0 TO N2-1
      FOR X=0 TO N1-1
         LET R1=RR(X,Y)
         LET G1=GR(X,Y)
         LET B1=BR(X,Y)
         LET R2=RI(X,Y)
         LET G2=GI(X,Y)
         LET B2=BI(X,Y)
         IF ABS(R1)>0 OR ABS(R2)>0 THEN
            LET MAXR=MAX(MAXR,LOG10(R1*R1+R2*R2))
            LET MINR=MIN(MINR,LOG10(R1*R1+R2*R2))
         END IF
         IF ABS(G1)>0 OR ABS(G2)>0 THEN
            LET MAXG=MAX(MAXG,LOG10(G1*G1+G2*G2))
            LET MING=MIN(MING,LOG10(G1*G1+G2*G2))
         END IF
         IF ABS(B1)>0 OR ABS(B2)>0 THEN
            LET MAXB=MAX(MAXB,LOG10(B1*B1+B2*B2))
            LET MINB=MIN(MINB,LOG10(B1*B1+B2*B2))
         END IF
      NEXT X
   NEXT Y
   FOR Y=0 TO N2-1
      FOR X=0 TO N1-1
         LET R1=RR(X,Y)
         LET G1=GR(X,Y)
         LET B1=BR(X,Y)
         LET R2=RI(X,Y)
         LET G2=GI(X,Y)
         LET B2=BI(X,Y)
         IF ABS(R1)>0 OR ABS(R2)>0 THEN LET R=(LOG10(R1*R1+R2*R2)-MINR)/(MAXR-MINR)*256 ELSE LET R=0
         IF ABS(G1)>0 OR ABS(G2)>0 THEN LET G=(LOG10(G1*G1+G2*G2)-MING)/(MAXG-MING)*256 ELSE LET G=0
         IF ABS(B1)>0 OR ABS(B2)>0 THEN LET B=(LOG10(B1*B1+B2*B2)-MINB)/(MAXB-MINB)*256 ELSE LET B=0
         LET R=INT(R/(256/L))*INT(255/(L-1))
         LET G=INT(G/(256/L))*INT(255/(L-1))
         LET B=INT(B/(256/L))*INT(255/(L-1))
         LET XX=X/(N1-1)*(XSIZE-1)
         LET YY=Y/(N2-1)*(YSIZE-1)
         CALL PSET(XX,YY,R,G,B)
      NEXT X
   NEXT Y
CASE 2
   FOR Y=0 TO N2-1
      FOR X=0 TO N1-1
         LET R1=RR(X,Y)
         LET G1=GR(X,Y)
         LET B1=BR(X,Y)
         LET R2=RI(X,Y)
         LET G2=GI(X,Y)
         LET B2=BI(X,Y)
         IF R1<>0 THEN LET THR=ATN(R2/R1) ELSE LET THR=PI/2*SGN(R2)
         IF G1<>0 THEN LET THG=ATN(G2/G1) ELSE LET THG=PI/2*SGN(G2)
         IF B1<>0 THEN LET THB=ATN(B2/B1) ELSE LET THB=PI/2*SGN(B2)
         LET R=(THR+PI/2)/PI*255
         LET G=(THG+PI/2)/PI*255
         LET B=(THB+PI/2)/PI*255
         LET R=INT(R/(256/L))*INT(255/(L-1))
         LET G=INT(G/(256/L))*INT(255/(L-1))
         LET B=INT(B/(256/L))*INT(255/(L-1))
         LET XX=X/(N1-1)*(XSIZE-1)
         LET YY=Y/(N2-1)*(YSIZE-1)
         CALL PSET(XX,YY,R,G,B)
      NEXT X
   NEXT Y
END SELECT
END

EXTERNAL SUB GINIT(XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
SET BITMAP SIZE XSIZE,YSIZE
SET COLOR MIX(0) 0,0,0
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB PICTURELOAD(N$,XSIZE,YSIZE)
OPTION ARITHMETIC NATIVE
SET COLOR MODE "NATIVE"
CLEAR
SET POINT STYLE 1
IF N$="" THEN STOP
GLOAD N$
LET XSIZE=PIXELX(1)+1
LET YSIZE=PIXELY(1)+1
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
END SUB

EXTERNAL SUB RGB(X,R,G,B)
OPTION ARITHMETIC NATIVE
LET B=MOD(INT(X/65536),256)
LET G=MOD(INT(X/256),256)
LET R=MOD(X,256)
END SUB

EXTERNAL SUB PSET(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
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 GETPOINT(X,Y,R,G,B)
OPTION ARITHMETIC NATIVE
ASK PIXEL VALUE (X,Y) C
CALL RGB(C,R,G,B)
END SUB

EXTERNAL SUB FFT(LENGTH,AR(),AI(),INV,OPT)
OPTION ARITHMETIC NATIVE
LET N=LOG2(LENGTH)
IF OPT=1 THEN
   FOR I=1 TO LENGTH-1 STEP 2
      LET AR(I)=-AR(I)
      LET AI(I)=-AI(I)
   NEXT I
END IF
LET NUMB=1
LET LENB=LENGTH
LET XX=-PI*2/LENGTH
IF INV<0 THEN LET XX=-XX
FOR I=0 TO N-1
   LET LENB=INT(LENB/2)
   LET TIMB=0
   FOR J=0 TO NUMB-1
      LET W=0
      FOR K=0 TO LENB-1
         LET J1=TIMB+K
         LET J2=J1+LENB
         LET XR=AR(J1)
         LET XI=AI(J1)
         LET YR=AR(J2)
         LET YI=AI(J2)
         LET AR(J1)=XR+YR
         LET AI(J1)=XI+YI
         LET XR=XR-YR
         LET XI=XI-YI
         LET AR(J2)=XR*COS(XX*W)-XI*SIN(XX*W)
         LET AI(J2)=XR*SIN(XX*W)+XI*COS(XX*W)
         LET W=W+NUMB
      NEXT K
      LET TIMB=TIMB+2*LENB
   NEXT J
   LET NUMB=NUMB*2
NEXT I
CALL BIRV(AR,LENGTH,N)
CALL BIRV(AI,LENGTH,N)
IF OPT=1 THEN
   FOR I=1 TO LENGTH-1 STEP 2
      LET AR(I)=-AR(I)
      LET AI(I)=-AI(I)
   NEXT I
END IF
LET NRML=1/SQR(LENGTH)
FOR I=0 TO LENGTH-1
   LET AR(I)=AR(I)*NRML
   LET AI(I)=AI(I)*NRML
NEXT I
END SUB

EXTERNAL SUB BIRV(A(),LENGTH,N)
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM B(LENGTH)
FOR I=0 TO LENGTH-1
   LET K=0
   LET II=I
   LET BIT=0
   DO
      LET BIT=BITOR(BITAND(II,1),BIT)
      LET K=K+1
      IF K=N THEN EXIT DO
      LET II=INT(II/2)
      LET BIT=BIT*2
   LOOP
   LET B(I)=A(BIT)
NEXT I
MAT A=B
END SUB

EXTERNAL SUB FFT2D(M,N,RR(,),II(,),FL,OPT)
OPTION ARITHMETIC NATIVE
LET NN=MAX(M,N)
OPTION BASE 0
DIM XR(NN),XI(NN)
FOR Y=0 TO N-1
   FOR X=0 TO M-1
      LET XR(X)=RR(X,Y)
      LET XI(X)=II(X,Y)
   NEXT X
   CALL FFT(M,XR,XI,FL,OPT)
   FOR X=0 TO M-1
      LET RR(X,Y)=XR(X)
      LET II(X,Y)=XI(X)
   NEXT X
NEXT Y
MAT XR=ZER
MAT XI=ZER
FOR X=0 TO M-1
   FOR Y=0 TO N-1
      LET XR(Y)=RR(X,Y)
      LET XI(Y)=II(X,Y)
   NEXT Y
   CALL FFT(N,XR,XI,FL,OPT)
   FOR Y=0 TO N-1
      LET RR(X,Y)=XR(Y)
      LET II(X,Y)=XI(Y)
   NEXT Y
NEXT X
END SUB
 

戻る