41. 모델 성능 평가(예제)


r

Overview

회귀 분석의 결과(검정 데이터)를 이용하여 회귀 모델의 예측치를 생성하는 예시


분석 예제 1

getLinearReg <- function(data01) {
  # 독립변수
  x <- data01[,2]
  # 종속변수
  y <- data01[,1]
  
  model <- lm(y ~ x, data = data01)
  plot(data01, pch = '*', lwd = 2, cex = 2.0, col = 'blue', main = 'y = 2 * x + 1 linear regression')
  abline(coef(model), col = 'red', lwd = 2)
}

test <- read.csv('test02.csv', header = T)

test[,2]
getLinearReg(test)

summary(test)

x <- test$x
y <- test$y

model <- lm(y ~ x, data = test)
model

attributes(model)

model$coefficients

fitted.values(model)

resi <- residuals(model)

resi_square_tot <- sum(resi ** 2)
resi_square_tot

summary(model)

분석 예제 2

getLinearReg <- function(data01) {
  # 독립변수
  x <- data01[,2]
  # 종속변수
  y <- data01[,1]
  
  model <- lm(y ~ x, data = data01)
  
  par(family = 'AppleGothic')
  plot(x, y, pch = '*', lwd = 2, cex = 2.0, col = 'blue', main = 'linear regression')
  abline(coef(model), col = 'red', lwd = 2)
  return(model)
}

# param : model
getSummary <- function(model) {
  print(attributes(model))
  print(model$coefficients)
  print(fitted.values(model))
  print(residuals(model))
  print(sum(resi ** 2))
  print(summary(model))
  
  # R-squared : 독립 변수와 종속 변수와의 상관관계
  # 1에 가까울수록 이상적인 모델
}

data1 <- read.csv('시험 점수와 공부 시간1.csv')
data2 <- read.csv('시험 점수와 공부 시간2.csv')

model1 <- getLinearReg(data1)
model2 <- getLinearReg(data2)

summary(model1)
summary(model2)

getSummary(model1)


분석 예제 3

library(corrgram)
library(scatterplot3d)

par(family = 'AppleGothic')

# 파일 이름 : factor_analysis.csv
# 위의 파일을 이용하여 요인 분석을 수행하세요
# 
setwd('../25.요인 분석/')
data <- read.csv('factor_analysis.csv')
# 상관 계수를 이용하여 개략적인 특징을 파악해 보세요.
head(data)
str(data)
class(data)

# 변수의 주요 성분 분석
# 요인 분석에서 공통 요인으로 묶일 요소 수

# 주성분 분석 수행 함수
pc <- prcomp(data)
class(pc)
summary(pc)
# Importance of components:
#                           PC1    PC2    PC3    PC4     PC5     PC6
# Standard deviation     2.9724 1.5844 1.4889 0.6763 0.44834 0.34049
# Proportion of Variance 0.6163 0.1751 0.1546 0.0319 0.01402 0.00809
# Cumulative Proportion  0.6163 0.7914 0.9460 0.9779 0.99191 1.00000
# PC1 ~ PC3까지의 변동폭이 크므로 factor를 3으로 가정한다.

# 상관 계수를 그래프를 그려 보세요.
mColor <- rainbow(ncol(data))
plot(pc, main = '주 성분 분석 결과 시각화', col = mColor, ylim = c(0, 6))
abline(h = seq(0, 6, 1), lty = 2)
legend('topright', '', c('PC1', 'PC2', 'PC3', 'PC4', 'PC5', 'PC6'), fill = mColor)

# 주성분 요인수를 분석하세요.
# 첫 번째 성분이 변동량 61%, 두 번째 성분이 18%, 세 번째 성분이 15%를 차지한다.
# 이 3개의 변동량이 전체의 94%를 차지한다. 
# 전체 6개 성분 중 주 성분 변수를 3개로 가정할 수 있다.

# 주성분에 대하여 시각화를 수행해 보세요.
# 상관 계수 행렬
class(cor(data))
cor(data)
# 변수간 상관 관계 분석과 요인 수 분석
# 상관 관계 분석 : 요인 분석은 변수 간 상관성으로 공통성을 인식
corrgram(cor(data), upper.panel = panel.conf)

