Notice
Recent Posts
Recent Comments
Link
«   2025/04   »
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
Tags
more
Archives
Today
Total
관리 메뉴

BASEMENT

R 프로그래밍 - 8주차 본문

Programming/R

R 프로그래밍 - 8주차

2_34 2020. 8. 11. 22:33

 

 

R 실습

 

1. 보스턴시의 주택가격 데이터

#data(Boston)
#CRIM : 1인당 범죄율
#ZN : 25,000초과하는 거주지역의 비율
#INDUS : 비소매상업지역이 점유하고 있는 토지의 비율
#CHAS : 찰스강 경계는 1, 아니면 0
#NOX : 10PPM당 일산화질소
#RM : 1가구당 평균 방의 개수
#AGE : 1940년 이전에 건축된 소유주택의 비율
#DIS : 직업센터까지의 접근성 지수
#RAD : 방사형도로까지 접근성 지수
#TAX : 재산세율
#PTRATIO : 학생/교사 비율
#B : 흑인의 비율
#LSTAT : 하위계층 비율
#MEDV : 본인 소유의 주택가격(1,000달러 단위)


## 1. 데이터 불러오기
library(MASS)
data(Boston)
write.csv(df, file="df.csv", row.names = TRUE)  # row.names = TRUE : 파일명 설정

df <- read.csv("Boston.csv", header=TRUE, stringsAsFactors = FALSE)
# header = TRUE : 파일의 첫행을 변수명으로 처리할지 여부
# stringsAsFactors = FALSE : 문자열으 팩터가 아닌 문자열 타입으로 읽기
df <- df[,-1]


## 그 밖에 입출력
# read.table("file.txt", header=TRUE, seg=" ")
# install.packages("readxl")
# read.excel(path="file.xlsx", 
#             sheet="table",    # 시트 이름
#             col_names=TRUE)


## 2. 기술통계량
install.packages("Hmisc")
library(Hmisc)
describe(df)
summary(medv~crim+zn, data=df)


## 3. 데이터 전처리

# 결측치 확인
sum(is.na(df))
df[complete.cases(df),]   # 결측치가 없으면 True
df[!complete.cases(df),]  # 결측치가 있으면 True

# 결측치 삭제
df <- na.omit(df)
# 결측치 대체
df$crim[is.na(df$crim)] <- 0     # is.na를 사용하여 원하는 값으로 대체함

install.packages("DMwR")
library(DMwR)
centralImputation(df) # NA중앙값 대체 : 숫자의 경우 중앙값, 팩터의 경우 최빈값
knnImputation(df)   # means를 활용한 결측치 대체


## 4. 데이터 분할 - 학습, 성능검증, 평가

# 랜덤 샘플링
t.idx <- sample(1:506, 300)		# 비율은 70%:30%, 70%로 샘플링함
df.tr <- df[t.idx,]
df.te <- df[-t.idx,]

# cf) 층화 샘플링
install.packages("sampling")
library(sampling)
data(iris)
(x <- strata(c("Species"), size=c(20,20,20), method="srswor", data=iris))
train <- getdata(iris,x)

# cf) 다중공선성 : 독립변수들 간에 상관관계를 알아봄
install.packages("car")
library(car)
lml <- lm(medv~., data=df)
vif(lml)		# 팽창지수
vif(lml) > 5

# cf) 분산이 0에 가까운 변수 제거
install.packages("caret")
library(caret)
nearZerovar(df, saveMetrics = TRUE)
df <- df[,-nearZeroVar(df)]

# cf) 상관관계
install.packages("caret")
install.packages("corrplot")
install.packages("psych")

library(caret)
findCorrelation(cor(subset(df, select=-c(medv))))
library(corrplot)
corrplot(cor(df), method = "ellipse")
library(psych)
pairs.panels(df[,])

# cf) 변수중요도 평가 - randomForest
install.packages("randomForest")
library(randomForest)
rf <- randomForest(medv~., data=df)
varImp(rf)


## 5. 모델링
lm1 <- lm(medv ~ crim + chas + nox + rm + dis + rad + ptratio + lstat, data = df.tr)
lm2 <- step(lm1, direction="both") # stepwise

pred <- predict(lm1, newdata=df.te)
pred <- predict(lm1, newdata=df.te, interval="confidence")
pred <- predict(lm1, newdata=df.te, interval="prediction")

pred
coef(lm1) # 회귀계수
fitted(lm1) # 예측된 값

install.packages("forecast")
library(forecast)
accuracy(lm1)

#prob <- predict(lm1, newdata=df.te, type="response")
#pr <- prediction(prob, df.te$medv)
#prf <- performance(pr, measure="tpr", x.measure="fpr")
#plot(prf)

## 6. 검증
library(caret)
confusionMatrix(predicted, actual)

library(ROCR)
pred <- prediction(prob,y값)
plot(performance(pred, "tpr","fpr"))
auc <- performance(pred, measure = "auc")
auc <- auc@y.values[[1]]
auc

## cf) 리포트
install.packages("rmarkdown")
install.packages("knitr")
library(rmarkdown)
library(knitr)
########### 회귀 lm ##############

library(MASS)
data(Boston)

