Group by Count

data4_dt[, ':=' (COUNT = .N, temp = "justTest" ) , by = job_id]



Order By

data4_dt[order(-COUNT), ]



Delete Column

data4_dt$cnt <- NULL

data4_dt[ , cnt := NULL]

data4_dt

반응형
Posted by JoeSung
,



 [ 신경망에 대한 이론 설명 ]


 로센블레트 ( 1958년 퍼셉트론 제안 )


  사람의 뇌 ---------->  컴퓨터를 이용한 지능처리


              ↓                 ↓


  생물학적 신경망내에                     인공신경망에서는

  반복적인 시그널이 발생할 때          가중치라는 것으로

  그 시그널을 기억하는 일종의          기억의 효과를 대체할 수 있음을

  학습효과 있다.                             설명했다.



  1958년 로젠블라트의  퍼셉트론  


                         반복

                          ↓

          1. 뇌 :  신호 ----->  암기



                                가중치

                                  ↓     1 (신호가 흐른다.)

          2. 인공신경망  : 신호 -----> 

                                         0 (신호가 안흐른다.)


인공신경망 기본 그림





컴퓨터            vs               뇌

          ↓                               ↓

     정보를 메모리의                    정보를 저장하는 공간이 

     특정위치에 저장                    따로 없음

                                          ↓

                                     신경세포(뉴런)의 연결관계를

                                     변경하는 방식으로 저장한다.

                                          ↓

                                     신경세포(뉴런)은 그저 다른 

                                     신경세포에서 오는 신호를 받아서

                                     자신의 신호를 내보내는 역할만 한다.



 * 뉴런의 갯수


  1. 사람 : 850억개 

  2. 고양이 ; 10억개

  3. 쥐  : 7500만개

  4. 바퀴벌레 : 몇백만개

  5. 하루살이 : 지금 현재까지 나온 최첨단 인공지능의 

                뉴런수보다 많다.




[코드]  -- > R 스크립트에 복붙 !


# 라이브러리

install.packages("neuralnet")

library(neuralnet)


# Step 1. 

# 먼저 아래의 행렬식을 R로 구현해보세요.

x <- matrix(c(1,2), nrow = 1, ncol = 2)

y <- matrix(c(1:6), nrow = 2 , ncol = 3, byrow = F)

res <- x %*% y

res



# Step 2.

x <- matrix(c(1:6), nrow = 2, ncol = 3, byrow = T)

y <- matrix(c(1:6), nrow = 3, ncol = 2, byrow = T)

res <- x %*% y

res



# Step 3.

x <- matrix(c(5, 11, 17), nrow = 1 , byrow = T)

y <- matrix(c(1:6), nrow = 3, ncol = 2)

z <- x %*% y

a <- matrix(c(1:4), nrow = 2)

z <- z %*% a

z



# Step 4. '순'전파

  # 2nd layer에서 3rd layer로 이동할 때

x <- matrix(c(5, 11, 17), nrow = 1 , byrow = T)

x <- x + c(1,2,3) # Bias 발생 각각 1, 2, 3

y <- matrix(c(1:6), nrow = 3, ncol = 2)

z <- x %*% y

z # 3nd layer의 value


  # 3nd layer에서 4th layer로 이동할 때

z <- z + c(1,2) # Bias 발생

a <- matrix(c(1:4), nrow = 2)

z <- z %*% a

z <- z + c(1,2) # Bias 발생 

z



 

#아래의 공식을 이용해서 시그모이드 함수를 R로 구현하시오

#                             1

# h(x) = ----------------------------- (비선형 함수)

#                      1 + exp(-x)




sigmoid <- function(x){

  return(1 / (1+ exp(-x)))

}


x <- c(1,2,3,4,5,6,7,8,9,10)

sigmoid(x)




반응형
Posted by JoeSung
,


## 폰트 설정 패키지 설치

install.packages("extrafont")

library(extrafont)


## 존재하는 모든 폰트 불러오기

font_import()


## 폰트 설정

theme_set(theme_gray(base_family='NanumGothic'))

## 혹은

theme_set(theme_gray(base_family='AppleMyungjo'))




참고 : http://www.mind-mining.co.kr/2016/05/using-r-mac.html

반응형
Posted by JoeSung
,

##

## dplyr practice of 5 core verbs ( select, mutate, filter, arrange, summarise )

##


## 1 select - 그냥 SQL select 처럼 쓰면 되나보다 범위 설정도 되는듯 1:4 이런식

buying_no_shopping %>%

  select(ID, BIZ_UNIT)


