私のための離散ウェーブレット変換〜二次元 - ryamadaの遺伝学・遺伝統計学メモ

二次元に拡張するときには、「縦」をやって「横」をやる
- 「縦」に「和」「差」の２種類、そこからさらに「和」「差」の２種類ができるから「和ー和」「和ー差」「差ー和」「差ー差」の４種類ができる
- waveslimパッケージのxboxというデータを使ってみる

library(waveslim)
data(xbox)
image(xbox)
||>
-やってみる
[f:id:ryamada22:20141125130748j:image]
>|r|
my.dwt.2d <- function(x,ord=c(1,2),fs){
# 1次元データにフィルタfをかけて、xと同じ長さのベクトルを返す関数
	tmp.fx <- function(x,f){
		x. <- c(rep(0,length(f)-1),x)
		y <- rep(0,length(x))
		for(i in 1:length(x)){
			y[i] <- sum(x.[i:(i+length(f)-1)] * f)
		}
		y
	}
	n <- length(x[,1])
	X <- x
# 上で作った関数を、行についてfs[[1]]のフィルタをかけ
# ついで、列についてfs[[2]]のフィルタをかける
	for(i in 1:length(ord)){
		for(j in 1:n){
			if(ord[i] ==1){
				X[j,] <- tmp.fx(X[j,],fs[[i]])
			}else if(ord[i]==2){
				X[,j] <- tmp.fx(X[,j],fs[[i]])
			}
		}
	}
	tmp <- 1:(n/2)
# 1/4個のセルを取り出す
	X[(tmp*2),(tmp*2)]
}
RC.out.f1.f1 <- my.dwt.2d(xbox,c(1,2),list(f1,f1))
RC.out.f1.f2 <- my.dwt.2d(xbox,c(1,2),list(f1,f2))
RC.out.f2.f1 <- my.dwt.2d(xbox,c(1,2),list(f2,f1))
RC.out.f2.f2 <- my.dwt.2d(xbox,c(1,2),list(f2,f2))
# waveslimパッケージの関数を使う
xbox.out <- dwt.2d(xbox,"haar",1)
# ４つずつできた出力行列は同じ色彩(値は定数倍の違いだけ)
par(mfcol=c(2,2))
image(RC.out.f2.f1)
image(RC.out.f1.f2)
image(RC.out.f1.f1)
image(RC.out.f2.f2)
par(mfcol=c(1,1))
dev.new()

par(mfcol=c(2,2))
image(xbox.out[[1]])
image(xbox.out[[2]])
image(xbox.out[[3]])
image(xbox.out[[4]])
par(mfcol=c(1,1))

- xboxを少し変えてやってみる
  - ２法で値は違うけれど、定数倍の関係にあることがわかる

xbox2 <- xbox + rnorm(length(xbox))
RC.out.f1.f1 <- my.dwt.2d(xbox2,c(1,2),list(f1,f1))
RC.out.f1.f2 <- my.dwt.2d(xbox2,c(1,2),list(f1,f2))
RC.out.f2.f1 <- my.dwt.2d(xbox2,c(1,2),list(f2,f1))
RC.out.f2.f2 <- my.dwt.2d(xbox2,c(1,2),list(f2,f2))
xbox.out <- dwt.2d(xbox2,"haar",1)

par(mfcol=c(2,2))
image(RC.out.f2.f1)
image(RC.out.f1.f2)
image(RC.out.f1.f1)
image(RC.out.f2.f2)
par(mfcol=c(1,1))
dev.new()

par(mfcol=c(2,2))
image(xbox.out[[1]])
image(xbox.out[[2]])
image(xbox.out[[3]])
image(xbox.out[[4]])
par(mfcol=c(1,1))
plot(c(RC.out.f2.f1,RC.out.f1.f2,RC.out.f1.f1,RC.out.f2.f2),c(xbox.out[[1]],xbox.out[[2]],xbox.out[[3]],xbox.out[[4]]),pch=20,cex=0.1)

行で処理して列を処理する、のと、列で処理して行を処理するのは同じ。確認しておく

RC.out.f1.f1 <- my.dwt.2d(xbox,c(1,2),list(f1,f1))
RC.out.f1.f2 <- my.dwt.2d(xbox,c(1,2),list(f1,f2))
RC.out.f2.f1 <- my.dwt.2d(xbox,c(1,2),list(f2,f1))
RC.out.f2.f2 <- my.dwt.2d(xbox,c(1,2),list(f2,f2))
CR.out.f1.f1 <- my.dwt.2d(xbox,c(2,1),list(f1,f1))
CR.out.f1.f2 <- my.dwt.2d(xbox,c(2,1),list(f1,f2))
CR.out.f2.f1 <- my.dwt.2d(xbox,c(2,1),list(f2,f1))
CR.out.f2.f2 <- my.dwt.2d(xbox,c(2,1),list(f2,f2))
par(mfcol=c(2,2))
image(RC.out.f2.f1)
image(RC.out.f1.f2)
image(RC.out.f1.f1)
image(RC.out.f2.f2)
par(mfcol=c(1,1))
dev.new()
par(mfcol=c(2,2))
image(CR.out.f2.f1)
image(CR.out.f1.f2)
image(CR.out.f1.f1)
image(CR.out.f2.f2)
par(mfcol=c(1,1))