close_btn
:)
조회 수 2878 추천 수 0 댓글 0
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
############## 연관성 분석 과제 ##############
# 패키지
if(!require(mlbench)) install.packages("mlbench"); library(mlbench)
if(!require(dplyr)) install.packages("dplyr"); library(dplyr)
if(!require(arules)) install.packages("arules"); library(arules)
if(!require(arulesViz)) install.packages("arulesViz"); library(arulesViz)

# 데이터
rm(list=ls())
data("BostonHousing")
boston_data <- BostonHousing
boston_data$medv<-cut(boston_data$medv,c(0,17.02,25.00,50.00),
                      labels = c("inexpensive","middle","expensive"))

#### medv는 집의 가격을 말함, 이를 rhs로 두면 어떤 변수들이 집값과 연관이 있는가를 알 수 있다.
#### 위의 boston_data 에서 medv 변수의 각 클래스에 연관을 주는
#### top5(lift순,confidence순)를각각 제시하세요

# 범주형 변수 chas, medv 제외 데이터 분포 살피기
# 붉은선 좌측 = 하위 25%, 붉은선 ~ 파란선 = 중간 50%, 파란선 우측 = 상위 25%
boston_data2 <- boston_data[,!colnames(boston_data) %in% c("medv","chas")]
windows()
par(mfrow=c(3,4))
for (i in 1:length(boston_data2)) {
  hist(boston_data2[,i], main =colnames(boston_data2[i]))
  abline(v = quantile(boston_data2[,i],0.25),col = "red", lwd = 3, lty = 5)
  abline(v = quantile(boston_data2[,i],0.75),col = "blue", lwd = 3, lty = 5)
}
2.png

# plot으로 확인해보니 indus,nox,rm,age,dis,ptratio,lstat은 medv와 같은 방식으로 나눌 수 있으나
# 나머지는 눈으로 확인 후 나눠야할 필요를 느낌

## summary 로 분류
# indus, 비소매상업지역의 토지 비율
boston_data$indus <- cut(boston_data$indus,c(0,summary(boston_data[,"indus"])[c(-4,-3,-1)]),
                         labels = c("l.indus","m.indus","h.indus"))

# nox, 일산화질소 농도
boston_data$nox <- cut(boston_data$nox,c(0,summary(boston_data[,"nox"])[c(-4,-3,-1)]),
                       labels = c("l.nox","m.nox","h.nox"))

# rm, 주거당 평균 객실 수
boston_data$rm <- cut(boston_data$rm,c(0,summary(boston_data[,"rm"])[c(-4,-3,-1)]),
                      labels = c("l.rm","m.rm","h.rm"))

# age, 1940년 이전에 건축된 소유주택의 비율
boston_data$age <- cut(boston_data$age,c(0,summary(boston_data[,"age"])[c(-4,-3,-1)]),
                       labels = c("l.age","m.age","h.age"))

# dis, 5개의 보스턴 직업센터까지의 접근성 지수
boston_data$dis <- cut(boston_data$dis,c(0,summary(boston_data[,"dis"])[c(-4,-3,-1)]),
                       labels = c("l.dis","m.dis","h.dis"))

# ptratio, 학생-교사 비율
boston_data$ptratio <- cut(boston_data$ptratio,c(0,summary(boston_data[,"ptratio"])[c(-4,-3,-1)]),
                           labels = c("l.ptratio","m.ptratio","h.ptratio"))

# lstat, 하위계층의 비율
boston_data$lstat <- cut(boston_data$lstat,c(0,summary(boston_data[,"lstat"])[c(-4,-3,-1)]),
                         labels = c("l.lstat","m.lstat","h.lstat"))


## 각 변수 분포 특성을 고려해 분류
# crim, 범죄율
1이하, 1~10, 10이상
sort(boston_data$crim)
boston_data$crim <- cut(boston_data$crim,c(0,1,10,max(boston_data$crim)),
                        labels = c("l.crim","m.crim","h.crim"))