custo %>%

  select(ID, GENDER, HOM_PST_NO)


custo %>% ## 컬럼 번호 범위로 가져오는 방법

  select(1:(ncol(custo)-1))


buying_shopping %>%

  select(ID, RCT_NO, PD_S_C)


## 2 mutate - 새로운 파생변수 만들 때 쓰는거 (변수 = 기존변수 * 조작)

glimpse(custo)

custo %>%

  mutate(GENDER_KR = ifelse(GENDER == 1, "남자", "여자") ) %>%

  select(1, 3:5,GENDER)


## 3 filter - where 같은거 &으로 연결지어서 사용 ,로도 된다.

custo %>%

  filter(GENDER == 1,

         HOM_PST_NO > 100

  ) %>%

  mutate(OVER =HOM_PST_NO/10) %>%

  group_by(ID, OVER) %>%

  summarise(n = n())


## 4 summarise - group_by 써서 aggregation function 쓸 때 summarise 활용하는 느낌이구나

custo %>%

  mutate(OVER =HOM_PST_NO/10) %>%

  group_by(AGE_PRD) %>%

  summarise( avg_cnt = sum(GENDER) / n() ) %>%

  mutate(rnk=rank(avg_cnt)) %>%

  arrange(desc(rnk))

## Aggregation function 쓸 때는 이거 쓰는거고 

## as 같이 column 이름 쓸 때 = 로 넣어준다.

## count avg sum 쓸 때 이거 쓰면 되겠다.


## 5 arrange - desc() 쓰면 디센딩 오더

custo %>%

  mutate(OVER =HOM_PST_NO/10) %>%

  group_by(AGE_PRD) %>%

  summarise( avg_cnt = sum(GENDER) / n() ) %>%

  mutate(rnk=rank(avg_cnt)) %>%

  arrange(desc(rnk))

반응형
Posted by JoeSung
,


[결과물]





[코드]


building.csv



install.packages(c("arules", "arulesViz", "visNetwork", "igraph" ))

library(arules) ## 연관관계 분석을 위한 aprior() 를 쓰기 위함

library(arulesViz) ## 시각화에 필요

library(visNetwork) ## 시각화 중 네트워크 표현에 필요

library(igraph) ## 시각화 결과물을 인터렉티브(움직이게) 해줌

 작업에 필요한 라이브러리를 설치하고 불러옵니다.


## 파일 로드

bui <- read.csv("building.csv", header = T)

head(bui, 3)


## NA 처리 

bui[is.na(bui)] <- 0

trans <- bui


#데이터 정제

roname <- bui[ , 1]

trans <- bui[, -1]

trans <- as.matrix(trans, "Transaction")

rownames(trans) <- roname


# 모델링

rules <- apriori(trans, parameter = list(supp = 0.001, conf = 0.6, target = "rules"))

rules


# 결과 출력

inspect(sort(rules))


 연관관계 모델링 및 결과 출력을 위한 코드입니다.


     lhs                                        rhs              support confidence lift    

[1]  {일반음식점}                            => {패밀리레스토랑} 0.40    1.0000000  2.222222

[2]  {패밀리레스토랑}                        => {일반음식점}     0.40    0.8888889  2.222222

[3]  {약국}                                  => {휴대폰매장}     0.25    1.0000000  3.333333

[4]  {휴대폰매장}                            => {약국}           0.25    0.8333333  3.333333

[5]  {약국}                                  => {병원}           0.25    1.0000000  3.333333

[6]  {병원}                                  => {약국}           0.25    0.8333333  3.333333

[7]  {휴대폰매장}                            => {병원}           0.25    0.8333333  2.777778

[8]  {병원}                                  => {휴대폰매장}     0.25    0.8333333  2.777778

[9]  {편의점}                                => {일반음식점}     0.25    1.0000000  2.500000

[10] {일반음식점}                            => {편의점}         0.25    0.6250000  2.500000

* 야매 개념 소개

  - Support : 지지도, 두 사건이 동시에 일어날 확률

  - Confidence : 신뢰도, 한 사건이 일어났을 때 다른 사건에 영향을 미치는 정도

  - Lift : 리프트, 상관관계와 유사한 개념.



## 시각화

subrules2 <- head(sort(rules, by="lift"), 20) ## lift 기준으로 상위 20개만을 시각화


ig <- plot( subrules2, method="graph", control=list(type="items") )


# saveAsGraph seems to render bad DOT for this case

tf <- tempfile( )

saveAsGraph( subrules2, file = tf, format = "dot" )

# clean up temp file if desired

#unlink(tf)







