station 5 . csv CARD _ SUBWAY _ MONTH _ 201704 . csv CARD _ SUBWAY _ MONTH _ 201704 _ a . csv forestfires . csv HR _ DATA . csv maintenance _ data . csv subway _ station . csv installRnRstudio . txt met _ scrpt _ 20170607 . txtR 설치 https : / / cran . r - project . org / bin / windows / base / R 스튜디오 설치 https : / / www . rstudio . com / products / rstudio / download 2 / # setwd ( " E : / restore _ Yong / 0 _ RnModeling 20161215 / metro ")# hr 01 <- read . csv ( " HR _ DATA . csv ")# 블로그 에서 바로 읽 어 오 기 hr 01 <- read . csv ( " https : / / t 1 . daumcdn . net / cfile / blog / 23402 B 3 B 591 A 45 D 631 ? download ") names ( hr 01 ) [ 9 ] <- " department " names ( hr 01 ) #----- 02 . 데이터 처리 : 조회 / 정렬 / 집계 / 계산 ---------# 데이터 조회 head ( hr 01 , 3 ) View ( hr 01 ) nrow ( hr 01 ) nrow ( hr 01 [ hr 01 $ satisfaction _ level > 0 . 99 , ] ) hr 01 [ hr 01 $ satisfaction _ level > 0 . 99 , ] hr 01 [ hr 01 $ satisfaction _ level > 0 . 99 & hr 01 $ average _ montly _ hours > 250 , ] nrow ( hr 01 [ hr 01 $ satisfaction _ level > 0 . 99 & hr 01 $ average _ montly _ hours > 250 , ] ) hr 01 [ hr 01 $ department == " technical ",] nrow ( hr 01 [ hr 01 $ department == " technical ",])# 데이터 정렬 hr 01 [ hr 01 $ satisfaction _ level > 0 . 99 & hr 01 $ average _ montly _ hours > 250 & hr 01 $ department == " technical ",] hr 02 <- hr 01 [ hr 01 $ satisfaction _ level > 0 . 99 & hr 01 $ average _ montly _ hours > 250 & hr 01 $ department == " technical ",] View ( hr 02 ) View ( hr 02 [ order ( hr 02 $ last _ evaluation ) , ] ) # 데이터 계산 hr 02 $ monthly _ hours _ per _ prj <- hr 02 $ average _ montly _ hours / hr 02 $ number _ projecthr 02 [ , c ( 3 , 4 , 11 ) ] View ( hr 02 [ , c ( 3 , 4 , 11 ) ] ) # 데이터 집계 table ( hr 01 $ department ) table ( hr 01 $ salary ) hr 03 <- aggregate ( hr 01 $ average _ montly _ hours , list ( hr 01 $ department ) , FUN = mean ) names ( hr 03 ) <- c ( " 부서 ", " 평균 근무 시간 ") View ( hr 03 ) hr 04 <- aggregate ( hr 01 $ satisfaction _ level , list ( hr 01 $ department ) , FUN = sd ) names ( hr 04 ) <- c ( " 부서 ", " 만족 도 표준편차 ") View ( hr 04 ) #---- 03 . 시각 적 인 데이터 분석 -----# 기본 챠트 생성 plot ( hr 03 ) plot ( hr 01 $ satisfaction _ level ) plot ( sort ( hr 01 $ satisfaction _ level ) ) hist ( hr 01 $ satisfaction _ level ) # 산점도 scatter plotplot ( hr 01 $ satisfaction _ level , hr 01 $ average _ montly _ hours ) # 산점도 에 이직 여부 를 반영 plot ( hr 01 $ satisfaction _ level , hr 01 $ average _ montly _ hours , col =( hr 01 $ left + 1 ) * 2 ) # 박스 플롯 boxplot ( hr 01 $ satisfaction _ level ~ hr 01 $ department , main =" 부서 별 만족 도 ")# 막대 챠트 barplot ( table ( hr 01 $ salary ) ) #===== 지도 시각화 ======= setwd ( " E : / restore _ Yong / 0 _ RnModeling 20161215 / metro ")#------ 서울 지하철 승하차 맵 --------------# 서울 지하철 호선 별 역 위치 정보 - 서울 열린 데이터 광장 # 서울 지하철 호선 별 역 별 승하차 인원 정보 # http : / / data . seoul . go . kr / openinf / fileview . jsp ? infId = OA - 12914 library ( ggplot 2 ) library ( ggmap ) station <- read . csv ( " subway _ station . csv ") station <- station [ ! is . na ( station $ xwgs ) & ! is . na ( station $ ywgs ) , ] station <- station [ station $ line % in % factor ( 1 : 9 ) , ] plot ( station $ xwgs , station $ ywgs , col = factor ( station $ line ) ) # 색상 구분 한 역좌 표 cent <- c ( mean ( station $ xwgs ) , mean ( station $ ywgs ) ) # 센터 좌표 2 seoul <- get _ map ( location = c ( lat = cent [ 1 ] , lon = cent [ 2 ] ) , zoom = 11 , maptype = " roadmap ") ggmap ( seoul ) + geom _ point ( data = station , size = 2 , alpha = 0 . 7 , mapping = aes ( x = ywgs , y = xwgs , color = factor ( line ) ) ) #---- 201704 승하차 인원 비율 표시 ------------------- station <- read . csv ( " subway _ station . csv ") station <- station [ ! is . na ( station $ xwgs ) & ! is . na ( station $ ywgs ) , ] station <- station [ station $ line % in % factor ( 1 : 9 ) , ] stationtrff <- read . csv ( " CARD _ SUBWAY _ MONTH _ 201704 _ a . csv ") stationtrff <- stationtrff [ stationtrff $ date == 20170404 , ] station 1 <- merge ( station , stationtrff [ , c ( 3 , 5 , 6 ) ] , by =" station ", all . x = T ) station 1 $ onoffratio <- station 1 $ onpass / station 1 $ offpassstation 1 $ onoffrhighname <- ifelse ( station 1 $ onoffratio > 1 . 2 , as . character ( station 1 $ name ) , "")# stationtrff $ onpass # stationtrffcv <- aggregate ( stationtrff [ , c ( 5 , 6 ) ] , by = list ( stationtrff $ station ) , FUN = sd , na . rm = T ) # stationtrffcv <- aggregate ( stationtrff [ , c ( 5 , 6 ) ] , list ( station = stationtrff $ station ) , FUN = mean , na . rm = T ) stationtrffcv <- aggregate ( stationtrff [ , c ( 5 , 6 ) ] , list ( station = stationtrff $ station ) , function ( x ) { sd ( x ) / mean ( x ) }) stationtrff 04 <- read . csv ( " CARD _ SUBWAY _ MONTH _ 201704 _ a . csv ") stationtrff 04 $ offpass [ stationtrff 04 $ offpass == 0 ] <- 0 . 5 stationtrffmcv <- aggregate ( stationtrff 04 [ , c ( 5 , 6 ) ] , list ( station = stationtrff 04 $ station ) , function ( x ) c ( cv = sd ( x ) / mean ( x ) ) ) names ( stationtrffmcv ) <- c ( " station ", onpassmcv ", " offpassmcv ") station 1 <- merge ( station 1 , stationtrffmcv , by =" station ", all . x = T ) # 승하차 비율 이 높 은 역 을 구분 표시 ggmap ( seoul ) + geom _ point ( data = station , size = 2 , alpha = 0 . 7 , mapping = aes ( x = ywgs , y = xwgs , color = factor ( line ) , shape = factor ( ifelse ( station 1 $ onoffratio > 1 . 2 , 1 , 0 ) ) ) ) seoul <- get _ map ( location = c ( lat = cent [ 1 ] , lon = cent [ 2 ] ) , zoom = 12 , maptype = " roadmap ") ggmap ( seoul ) + geom _ point ( data = station 1 , size = 3 , alpha = 0 . 7 , mapping = aes ( x = ywgs , y = xwgs , color = factor ( line ) , shape = factor ( ifelse ( station 1 $ onoffratio > 1 . 2 , 1 , 0 ) ) ) ) + geom _ text ( data = station 1 , aes ( x = ywgs , y = xwgs , label = onoffrhighname ) , hjust = 0 , vjust = 0 , size = 3 ) # 플롯 으로 기초 비교 plot ( sort ( station 1 $ onoffratio ) ) abline ( h = 1 ) # 승차 변동 성 이 높 은 역 을 크 게 표시 plot ( sort ( station 1 $ onpassmcv ) ) # 0 . 4 이상 이 면 변동성 크 다고 보임 station 1 $ onpassmcvHstn <- ifelse ( station 1 $ onpassmcv >= 0 . 4 , as . character ( station 1 $ name ) , "") ggmap ( seoul ) + geom _ point ( data = station 1 , alpha = 0 . 7 , mapping = aes ( x = ywgs , y = xwgs , size = onpassmcv , color = factor ( line ) ) ) + geom _ text ( data = station 1 , aes ( x = ywgs , y = xwgs , label = onpassmcvHstn ) , hjust = 0 , vjust = 0 , size = 3 ) # 하차 변동성 이 작 은 역 을 크 게 표시 station 2 <- station 1 [ ! ( station 1 $ station % in % c ( 260 , 1022 , 1458 ) ) , ] plot ( sort ( station 2 $ offpassmcv ) ) # 0 . 1 이상 이 면 변동 성 매우 작 다고 보임 station 2 $ offpassmcvLstn <- ifelse ( station 2 $ onpassmcv < 0 . 1 , as . character ( station 2 $ name ) , "") station 2 $ offpassmcvLndx <- 1 - ( station 2 $ offpassmcv / max ( station 2 $ offpassmcv ) ) plot ( station 2 $ offpassmcv / max ( station 2 $ offpassmcv ) ) ggmap ( seoul ) + geom _ point ( data = station 2 , alpha = 0 . 5 , mapping = aes ( x = ywgs , y = xwgs , size = offpassmcvLndx / 3 , color = factor ( line ) ) ) + geom _ text ( data = station 2 , aes ( x = ywgs , y = xwgs , label = offpassmcvLstn ) , hjust = 0 , vjust = 0 , size = 3 ) seoul <- get _ map ( location = c ( lat = cent [ 1 ] , lon = cent [ 2 ] ) , zoom = 12 , maptype = " toner ") ggmap ( seoul ) + geom _ point ( aes ( x = ywgs , y = xwgs , size = offpassmcvLndx , col = factor ( line ) ) , data = station 2 , alpha = 0 . 5 ) + annotate ( " text ", x = station 2 $ ywgs , y = station 2 $ xwgs , label = station 2 $ offpassmcvLstn , hjust = 0 , vjust = 0 , size = 3 ) # 2 호 선 노선 중 일평균 승하차 인원수 합계 가 큰 역 을 크 게 표시 해 본다면 ? 4 월 평균 ? station 5 <- station [ station $ line % in % factor ( 2 ) , ] stationtrff 04 _ 5 <- stationtrff 04 [ stationtrff 04 $ line ==" 2 호 선 ",]# 일별 승하차 인원수 합계 stationtrff 04 _ 5 $ onoffpasssum <- stationtrff 04 _ 5 $ onpass + stationtrff 04 _ 5 $ offpassstationtrffsum <- aggregate ( stationtrff 04 _ 5 $ onoffpasssum , list ( station = stationtrff 04 _ 5 $ station ) , FUN = mean ) names ( stationtrffsum ) <- c ( " station ", " daily _ onoffsum ") station 5 <- merge ( station 5 , stationtrffsum , by =" station ", all . x = T ) # toner versioncent <- c ( mean ( station 5 $ xwgs ) , mean ( station 5 $ ywgs ) ) # 센터 좌표 2 seoul <- get _ map ( location = c ( lat = cent [ 1 ] , lon = cent [ 2 ] ) , zoom = 12 , maptype = " toner ") # or " watercolor " ggmap ( seoul ) + geom _ point ( aes ( x = ywgs , y = xwgs , size = daily _ onoffsum ) , data = station 5 , alpha = 0 . 7 , col =" green ") + annotate ( " text ", x = station 5 $ ywgs , y = station 5 $ xwgs , label = station 5 $ name , col = ifelse ( station 5 $ station % in % c ( 222 , 216 , 239 ) , " red ", " black "), # 상위 3 개 역 red hjust = 0 , vjust = 0 , size = 3 ) # roadmap possibly in a wide formatcent <- c ( mean ( station 5 $ xwgs ) , mean ( station 5 $ ywgs ) ) # 센터 좌표 2 seoul <- get _ googlemap ( center = c ( lon = cent [ 2 ] , lat = cent [ 1 ] ) , zoom = 11 , maptype = " roadmap ") # get _ googlemap options appliedggmap ( seoul ) + geom _ point ( aes ( x = ywgs , y = xwgs , size = daily _ onoffsum ) , data = station 5 , alpha = 0 . 7 , col =" green ") + annotate ( " text ", x = station 5 $ ywgs , y = station 5 $ xwgs , label = station 5 $ name , hjust = 0 , vjust = 0 , size = 3 ) # 새로 읽 어 오 기 # station 5 <- read . csv ( " station 5 . csv ") station 5 <- read . csv ( " https : / / t 1 . daumcdn . net / cfile / blog / 2160164 D 594 C 562634 ? download ") names ( station 5 ) <- c ( " 역 코드 ", " 역명 ", " 호선 ", " x 좌표 ", " y 좌표 ", " 일 일 승하차 인 원합 계 ", " 평균 습도 ")# base plot version # 단순 한 플롯 그림 plot ( station 5 $ y 좌표 , station 5 $ x 좌표 , col =" green ", pch = 19 , cex = station 5 $ 일 일 승하차 인 원합 계 / 100000 , xlab ="", ylab ="", main =" 지하철역 붐비 는 정도 " , xlim = c ( 126 . 82 , 127 . 13 ) , ylim = c ( 37 . 47 , 37 . 58 ) ) text ( station 5 $ y 좌표 , station 5 $ x 좌표 , labels = station 5 $ 역명 , col = ifelse ( station 5 $ 역명 % in % c ( 222 , 216 , 239 ) , " red ", " black "), pos = 3 , cex = 0 . 5 ) # 승하차 인원 과 습도 비교 해 보 기 plot ( station 5 $ 일 일 승하차 인 원합 계 , station 5 $ 평균 습도 ) text ( station 5 $ 일 일 승하차 인 원합 계 , station 5 $ 평균 습도 , labels = station 5 $ 역명 , col = ifelse ( station 5 $ 역명 % in % c ( 222 , 216 , 239 ) , " red ", " black "), pos = 3 , cex = 0 . 5 ) #---- 04 . 예측 분석 이해 ---------------# 상관관계 plot ( hr 01 $ satisfaction _ level , hr 01 $ average _ montly _ hours ) abline ( lm ( hr 01 $ average _ montly _ hours ~ hr 01 $ satisfaction _ level ) , col =" red ", lwd = 2 ) cor ( hr 01 $ satisfaction _ level , hr 01 $ average _ montly _ hours ) plot ( hr 01 $ satisfaction _ level , jitter ( hr 01 $ number _ project , factor = 2 ) ) abline ( lm ( hr 01 $ number _ project ~ hr 01 $ satisfaction _ level ) , col =" red ", lwd = 2 ) cor ( hr 01 $ satisfaction _ level , hr 01 $ number _ project ) # 회귀분석 plot ( jitter ( hr 01 $ number _ project , factor = 2 ) , hr 01 $ satisfaction _ level ) abline ( lm ( hr 01 $ satisfaction _ level ~ hr 01 $ number _ project ) , col =" red ", lwd = 2 ) lines ( lowess ( hr 01 $ satisfaction _ level ~ hr 01 $ number _ project ) , col =" blue ", lwd = 2 ) summary ( lm ( hr 01 $ satisfaction _ level ~ hr 01 $ number _ project ) ) # 수식 으로 표현 : satisfaction _ level = - 0 . 028839 * number _ project + 0 . 722509 # 다중 회귀분석 결과 summary ( lm ( left ~., data = hr 01 ) ) # 의사 결정 나무 분석 library ( rpart ) # load the rpart packaget 1 <- rpart ( left ~ . , data = hr 01 , minbucket = 500 ) library ( rattle ) library ( rpart . plot ) library ( RColorBrewer ) fancyRpartPlot ( t 1 ) # ctree 버전 library ( party ) # 숫자 가 아닌 종류 로 형식 변경 hr 01 t <- hr 01 hr 01 t $ left <- as . factor ( hr 01 t $ left ) t 1 <- ctree ( left ~ . , data = hr 01 t , controls = ctree _ control ( minbucket = 500 ) ) plot ( t 1 ) t 1 <- ctree ( left ~ . , data = hr 01 t , controls = ctree _ control ( minbucket = 500 , maxdepth = 3 ) ) plot ( t 1 ) # 산점 도 확인 plot ( hr 01 $ satisfaction _ level , jitter ( hr 01 $ time _ spend _ company , factor = 2 ) , col =( hr 01 $ left + 1 ) * 3 ) plot ( hr 01 $ satisfaction _ level , jitter ( hr 01 $ number _ project , factor = 2 ) , col =( hr 01 $ left + 1 ) * 2 ) # 군집 분석 hr 06 <- hr 01 [ , c ( 2 , 4 , 6 , 8 ) ] k 01 <- kmeans ( scale ( hr 06 ) , 3 ) plot ( hr 01 $ average _ montly _ hours , hr 01 $ satisfaction _ level , col = k 01 $ cluster + 3 ) plot ( jitter ( hr 01 $ Work _ accident , factor = 2 ) , hr 01 $ last _ evaluation , col = k 01 $ cluster + 3 ) #---- 산불 피해 분석 예제 # setwd ( " E : / restore _ Yong / GAMDFM / Ffire ")# ff <- read . csv ( " forestfires . csv ") ff <- read . csv ( " https : / / t 1 . daumcdn . net / cfile / blog / 26021135594 B 019 B 01 ? download ") names ( ff ) #------ 컬럼 설명 -------# Montesinho park ( Portugal ) 1 . X - x - axis spatial coordinate within the Montesinho park map : 1 to 9 2 . Y - y - axis spatial coordinate within the Montesinho park map : 2 to 9 3 . month - month of the year : " jan " to " dec " 4 . day - day of the week : " mon " to " sun " 5 . FFMC - FFMC index from the FWI system : 18 . 7 to 96 . 20 6 . DMC - DMC index from the FWI system : 1 . 1 to 291 . 3 7 . DC - DC index from the FWI system : 7 . 9 to 860 . 6 8 . ISI - ISI index from the FWI system : 0 . 0 to 56 . 10 9 . temp - temperature in Celsius degrees : 2 . 2 to 33 . 30 10 . RH - relative humidity in %: 15 . 0 to 100 11 . wind - wind speed in km / h : 0 . 40 to 9 . 40 12 . rain - outside rain in mm / m 2 : 0 . 0 to 6 . 4 13 . area - the burned area of the forest ( in ha ) : 0 . 00 to 1090 . 84 require ( party ) ct 1 <- ctree ( area ~ . , data = ff , controls = ctree _ control ( maxdepth = 3 , minbucket = as . integer ( nrow ( ff ) / 100 ) ) ) plot ( ct 1 ) plot ( ff $ area , jitter ( ff $ wind ) ) plot ( sort ( ff $ area ) ) ff 1 <- ffff 1 $ logarea <- log ( ff $ area + 1 ) plot ( sort ( ff 1 $ logarea ) ) ff 1 <- ff 1 [ , ! ( names ( ff 1 ) % in % c ( " area ", " DMC ", " DC "))] ct 2 <- ctree ( logarea ~ . , data = ff 1 , controls = ctree _ control ( maxdepth = 3 , minbucket = 5 , , mincriterion = 0 . 2 ) ) plot ( ct 2 ) ff 11 <- ff 1 [ ff 1 $ month ! = " dec ",] plot ( jitter ( ff 11 $ Y ) , jitter ( ff 11 $ temp ) , col = ifelse ( ff 11 $ logarea > 0 , 2 , 1 ) ) abline ( h = 25 . 9 , lty = 2 ) abline ( v = 5 , lty = 2 ) plot ( jitter ( ff 11 $ X ) , jitter ( ff 11 $ Y ) , col = rgb ( ff 1 $ logarea / max ( ff 1 $ logarea ) , 0 . 3 , 0 . 3 , alpha = 0 . 7 ) , pch = 19 ) #========== plot ( jitter ( ff $ wind ) , jitter ( ff $ rain ) , col = ifelse ( ff $ area > 0 , 2 , 1 ) ) plot ( jitter ( ff $ wind ) , jitter ( ff $ temp ) , col = ifelse ( ff $ area > 0 , 2 , 1 ) ) ff 3 <- ff ff 3 $ isLarea <- ifelse ( ff 3 $ area >= 2 , 1 , 0 ) ff 3 <- ff 3 [ , ! ( names ( ff 3 ) == " area ")] ct 3 <- ctree ( isLarea ~ . , data = ff 3 , controls = ctree _ control ( maxdepth = 5 , minbucket = 3 , mincriterion = 0 . 9 ) ) plot ( ct 3 ) ct 3 <- ctree ( isLarea ~ temp + wind + RH + rain , data = ff 3 , controls = ctree _ control ( maxdepth = 5 , minbucket = 3 , mincriterion = 0 . 9 ) ) plot ( ct 3 ) #---- 고장 분석 예제 # setwd ( " E : / restore _ Yong / GAMDFM / FAULT ")# dataset source : https : / / www . kaggle . com / ludobenistant / predictive - maintenance # m 1 <- read . csv ( " maintenance _ data . csv ") m 1 <- read . csv ( " https : / / t 1 . daumcdn . net / cfile / blog / 27711 B 35594 B 019 D 05 ? download ") plot ( m 1 $ temperatureInd , m 1 $ pressureInd , col = ifelse ( m 1 $ broken == 1 , 2 , 1 ) ) m 2 <- m 1 m 2 $ lifetimeyear <- as . integer ( m 2 $ lifetime / 12 ) plot ( sort ( m 2 $ lifetimeyear ) ) plot ( sort ( m 2 $ pressureInd ) ) m 2 $ pressureCla <- ifelse ( m 2 $ pressureInd >= 120 , " pressure _ H ", ifelse ( m 2 $ pressureInd >= 80 , " pressure _ M "," pressure _ L ")) table ( m 2 $ pressureCla ) plot ( sort ( m 2 $ moistureInd ) ) m 2 $ moistureCla <- ifelse ( m 2 $ moistureInd >= 110 , " moisture _ H ", ifelse ( m 2 $ moistureInd >= 85 , " moisture _ M "," moisture _ L ")) table ( m 2 $ moistureCla ) plot ( sort ( m 2 $ temperatureInd ) ) m 2 $ temperatureCla <- ifelse ( m 2 $ temperatureInd >= 130 , " temperature _ H ", ifelse ( m 2 $ temperatureInd >= 80 , " temperature _ M "," temperature _ L ")) table ( m 2 $ temperatureCla ) barplot ( table ( m 2 $ broken , m 2 $ lifetimeyear ) ) # barplot ( prop . table ( table ( m 2 $ broken , m 2 $ lifetimeyear ) , 2 ) ) # 비율 로 비교 m 2 $ brokenCla <- ifelse ( m 2 $ broken == 1 , " broken ", " normal ") m 2 $ lifetimeyearCla <- paste 0 ( " lifetime ", as . character ( m 2 $ lifetimeyear ) ) m 3 <- m 2 [ , ( names ( m 2 ) % in % c ( " brokenCla ", " team ", " provider ", " lifetimeyearCla ", " pressureCla ", " moistureCla ", " temperatureCla " ) ) ] #---------- install . packages ( " arules ") install . packages ( " arulesViz ") install . packages ( " datasets ") library ( arules ) library ( arulesViz ) library ( datasets ) write . csv ( m 3 , " maint _ trs . csv ", row . names = F , col . names = F ) m 4 <- read . transactions ( " maint _ trs . csv ", format =" basket ", sep ="," , skip = 1 ) ; inspect ( head ( m 4 , 5 ) ) inspect ( head ( m 4 , 5 ) ) itemFrequencyPlot ( m 4 , topN = 20 , type =" absolute ") rules <- apriori ( m 4 , parameter = list ( supp = 0 . 03 , conf = 0 . 3 , minlen = 2 , maxlen = 2 ) ) options ( digits = 3 ) inspect ( rules [ 1 : 20 ] ) summary ( rules ) df 1 <- as . data . frame ( inspect ( rules ) ) df 2 <- df 1 [ df 1 $ rhs =="{ broken }" & df 1 $ lift > 1 , ] df 2 [ order ( - df 2 $ confidence ) , ] plot ( rules ) rules 1 <- apriori ( m 4 , parameter = list ( supp = 0 . 01 , conf = 0 . 6 , minlen = 2 , maxlen = 2 ) ) rules 2 <- head ( sort ( rules , by =" confidence "), 30 ) rules 3 <- subset ( rules 1 , subset = rhs % pin % " broken ") rules 4 <- subset ( rules 1 , subset = rhs % in % c ( " broken ", " normal ")) inspect ( rules 4 ) plot ( rules 4 , method =" graph ", interactive = F , shading = NA ) plot ( rules 4 , method =" graph ", interactive = T , shading = NA ) df 5 <- as . data . frame ( inspect ( rules 4 ) ) df 5 [ order ( - df 5 $ confidence ) , ]#---- 05 . 텍스트 분석 이해 ------------:: 텍스트 마이닝 ( + 크롤링 ) #-----[ 크롤링 crawling : : data harvesting ; scraping ; wrangling ] ---# install . packages ( " XML ")# install . packages ( " rvest ") library ( XML ) library ( rvest ) #-- [ 지하철 ] 에 대한 네이버 뉴스 # 네이버 -> 뉴스 검색 -> [ 키워드 : 지하철 ] 검색 newsURL <- " http : / / news . naver . com / main / search / search . nhn ? query =% C 1 % F 6 % C 7 % CF % C 3 % B 6 & st = news . all & q _ enc = EUC - KR & r _ enc = UTF - 8 & r _ format = xml & rp = none & sm = all . basic & ic = all & so = rel . dsc & detail = 0 & pd = 1 & r _ cluster 2 _ start = 1 & r _ cluster 2 _ display = 10 & start = 1 & display = 10 & page ="# 네이버 -> 뉴스 검색 -> [ 키워드 : 서울 지하철 ] 검색 newsURL <- " http : / / news . naver . com / main / search / search . nhn ? query =% BC % AD % BF % EF +% C 1 % F 6 % C 7 % CF % C 3 % B 6 & st = news . all & q _ enc = EUC - KR & r _ enc = UTF - 8 & r _ format = xml & rp = none & sm = all . basic & ic = all & so = rel . dsc & detail = 0 & pd = 1 & r _ cluster 2 _ start = 1 & r _ cluster 2 _ display = 10 & start = 1 & display = 10 & page ="# 네이버 -> 뉴스 검색 -> [ 키워드 : 서울 지하철 불편 ] 검색 newsURL <- " http : / / news . naver . com / main / search / search . nhn ? query =% BC % AD % BF % EF +% C 1 % F 6 % C 7 % CF % C 3 % B 6 +% BA % D 2 % C 6 % ED & st = news . all & q _ enc = EUC - KR & r _ enc = UTF - 8 & r _ format = xml & rp = none & sm = all . basic & ic = all & so = rel . dsc & detail = 0 & pd = 1 & r _ cluster 2 _ start = 1 & r _ cluster 2 _ display = 10 & start = 1 & display = 10 & page =" GetStockCommentData <- function ( num = 1 , newsURL ) { url <- gsub ( " ","", paste 0 ( newsURL , as . character ( num ) ) ) doc <- htmlTreeParse ( url , useInternalNodes = T ) print ( url ) subject <- xpathSApply ( doc , "// div [ @ class =' ct ']/ a ", xmlValue ) # subject date <- xpathSApply ( doc , "// div [ @ class =' ct ']/ div / span [ 4 ] ", xmlValue ) # 보도 일자 main <- xpathSApply ( doc , "// div [ @ class =' ct ']/ p ", xmlValue ) # 요약 보 기 press <- xpathSApply ( doc , "// div [ @ class =' ct ']/ div / span [ 2 ] ", xmlValue ) # 신문사 url 2 <- xpathSApply ( doc , "// div [ @ class =' ct ']/ div / a ", xmlGetAttr , ' href ') subject <- iconv ( subject , " UTF - 8 "," EUC - KR ") date <- iconv ( date , " UTF - 8 "," EUC - KR ") main <- iconv ( main , " UTF - 8 "," EUC - KR ") press <- iconv ( press , " UTF - 8 "," EUC - KR ") main <- gsub ( "\ r |\ t |\ n ","", main ) stock _ data <- cbind ( subject , date , main , press ) return ( stock _ data ) } gc ( ) # 메모리 상 의 불 필요 한 데이터 제거 DATA <- NULLStartPage <- 1 EndPage <- 5 # newsUrl 에 키워드 검색 결과 페이지 URL 을 paste # newsUrl <- " http : / / news . naver . com / main / search / search . nhn ? query =% B 4 % EB % C 7 % D 0 % B 1 % B 3 & st = news . all & q _ enc = EUC - KR & r _ enc = UTF - 8 & r _ format = xml & rp = none & sm = all . basic & ic = all & so = rel . dsc & rcnews = exist : 032 : 005 : 086 : 020 : 021 : 081 : 022 : 023 : 025 : 028 : 038 : 469 : 421 : 003 : 001 : 422 : 449 : 004 : 215 : 437 : 056 : 214 : 019 : 057 : 096 : 374 : 055 : 448 : 052 : 009 : 008 : 011 : 277 : 018 : 366 : 014 : 015 : 016 : 375 : 079 : 119 : 006 : 047 : 143 : 002 : 138 : 029 : 293 : 031 : 030 : 092 : 145 : 024 : 417 : 242 : 308 : 262 : 140 : 094 : 243 : 007 : 033 : 037 : 053 : 042 : 353 : 105 : 036 : 050 : & stDate = range : 20170401 : 20170415 & detail = 0 & pd = 4 & r _ cluster 2 _ start = 1 & r _ cluster 2 _ display = 10 & start = 1 & display = 10 & startDate = 2017 - 04 - 01 & endDate = 2017 - 04 - 15 " DATA <- NULLStartPage <- 1 EndPage <- 5 for ( i in StartPage : EndPage ) { getData <- GetStockCommentData ( i , newsURL ) print ( length ( getData ) ) DATA <- rbind ( DATA , getData ) print ( paste 0 ( " page ", as . character ( i ) , " done "))}# write . csv ( DATA , " F : / data / aaa . csv ")#------------ library ( XML ) library ( rvest ) #--- [ 키워드 ] 에 대한 네이버 블로그 수집 # https ==> http [ http 로 바꾸 어 주 고 돌려야 함 ] GetStockCommentData <- function ( num ) { url = gsub ( " ","", paste 0 ( " https : / / section . blog . naver . com / sub / SearchBlog . nhn ? type = post & option . keyword =% EC % 84 % 9 C % EC % 9 A % B 8 % 20 % EC % A 7 % 80 % ED % 95 % 98 % EC % B 2 % A 0 & term =& option . startDate =& option . endDate =& option . page . currentPage =", as . character ( num ) ) ) print ( url ) doc = htmlTreeParse ( url , useInternalNodes = T , encoding =" UTF - 8 ") xpathSApply ( doc , "//*[@ id =' blogSearchForm ']/ div [ 2 ] / ul [ 3 ] ", xmlValue ) subject <- xpathSApply ( doc , "// ul [ @ class =' list _ type _ 1 search _ list ']/ li / h 5 / a ", xmlValue ) # subject print ( subject ) date <- xpathSApply ( doc , "// span [ @ class =' date ']", xmlValue ) # 작성 일 main <- xpathSApply ( doc , "// div [ @ class =' list _ content ']", xmlValue ) # 본문 요약 main <- gsub ( "\ r |\ n ","", main ) nick <- xpathSApply ( doc , "// div [ @ class =' list _ data ']/ a ", xmlValue ) # 블로그 닉네임 category <- xpathSApply ( doc , "// span [ @ class =' category ']/ a ", xmlValue ) # 블로그 카테고리 href <- xpathSApply ( doc , "// ul [ @ class =' list _ type _ 1 search _ list ']/ li / h 5 / a ", xmlGetAttr , ' href ') stock _ data <- cbind ( subject , date , main , nick , category , href ) print ( stock _ data ) return ( stock _ data ) } gc ( ) DATA <- NULLStartPage <- 1 EndPage <- 5 for ( i in StartPage : EndPage ) { getData <- GetStockCommentData ( i ) DATA <- rbind ( DATA , getData ) }# write . csv ( DATA , " aaablog . csv ", row . names = F ) # - - ------------------#------ 워드 클라우드 생성 ------------# install . packages ( " KoNLP ") library ( KoNLP ) useSejongDic ( ) # 세종 사전 생성 # setwd ( ".... 사용 자 path 지정 ") # DATA <- readLines ( " abcd . txt ") # 텍스트 파일 에서 읽 어 오 는 경우 article <- paste 0 ( as . data . frame ( DATA ) $ subject , as . data . frame ( DATA ) $ main ) paste ( c ( " acde "," ee "), collapse ="") article <- paste 0 ( article , collapse ="") article 1 <- sapply ( article , extractNoun , USE . NAMES = F ) article 2 <- unlist ( article 1 ) article 3 <- Filter ( function ( x ) { nchar ( x ) >= 2 }, article 2 ) article 3 <- gsub ( "\ r |\ n |\ t ","", article 3 ) article 3 <- gsub ( " 하 기 ","", article 3 ) article 3 <- gsub ( "△","", article 3 ) article 3 <- gsub ( " 하 게 ","", article 3 ) # article 3 <- gsub ( " 빅 데이터 를 "," 빅 데이터 ", article 3 ) # article 3 <- gsub ( " 빅 데이터 로 "," 빅 데이터 ", article 3 ) wordcount <- table ( article 3 ) barplot ( sort ( wordcount ) , las = 2 , cex . names = 0 . 7 ) barplot ( head ( tail ( wordcount [ order ( - wordcount ) ] , length ( wordcount ) - 2 ) , 20 ) ) # sort table # wc 1 <- head ( tail ( wordcount [ order ( - wordcount ) ] , length ( wordcount ) - 3 ) , 50 ) # wc 1 <- head ( wordcount [ order ( - wordcount ) ] , 50 ) [ c ( 2 , 5 : 50 ) ] wc 1 <- head ( wordcount [ order ( - wordcount ) ] , 50 ) barplot ( wc 1 , las = 2 , cex . names = 0 . 7 ) head ( as . data . frame ( wordcount ) ) df _ a 3 <- as . data . frame ( wordcount ) df _ a 31 <- df _ a 3 [ df _ a 3 $ Freq >= 3 , ] barplot ( df _ a 31 $ Freq , names . arg = df _ a 31 $ article 3 , cex . names = 0 . 7 ) head ( df _ a 31 [ order ( - df _ a 31 $ Freq ) , ] , 20 ) barplot ( wordcount [ order ( wordcount ) ] ) #------ wordcloud 생성 --------------------# install . packages ( " wordcloud 2 ") library ( wordcloud 2 ) # windowsFonts ( malgun = windowsFont ( " 맑 은 고딕 ")) wordcloud 2 ( data = wordcount , minSize = 7 , minRotation = - pi / 0 , maxRotation = - pi / 0 , rotateRatio = 1 , fontFamily =' 맑 은 고딕 ', size = 0 . 8 ) # < 지하철 > 제외 후 wc -- 다이아몬드 모양 wordcloud 2 ( data = wc 1 , minSize = 7 , minRotation = - pi / 0 , maxRotation = - pi / 0 , rotateRatio = 1 , fontFamily =' 맑 은 고딕 ', size = 0 . 7 , shape =' diamond ') wordcloud 2 ( data = wordcount , minSize = 7 , minRotation = - pi / 0 , maxRotation = - pi / 0 , rotateRatio = 1 , fontFamily =' 맑 은 고딕 ', size = 0 . 7 , shape =' diamond ')# < 빅 데이터 > 와 < 분석 > 제외 후 wc -- 다이아몬드 모양 wordcloud 2 ( data = wc 1 , minSize = 3 , minRotation = - pi / 0 , maxRotation = - pi / 0 , rotateRatio = 1 , fontFamily =' 맑 은 고딕 ', size = 0 . 4 , shape =' diamond ')#-------[ by article ] ------ df _ DATA <- as . data . frame ( DATA ) a 1 <- apply ( df _ DATA [ , c ( 1 , 3 ) ] , 1 , paste , collapse =" ") a 1 <- sapply ( a 1 , extractNoun , USE . NAMES = F ) a 2 <- NAaid <- NA for ( i in 1 : length ( a 1 ) ) { a 2 <- c ( a 2 , a 1 [ [ i ] ] ) aid <- c ( aid , rep ( i , length ( a 1 [ [ i ] ] ) ) ) } df _ article <- data . frame ( aid , a 2 ) df _ article <- df _ article [ ! is . na ( df _ article $ aid ) , ] head ( df _ article , 60 ) df _ article <- df _ article [ nchar ( as . character ( df _ article $ a 2 ) ) >= 2 , ] head ( df _ article , 60 ) df _ article $ a 2 <- gsub ( "\ r |\ n |\ t ","", df _ article $ a 2 ) df _ article $ a 2 <- gsub ( "“|”|\\[|\\]| 오전 | 오후 | 뉴시스 와 ","", df _ article $ a 2 ) df _ article $ a 2 <- gsub ( " 빅 데이터 를 "," 빅 데이터 ", df _ article $ a 2 ) df _ article $ a 2 <- gsub ( " 빅 데이터 로 "," 빅 데이터 ", df _ article $ a 2 ) df _ article <- df _ article [ nchar ( as . character ( df _ article $ a 2 ) ) >= 2 , ] head ( df _ article , 60 ) #------- association rules [ single format ] -----------# 키워드 간 연관 성 분석 ( 동시 출현 패턴 ) library ( arules ) library ( arulesViz ) setwd ( " E : / restore _ Yong / GAMDFM / text _ m ") head ( df _ article ) write . csv ( df _ article , " dfa . csv ", row . names = F ) tr <- read . transactions ( " dfa . csv ", format = " single ", sep =',', skip = 1 , rm . duplicates = FALSE , cols = c ( 1 , 2 ) ) inspect ( head ( tr ) ) itemFrequencyPlot ( tr , topN = 20 , type =" absolute ") srules <- apriori ( tr , parameter = list ( supp = 0 . 06 , conf = 0 . 4 , minlen = 2 , maxlen = 2 ) ) # options ( digits = 3 ) inspect ( head ( srules ) ) summary ( srules ) rules 1 <- head ( sort ( srules , by =" confidence "), 50 ) inspect ( rules 1 ) rules 2 <- subset ( rules 1 , subset =( lift > 1 ) ) # rules 2 <- subset ( rules 1 , subset =(!( lhs % pin % " 서울 | 지하철 | 들 이 ")))# rules 2 <- subset ( rules 2 , subset =(!( rhs % pin % " 서울 | 지하철 | 들 이 "))) inspect ( head ( sort ( rules 2 , by =" lift "), 30 ) ) plot ( rules 2 , method =" graph ", interactive = T , shading = NA ) inspect ( rules 1 ) inspect ( head ( sort ( rules 2 , by =" lift "), 10 ) ) #--- 끝 -----