|
|
ウェーブレット変換を行います。
Wavelet変換によりフィルタ処理します。
Haar Wavelet Transform(ハールウェーブレット変換) について
8個のデータ(1次元)を
1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 とする
変換は2組ずつ行う。
1と2 , 3と4 , 5と6 , 7と8 について
wavelet変換は
低域へは、足して2で割る
(1+2)/2 , (3+4)/2 , (5+6)/2 , (7+8)/2 これを低域(L 成分)とする
高域へは、引いて2で割る
(1-2)/2 , (3-4)/2 , (5-6)/2 , (7-8)/2 これを高域(H 成分)とする
低域(L)、高域(H)を並べて、これがWavelet変換。変換1回で2分割(LとH)される。
1.5 , 3.5 , 5.5 , 7.5 , -.5 , -.5 , -.5 , -.5 となる。
( ↑この部分が L 成分)( ↑この部分が H 成分 )
Wavelet逆変換には
低域、高域について、それぞれを足すと引く
1.5+(-.5) , 1.5-(-.5) , 3.5+(-.5) , 3.5-(-.5) , 5.5+(-.5) , 5.5-(-.5) , 7.5+(-.5) , 7.5-(-.5)で
1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 となる(元のデータに戻る)
ちなみに、レベル2へは
低域と高域に対して行う(再帰的に)
level 1 変換の
1.5 , 3.5 , 5.5 , 7.5 , -.5 , -.5 , -.5 , -.5 から
まず低域部分(L)から変換
(1.5+3.5)/2 , (5.5+7.5)/2 , (1.5-3.5)/2 , (5.5-7.5)/2 で
2.5 , 6.5 , -1 , -1 となり(LLとLH)
続いて高域部分(H)を変換
(-.5+(-.5))/2 , (-.5+(-.5))/2 , (-.5-(-.5))/2 , (-.5-(-.5))/2 で
-.5 , -.5 , 0 , 0 となる(HLとHH)
低域、高域並べて
2.5 , 6.5 , -1 , -1 , -.5 , -.5 , 0 , 0 (level 2 変換)
( ↑ LL )(↑ LH )( ↑ HL )( ↑ HH )
逆変換は今の手順を逆に行う。(level2 → level 1 → 元のデータ)
LL,LH,HL,HH成分に対し、0に書き換えてフィルタ処理を行う
データ数が13個の場合
変換1回(level 1)なら2分割(L,H)なので2の倍数へ補正
14個となり
変換2回(level 2)なら4分割(LL,LH,HL,HH)なので4の倍数へ補正
16個とする。(個数の増えた部分は0とする)
説明終わり チャン! チャン!
OPTION ARITHMETIC NATIVE
OPTION BASE 0
FILE GETNAME F$,"BMP,JPG,GIF,PNGファイル|*.BMP;*.JPG;*.GIF;*.PNG"
CALL PICTURELOAD(F$,XSIZE,YSIZE)
DIM S$(3)
MAT READ S$
DATA "LEVEL 1","LEVEL 2","LEVEL 3","LEVEL 4"
LOCATE CHOICE(S$) : LEV
PRINT 4^LEV;"分割します"
LET N1=INT((XSIZE+2^LEV-1)/2^LEV)*2^LEV !'サイズ補正
LET N2=INT((YSIZE+2^LEV-1)/2^LEV)*2^LEV
DIM RR1(N1,N2),GG1(N1,N2),BB1(N1,N2),RR2(N1,N2),GG2(N1,N2),BB2(N1,N2)
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
CALL GETPOINT(X,Y,R,G,B)
LET RR1(X,Y)=R
LET GG1(X,Y)=G
LET BB1(X,Y)=B
NEXT X
NEXT Y
CALL WAVELET2D(LEV,0,0,N1,N2,RR1,GG1,BB1,RR2,GG2,BB2)
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET R=RR2(X,Y)
LET G=GG2(X,Y)
LET B=BB2(X,Y)
CALL PSET(X,Y,ABS(R),ABS(G),ABS(B))
NEXT X
NEXT Y
LET XX=INT(N1/2^LEV)
LET YY=INT(N2/2^LEV)
FOR X=0 TO XSIZE-1 STEP XX
CALL LINE(X,0,X,YSIZE-1,255,0,0)
NEXT X
FOR Y=0 TO YSIZE-1 STEP YY
CALL LINE(0,Y,XSIZE-1,Y,255,0,0)
NEXT Y
PRINT "マウスでクリアしたいエリアを左クリック"
PRINT "右クリックで再構成します"
DO
DO
MOUSE POLL XX,YY,L,R
LOOP UNTIL L<>0 OR R<>0
IF L<>0 THEN CALL CLEARAREA(LEV,XX,YY,N1,N2,RR2,GG2,BB2)
LOOP UNTIL R<>0
PRINT "再構成します"
CALL IWAVELET2D(LEV,0,0,N1,N2,RR2,GG2,BB2,RR1,GG1,BB1)
CLEAR
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
LET R=RR1(X,Y)
LET G=GG1(X,Y)
LET B=BB1(X,Y)
CALL PSET(X,Y,R,G,B)
NEXT X
NEXT Y
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 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 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 LINE(X0,Y0,X1,Y1,R,G,B)
OPTION ARITHMETIC NATIVE
SET COLOR COLORINDEX(R/255,G/255,B/255)
PLOT LINES:X0,Y0;X1,Y1
END SUB
EXTERNAL SUB CLEARAREA(N,X,Y,SIZEX,SIZEY,RR(,),GG(,),BB(,))
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
LET XX=INT(SIZEX/2^N)
LET YY=INT(SIZEY/2^N)
LET XS=INT(X/XX)*XX
LET YS=INT(Y/YY)*YY
PRINT "(";XS;",";YS;")-(";XS+XX-1;",";YS+YY-1;")をクリア"
CALL CLEAR(XS,YS,XS+XX-1,YS+YY-1,RR,GG,BB)
END SUB
EXTERNAL SUB CLEAR(XS,YS,XE,YE,RR(,),GG(,),BB(,))
OPTION ARITHMETIC NATIVE
FOR YY=YS TO YE
FOR XX=XS TO XE
LET RR(XX,YY)=0
LET GG(XX,YY)=0
LET BB(XX,YY)=0
IF MOD(XX,32)<16 THEN LET C=8 ELSE LET C=16
IF MOD(YY,32)<16 THEN LET C=24-C
CALL PSET(XX,YY,C*16,C*16,C*16)
NEXT XX
NEXT YY
END SUB
EXTERNAL SUB WAVELET2D(LEV,XS,YS,XSIZE,YSIZE,RR1(,),GG1(,),BB1(,),RR2(,),GG2(,),BB2(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM X1(MAX(XSIZE,YSIZE)),X2(MAX(XSIZE,YSIZE)),X3(MAX(XSIZE,YSIZE))
DIM Y1(MAX(XSIZE,YSIZE)),Y2(MAX(XSIZE,YSIZE)),Y3(MAX(XSIZE,YSIZE))
IF LEV>0 THEN
FOR J=0 TO YSIZE-1
FOR I=0 TO XSIZE-1
LET X1(I)=RR1(I+XS,J+YS)
LET X2(I)=GG1(I+XS,J+YS)
LET X3(I)=BB1(I+XS,J+YS)
NEXT I
CALL WAVELET(XSIZE,X1,Y1)
CALL WAVELET(XSIZE,X2,Y2)
CALL WAVELET(XSIZE,X3,Y3)
FOR I=0 TO XSIZE-1
LET RR2(I+XS,J+YS)=Y1(I)
LET GG2(I+XS,J+YS)=Y2(I)
LET BB2(I+XS,J+YS)=Y3(I)
NEXT I
NEXT J
FOR I=0 TO XSIZE-1
FOR J=0 TO YSIZE-1
LET X1(J)=RR2(I+XS,J+YS)
LET X2(J)=GG2(I+XS,J+YS)
LET X3(J)=BB2(I+XS,J+YS)
NEXT J
CALL WAVELET(YSIZE,X1,Y1)
CALL WAVELET(YSIZE,X2,Y2)
CALL WAVELET(YSIZE,X3,Y3)
FOR J=0 TO YSIZE-1
LET RR1(I+XS,J+YS)=Y1(J)
LET GG1(I+XS,J+YS)=Y2(J)
LET BB1(I+XS,J+YS)=Y3(J)
NEXT J
NEXT I
FOR J=0 TO YSIZE-1
FOR I=0 TO XSIZE-1
LET RR2(I+XS,J+YS)=RR1(I+XS,J+YS)
LET GG2(I+XS,J+YS)=GG1(I+XS,J+YS)
LET BB2(I+XS,J+YS)=BB1(I+XS,J+YS)
NEXT I
NEXT J
CALL WAVELET2D(LEV-1,XS,YS, XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2) !'再帰呼び出し
CALL WAVELET2D(LEV-1,XS+XSIZE/2,YS, XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2)
CALL WAVELET2D(LEV-1,XS,YS+YSIZE/2, XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2)
CALL WAVELET2D(LEV-1,XS+XSIZE/2,YS+YSIZE/2,XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2)
END IF
END SUB
EXTERNAL SUB IWAVELET2D(LEV,XS,YS,XSIZE,YSIZE,RR1(,),GG1(,),BB1(,),RR2(,),GG2(,),BB2(,))
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM X1(MAX(XSIZE,YSIZE)),X2(MAX(XSIZE,YSIZE)),X3(MAX(XSIZE,YSIZE))
DIM Y1(MAX(XSIZE,YSIZE)),Y2(MAX(XSIZE,YSIZE)),Y3(MAX(XSIZE,YSIZE))
IF LEV>0 THEN
CALL IWAVELET2D(LEV-1,XS,YS, XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2) !'再帰呼び出し
CALL IWAVELET2D(LEV-1,XS+XSIZE/2,YS, XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2)
CALL IWAVELET2D(LEV-1,XS,YS+YSIZE/2, XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2)
CALL IWAVELET2D(LEV-1,XS+XSIZE/2,YS+YSIZE/2,XSIZE/2,YSIZE/2,RR1,GG1,BB1,RR2,GG2,BB2)
FOR J=0 TO YSIZE-1
FOR I=0 TO XSIZE-1
LET X1(I)=RR1(I+XS,J+YS)
LET X2(I)=GG1(I+XS,J+YS)
LET X3(I)=BB1(I+XS,J+YS)
NEXT I
CALL IWAVELET(XSIZE,X1,Y1)
CALL IWAVELET(XSIZE,X2,Y2)
CALL IWAVELET(XSIZE,X3,Y3)
FOR I=0 TO XSIZE-1
LET RR2(I+XS,J+YS)=Y1(I)
LET GG2(I+XS,J+YS)=Y2(I)
LET BB2(I+XS,J+YS)=Y3(I)
NEXT I
NEXT J
FOR I=0 TO XSIZE-1
FOR J=0 TO YSIZE-1
LET X1(J)=RR2(I+XS,J+YS)
LET X2(J)=GG2(I+XS,J+YS)
LET X3(J)=BB2(I+XS,J+YS)
NEXT J
CALL IWAVELET(YSIZE,X1,Y1)
CALL IWAVELET(YSIZE,X2,Y2)
CALL IWAVELET(YSIZE,X3,Y3)
FOR J=0 TO YSIZE-1
LET RR1(I+XS,J+YS)=Y1(J)
LET GG1(I+XS,J+YS)=Y2(J)
LET BB1(I+XS,J+YS)=Y3(J)
NEXT J
NEXT I
FOR J=0 TO YSIZE-1
FOR I=0 TO XSIZE-1
LET RR2(I+XS,J+YS)=RR1(I+XS,J+YS)
LET GG2(I+XS,J+YS)=GG1(I+XS,J+YS)
LET BB2(I+XS,J+YS)=BB1(I+XS,J+YS)
NEXT I
NEXT J
END IF
END SUB
EXTERNAL SUB WAVELET(SIZE,DAT1(),DAT2()) !'ウェーブレット変換
OPTION ARITHMETIC NATIVE
FOR I=0 TO SIZE/2-1
LET DAT2(I) =.5*DAT1(I*2)+.5*DAT1(I*2+1) !'足して2で割る
LET DAT2(I+SIZE/2)=.5*DAT1(I*2)-.5*DAT1(I*2+1) !'引いて2で割る
NEXT I
END SUB
EXTERNAL SUB IWAVELET(SIZE,DAT2(),DAT1()) !'ウェーブレット逆変換
OPTION ARITHMETIC NATIVE
FOR I=0 TO SIZE/2-1
LET DAT1(I*2) =DAT2(I)+DAT2(I+SIZE/2) !'足す
LET DAT1(I*2+1)=DAT2(I)-DAT2(I+SIZE/2) !'引く
NEXT I
END SUB
|
|