# 인터렉티브 코드

ig_df <- get.data.frame( ig, what = "both" )

visNetwork(

  nodes = data.frame(

    id = ig_df$vertices$name

    ,value = ig_df$vertices$support # could change to lift or confidence

    ,title = ifelse(ig_df$vertices$label == "",ig_df$vertices$name, ig_df$vertices$label)

    ,ig_df$vertices

  )

  , edges = ig_df$edges

) %>%

  visEdges(  ig_df$edges ) %>%

  visOptions( highlightNearest = T )





## 참고(Reference)

R visualization of arules with arulesViz + igraph + visNetwork


반응형
Posted by JoeSung
,

 -앙상블 (Ensemble) 기법 중 배깅(Bagging) 기법 원리 이해하기 :: R 모조리 정복하기


 이번 포스팅에서는 머신러닝의 모델링 기법중 하나인 앙상블, 그 중에서도 가장 기본적인 방법인 배깅(Bagging, Bootstrap Aggregating) 방법에 대해서 알아보고자 합니다. 


[INDEX]

1. 원리

2. 연습 in R



1.  Bagging 원리 (feat. 앙상블)


(출처 :  Youtube 영상 , Ensemble Learner , Udactiy)



  앙상블 모형은 여러개의 weak learners 를 이용해 최적의 답을 찾아내는 기법입니다. 그냥 학습자가 아닌 '약한 학습자'를 활용하게 되는데요, 굳이 이렇게 하는 이유는 좀 더 다양한 의견을 수렴하는 것과 같은 효과를 얻게 되기 때문입니다.


마치, 변호사로만 이루어진 팀보다는 변호사도 있고 배우도 있고 가수도 있는 팀이 좀 더 다양한 의견을 내서 퀴즈쇼에서 좋은 결과를 낼 수 있는 것과 같은 원리라고 보시면 됩니다. 약한 학습자 여러개를 결합하면 강한 학습자가 만들어진다는 아이디어를 기반으로 한다는 것이죠.


배깅(Bagging, Bootstrap aggregatng)은 이러한 앙상블 모형의 기법중 하나인데요, 그림에서 처럼 샘플링을 복원추출로 해온 여러개의 데이터셋으로 부터 각각 모델을 만들고, 그 모델들에서 나온 결과들을 투표(Voting) 혹은 평균(Mean, 보통 회귀분석으로 앙상블을 시도했을 때 평균으로 종합한다고 합니다.) 하여 결과를 도출하는 방법입니다.


 유튜브 영상을 보면 조금 더 이해가 쉬운데요, Udacity에서 쉽게 강의한 영상이 있어 아래에 소개합니다.







이런 앙상블 기법에 대해 정확도를 올리기 위한 방법에 대한 질문을 3가지를 던질 수 있는데


 1. 데이터에 대해 어떤 머신러닝 모델을 구현할 것인가? (회귀인지, 의사결정 트리인지 등)

 2. 해당 모델에 대해서 파라미터 튜닝을 어떻게 할 것인가? (샘플 갯수를 몇개로 할 것인지 등)

 3. 최고의 후보를 찾기 위해 모델 평가하는데 어떤 기준을 사용할 것인가? (투표인지, 평균인지)


이 세가지 질문에 대해 답하는 것이 앙상블 기법의 정확도를 올리고 과적합(Ovefitting) 문제를 조절하는 데에 가장 중요합니다.



2. R 을 통한 연습


2.1 ipred를 활용한 bagging


## bagging 연습 - ipred

credit <- read.csv("credit.csv", header = T)

head(credit, 3)


install.packages("ipred")

library(ipred)

set.seed(300)

 독일은행 채무 이행여부 데이터인 credit.csv를 통해 연습을 진행했습니다. bagging() 펑션을 담고있는 패키지인 ipred를 설치하고 다운받았고, 샘플링을 위한 set.seed()를 실행했습니다.



## nbag = 25  ## 앙상블에 사용되는 의사결정 트리의 갯수가 25개

mybag <- bagging(default ~ . , data = credit, nbagg = 25)

credit_pred <- predict(mybag, credit)

table(credit_pred, credit$default)

prop.table(table(credit_pred == credit$default))





## nbag = 50 ## 앙상블에 사용되는 의사결정 트리의 갯수가 50개

mybag <- bagging(default ~ . , data = credit, nbagg = 50)

credit_pred <- predict(mybag, credit)

table(credit_pred, credit$default)

prop.table(table(credit_pred == credit$default))



