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

RでDeep Learning(1)

環境はWindows10 & R-3.3.3

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

まずはいろいろな活性化関数を定義する。

#ステップ関数
step_function <- function(x) as.numeric(x>0)

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

#ReLU関数
relu <- function(x) sapply(x, function(z) max(0,z))

#恒等関数
identity_function <- function(x) x

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

#重みとバイアスの初期化
init_network <- function(){
	network <- as.list(NULL)
	network <- network %>% c(list(W1=rbind(c(0.1,0.3,0.5),c(0.2,0.4,0.6))))
	network <- network %>% c(list(W2=rbind(c(0.1,0.4),c(0.2,0.5),c(0.3,0.6))))
	network <- network %>% c(list(W3=rbind(c(0.1,0.3),c(0.2,0.4))))
	network <- network %>% c(list(b1=c(0.1,0.2,0.3)))
	network <- network %>% c(list(b2=c(0.1,0.2)))
	network <- network %>% c(list(b3=c(0.1,0.2)))
	return(network)
}	

#入力→出力
forward <- 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 <- identity_function(a3)
	return(y)
}

いよいよ実行。

network <- init_network()
x <- c(1.0,0.5)
x %>% forward(network,.)
          [,1]      [,2]
[1,] 0.3168271 0.6962791

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

RでEutilsを使ってみる

library(dplyr)
library(rvest)

pubmedID <- "25517282"
address <- "http://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?db=pubmed&mode=XML&id="

myXML <- read_xml(paste(address,pubmedID,sep=""))

#雑誌名
myXML %>% 
	xml_nodes(xpath="//Journal/Title") %>% xml_text()

#年
myXML %>% 
	xml_nodes(xpath="//JournalIssue/PubDate") %>%
	xml_children() %>%
	xml_text() %>% 
	paste(collapse=" ") 

#ページ数
myXML %>% 
	xml_nodes(xpath="//MedlinePgn") %>% xml_text()

#タイトル
myXML %>% 
	xml_nodes(xpath="//ArticleTitle") %>% xml_text()

これもスクレイピングと言えるのかな?

Rのパイプ処理が使えない?

環境はWindows10 & R-3.3.3
原因は

Help on topic 'filter' was found in the following packages:
Return rows with matching conditions.
(in package dplyr in library C:/R-3.3.3/library)
Linear Filtering on a Time Series
(in package stats in library C:/R-3.3.3/library)

これはダメ

> mtcars %>% filter(cyl==8)
 filter(., cyl == 8) でエラー:  オブジェクト 'cyl' がありません 

これはOK

> mtcars %>% dplyr::filter(cyl==8)
    mpg cyl  disp  hp drat    wt  qsec vs am gear carb
1  18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2
2  14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4
3  16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3
4  17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3
5  15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3
6  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4
7  10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4
8  14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4
9  15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2
10 15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2
11 13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4
12 19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2
13 15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4
14 15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8

ちなみにデータフレームから特定の列をベクトルとして抽出するのに難渋した。
以下の二つはデータフレームとして抽出される

iris["Sepal.Length"]
iris %>% select(Sepal.Length)

以下のようにすればベクトルとして抽出できる

iris$Sepal.Length
iris[["Sepal.Length"]]
iris %>% getElement("Sepal.Length")

パイプ処理ってややこしい。

ExcelからWord内の単語を置換する

環境はWindows10 & Office 2013

    Dim wdObj As Object
    Dim wdDoc As Object

    Set wdObj = CreateObject("Word.Application")
    wdObj.Visible = True
    wdObj.Activate

    Set wdDoc = wdObj.Documents.Open(ThisWorkbook.Path & "\test.docx")
    
    With wdDoc.Content.Find
        .Text = "置換前"
        .Replacement.Text = "置換後"
        .Forward = True
        .Execute Replace:=2
    End With