Drop Down MenusCSS Drop Down MenuPure CSS Dropdown Menu

公開日 : 2017-08-20

主成分分析までをRで書いてみる(データサイエンス養成読本)

このエントリーをはてなブックマークに追加
2017/08/20
今日もちびちびデータサイエンティスト養成読本を進めながらRを学習しました。




基本的には写経ですが、気になったところも少し深堀して調べてみました。



データフレームの基本操作 P30~


#csvが存在するディレクトリを選択
setwd("C:/Users/Dai/Desktop")


#csvデータの読み込み
body.data <- read.table("body_sample.csv", header = T)
head(body.data)


#データフレームの基本操作

body.data[, 2] #列番号を指定して取得
body.data[, c[1,3]] #複数の列番号を指定して取得
body.data[, "weight"] #列名で取得
body.data$weight #列名で取得
body.data[, c("height","weight")]

body.data[body.data$gender == "F"] #条件にあった行だけ取り出す
body.data[order(body.data$height)] #身長順にソート
body.data[order(body.data$height, decreasing = T )] #身長順にソート

#要約統計量

summary(body.data)

#標準偏差と不偏分散

sd(body.data$height)
val(body.data$weight)

ggplot2のインストールで詰まる


ggplotをインストールする際に、いろいろエラーが発生してしまいました。そこまでの軌跡はこちらにまとめておきました。

セキュリティの問題だったので、カスペルスキーをいったん解除したら治りましたとさ。


ヒストグラムを書いてみよう



#ヒストグラムの描画

ggplot(data, aes(x=height)) + geom_histogram() + theme_bw(16) + ylab("count")
ggplot(data, aes(x=height, fill = gender)) + geom_histogram() + theme_bw(16) + ylab("count")

#身長データの箱ひげ図

ggplot(data, aes(x = gender, y=height, fill = gender)) + geom_boxplot() + theme_bw(16)



#(番外編) 散布図を作成する
ggplot(data, aes(x = height, y=height, fill = gender)) + geom_point() + theme_bw(16)

#(番外編) 散布図を作成し、genderごとに色を分ける
ggplot(data, aes(x = height, y = weight, fill = gender)) + geom_point(aes(colour=gender)) #+ theme_bw(16)

#(番外編)X軸とY軸に名前をつけ、さらにタイトルにまで名前を付ける

ggplot(data, aes(x = height, y = weight, fill = gender)) + geom_point(aes(colour=gender)) + ggtitle("Weight and Height in Sex Difference") + xlab("Height") + ylab("Height")




#回帰直線を追加

ggplot(data, aes(x = height, y = weight, fill = gender)) + geom_point(aes(colour=gender)) + ggtitle("Weight and Height in Sex Difference") + xlab("Height") + ylab("Height") + geom_smooth(method = "lm")

#相関係数を算出(全体)

cor(data$height,data$weight)

#相関係数を算出(男性)
m <- data[data$gender == "M",]
cor(m$height, m$weight)

#相関係数を算出(女性)
f <- data[data$gender == "F",]
cor(m$height, m$weight)

多変量解析をやってみよう(P34~)



#仮想データの読み込み

amount <- read.csv("amount1.csv")

#上位6県を表示

head(amount)

#数値要約

summary(amount)

#散布図の描画

ggplot(amount, aes(x = invest, y = amount)) + geom_point() + theme_bw(16)+ggtitle("多変量解析")

#線形回帰分析(liner models)

data <- amount
lm <- lm(amount^invest, data=data)
summary(lm)

#逓減型回帰モデル

ggplot(amount, aes(x = invest, y = amount)) + geom_point() + theme_bw(16)+ggtitle("多変量解析") + geom_smooth(method = "lm", formula = y ~ log(x))


このへんよく理解できなかったなぁ。

P36

#ロジスティック回帰モデル

z <- data.frame(Titanic)
head(z)




#データの整形

data <- data.frame(
     Class = rep(z$Class, z$Freq),
     Sex = rep(z$Sex, z$Freq),
     Age = rep(z$Age, z$Freq),
     Survived = rep(z$Survived, z$Freq))

nrow(data) #データの個数を調べる

#モデルの構築

logit <- glm(Survived~., data = data, family = binomial)
summary(logit)

#epicalcパッケージの読み込みとオッズ比の計算

install.packages("devtools")
library(devtools)
install_github("cran/epicalc")
library(epicalc)

#オッズ比の算出
logistic.display(logit,simplified  =T)

#決定木モデルの構築

install.packages("partykit")
library(rpart)
library(partykit)

#決定木モデルの構築

rp <- rpart(Survived~., data=data )

#決定木の描画

plot(as.party(rp), tp_args=T)





library(rpart.plot)
prp(rp, type=2, extra=101, nn=TRUE, fallen.leaves=TRUE, faclen=0, varlen=0, shadow.col="grey", branch.lty=2, cex = 0.9, split.cex=1.3, under.cex = 1.0)

#主成分分析 Population Income Illiteracy Life Exp Murder HS Grad Frost   Area

data <- state.x77
nrow(data)
pca <- prcomp(data[,1:6], scale = T)
biplot(pca)




今日はここまででした!



スポンサーリンク