読者です 読者をやめる 読者になる 読者になる

RでDeep Learning(8)

正解できなかった問題の一部。

y <- predict(x_test)
y_1 <- apply(y,1,which.max)
t <- apply(t_test,1,which.max)
error <- t!=y_1

num_image <- x_test[error,]
num_t <- t_test[error,]
num_predict <- y[error,]

hyozi <- function(x){
a <- num[x,]
b <- matrix(a,nrow=28,byrow=T)
d <- t(b[nrow(b):1,ncol(b):1])[ncol(b):1,]
image(d,axes=FALSE)

print(paste("正解:",which.max(num_t[x,])-1))
print(paste("予測:",which.max(num_predict[x,])-1))
}

正解:9、予測:3
f:id:touch-sp:20170428044716p:plain:w300

正解:5、予測:6
f:id:touch-sp:20170428044813p:plain:w300

正解:0、予測:8
f:id:touch-sp:20170428044939p:plain:w300

RでDeep Learning(7)

前回の続き(テストデータで評価)

library(dplyr)
library(R6)

#パラメータの初期化
W1 <- matrix(rnorm(784*50),nrow=784)*0.01
W2 <- matrix(rnorm(50*10),nrow=50)*0.01
b1 <- matrix(numeric(50),nrow=1)
b2 <- matrix(numeric(10),nrow=1)

#データの読み込み
x_train <- readRDS("x_train")
x_train <- x_train/255
t_train <- readRDS("t_train")
x_test <- readRDS("x_test")
t_test <- readRDS("t_test")
Relu <- R6Class("Relu",

	public = list(
		mask = NULL,
		
		forward = function(x){
			out <- x
			self$mask <- x<=0
			out[self$mask] <-0
			return(out)
		},
		
		backward = function(dout){
			dout[self$mask] <- 0
			return(dout)
		}
	)
)
Affine <- R6Class("Affine",

	public = list(
		W = NULL,
		b = NULL,
		x = NULL,
		dW = NULL,
		db = NULL,
		
		initialize = function(W,b){
			self$W <- W
			self$b <- b
		},

		forward = function(x){
			if(x %>% is.vector()){
				batch <- 1
			}else{
				batch <- nrow(x)
			}
			self$x <- x
			out <- (x %*% self$W)+matrix(rep(self$b,batch),nrow=batch,byrow=T)
			return(out) 
		},
		
		backward = function(dout){
			dx <- dout %*% (self$W %>% t())
			self$dW <- (self$x %>% t()) %*% dout
			self$db <- apply(dout,2,sum)
			return(dx)
		}
	)
)
#softmax関数
softmax <- function(x){
	sm_in <- function(a){
		m <- max(a)
		exp_x <- exp(a-m)
		sum_exp_x <- sum(exp_x)
		b <- exp_x/sum_exp_x
		return(b)
	}
	y <- apply(x,1,sm_in) %>% t()
	return(y)
}

#交差エントロピー誤差
cross_entropy_error <- function(y,t){

	batch_size <- nrow(y)

	temp <- (-1)*sum(t*log(y))/batch_size
	return(temp)
}

SoftmaxWithLoss <- R6Class("SoftmaxWithLoss",

	public = list(
		loss = NULL,
		y = NULL,
		t = NULL,

		forward = function(x,t){
			self$t <- t
			self$y <- softmax(x)
			self$loss <- cross_entropy_error(self$y,self$t)
			return(self$loss) 
		},
		
		backward = function(dout){
			batch_size <- self$t %>% nrow()
			dx <- (self$y - self$t)/batch_size
			return(dx)
		}
	)
)
layers <- as.list(NULL)
layers[[1]] <- Affine$new(W1,b1)
layers[[2]] <- Relu$new()
layers[[3]] <- Affine$new(W2,b2)
lastlayer <- SoftmaxWithLoss$new()

predict <- function(x){
	for(i in 1:3){
		x <- layers[[i]]$forward(x)
	}
	return(x)
}

loss <- function(x,t){
	y <- predict(x)
	z <- lastlayer$forward(y,t)
	return(z)
}