# 요인을 분석하세요.
# 상관 계수 행렬을 대상으로 초기 고유값으로 요인 수를 알아본다.
en <- eigen(cor(data))

# 초기 고유값 계산
en$values
# [1] 3.69391386 1.03419457 0.94752707 0.19286642 0.08178566 0.04971242

# 고유 벡터
en$vectors
#           [,1]       [,2]        [,3]       [,4]        [,5]        [,6]
# [1,] 0.3927278  0.2606205 -0.54819213  0.5976675 -0.11344385  0.32749236
# [2,] 0.4196373  0.3310316  0.45128226 -0.3526018 -0.03339597  0.62066384
# [3,] 0.4144774  0.2890788 -0.46606690 -0.5635109  0.21591790 -0.40405262
# [4,] 0.4147989 -0.5545170 -0.04007911 -0.1554791 -0.69859479 -0.08147389
# [5,] 0.3972015 -0.6017487  0.05300804  0.1144664  0.67155730  0.11501251
# [6,] 0.4099400  0.2633209  0.52363648  0.4045301 -0.01925539 -0.56956190

# 고유값을 이용한 시각화
plot(en$values, type = 'o', pch = 19)

# 요인 분석 : 요인 회전법 적용
## 요인 분석에서 해석이 어려운 한 요인을 높게 나타나도록 하기 위해 요인 축 회전
## 일반적으로 varimax 회전법을 사용한다.

# 주 성분 분석의 가정에 의한 3개 요인으로 분석
res <- factanal(data, factors = 3, rotation = 'varimax', scores = "regression")
res
# Call:
#   factanal(x = data, factors = 3, rotation = "varimax")
# 
# Uniquenesses: ## 유효성 판단값, 0.5이하면 유효 
#   col1  col2  col3  col4  col5  col6 
# 0.269 0.005 0.005 0.150 0.005 0.158 
# 
# Loadings: ## 요인 적재 값, 값이 +0.4 미만이면 중요도가 낮음
#   Factor1 Factor2 Factor3
# col1 0.233   0.169   0.805  
# col2 0.179   0.936   0.294  
# col3 0.191   0.275   0.940  
# col4 0.847   0.224   0.287  
# col5 0.958   0.219   0.169  
# col6 0.262   0.864   0.167  
# 
# Factor1 Factor2 Factor3
# SS loadings      1.827   1.825   1.756
# Proportion Var   0.305   0.304   0.293
# Cumulative Var   0.305   0.609   0.901
# 
# The degrees of freedom for the model is 0 and the fit was 0.2353 
# 적합한 요인의 개수라고 볼 수 있음 

# 여러 방식으로 요인 적재량 보기
attributes(res)
# $names
# [1] "converged"    "loadings"     "uniquenesses" "correlation"  "criteria"     "factors"     
# [7] "dof"          "method"       "rotmat"       "scores"       "n.obs"        "call"        
# 
# $class
# [1] "factanal"
res$loadings
# Loadings:
#   Factor1 Factor2 Factor3
# col1 0.233   0.169   0.805  
# col2 0.179   0.936   0.294  
# col3 0.191   0.275   0.940  
# col4 0.847   0.224   0.287  
# col5 0.958   0.219   0.169  
# col6 0.262   0.864   0.167  
# 
# Factor1 Factor2 Factor3
# SS loadings      1.827   1.825   1.756
# Proportion Var   0.305   0.304   0.293
# Cumulative Var   0.305   0.609   0.901

# all factor loadings value
print(res$loadings, cutoff = 0)

# 요인 점수 (요인 분석에서 추정된 값)
res$scores
# Factor1    Factor2    Factor3
# [1,] -0.9536135 -0.9663100  0.9561057
# [2,] -0.9536135 -0.9663100  0.9561057
# [3,] -0.9525837 -0.9952723  0.9781491
# [4,] -0.2543226 -1.0882619  0.8498464
# [5,] -1.0914886 -0.2472676  0.7830621
# [6,]  0.6513422 -0.7618637 -0.7770620
# [7,]  0.6502774 -0.7428198 -0.7744200
# [8,]  0.6502774 -0.7428198 -0.7744200
# [9,]  1.3485386 -0.8358094 -0.9027227
# [10,]  0.6513422 -0.7618637 -0.7770620
# [11,]  0.2488247  0.5689370 -0.4194070
# [12,] -1.0639020  0.9999696 -0.9409056
# [13,] -1.0628722  0.9710073 -0.9188622
# [14,] -0.3646110  0.8780177 -1.0471649
# [15,] -1.0628547  0.9759665 -0.9312049
# [16,]  2.0435182  0.3693182  1.3237255
# [17,]  1.2512776  1.4723271  0.5049916
# [18,]  0.2644633  1.8730547  1.9112451

