昨日の続き。もはや単層パーセプトロンでも、ロジステック回帰でもどっちでもよくて、最急降下法の練習問題と化してしまっている。
www.yasuhisay.info
必要なデータの読み込みと関数の作成
data <- read.table("http://aoki2.si.gunma-u.ac.jp/R/lr.data",header=T) data[c(-3)] <- data[c(-3)]/1000 y <- function(x1,x2,a0,a1,a2){ s <- a0 + a1*x1 +a2*x2 o <- exp(s)/(1+exp(s)) return(o) } deda0 <- function(y,x1,x2,a0,a1,a2){ sum(y-y(x1,x2,a0,a1,a2)) } deda1 <- function(y,x1,x2,a0,a1,a2){ sum((y-y(x1,x2,a0,a1,a2)) * x1) } deda2 <- function(y,x1,x2,a0,a1,a2){ sum((y-y(x1,x2,a0,a1,a2)) * x2) }
初期値の設定とループ処理
a0 <- 0.1 a1 <- 0.1 a2 <- 0.1 alpha <- 0.1 for(i in seq(100000)){ a0 <- a0 + alpha * deda0(data$y,data$x1,data$x2,a0,a1,a2) a1 <- a1 + alpha * deda1(data$y,data$x1,data$x2,a0,a1,a2) a2 <- a2 + alpha * deda2(data$y,data$x1,data$x2,a0,a1,a2) }
パラメータの比較
Rのglmで計算されるパラメータとほぼ一致していることが分かる。> a0 [1] -5.645581 > a1 [1] 8.297108 > a2 [1] 11.38648 > glm(y~x1+x2,family=binomial,data=data) Call: glm(formula = y ~ x1 + x2, family = binomial, data = data) Coefficients: (Intercept) x1 x2 -5.646 8.297 11.386 Degrees of Freedom: 97 Total (i.e. Null); 95 Residual Null Deviance: 76.71 Residual Deviance: 72.18 AIC: 78.18