# データ解析基礎論B W10

```install.packages("nnet")
library(nnet)

# regression
for (i.iter in 1:10){
set.seed(5)
print(i.iter)
x = dat[,1:3]
y = dat[,4]
dat.nnet = nnet(x,y, size = 150, linout= TRUE,maxit = 1000)
nnet.pred <-predict(dat.nnet,dat)
print(c(cor(nnet.pred,dat\$sales),cor(nnet.pred,dat\$sales)^2))
plot(dat.nnet\$fitted.values, dat\$sales,pch=20,col='black')
points(predict(dat.lm), dat\$sales,pch=20,col='red')
abline(h=max(dat\$sales),col='green')
abline(v=max(dat\$sales),col='green')
abline(h=min(dat\$sales),col='green')
abline(v=min(dat\$sales),col='green')
abline(h=mean(dat\$sales),col='green')
abline(v=mean(dat\$sales),col='green')

n.data = nrow(dat);n.sample = n.data*0.6; n.rep = 1000
trainNN.cor = rep(0,n.rep); trainLM.cor = rep(0,n.rep)
testNN.cor = rep(0,n.rep); testLM.cor = rep(0,n.rep)
for (i.rep in 1:n.rep){
randperm = sample(1:n.data)
train.idx = randperm[1:n.sample]
test.idx = randperm[(n.sample+1):n.data]
dat.nnet <- nnet(sales~.,size = 10, linout=T,decay= 0.1, maxit=1000, data = dat[train.idx,])
dat.lm <-lm(sales~.,data=dat[train.idx, ])
trainNN.cor[i.rep] <- cor(predict(dat.nnet,dat[train.idx, ]), dat[train.idx,]\$sales)
trainLM.cor[i.rep] <- cor(predict(dat.lm,dat[train.idx, ]), dat[train.idx,]\$sales)
testNN.cor[i.rep] <- cor(predict(dat.nnet,dat[test.idx, ]), dat[test.idx,]\$sales)
testLM.cor[i.rep] <- cor(predict(dat.lm,dat[test.idx, ]), dat[test.idx,]\$sales)
}
print(c(mean(trainNN.cor,na.rm=T),mean(testNN.cor,na.rm=T)))
print(c(mean(trainLM.cor,na.rm=T),mean(testLM.cor,na.rm=T)))

# logistic regression
dat.nnet<-nnet(class~.,dat,size=30,maxit=1000,decay=0.05)
dat.pred<-predict(dat.nnet,dat,type="class")
table(dat.pred,dat\$class)

dat.glm<-glm(class~., family="binomial",dat)
glm.pred<-predict(dat.glm, dat, type="response")>0.5
table(glm.pred,dat\$class)
dat.glm<-glm(class~social*coop.*dilig.*enterp., family="binomial",dat)

dat.nnet<-nnet(survival~., dat, size=30, maxit=1000, decay=0.01)
dat.pred<-predict(dat.nnet,dat,type="class")
table(dat.pred,dat\$survival)

Ns = summary(dat\$survival)
(Ns[1]/Ns[2])^-1

wts = rep(1,nrow(dat))
wts[which(dat\$survival=="no")]=45
dat.nnet<-nnet(survival~., weights=wts, dat, size=30, maxit=1000, decay=0.01)
dat.pred<-predict(dat.nnet,dat,type="class")
table(dat.pred,dat\$survival)

# discriminant analysis
class.id<-class.ind(dat\$class)
x = dat[,1:6]
dat.nnet<-nnet(x,class.id,size=30, maxit=1000, decay=0.01, softmax=TRUE)
max.id = apply(dat.nnet\$fitted.values,1,which.max)
table(max.id,dat\$class)

dat.nnet<-nnet(dat,dat,size=2, maxit=1000, decay=0.01, linout=TRUE)
```

# 基礎実習MB02

```multi.forwd <- function(x,y){
return(x*y)
}
multi.bckwd <- function(x, y, dout){
dx = dout * y
dy = dout * x
return(list(dx = dx, dy = dy))
}

apple = 100; n.apple = 2; tax = 1.1
apple.pre.tax = multi.forwd(apple, n.apple)
apple.post.tax = multi.forwd(apple.pre.tax, tax)

dprice = 1
d.apple.post.tax = multi.bckwd(apple.pre.tax, tax, dprice)
d.apple = multi.bckwd(apple, n.apple, d.apple.post.tax\$dx)\$dx
d.n.apple = multi.bckwd(apple, n.apple, d.apple.post.tax\$dx)\$dy

```

# データ解析基礎論B W08

```dat<-data.frame(x1=c(50,69,93,76,88,43,56,38,21,25),
x2=c(15.5,18.4,26.4,22.9,18.6,16.9,21.6,12.2,16.0,10.5),
cl=c(rep("h",5),rep("d",5)))
library(MASS)
dat.lda<-lda(cl~.,data=dat)
2, col='skyblue')

dat.lda<-lda(class~.,dat)

dat.lda=lda(class~.,data=dat)
lda.pred<-predict(dat.lda,dat)

plot(dat.lda, dimen=2, col=as.numeric(dat\$class), cex=3)
plot(dat.lda, dimen=5, col=as.numeric(lda.pred\$class),cex=2)

dat.km<-kmeans(dat[,1:6],5)

dat1<-subset(dat,dat\$popularity<5)
dat2<-subset(dat,dat\$popularity>4 & dat\$popularity<6)
dat3<-subset(dat,dat\$popularity>6)
datT=rbind(dat1,dat2,dat3)
datT.lda<-lda(popularity~.,datT)
datT.pred<-predict(datT.lda,datT)
table(datT.pred\$class,datT\$popularity)

plot(datT.lda,col=as.numeric(datT.pred\$class)+2,cex=1)
colors=rep("black",nrow(datT))
miss.idx = which(datT.pred\$class!= datT\$popularity)
colors[miss.idx]='red'
points(datT.pred\$x,pch=20,col=colors)
legend("bottomright",c("correct pred.", "missed"), pch=20,col=(1:2))

dat.lda<-lda(class~.,dat)
dat.glm<-glm(class~.,family=binomial,data=dat)

#MDS
dat<-data.frame(p1=c(4,1,5,1,5),p2=c(1,5,4,3,1))
rownames(dat)<-c('a','b','c','d','e')
dat.mds<-cmdscale(dist(dat),2)
plot(dat.mds[,1],dat.mds[,2], type='n')
text(dat.mds[,1],dat.mds[,2],labels=row.names(dat))
dat.mds<-cmdscale(dist(t(dat)),2,eig=T)

plot(dat.mds\$points[,1],dat.mds\$points[,2], type='n')
text(dat.mds\$points[,1],dat.mds\$points[,2],labels=colnames(dat), cex=2)