# zn, 25,000를 초과하는 거주지역 비율
# 0, 40미만, 40이상
sort(boston_data$zn)
boston_data$zn <- ifelse(boston_data$zn == 0.0, "l.zn", ifelse(boston_data$zn > 40,"h.zn","m.zn"))

# rad, 고속도로 접근성 지수
# 4미만, 8미만, 24
sort(boston_data$rad)
boston_data$rad <- ifelse(boston_data$rad <= 4, "l.rad", ifelse(boston_data$rad >= 24,"h.rad","m.rad"))

# tax, 10,000$당 재산세
# 300미만, 300~ 469 ,666이상
sort(boston_data$tax)
boston_data$tax <- ifelse(boston_data$rad < 300, "l.tax", ifelse(boston_data$rad >= 666,"h.tax","m.tax"))

# b, 흑인 비율
# 200미만, 350 미만, 350~390, 390이상
sort(boston_data$b)
boston_data$b <- cut(boston_data$b,c(0,200,350,390,max(boston_data$b)),
                     labels = c("l.b","m.b","h.b","exh.b"))

# chas, 1 = 강주변, 0 = 강주변 아님
boston_data$chas <- ifelse(boston_data$chas == 1, "riverSide","non-river")

# factor
boston_data$zn <- as.factor(boston_data$zn)
boston_data$chas <- as.factor(boston_data$chas)
boston_data$rad <- as.factor(boston_data$rad)
boston_data$tax <- as.factor(boston_data$tax)

# transactions
boston_data.tr <- as(boston_data, "transactions")
inspect(boston_data.tr[1])

### 파라매터는 set of rules가 500개 내외로 나오게끔 조정
## 높은 집값 요인 medv=expensive

# 첫번째 방법
rule_ex <- apriori(boston_data.tr,parameter = list(supp = 0.06, conf = 0.7),
                   appearance = list(default ="lhs",rhs = "medv=expensive"))
summary(rule_ex) #set of 436 rules
inspect(sort(rule_ex,by="lift")[1:5])
inspect(sort(rule_ex,by="confidence")[1:5])

# 결과
#> inspect(sort(rule_ex,by="lift")[1:5])
#    lhs                                            rhs              support    confidence lift     count
#[1] {rm=h.rm,ptratio=l.ptratio,b=h.b}           => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[2] {crim=l.crim,rm=h.rm,b=h.b}                 => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[3] {rm=h.rm,tax=h.tax,ptratio=l.ptratio,b=h.b} => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[4] {crim=l.crim,rm=h.rm,tax=h.tax,b=h.b}       => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[5] {rm=h.rm,age=l.age,lstat=l.lstat}           => {medv=expensive} 0.08102767 0.9761905  3.983487 41 
 
#> inspect(sort(rule_ex,by="confidence")[1:5])
#    lhs                                            rhs              support    confidence lift     count
#[1] {rm=h.rm,ptratio=l.ptratio,b=h.b}           => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[2] {crim=l.crim,rm=h.rm,b=h.b}                 => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[3] {rm=h.rm,tax=h.tax,ptratio=l.ptratio,b=h.b} => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[4] {crim=l.crim,rm=h.rm,tax=h.tax,b=h.b}       => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[5] {rm=h.rm,age=l.age,lstat=l.lstat}           => {medv=expensive} 0.08102767 0.9761905  3.983487 41

# 두번째 방법
# total rule
# 모든 경우를 포함하려면 신뢰도와 지지도를 최대로 낮추어야 하나 시간이 오래걸려 적당한 수준으로 기입
t.rules <- apriori(boston_data.tr,parameter = list(supp = 0.01, conf = 0.01,minlen=2))

# 전체 rule에서 rhs에 medv=expensive가 들어간것 & support >= 0.06, confidence >= 0.7인것만 추출
expensive.rules <- subset(t.rules, (rhs %in% "medv=expensive") & support >= 0.06 & confidence >= 0.7)
summary(expensive.rules)  #set of 436 rules
inspect(sort(expensive.rules,by="lift")[1:5])
inspect(sort(expensive.rules,by="confidence")[1:5])

