투빅스 8&9기 8주차 과제 PCA -9기 신용재

by 신용재 posted Mar 23, 2018

단축키

Prev이전 문서

Next다음 문서

ESC닫기

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
PCA 분석 과제입니다.

cereal<-read.csv("cereals.csv", header=TRUE)
#열 이름 깨짐
colnames(cereal)[1]<-"name"
row.names(cereal) <- paste(round(cereal$rating),'-', cereal$name, sep = '')
str(cereal)
 
#이번 분석은 PCA를 이용해 cereal의 rating을 예측해보기로 한다.
 
library(psych)
pairs.panels(cereal[,-c(1,2,3,13)],pch=20)




#종속 변수와 상관계수가 높은 변수들이 보인다. 일단 범주형 변수는 제외하고 시각화.
#rating과의 관계에서, 11개의 변수들 중 8개의 변수들이 상관계수가 0.3을 넘는다.
#그 중 상관계수가 높은 변수들 3개만 꼽자면,
#sugars:-0.76   calories: -0.69     fiber:0.58
#cereal의 경우 건강의 요소가 중요하게 작용하는 것으로 보인다.
 
#test 와 train 분할
library(caret)
index <- createDataPartition(cereal[,16], p = 0.7, list = FALSE)
train <- cereal[index,]
test <- cereal[-index,]
 
#데이터 조작을 위해 잠시 합친다.
combine<-rbind(train, test)
data<-subset(combine, select=-c(name,rating))
str(data)
 
#pca 분석은 수치형만 가능하므로, one-hot encoding을 활용해 범주형변수는 수치형으로 변환해준다.
library(dummies)
new_data<-dummy.data.frame(data,names=c("mfr","type","shelf"))
#shelf의 경우에도, 범주형 변수의 특성을 갖고 있으므로 one-hot encoding해준다.
str(new_data)
pca.train<-new_data[1:nrow(train),]
pca.test<-new_data[-(1:nrow(train)),]
#train 데이터를 pca해준다.
prin<-prcomp(pca.train, scale=TRUE)
 
#주요성분 2개로 biplot을 그려본다.
biplot(prin, col=c("gray","red"),scale=0)

#밀집도가 높아 좋은 시각화는 아니지만, 밀집도가 낮고, rating이 높은 cereal을 살펴보자.
 
#PC2 에서 eigen vector 계수가 높은 fiber(-0.42),potass(-0.36) 두 축의 관점에서 보면,
#rating이 약 94점인 All_Bran~ 과 68점인 100%-Bran 이 분포해있다. 칼슘과 식이섬유를 상대적으로 많다.
 
#mfrN 또한 PC1,PC2에서 상대적으로 높은 eigen vector계수를 갖고 있다.
#제조사가 Nabisco인 제품.Shredded~ 3개의 제품이 평점이 70점대에 있어 상대적으로 높다.
 
#Nabisco 제조사가 신제품을 계획한다면,
#fiber와 potass를 많이 함유한 제품을 제조해 좋은 rating을 받을 수도 있겠다.
 
#typeH 뜨거운 시리얼의 경우에도 eigen vector 계수가 높다.(상대적으로 Hot cereal의 분포가 적기 때문에 발생한 것으로 추측된다. )
 
#분산을 이용해 설명력을 살펴보자.
explain_rate<-sort(prin$sdev^2/sum(prin$sdev^2), decreasing = TRUE)
#scree plot( elbow)
plot(explain_rate,type="b")

#20개 정도의 주요성분을 사용하면, 모든 데이터에 대한 설명력을 갖추게 된다.
 
#cumulative graph
plot(cumsum(explain_rate),type="b")

 
summary(prin)
 
#이제 test 데이터의 rating을 예측해보자.
 
#하지만 차원 축소의 효과를 위해, 11개 정도의 주요성분으로 예측을 해보기로 한다.
#11개의 주요성분을 사용할 경우 데이터의 90%정도가 설명이 가능하다.
head(prin$x)
#train data와 동일한 축(11개)를 test에 적용시킨다.
train.data<-data.frame(rating=train$rating,prin$x)
train.data<-train.data[,1:12]
 
 
#test 데이터도 pc1~11의 축에 맞춰준다.
test.data<-predict(prin, newdata=pca.test)
test.data<-as.data.frame(test.data)
test.data<-test.data[,1:11]
 
#train data의 11개의 주성분을 이용해 선형회귀 모델을 만든다.
linear_model<-lm(rating~., data=train.data)
#예측
linear.prediction<-predict(linear_model,test.data)
#성능평가 
cor(linear.prediction,test$rating)
#0.9205267
 
#rpart 트리로도 적용시켜본다.
library(rpart)
rpart_model<-rpart(rating~., data=train.data)
rpart.prediction<-predict(rpart_model,test.data)
cor(rpart.prediction,test$rating)
#0.8339041
 
 
 
 
#### 2번 문제..
#접근 방식은 위의 문제와 같이 한다.
 
df<-read.csv("2015_7차_직접측정 데이터.csv")
library(dplyr)
female<-df %>% filter(성별=="여")
#row.names(female) <- paste(round(femalel$몸무게),'-', cereal$name, sep = '')
 
sum(is.na(female))
#결측치: 129
#여성만 추출
female<-na.omit(female)
summary(female)
 
index <- createDataPartition(female[,1], p = 0.7, list = FALSE)
train <- female[index,]
test <- female[-index,]
 
combine<-rbind(train, test)
#종속변수와 성별을 빼준다.
data<-subset(combine, select=-c(몸무게,성별))
str(data)
#pca를 돌리기 위한 train, test 생성
pca.train<-data[1:nrow(train),]
pca.test<-data[-(1:nrow(train)),]
str(pca.train)
#train 데이터를 pca해준다.
prin<-prcomp(pca.train, scale=TRUE)
 
#주요성분 2개로 biplot을 그려본다.
biplot(prin, col=c("gray","red"),scale=0)
#변수가 많은 만큼 시각화하기가 편하지는 않다..
 
 
#PC들의 표준편차, 분산, 누적비율을 살펴본다.
summary(prin)
#135개 중에서 PC 36개를 사용할 경우 약 90%의 설명력을 갖추게 된다.
 
#이제 test 데이터의 rating을 예측해보자.
 
#train data와 동일한 축(36개)를 test에 적용시킨다.
train.data<-data.frame(몸무게=train$몸무게,prin$x)
train.data<-train.data[,1:37]
 
 
#test 데이터도 pc1~36의 축에 맞춰준다.
test.data<-predict(prin, newdata=pca.test)
test.data<-as.data.frame(test.data)
test.data<-test.data[,1:36]
 
#train data의 11개의 주성분을 이용해 선형회귀 모델을 만든다.
linear_model<-lm(몸무게~., data=train.data)
#예측
linear.prediction<-predict(linear_model,test.data)
#성능평가 
cor(linear.prediction,test$몸무게)
#0.9825608
 
#rpart 트리로도 적용시켜본다.
rpart_model<-rpart(몸무게~., data=train.data)
rpart.prediction<-predict(rpart_model,test.data)
cor(rpart.prediction,test$몸무게)
#0.9113444
 
 
 
Colored by Color Scripter
cs