샘플링한 갯수가 많아질 수록 정확도가 미약하지만 좀 더 향상되는 모습입니다. nbagg이 bagging()에서는 샘플링하는 집단의 갯수를 결정하는 파라미터입니다.




 2.2 caret을 활용한 연습


## bagging 연습 - caret :: train()

install.packages("caret") ## 파라미터를 튜닝해주는 데에 필요한 caret 패키지

install.packages("e1071") ## trainControl 시에 e1071 패키지가 필요

library(caret)

library(e1071)


set.seed(300)


## numbet = 10

ctrl <- trainControl(method = "cv", number = 10) ## method : 샘플링을 하는 방법을 결정

                                                                             ## number : 리샘플링한 folds의 갯수

train(default ~ . , data = credit, method = "treebag",   trControl = ctrl) ## method : 적용 모델


## numbet = 20

ctrl <- trainControl(method = "cv", number = 10)

train(default ~ . , data = credit, method = "treebag",

      trControl = ctrl)


## numbet = 30

ctrl <- trainControl(method = "cv", number = 30)

train(default ~ . , data = credit, method = "treebag",

      trControl = ctrl)




 number는 리샘플링을 하는 횟수를 조절하는 파라미터인데요, 이를 높일 수록 credit 데이터상에서는 정확도와 kappa가 더 낮아지는 경향을 보였습니다. 가령 1000개의 데이터가 있다면, number = 10인 경우 100개씩 나뉘어 10개의 집합이 될 것이고, number = 20인 경우 각각 50개의 데이터를 가진 20개의 집합이 될텐데, 데이터의 갯수가 충분하지 않은 모델들이 많다고만 해서 좋은 결과가 나오지는 않는 다는 것을 알 수 있었습니다.






[참고 서적]


1. R을 활용한 머신러닝 - 브레트 란츠

2. R Programming - Coursera (2017년 강의)








반응형
Posted by JoeSung
,


R에서 hist() 명령어로 쓰이는 히스토그램에 대한 간단 정리입니다.



[파일]


2. 막대그래프 vs 히스토그램.pdf


*대단한 자료는 아니지만, 가져가실 때 출처 밝혀주시는 센스! 부탁드립니다.



[이미지]





[참고 서적]


1. R을 활용한 머신러닝 - 브레트 란츠

2. R Programming - Coursera (2017년 강의)


반응형
Posted by JoeSung
,


 머신러닝에는 크게 지도, 비지도, 강화학습 크게 3가지 종류가 있습니다. k-means는 직접 데이터에게 분류하는 라벨을 알려주며 학습시키는 지도학습과는 달리, 알고리즘이 직접 분류를 하는 비지도 학습의 대표적인 알고리즘인데요, 이번 포스팅에서 간단하게 원리를 소개하고자 합니다.



1. 기본 원리



-K-MEANS?

 각 문서들 속에 들어있는 데이터 분석을 통해 유사하거나 관계가 높은 항목들끼리 집합을 만들고 싶을 때 사용하는 알고리즘입니다. 알고리즘이 진행되는 순서는 아래와 같습니다.


 1. 
(처음 중심값 선택) 랜덤하게 중심값을 선택한다.
 
 2. 
(클러스터 할당) K개의 중심값과 각 개별 데이터간의
    거리를 측정한다.
    가장 가까운 클러스터에 해당 데이터를 Assign 한다.

 3. 
(새 중심값 선택) 클러스터마다 새로운 중심값을 계산한다.

 4. 
(범위 확인) 선택된 중심값이 변화가 어느정도 없다면 멈춘다.
    만약 데이터의 변화가 있다면 다시 1번부터 반복한다.




k-means의 진행순서


위와 같이 각 군집간의 평균 위치값을 잡고, 

그 위치값을 기준으로 계속해서 최적화를 해나가는 알고리즘입니다.


사진을 보면 좀 더 쉽게 이해가 되는데요,

군집의 갯수(K)와 초기 랜덤값만 지정해주면 알고리즘이 군집내의 평균점을 잡아서

가까운 지점들을 다시 군집화하고 다시 평균점을 잡고...

반복하며 최적화가 될 때까지 분류를 하는 알고리즘입니다.


초기 중심으로부터의 오차 제곱합을 최소화하는 방향으로 군집이 형성되는

일종의 Greedy 알고리즘이기 때문에 안정된 군집은 보장하지만 최적이라고는 말할 수가 없습니다.


k = squart(n/2)

적당한 k 값을 구하는 공식



k-means의 단점


적용이 상당히 쉬운반면, 적중률도 높은 편이어서 자주 쓰이는 알고리즘이지만