#결과
#> inspect(sort(expensive.rules,by="lift")[1:5])
#    lhs                                            rhs              support    confidence lift     count
#[1] {rm=h.rm,ptratio=l.ptratio,b=h.b}           => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[2] {crim=l.crim,rm=h.rm,b=h.b}                 => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[3] {rm=h.rm,tax=h.tax,ptratio=l.ptratio,b=h.b} => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[4] {crim=l.crim,rm=h.rm,tax=h.tax,b=h.b}       => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[5] {rm=h.rm,age=l.age,lstat=l.lstat}           => {medv=expensive} 0.08102767 0.9761905  3.983487 41   

#> inspect(sort(expensive.rules,by="confidence")[1:5])
#    lhs                                            rhs              support    confidence lift     count
#[1] {rm=h.rm,ptratio=l.ptratio,b=h.b}           => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[2] {crim=l.crim,rm=h.rm,b=h.b}                 => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[3] {rm=h.rm,tax=h.tax,ptratio=l.ptratio,b=h.b} => {medv=expensive} 0.06126482 1.0000000  4.080645 31   
#[4] {crim=l.crim,rm=h.rm,tax=h.tax,b=h.b}       => {medv=expensive} 0.06324111 1.0000000  4.080645 32   
#[5] {rm=h.rm,age=l.age,lstat=l.lstat}           => {medv=expensive} 0.08102767 0.9761905  3.983487 41 
# 둘의 값이 동일한 것을 알 수 있다.
# 그러나 만약 total rule의 크기가 방대하다면 속도면에서 첫번째 방법이 유리하다.
# 두번째 방법은 기존에 구한 연관규칙에서 부분집합을 구할 때 사용하면 유용할듯 하다.
# 따라서 앞으로의 내용은 첫번째 방법으로 진행

## 중간 집값 요인 medv=middle
rule_mid <- apriori(boston_data.tr,parameter = list(supp = 0.1, conf = 0.85),
                    appearance = list(default ="lhs",rhs = "medv=middle"))
summary(rule_mid)  #set of 458 rules
inspect(sort(rule_mid,by="lift")[1:5])
inspect(sort(rule_mid,by="confidence")[1:5])

## 낮은 집값 요인 medv=inexpensive
rule_inex <- apriori(boston_data.tr,parameter = list(supp = 0.1, conf = 0.7),
                     appearance = list(default ="lhs",rhs = "medv=inexpensive"))
summary(rule_inex) #set of 464 rules
inspect(sort(rule_inex,by="lift")[1:5])
inspect(sort(rule_inex,by="confidence")[1:5])

# 궁금증
## 강의 유무는 집값에 어떤 영향을 끼치나?
rule_river <- apriori(boston_data.tr,parameter = list(supp = 0.01, conf = 0.01,minlen=2),
                      appearance = list(lhs = c("chas=riverSide","chas=non-river"),
                                        rhs = c("medv=expensive","medv=middle","medv=inexpensive")))
summary(rule_river)
inspect(sort(rule_river,by="lift"))
inspect(sort(rule_river,by="confidence"))

# 결과
#> inspect(sort(rule_river,by="lift"))
#    lhs                   rhs                support    confidence lift      count
#[1] {chas=riverSide} => {medv=expensive}   0.03162055 0.4571429  1.8654378  16  
#[2] {chas=non-river} => {medv=inexpensive} 0.24110672 0.2590234  1.0320143 122  
#[3] {chas=non-river} => {medv=middle}      0.47628458 0.5116773  1.0153283 241  
#[4] {chas=non-river} => {medv=expensive}   0.21343874 0.2292994  0.9356893 108  
#[5] {chas=riverSide} => {medv=middle}      0.02766798 0.4000000  0.7937255  14  