# 요인 점수를 이용한 요인 loadings 시각화
plot(res$scores[, c(1:2)], main = 'Factor1, 2, 3의 요인 점수 행렬', lwd = 5, col = 'red')
# 산점도에 따른 레이블 표시
name <- paste('문제', c(1:10), sep = "")
text(res$scores[,1], res$scores[,2], labels = name, cex = 0.7, pos = 3, col = 'blue')

# 요인 적재량 추가
points(res$loadings[, 1], res$loadings[, 2], pch=19, col='green', lwd = 5)
text(res$loadings[, 1], res$loadings[, 2], labels = rownames(res$loadings), 
     cex = 0.7, pos = 3, col = 'red')
abline(h = 1.0, lty = 2)
abline(v = 1.0, lty = 2)

# Factor1과 Factor3를 이용한 요인 적재량 시각화
plot( res$scores[, c(1, 3)], main='Factor1과 Factor3 요인 점수 행렬', lwd = mylwd, col='red')
# 산점도에 따른 레이블 표시(문항 이름 : name)
# 산점도에 따른 레이블 표시(문항 이름 : name)
text(res$scores[, 1], res$scores[, 3], labels=name, cex=0.7, pos=3, col='blue')

# 요인 적재량 추가
points( res$loadings[, c(1, 3)], col='green', lwd = mylwd)
# 요인 적재량의 레이블 표시
text( res$loadings[, 1], res$loadings[, 3], labels=rownames(res$loadings),
      cex=0.7, pos=3, col='red')
abline(h = 1.0, lty = 2)
abline(v = 1.0, lty = 2)

Factor1 <- res$scores[, 1]
Factor2 <- res$scores[, 2]
Factor3 <- res$scores[, 3]

d3 <- scatterplot3d( Factor1, Factor2, Factor3, type='p' )

# 요인 적재량 표시
loadings1 <- res$loadings[,1]
loadings2 <- res$loadings[,2]
loadings3 <- res$loadings[,3]

d3$points3d(loadings1, loadings2, loadings3, bg='red', pch=21, cex=2, type='h')

# 요인 부하량 막대 그래프 표현
barplot(res$loadings, beside = T, col = rainbow(nrow(res$loadings)))

# 각 요인별로 어느 변수가 많은 비율을 차지하는 지 시각화
par(mfrow = c(1, 3))
pie(loadings1, beside = T)
pie(loadings2, beside = T)
pie(loadings3, beside = T)

# 요인 점수 및 시각화
par(mfrow = c(1, 1))
barplot(res$scores, beside = T)

# 요인별 산술 평균을 이용하여 변수의 개수를 줄여 보세요.
fac01 <- (data$col4 + data$col5)
fac02 <- (data$col2 + data$col6)
fac03 <- (data$col1 + data$col3)

data_df <- data.frame(fac01, fac02, fac03)
cor(data_df)
#           fac01     fac02     fac03
# fac01 1.0000000 0.4687506 0.4667733
# fac02 0.4687506 1.0000000 0.5009525
# fac03 0.4667733 0.5009525 1.0000000

# 추려진 요인들을 이용하여 상관 관계 분석을 수행해 보세요.
# 상관관계분석표를 보면 fac02와 fac03이 0.5의 
# 양의 상관 관계를 가지고 있다는 것을 알 수 있다.
corrgram(cor(data_df), upper.panel = panel.conf)



분석 예제 4

library("ggplot2")

# cars : 기본 데이터
cars
str(cars)
# 'data.frame':	50 obs. of  2 variables:
# $ speed: num  4 4 7 7 8 9 10 10 10 11 ...
# $ dist : num  2 10 4 22 16 10 18 26 34 17 ...