gradient <- function(x,t){

	#forward
	loss(x,t)

	#backward
	dout <- lastlayer$backward(1)
	for(i in 3:1){
		dout <- layers[[i]]$backward(dout)
	}
	
	grads <- as.list(NULL)
	grads <- grads %>% c(list(W1=layers[[1]]$dW))
	grads <- grads %>% c(list(b1=layers[[1]]$db))
	grads <- grads %>% c(list(W2=layers[[3]]$dW))
	grads <- grads %>% c(list(b2=layers[[3]]$db))
	return(grads)
}
accuracy <- function(x,t){
	batch <- nrow(x)
	y <- predict(x)
	y <- apply(y,1,which.max)
	t <- apply(t,1,which.max)
	accuracy <- sum(t==y)/batch
	return(accuracy)
}

#ハイパーパラメータ
iters_num <- 9000
train_size <- 60000
batch_size <- 100
learning_rate <- 0.1

test_acc <- accuracy(x_test,t_test)

for(i in 1:iters_num){

	#ミニバッチの取得
	batch_mask<-sample(train_size,batch_size)
	x_batch <- x_train[batch_mask,]
	t_batch <- t_train[batch_mask,]

	#勾配の計算
	grads <- gradient(x_batch,t_batch)

	#パラメータの更新
	layers[[1]]$W <- layers[[1]]$W - (grads$W1 * learning_rate)
	layers[[3]]$W <- layers[[3]]$W - (grads$W2 * learning_rate)
	layers[[1]]$b <- layers[[1]]$b - (grads$b1 * learning_rate)
	layers[[3]]$b <- layers[[3]]$b - (grads$b2 * learning_rate)

	if(i%%600==0){
		test_acc <- c(test_acc,accuracy(x_test,t_test))
	}
}

f:id:touch-sp:20170428042004p:plain

RでDeep Learning(6)

環境はWindows10 & R-3.3.3

誤差逆伝播法を用いた2層ニューラルネットワーク

library(dplyr)
library(R6)

#パラメータの初期化
W1 <- matrix(rnorm(784*50),nrow=784)*0.01
W2 <- matrix(rnorm(50*10),nrow=50)*0.01
b1 <- matrix(numeric(50),nrow=1)
b2 <- matrix(numeric(10),nrow=1)

#データの読み込み
x_train <- readRDS("x_train")
x_train <- x_train/255
t_train <- readRDS("t_train")

Reluレイヤ

Relu <- R6Class("Relu",

	public = list(
		mask = NULL,
		
		forward = function(x){
			out <- x
			self$mask <- x<=0
			out[self$mask] <-0
			return(out)
		},
		
		backward = function(dout){
			dout[self$mask] <- 0
			return(dout)
		}
	)
)

Affineレイヤ

Affine <- R6Class("Affine",

	public = list(
		W = NULL,
		b = NULL,
		x = NULL,
		dW = NULL,
		db = NULL,
		
		initialize = function(W,b){
			self$W <- W
			self$b <- b
		},

		forward = function(x){
			if(x %>% is.vector()){
				batch <- 1
			}else{
				batch <- nrow(x)
			}
			self$x <- x
			out <- (x %*% self$W)+matrix(rep(self$b,batch),nrow=batch,byrow=T)
			return(out) 
		},
		
		backward = function(dout){
			dx <- dout %*% (self$W %>% t())
			self$dW <- (self$x %>% t()) %*% dout
			self$db <- apply(dout,2,sum)
			return(dx)
		}
	)
)

SoftmaxWithLossレイヤ

#softmax関数
softmax <- function(x){
	sm_in <- function(a){
		m <- max(a)
		exp_x <- exp(a-m)
		sum_exp_x <- sum(exp_x)
		b <- exp_x/sum_exp_x
		return(b)
	}
	y <- apply(x,1,sm_in) %>% t()
	return(y)
}

#交差エントロピー誤差
cross_entropy_error <- function(y,t){

	batch_size <- nrow(y)

	temp <- (-1)*sum(t*log(y))/batch_size
	return(temp)
}

SoftmaxWithLoss <- R6Class("SoftmaxWithLoss",

	public = list(
		loss = NULL,
		y = NULL,
		t = NULL,

		forward = function(x,t){
			self$t <- t
			self$y <- softmax(x)
			self$loss <- cross_entropy_error(self$y,self$t)
			return(self$loss) 
		},
		
		backward = function(dout){
			batch_size <- self$t %>% nrow()
			dx <- (self$y - self$t)/batch_size
			return(dx)
		}
	)
)
layers <- as.list(NULL)
layers[[1]] <- Affine$new(W1,b1)
layers[[2]] <- Relu$new()
layers[[3]] <- Affine$new(W2,b2)
lastlayer <- SoftmaxWithLoss$new()

predict <- function(x){
	for(i in 1:3){
		x <- layers[[i]]$forward(x)
	}
	return(x)
}