# 첫번째 규칙의 지지도가 0.03 이고 신뢰도가 0.45이므로 해당 규칙이 전체의 3% 정도를 말하며
# 강변에 위치한 건물들 중 45%는 첫번째 규칙에 해당함을 알 수 있다.
# lift가 1보다 크기 때문에 둘은 양의 상관을 가진다. (우연이라 생각했던 것보다 자주 발견된다.)

# 시각화
windows()
plot(rule_river, method="graph", control=list(type="items"), main = "rule_river")
3.png

# 도표와 결과에서 알 수 있듯이 강가에 있는 주택(riverSide)은 집의 가격이 높음을 알 수 있고
# 강과 맞닿아 있지 않는 경우(non-river) 가격이 하위 25% 혹은 중간 가격에 주로 속함을 알 수 있다.

## 일산화질소 농도는 집값과 어떤 연관이 있나?
rule_nox <- apriori(boston_data.tr,parameter = list(supp = 0.001, conf = 0.01,minlen=2),
                    appearance = list(lhs = c("nox=l.nox","nox=m.nox","nox=h.nox"),
                                      rhs = c("medv=expensive","medv=middle","medv=inexpensive")))
summary(rule_nox)
inspect(sort(rule_nox,by="lift"))
inspect(sort(rule_nox,by="confidence"))

# 결과
#> inspect(sort(rule_nox,by="lift"))
#   lhs            rhs                support     confidence lift       count
#[1] {nox=h.nox} => {medv=inexpensive} 0.160079051 0.65322581 2.60261621  81  
#[2] {nox=l.nox} => {medv=expensive}   0.110671937 0.43410853 1.77144286  56  
#[3] {nox=m.nox} => {medv=middle}      0.310276680 0.62055336 1.23137255 157  
#[4] {nox=l.nox} => {medv=middle}      0.140316206 0.55038760 1.09214166  71  
#[5] {nox=m.nox} => {medv=expensive}   0.102766798 0.20553360 0.83870968  52  
#[6] {nox=m.nox} => {medv=inexpensive} 0.086956522 0.17391304 0.69291339  44  
#[7] {nox=h.nox} => {medv=expensive}   0.031620553 0.12903226 0.52653486  16  
#[8] {nox=h.nox} => {medv=middle}      0.053359684 0.21774194 0.43206831  27  
#[9] {nox=l.nox} => {medv=inexpensive} 0.003952569 0.01550388 0.06177135   2 

# 시각화
windows()
plot(rule_nox, method="graph", control=list(type="items"), main = "rule_nox")
4.png

# h.nox(산화농도 높음)일 수록 가격이 낮고 l.nox(산화농도 낮음)일 수록 가격이 높은 범주로 가는 것을 확인할 수 있다.

## 범죄율은 집값과 어떤 연관이 있나?
rule_crim <- apriori(boston_data.tr,parameter = list(supp = 0.001, conf = 0.01,minlen=2),
                     appearance = list(lhs = c("crim=l.crim","crim=m.crim","crim=h.crim"),
                                       rhs = c("medv=expensive","medv=middle","medv=inexpensive")))
summary(rule_crim)
inspect(sort(rule_crim,by="lift"))
inspect(sort(rule_crim,by="confidence"))

# 결과
#> inspect(sort(rule_crim,by="lift"))
#    lhs                rhs                support     confidence     lift      count
#[1] {crim=h.crim} => {medv=inexpensive} 0.088932806 0.83333333 3.3202100  45  
#[2] {crim=m.crim} => {medv=inexpensive} 0.114624506 0.48333333 1.9257218  58  
#[3] {crim=l.crim} => {medv=expensive}   0.215415020 0.32831325 1.3397299 109  
#[4] {crim=l.crim} => {medv=middle}      0.393280632 0.59939759 1.1893929 199  
#[5] {crim=m.crim} => {medv=middle}      0.096837945 0.40833333 0.8102614  49  
#[6] {crim=m.crim} => {medv=expensive}   0.025691700 0.10833333 0.4420699  13  
#[7] {crim=l.crim} => {medv=inexpensive} 0.047430830 0.07228916 0.2880182  24  
#[8] {crim=h.crim} => {medv=middle}      0.013833992 0.12962963 0.2572259   7  
#[9] {crim=h.crim} => {medv=expensive}   0.003952569 0.03703704 0.1511350   2  