이런 K-Means의 큰 약점중 하나는 이상치(Outliers)가 많을 경우

적절한 군집화가 이루어지지 않는다는 점입니다.


위의 그림과 같이 이상치가 많을경우 저렇게 섬처럼

군집이 형성되는데 이상치만 포함되어있을 가능성이 크기 때문에

알고리즘을 적용하기 이전에 데이터의 모양을 먼저 파악하고 적용을 결정해야합니다.


(U자형 데이터 모양이 나타났을 때에도 분류가 잘 안된다는 단점이 있습니다.)


2. 사례



 c <- c(3,4,1,5,7,9,5,4,6,8,4,5,9,8,7,8,6,7,2,1)

 row <- c("A","B","C","D","E","F","G","H","I","J")

 col <- c("X","Y")

 data <- matrix( c, nrow= 10, ncol=2, byrow=TRUE, dimnames=list(row,col))

 data 

기본 데이터 셋을 먼저 만듭니다.


  X Y

A 3 4

B 1 5

C 7 9

D 5 4

E 6 8

F 4 5

G 9 8

H 7 8

I 6 7

J 2 1



 plot(data)


 이 데이터를 2개의 군집으로 분류하는 k-means를 돌려보는 것이 목적!



 install.packages("stats")

 library(stats)


 km <- kmeans( data , 2 )

 라이브러리는 stats이고 kmeans 함수를 씁니다. 분류대상 데이터를 넣고, k값 갯수만 넣어주면됩니다. 아주 간단합니다.


K-means clustering with 2 clusters of sizes 5, 5


Cluster means:

  X   Y

1 3 3.8

2 7 8.0


Clustering vector:

A B C D E F G H I J 

1 1 2 1 2 1 2 2 2 1 


Within cluster sum of squares by cluster:

[1] 20.8  8.0

 (between_SS / total_SS =  74.5 %)


Available components:


[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss" "betweenss"   

[7] "size"         "iter"         "ifault"      

맨 아래의 Available components를 통해 값들에 접근이 가능합니다.



 plot( round(km$center), col = km$center, pch = 22, bg = "dark blue", 

       xlim = range(0:10), ylim = range(0:10) )

  분류가 된 k개의 군집의 중앙값을 출력합니다.

 plot( round(km$center), col = km$center, pch = 22, bg = "dark blue", 

      xlim = range(0:10), ylim = range(0:10) )

 par(new = T) 

 plot(data, col = km$cluster+1  ,xlim = range(0:10), ylim = range(0:10))


 원래 데이터를 위의 그래프에 합쳐서 출력하면 구분된 군집을 시각화할 수 있습니다.




이렇게 나오면 끝!

동그라미 하나를 그려주고 싶은 욕심이 드네요...


*아이티윌 유연수 선생님의 강의를 요약한 포스팅입니다.








반응형
Posted by JoeSung
,

[?]

가끔씩 패키지들을 너무많이 다운받으면 

패키지간에 충돌을 일으켜서 실행이 안되곤 합니다.

detach를 활용해서 패키지를 하나씩 언로드 할수도 있는것 같지만

어떤 패키지에서 문제가 일어나는지 모를 때는 한번 밀어버리고 싶은데

R-Blogger에서 좋은 스크립트를 발견!


[코드]


# create a list of all installed packages

ip <- as.data.frame(installed.packages())

head(ip)

# if you use MRO, make sure that no packages in this library will be removed

ip <- subset(ip, !grepl("MRO", ip$LibPath))

# we don't want to remove base or recommended packages either\

ip <- ip[!(ip[,"Priority"] %in% c("base", "recommended")),]

# determine the library where the packages are installed

path.lib <- unique(ip$LibPath)

# create a vector with all the names of the packages you want to remove

pkgs.to.remove <- ip[,1]

head(pkgs.to.remove)

# remove the packages

sapply(pkgs.to.remove, remove.packages, lib = path.lib)



출처 :  R-Blogger

https://www.r-bloggers.com/how-to-remove-all-user-installed-packages-in-r/

반응형
Posted by JoeSung
,




head(cars)

attach(cars)


# 1 plot


plot(dist~speed, data = cars)


# 2 lm() ~ abline()


m3 <- lm(dist~speed, cars)

abline(m3, col = "red")


# 3 draw the residual line by lines & sapply


yhat <- predict(m3, speed = speed)

cbind( dist, yhat )


join <- function(i)

lines( c(speed[i], speed[i]), c(dist[i], yhat[i]), col="green")

sapply(1:50, join)

반응형
Posted by JoeSung
,