plot(cars$speed, cars$dist, main = 'scatter plot')

model <- lm(dist ~ speed, cars)
model

# dist = 3.932 * speed - 17.579
abline(coef(model), col = 'red', lwd = 2)

coef(model)
fitted.values(model)[1:4]
residuals(model)[1:4]

cars$dist[1:4]

# 잔차 제곱의 총합
deviance(model)

# 학습된 모델을 이용하여 예측하기
testData <- data.frame(speed = 3)
testData

predict(model, testData)
# > # dist = 3.932 * speed - 17.579
# -5.781869 

# confidence : 오차 범위가 평균값(fit)을 기준
# prediction : 잔차가 정규분포를 따르고 변화(variance)가 일정할때 사용
predict(model, testData, interval = 'confidence')
predict(model, testData, interval = 'prediction')
        # fit       lwr      upr
# 1 -5.781869 -17.02659 5.462853
# 1 -5.781869 -38.68565 27.12192

# speed의 최솟값과 최댓값을 확인
summary(model)
# 위의 최소, 최대의 범위를 이용하여 신뢰구간 확인
newData <- data.frame(speed = seq(4.0, 25.0, 0.2))
predict(model, newdata = newData, interval = 'confidence')

# 그래프
data("cars", package = "datasets")
model <- lm(dist ~ speed, data = cars)
# 1. Add predictions 
pred.int <- predict(model, interval = "prediction")
mydata <- cbind(cars, pred.int)
# 2. Regression line + confidence intervals
p <- ggplot(mydata, aes(speed, dist)) +
  geom_point() +
  stat_smooth(method = lm)
# 3. Add prediction intervals
p + geom_line(aes(y = lwr), color = "red", linetype = "dashed")+
  geom_line(aes(y = upr), color = "red", linetype = "dashed")


분석 예제 5

library(car)

product <- read.csv('product.csv')
str(product)
head(product)

colnames(product) <- c('xdata1', 'xdata2', 'ydata')
head(product)

model <- lm(formula = ydata ~ xdata1 + xdata2, data = product)
model

# vif() : 다중공선성이 있는지 검증하는 함수 
# 다중 공선성 : 독립 변수가 여러개일 때, 독립 변수간 강한 상관관계를 가지는 현상.
# 다중 공선성을 가지면 여러 독립 변수를 사용하는 의미가 없어진다. 
# 따라서 연관성을 갖는 독립변수를 제거하는 과정을 거쳐야 한다.
vif_res <- vif(model)
class(vif_res)

table(vif_res >= 10.0)
# FALSE 
# 2 
# 다중공선성을 갖지 않음 

분석 예제 6

str(iris)
head(iris)
unique(iris$Species)

# 학습 데이터와 검증 데이터를 7:3으로 분리
set.seed(1)
idx <- sample(1:nrow(iris), 0.7 * nrow(iris))
idx

training <- iris[idx, ]
testing <- iris[-idx, ]

dim(training)
dim(testing)

colnames(iris)
mFomula <- Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width
model <- lm(formula = mFomula, data = training)
model

vif_res <- vif(model)
table(vif_res >= 10)
# FALSE  TRUE 
# 1     2 

cor(iris[,-5])
#             Sepal.Length Sepal.Width Petal.Length Petal.Width
# Sepal.Length    1.0000000  -0.1175698    0.8717538   0.8179411
# Sepal.Width    -0.1175698   1.0000000   -0.4284401  -0.3661259
# Petal.Length    0.8717538  -0.4284401    1.0000000   0.9628654
# Petal.Width     0.8179411  -0.3661259    0.9628654   1.0000000

mFomula <- Sepal.Length ~ Sepal.Width + Petal.Length
model <- lm(formula = mFomula, data = training)
model
# FALSE 
# 2 

vif_res <- vif(model)
table(vif_res >= 10)

predictData <- predict(model, testing)
predictData[1:5]
# 3        4        5        8        9 
# 4.756282 4.790010 5.060498 4.981578 4.613506 

cor(predictData, testing$Sepal.Length)







© 2019. by RaP0d

Powered by aiden