# 첫번째~네번째 규칙을 통해 범죄가 높을 수록(h.crim) 집값이 낮음을 알 수 있다. 

# 시각화 자료첨부 생략
windows()
plot(rule_crim, method="graph", control=list(type="items"), main = "rule_crim")

## 방의 개수는 집값과 어떤 연관이 있나?
rule_rm <- apriori(boston_data.tr,parameter = list(supp = 0.001, conf = 0.01,minlen=2),
                   appearance = list(lhs = c("rm=l.rm","rm=m.rm","rm=h.rm"),
                                     rhs = c("medv=expensive","medv=middle","medv=inexpensive")))
summary(rule_rm)
inspect(sort(rule_rm,by="lift"))
inspect(sort(rule_rm,by="confidence"))

# 결과
#> inspect(sort(rule_rm,by="lift"))
#    lhs          rhs                support     confidence lift      count
#[1] {rm=h.rm} => {medv=expensive}   0.195652174 0.77952756 3.1809754  99  
#[2] {rm=l.rm} => {medv=inexpensive} 0.114624506 0.45669291 1.8195796  58  
#[3] {rm=m.rm} => {medv=middle}      0.345849802 0.69444444 1.3779956 175  
#[4] {rm=l.rm} => {medv=middle}      0.126482213 0.50393701 0.9999691  64  
#[5] {rm=m.rm} => {medv=inexpensive} 0.112648221 0.22619048 0.9011999  57  
#[6] {rm=h.rm} => {medv=inexpensive} 0.023715415 0.09448819 0.3764648  12  
#[7] {rm=m.rm} => {medv=expensive}   0.039525692 0.07936508 0.3238607  20  
#[8] {rm=h.rm} => {medv=middle}      0.031620553 0.12598425 0.2499923  16  
#[9] {rm=l.rm} => {medv=expensive}   0.009881423 0.03937008 0.1606553   5 
# 방의 개수가 많을 수록 (h.rm) 가격이 높고 적을 수록 (l.rm) 가격이 낮음을 첫번째, 두번째 규칙을 통해 알 수 있다.

#시각화 자료첨부 생략
windows()
plot(rule_rm, method="graph", control=list(type="items"), main = "rule_rm")

## 학생-교사의 비율은 집값과 어떤 연관이 있나?
rule_ptratio <- apriori(boston_data.tr,parameter = list(supp = 0.001, conf = 0.01,minlen=2),
                   appearance = list(lhs = c("ptratio=l.ptratio","ptratio=m.ptratio","ptratio=h.ptratio"),
                                     rhs = c("medv=expensive","medv=middle","medv=inexpensive")))
summary(rule_ptratio)
inspect(sort(rule_ptratio,by="lift"))
inspect(sort(rule_ptratio,by="confidence"))

#결과
#> inspect(sort(rule_ptratio,by="lift"))
#    lhs                    rhs                support     confidence lift      count
#[1] {ptratio=l.ptratio} => {medv=expensive}   0.134387352 0.47222222 1.9269713  68  
#[2] {ptratio=h.ptratio} => {medv=inexpensive} 0.037549407 0.33928571 1.3517998  19  
#[3] {ptratio=h.ptratio} => {medv=middle}      0.069169960 0.62500000 1.2401961  35  
#[4] {ptratio=m.ptratio} => {medv=inexpensive} 0.185770751 0.30718954 1.2239205  94  
#[5] {ptratio=m.ptratio} => {medv=middle}      0.312252964 0.51633987 1.0245803 158  
#[6] {ptratio=l.ptratio} => {medv=middle}      0.122529644 0.43055556 0.8543573  62  
#[7] {ptratio=m.ptratio} => {medv=expensive}   0.106719368 0.17647059 0.7201139  54  
#[8] {ptratio=l.ptratio} => {medv=inexpensive} 0.027667984 0.09722222 0.3873578  14  
#[9] {ptratio=h.ptratio} => {medv=expensive}   0.003952569 0.03571429 0.1457373   2  