loss <- function(x,t){
	y <- predict(x)
	z <- lastlayer$forward(y,t)
	return(z)
}

gradient <- function(x,t){

	#forward
	loss_vector <<- c(loss_vector,loss(x,t))

	#backward
	dout <- lastlayer$backward(1)
	for(i in 3:1){
		dout <- layers[[i]]$backward(dout)
	}
	
	grads <- as.list(NULL)
	grads <- grads %>% c(list(W1=layers[[1]]$dW))
	grads <- grads %>% c(list(b1=layers[[1]]$db))
	grads <- grads %>% c(list(W2=layers[[3]]$dW))
	grads <- grads %>% c(list(b2=layers[[3]]$db))
	return(grads)
}
#ハイパーパラメータ
iters_num <- 10000
train_size <- 60000
batch_size <- 100
learning_rate <- 0.1

loss_vector <- NULL

for(i in 1:iters_num){

	#ミニバッチの取得
	batch_mask<-sample(train_size,batch_size)
	x_batch <- x_train[batch_mask,]
	t_batch <- t_train[batch_mask,]

	#勾配の計算
	grads <- gradient(x_batch,t_batch)

	#パラメータの更新
	layers[[1]]$W <- layers[[1]]$W - (grads$W1 * learning_rate)
	layers[[3]]$W <- layers[[3]]$W - (grads$W2 * learning_rate)
	layers[[1]]$b <- layers[[1]]$b - (grads$b1 * learning_rate)
	layers[[3]]$b <- layers[[3]]$b - (grads$b2 * learning_rate)
}

f:id:touch-sp:20170428023009p:plain:w350

RでDeep Learning(5)

環境はWindows10 & R-3.3.3

2層ニューラルネットワークの実装と実行
(数値微分を使っているため時間がかかり過ぎて使い物にならない)

library(dplyr)
library(R6)

#シグモイド関数
sigmoid <- function(x) 1/(1+exp(-x))

#softmax関数
softmax <- function(x){
	sm_in <- function(a){
		m <- max(a)
		exp_x <- exp(a-m)
		sum_exp_x <- sum(exp_x)
		b <- exp_x/sum_exp_x
		return(b)
	}
	y <- apply(x,1,sm_in) %>% t()
	return(y)
}

#交差エントロピー誤差
cross_entropy_error <- function(y,t){

	batch_size <- nrow(y)

	temp <- (-1)*sum(t*log(y))/batch_size
	return(temp)
}

#勾配を求める関数
numerical_gradient <- function(f,x){
	h <- 1e-4
	grad <- matrix(numeric(nrow(x)*ncol(x)),nrow=nrow(x))

	for(i in 1:(nrow(x)*ncol(x))){
		tmp_val <- x[i]
		#f(x+h)の計算
		x[i] <- tmp_val+h
		fxh1 <- f(x)

		#f(x-h)の計算
		x[i] <- tmp_val-h
		fxh2 <- f(x)

		grad[i]=(fxh1-fxh2)/(2*h)
		x[i] <- tmp_val
	}
	return(grad)
}
# input_ size <- 784
# hidden_size <- 50
# output_seze <- 10
# weight_init_std <- 0.01

#パラメータの初期化
W1 <- matrix(rnorm(784*50),nrow=784)*0.01
W2 <- matrix(rnorm(50*10),nrow=50)*0.01
b1 <- matrix(numeric(50),nrow=1)
b2 <- matrix(numeric(10),nrow=1)

#データの読み込み
x_train <- readRDS("x_train")
t_train <- readRDS("t_train")
TwoLayerNet <- R6Class("TwoLayerNet",

	public = list(
		
		predict = function(x,W1,W2,b1,b2){
			if(x %>% is.vector()){
				batch <- 1
			}else{
				batch <- nrow(x)
			}
			a1 <- (x %*% W1) + matrix(rep(b1,batch),nrow=batch,byrow=T)
			z1 <- sigmoid(a1)
			a2 <- (z1 %*% W2) + matrix(rep(b2,batch),nrow=batch,byrow=T)
			y <- softmax(a2)
			return(y)
		},

		loss = function(x,W1,W2,b1,b2,t){
			z <- self$predict(x,W1,W2,b1,b2)
			loss <- cross_entropy_error(z,t)
			return(loss)
		}
	)
)
#ハイパーパラメータ
iters_num <- 10000
train_size <- 60000
batch_size <- 100
learning_rate <- 0.1

