RでDeep Learning(9)

Rでim2colの実装(プーリング層はim2col_poolingとして別に実装)
Rのdrop機能にはまった。

im2col <- function(input_data,filter_h,filter_w,stride=1,pad=0){
	#imput_data:4次元配列からなるデータ
	#filter_h:フィルターの高さ
	#filter_w:フィルターの幅

	H <- dim(input_data)[1]
	W <- dim(input_data)[2]
	C <- dim(input_data)[3]
	N <- dim(input_data)[4]
	
	out_h <- ((H + 2*pad - filter_h) %/% stride) + 1
	out_w <- ((W + 2*pad - filter_w) %/% stride) + 1

	if(pad==0){
		img <- input_data
	}else{
		img <- array(0,c((H+2*pad),(W+2*pad),C,N))
		for(i in 1:C){
			for(v in 1:N){
				img[(1+pad):(H+pad),(1+pad):(W+pad),i,v] <- input_data[,,i,v]
			}
		}
	}
	m_col <- filter_h * filter_w * C
	m_row <- N * out_h * out_w
	m <- matrix(0,m_row,m_col)

	if(C != 1){
		row_number <- 1
		for(dim_4 in 1:N){
			for(out_w_index in 1:out_w){
				w_start <- (out_w_index - 1) * stride + 1
				w_end <- (out_w_index - 1) * stride + filter_w
			
				for(out_h_index in 1:out_h){
					h_start <- (out_h_index - 1) * stride + 1
					h_end <- (out_h_index - 1) * stride + filter_h
					y <- apply(img[,,,dim_4],3,function(x)x[h_start:h_end,w_start:w_end])
					m[row_number,] <- as.vector(y)
					row_number <- row_number + 1
				}
			}
		}
	}else{
		row_number <- 1
		for(dim_4 in 1:N){
			for(out_w_index in 1:out_w){
				w_start <- (out_w_index - 1) * stride + 1
				w_end <- (out_w_index - 1) * stride + filter_w
			
				for(out_h_index in 1:out_h){
					h_start <- (out_h_index - 1) * stride + 1
					h_end <- (out_h_index - 1) * stride + filter_h
					y <- img[h_start:h_end,w_start:w_end,1,dim_4]
					m[row_number,] <- as.vector(y)
					row_number <- row_number + 1
				}
			}
		}
	}
	return(m)
}

MNISTはチャネル数1なので3次元用のim2col_singleを使用。
(コード簡略化と高速化のため)
Convolution層を最初にしか置かないのでこれでOK。

im2col_single <- function(input_data){

	#imput_data:3次元配列(チャネル数1)
	#フィルター5×5
	#stride:1
	#pad:0

	H <- dim(input_data)[1]
	W <- dim(input_data)[2]
	N <- dim(input_data)[3]

	out_h <- H - 4
	out_w <- W - 4

	m_row <- N * out_h * out_w
	m <- matrix(0,m_row,25)

	myF <- function(x){
		for(w_index in 1:out_w){
			for(h_index in 1:out_h){
				m[row_number,] <<- as.vector(x[h_index:(h_index+4),w_index:(w_index+4)])
				row_number <<- row_number + 1
				}
			}
		}
	row_number <- 1
	apply(input_data,3,myF)
	
	return(m)
}
> dim(x_test)
[1]    28    28     1 10000
> x_test_3D <- x_test[,,1,]
> dim(x_test_3D)
[1]    28    28 10000
> system.time(col <- im2col(x_test,5,5,stride=1,pad=0))
   ユーザ   システム       経過  
     37.84       0.28      38.19 
> system.time(col2 <- im2col_single(x_test_3D))
   ユーザ   システム       経過  
     26.41       0.23      26.72 
> identical(col,col2)
[1] TRUE
im2col_pooling <- function(input_data,filter_h,filter_w){

	#stride=2
	#pad=0

	H <- dim(input_data)[1]
	W <- dim(input_data)[2]
	C <- dim(input_data)[3]
	N <- dim(input_data)[4]

	row_num <- ((H*W)/(filter_h*filter_w))*C*N
	col_num <- filter_h * filter_w

	t <- array(input_data,c(filter_h,H/filter_h,filter_w,W/filter_w,C,N))
	tt <- aperm(t,c(1,3,2,4,5,6))
	ttt <- matrix(tt,c(row_num,col_num),byrow=T)
	
	return(ttt)
}
col2im_pooling <- function(x,H,W,C,N,filter_h,filter_w){

	#stride=2
	#pad=0

	t <- array(t(x),c(filter_h,filter_w,H/filter_h,W/filter_w,C,N))
	tt <- aperm(t,c(1,3,2,4,5,6))
	ttt <- array(tt,c(H,W,C,N))
	return(ttt)
}