# 학생 / 교사 비율이 낮으면(l.ptratio) 가격이 높고 비율이 높으면 가격이 낮음을 첫번째 두번째 규칙에서 확인할 수 있다.
#시각화 자료첨부 생략
windows()
plot(rule_ptratio, method="graph", control=list(type="items"), main = "rule_ptratio")

List of Articles
번호 제목 글쓴이 날짜 조회 수
공지 R 소스 공유 게시판 이용 관련 공지사항 1 DataMarket 2014.05.21 26117
102 투빅스 8&9기 설 분석 과제 16' 뉴욕 택시 운행시간 예측 - 9기 최영제 :) 2018.02.24 3148
101 투빅스 8&9기 4주차 과제 Random Forest -9기 이잉걸 잉걸 2018.02.15 2758
100 투빅스 8&9기 4주차 과제 Naive Bayes Classification -9기 서석현 file 스르륵 2018.02.14 2691
99 투빅스 8&9기 3주차 과제 K-Nearest Neighbor, K-means 구현 -9기 신용재 1 신용재 2018.02.08 3208
» 투빅스 8&9기 3주차 과제 연관성 분석 - 9기 최영제 :) 2018.02.08 2878
97 투빅스 8&9기 2주차 과제 Gradient Descent, Softmax, Cross Entropy - 9기 서석현 file 스르륵 2018.02.02 2734
96 투빅스 8&9기 2주차 과제 회귀분석/로지스틱 - 9기 최영제 file :) 2018.02.02 3233
95 투빅스 8&9기 2주차 과제 Gradient Descent, Softmax, Cross Entropy - 9기 김명진 file kimji 2018.02.02 2628
94 투빅스 8&9기 1주차 과제 R 9기-신용재 file 신용재 2018.01.25 3052
93 투빅스 8&9기 1주차 과제 R 알고리즘 - 9기 서석현 file 스르륵 2018.01.25 3101
92 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 김민정 민정e 2017.09.23 4432
91 투빅스 7&8기 9주차 과제 Neural Network를 이용한 MNIST 분류 - 8기 최서현 최서현 2017.09.22 4253
90 투빅스 7&8기 7주차 과제 유기동물 과제 - 8기 조양규 dial123 2017.09.14 4444
89 투빅스 7&8기 7주차 과제 유기동물입양예측 - 8기 김강열 김강열 2017.09.14 4190
88 투빅스 7&8기 6주차 과제 word2vec - 8기 황다솔 다솔 2017.08.31 4824
87 투빅스 7&8기 6주차 과제 TF-IDF 문서유사도 측정 - 8기 최서현 최서현 2017.08.31 4604
86 투빅스 7&8기 5주차 과제 Selenium Crawling - 8기 김강열 김강열 2017.08.24 4606
85 투빅스 7&8기 5주차 과제 Image Augmentation - 8기 김민정 김소희 최수정 황다솔 file 민정e 2017.08.24 4461
84 투빅스 7&8기 5주차 과제 Beautiful Soup 이용한 Crawling - 8기 류호성 file 류호성 2017.08.24 4409
83 투빅스 7&8기 4주차 과제 tree, RF, bagging, boosting 이용 분석 - 8기 조양규 file dial123 2017.08.17 4321
Board Pagination ‹ Prev 1 2 3 4 5 6 ... 7 Next ›
/ 7

나눔글꼴 설치 안내


이 PC에는 나눔글꼴이 설치되어 있지 않습니다.

이 사이트를 나눔글꼴로 보기 위해서는
나눔글꼴을 설치해야 합니다.

설치 취소

Designed by sketchbooks.co.kr / sketchbook5 board skin

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5