network <- TwoLayerNet$new()

#ダミー関数の定義
dummy_W1 <- function(z) network$loss(x_batch,z,W2,b1,b2,t_batch)
dummy_W2 <- function(z) network$loss(x_batch,W1,z,b1,b2,t_batch)
dummy_b1 <- function(z) network$loss(x_batch,W1,W2,z,b2,t_batch)
dummy_b2 <- function(z) network$loss(x_batch,W1,W2,b1,z,t_batch)

for(i in 1:iters_num){

	#ミニバッチの取得
	batch_mask<-sample(train_size,batch_size)
	x_batch <- x_train[batch_mask,]
	t_batch <- t_train[batch_mask,]

	#勾配の計算
	grads_W1 <- numerical_gradient(dummy_W1,W1)
	grads_W2 <- numerical_gradient(dummy_W2,W2)
	grads_b1 <- numerical_gradient(dummy_b1,b1)
	grads_b2 <- numerical_gradient(dummy_b2,b2)

	#パラメータの更新
	W1 <- W1 - (learning_rate * grads_W1)
	W2 <- W2 - (learning_rate * grads_W2)
	b1 <- b1 - (learning_rate * grads_b1)
	b2 <- b2 - (learning_rate * grads_b2)

	#学習経過の記録
	loss <- network$loss(x_batch,W1,W2,b1,b2,t_batch)
	print(paste(i,":",loss))
}

RでDeep Learning(4)

環境はWindows10 & R-3.3.3

非常に良い本である。
ただし、自分はPythonに精通していないのでRでDeep Learningを試してみた。

この記事は上記の本に記載されているPythonのコードのほんの一部をRに書き換えただけです。
詳しく知りたい人はぜひ本を読んでみることをお勧めします。
非常に詳しくわかりやすく書かれています。

勾配降下法を実装。

gradient_descent <- function(f,init_x,lr=0.01,step_num=100){
	x <- init_x

	for(i in 1:step_num){
		grad <- numerical_gradient(f,x)
		x <- x-(lr*grad)
	}
	return(x)
}

勾配法による更新のプロセスを図示する。

gradient_descent_plot <- function(f,init_x,lr=0.01,step_num=100){
	x <- init_x
	y <- x

	for(i in 1:step_num){
		grad <- numerical_gradient(f,x)
		x <- x-(lr*grad)
		y <- cbind(y,x)
	}
	return(y)
}
plot_data <- gradient_descent_plot(function_2,c(-3,4),lr=0.1)
plot(plot_data[1,],plot_data[2,],xlim=c(-3,3),ylim=c(-4,4))

f:id:touch-sp:20170420184500p:plain:w350

RでDeep Learning(3)

環境はWindows10 & R-3.3.3

非常に良い本である。
ただし、自分はPythonに精通していないのでRでDeep Learningを試してみた。

この記事は上記の本に記載されているPythonのコードのほんの一部をRに書き換えただけです。
詳しく知りたい人はぜひ本を読んでみることをお勧めします。
非常に詳しくわかりやすく書かれています。

損失関数を定義する。

#2乗和誤差
mean_squared_error <- function(y,t) 0.5*sum((y-t)^2)

#交差エントロピー誤差
cross_entropy_error <- function(y,t) (-1)*sum(t*log(y+1e-7))

f(x_0,x_1)={x_0}^2+{x_1}^2の図示。

Myfunc <- function(x,y) x^2+y^2
x <- seq(-3,3,by=0.1)
y <- x
z <- outer(x,y,Myfunc)
persp(x,y,z,theta=60,phi=25)

f:id:touch-sp:20170419132321p:plain:w350
勾配の実装。

#関数の定義
function_2 <- function(x) sum(x^2)

#勾配を求める関数
numerical_gradient <- function(f,x){
	h <- 1e-4
	grad <- numeric(length(x))

	for(i in 1:length(x)){
		tmp_val <- x[i]
		#f(x+h)の計算
		x[i] <- tmp_val+h
		fxh1 <- f(x)

		#f(x-h)の計算
		x[i] <- tmp_val-h
		fxh2 <- f(x)

		grad[i]=(fxh1-fxh2)/(2*h)
		x[i] <- tmp_val
	}
	return(grad)
}

RでDeep Learning(2)

環境はWindows10 & R-3.3.3

非常に良い本である。
ただし、自分はPythonに精通していないのでRでDeep Learningを試してみた。