# medv 값이 40이상이면 1, 미만이면 0인 데이터를 추가해줌
df <- Boston
df$class[df$medv >=40] <- 1
df$class[df$medv < 40] <- 0
table(df$class)

library(Hmisc)
describe(df)
summary(medv~crim+zn+rad, data=df)
str(df)

sum(is.na(df))

t.idx <- sample(1:506, 300)
df.tr <- df[t.idx,]
df.te <- df[-t.idx,]

install.packages("car")
library(car)
lm1 <- lm(medv~., data=df)
summary(lm1)
vif(lm1)
vif(lm1) > 10

library(caret)
findCorrelation(cor(subset(df, select=-c(medv))))
library(corrplot)
corrplot(cor(df), method="ellipse")
library(psych)
pairs.panels(df[,])

install.packages("randomForest")
library(randomForest)
rf <- randomForest(medv~., data=df[,-15])
varImp(lm1)

lm1 <- lm(medv~., data=df.tr[,-15])
lm2 <- step(lm1,direction = "both")

prob <- predict(lm1, newdata = df.te)
coef(lm1)
fitted(lm1)

########### 분류 glm ##############

# df에서 주택값을 지움
df <- df[,-1]

t.idx <- sample(1:506, 300)
df.tr <- df[t.idx,]
df.te <- df[-t.idx,]

logit <- glm(class~., df.tr, family="binomial")
summary(logit)
logit2 <- step(logit,direction = "both")

prob <- predict(logit, newdata=df.te, type="response")
pr <- prediction(prob, df.te$class)
prf <- performance(pr, measure = "tpr", x.measuer="fpr")
plot(prf)
auc <- performance(pr, measure = "auc")
auc <- auc@y.values[[1]]
auc

 

2. GermanCredit 데이터

library(caret)
data("GermanCredit")

df <- GermanCredit

str(df)

# Class데이터를 character로 변환 후 Bad, Good 값을 1과 0으로 변환, 다시 factor로 변환해줌
df$Class <- as.character(df$Class)
df$Class[df$Class == "Bad"] <- 1
df$Class[df$Class == "Good"] <- 0
df$Class <- as.factor(df$Class)
table(df$Class)

# 랜덤 샘플링
t.idx <- sample(1:1000, 700)
df.tr <- df[t.idx,]
df.te <- df[-t.idx,]

# 결측치 확인
sum(is.na(df))

# 로지스틱 회귀분석
logit <- glm(Class~., df.tr, family="binomial")
summary(logit)

prob <- predict(logit, newdata=df.te, type="response")
pr <- prediction(prob, df.te$Class)
prf <- performance(pr, measure = "tpr", x.measuer="fpr")
plot(prf)
auc <- performance(pr, measure = "auc")
auc <- auc@y.values[[1]]
auc

 

3. biopsy - 유방암 양성/음성 데이터

library(MASS)
data("biopsy")

df <- biopsy

# ID 데이터 삭제
df <- df[,-1]

# benign을 0, malignant을 1로 변환
table(df$class)
df$class <- as.character(df$class)
df$class[df$class == "benign"] <- 0
df$class[df$class == "malignant"] <- 1
df$class <- as.factor(df$class)

str(df$class)

# 결측치 확인
sum(is.na(df))
# 결측치 중앙값으로 대체
df <- centralImputation(df)

# 랜덤 샘플링
t.idx <- sample(1:699, 500)
df.tr <- df[t.idx,]
df.te <- df[-t.idx,]

# 로지스틱 회귀분석
logit <- glm(class ~ V1 + V3 + V4 + V6 + V7 + V9, df.tr, family="binomial")
summary(logit)
logit2 <- step(logit, direction = "both")

library(ROCR)
prob <- predict(logit, newdata = df.te, type="response")

prob[prob < 0.5] <- "0"
prob[prob >= 0.5] <- "1"
prob <- as.numeric(prob)
str(df.te$class)
df.te$class <- as.numeric(df.te$class)

pr <- prediction(prob, df.te$class)
prf <- performance(pr, measure = "tpr", x.measuer="fpr")
plot(prf)
auc <- performance(pr, measure = "auc")
auc <- auc@y.values[[1]]
auc

# cf) 파생변수
install.packages("smbinning")
library(smbinning)

str(df$class)

# 숫자형 데이터로 변환
df$V1 <- as.numeric(df$V1)
df$class <- as.numeric(df$class) - 1

# 연속형 변수를 범주형 변수로 변환
result = smbinning(df, x="V1", y="class")  
result$ivtable
result$iv
pop = smbinning.gen(df, result, "v1_2")
table(pop$v1_2)
summary(pop$v1_2)
pop$v1_2

# 범주형 변수를 구간화
# result <- smbinning.factor(GermanCredit, x="Duration", y="class", maxcat=11)
# result$ivtable

'Programming > R' 카테고리의 다른 글

R 프로그래밍 - 7주차  (0) 2020.08.11
R 프로그래밍 6주차  (0) 2020.07.20
R 프로그래밍 5주차  (0) 2020.07.18
R프로그래밍 4주차  (0) 2020.07.06
R프로그래밍 3주차  (0) 2020.07.05
Comments