この記事は上記の本に記載されているPythonのコードのほんの一部をRに書き換えただけです。
詳しく知りたい人はぜひ本を読んでみることをお勧めします。
非常に詳しくわかりやすく書かれています。

まずはソフトマックス関数を定義する。

softmax <- function(x){
	m <- max(x)
	exp_x <- exp(x-m)
	sum_exp_x <- sum(exp_x)
	y <- exp_x/sum_exp_x
	return(y)
}

次にニューラルネットワークを実装してみる。

#学習済みの重みパラメータとバイアスの読み込み
init_network <- function(){
	network <- as.list(NULL)
	#学習済みの重みパラメータ
	data_W1 <- read.csv("network_W1.csv",header=F) %>% as.matrix()
	data_W2 <- read.csv("network_W2.csv",header=F) %>% as.matrix()
	data_W3 <- read.csv("network_W3.csv",header=F) %>% as.matrix()
	network <- network %>% c(list(W1=data_W1))
	network <- network %>% c(list(W2=data_W2))
	network <- network %>% c(list(W3=data_W3))
	#バイアス
	data_b1 <- read.csv("network_b1.csv",header=F) %>% as.matrix() %>% as.vector()
	data_b2 <- read.csv("network_b2.csv",header=F) %>% as.matrix() %>% as.vector()
	data_b3 <- read.csv("network_b3.csv",header=F) %>% as.matrix() %>% as.vector()
	network <- network %>% c(list(b1=data_b1))
	network <- network %>% c(list(b2=data_b2))
	network <- network %>% c(list(b3=data_b3))
	return(network)
}

#MNISTテストデータの読み込み
get_data <- function(){
	test_data <- as.list(NULL)
	data_x <- read.csv("x_test.csv",header=F) %>% as.matrix()
	data_t <- read.csv("t_test.csv",header=F) %>% as.matrix()
	test_data <- test_data %>% c(list(x_test=data_x))
	test_data <- test_data %>% c(list(t_test=data_t))
	return(test_data)
}

#分類
predict <- function(network,x){
	W1 <- network$W1
	W2 <- network$W2
	W3 <- network$W3
	b1 <- network$b1
	b2 <- network$b2
	b3 <- network$b3

	a1 <- (x %*% W1) + b1
	z1 <- sigmoid(a1)
	a2 <- (z1 %*% W2) + b2
	z2 <- sigmoid(a2)
	a3 <- (z2 %*% W3) + b3
	y <- softmax(a3)
	return(y)
}

いよいよ実行。

myData <- get_data()
x <- myData$x_test
t <- myData$t_test

x <- x/255

network <- init_network()

accuracy_cnt <- 0
for(i in 1:nrow(x)){
	y <- predict(network,x[i,])
	p <- which.max(y)
	if((p-1)==t[i]) accuracy_cnt <- accuracy_cnt+1
}

accuracy_cnt/nrow(x)
[1] 0.9352

画像の表示。

a <- x[1000,]
b <- matrix(a,nrow=28,byrow=T)
y <- t(b[nrow(b):1,ncol(b):1])[ncol(b):1,]
image(y,axes=FALSE)

バッチ処理するためにpredictを書き換え。

predict <- function(network,x){
	if(x %>% is.vector()){
		batch_size <-1
	}else{
		batch_size <- nrow(x)
	}

	W1 <- network$W1
	W2 <- network$W2
	W3 <- network$W3
	b1 <- matrix(rep(network$b1,batch_size),nrow=batch_size,byrow=T)
	b2 <- matrix(rep(network$b2,batch_size),nrow=batch_size,byrow=T)
	b3 <- matrix(rep(network$b3,batch_size),nrow=batch_size,byrow=T) 

	a1 <- (x %*% W1) + b1
	z1 <- sigmoid(a1)
	a2 <- (z1 %*% W2) + b2
	z2 <- sigmoid(a2)
	a3 <- (z2 %*% W3) + b3
	y <- apply(a3,1,softmax) %>% t()
	return(y)
}

そして実行。

myData <- get_data()
x <- myData$x_test
t <- myData$t_test

x <- x/255

network <- init_network()

batch_size <- 100
accuracy_cnt <- 0

for(i in seq(1,10000,by=batch_size)){
	x_batch <- x[i:(i+batch_size-1),]
	y_batch <- predict(network,x_batch)
	p <- apply(y_batch,1,which.max)
	accuracy_cnt <- accuracy_cnt + sum((p-1)==t[i:(i+batch_size-1)])
}

accuracy_cnt/nrow(x)
[1] 0.9352