이번 포스팅은 페이스북의 R User Group 에서 아이디어 토론 주제로 올라왔길레 한번 짜봤던 코드입니다.  


'0'과 '1'로 가지는 긴 벡터를 처음부터 끝까지 쭉 훓어가면서 


(1) '0'이 연속으로 3번 나오면 그 구간을 기준으로 나누어서 

=> (2) 나누어진 구간을 새로운 벡터로 생성하기


입니다.  


'0'이 연속으로 나오는 회수는 분석가가 필요로 하는 회수로 지정할 수 있도록 매개변수(argument)로 지정해서 프로그래밍해보겠습니다. 


간단한 예제 벡터로서, '0'과 '1'을 원소로 해서 30개의 무작위수(이항분포 랜덤 샘플링, 0이 80%, 1이 20%)로 구성된 벡터를 생성해보겠습니다. 


 

> rm(list=ls()) # clean all


# Sample vector


> set.seed(123) # for reproducibility

> vec_raw <- sample(c(0, 1), size=30, replace=TRUE, prob=(c(0.8, 0.2)))

> vec_raw

 [1] 0 0 0 1 1 0 0 1 0 0 1 0 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 0 0 0

> vec <- vec_raw # copy for manipulation




R 프로그래밍을 하고자 하는 일의 아웃풋 이미지는 아래와 같습니다. 

'0'이 연속 세번 나오는 구간을 노란색으로 표시를 했습니다. 이 구간을 기준으로 원래의 벡터를 구분해서 나눈 후에(split), 각각을 새로운 벡터로 생성하여 분리해주는 프로그램을 짜보는 것이 이번 포스팅의 주제입니다. 




아래에 wihle() 반복문, if(), else if() 조건문, assign() 함수를 사용해서 위의 요건을 수행하는 코드를 짜보았습니다. 원래 벡터에서 제일 왼쪽에 있는 숫자가 '0'이 아니면 하나씩 빼서 빈 벡터에 차곡차곡 쌓아 놓구요, '0'이 3개 나란히 있는 '000'이 나타나면 그동안 쌓아두었던 벡터를 잘라내서 다른 이름의 벡터로 저장하고, '000'도 그 다음 이름의 벡터로 저장하면서 원래 벡터에서 '000'을 빼놓도록 하는 반복문입니다. assign() 함수는 저장하는 객체의 이름에 paste()를 사용해서 변화하는 숫자를 붙여주고자 할 때 사용하는 함수인데요, 자세한 사용법 예제는 여기(=> http://rfriend.tistory.com/108)를 참고하세요. 


아래 프로그램에서 'bin_range'에 할당하는 숫자를 변경하면 원하는 회수만큼 '0'이 반복되었을 때 구간을 분할하도록 조정할 수 있습니다.  가령, '0'이 연속 10번 나오면 분할하고 싶으면 bin_range <- 10  이라고 할당해주면 됩니다. 



##---------------------------------------------

# Vector Bin Split by successive '0's criteria

##---------------------------------------------


# Setting

vec_tmp <- c() # null vector

bin_range <- 3 # successive '0's criterion

vec_idx <- 1

vec_num <- 1


# Zero_Bin_Splitter

while (length(vec) > 0){

  if (sum(vec[1:bin_range], na.rm=T) != 0){

    vec_tmp[vec_idx] <- vec[1]

    vec <- vec[-1]

    vec_idx <- vec_idx + 1

  } else if (is.null(vec_tmp)){

    assign(paste0("vec_split_", vec_num), vec[1:bin_range])

    vec <- vec[-(1:bin_range)]

    vec_idx <- 1 # initialization

    vec_num <- vec_num + 1

  } else {

    assign(paste0("vec_split_", vec_num), vec_tmp)

    vec_tmp <- c() # initialization

    vec_num <- vec_num + 1

    assign(paste0("vec_split_", vec_num), vec[1:bin_range])

    vec <- vec[-(1:bin_range)]

    vec_idx <- 1 # initialization

    vec_num <- vec_num + 1

  }

}


# delete temp vector and arguments

rm(vec, vec_tmp, bin_range, vec_idx, vec_num)




아래는 위의 프로그램을 실행시켰을 때의 결과입니다.  원래 의도했던대로 잘 수행되었네요. 




=====================================================

아래의 코드는 페이스북 R User Group의 회원이신 June Young Lee 님께서 data.table 라이브러리를 사용해서 짜신 것입니다.  코드도 간결할 뿐만 아니라, 위에 제가 짠 코드보다 월등히 빠른 실행속도를 자랑합니다. 대용량 데이터를 빠른 속도로 조작, 처리하려면 data.table 만한게 없지요. 아래 코드는 저도 공부하려고 옮겨 놓았습니다. 


똑같은 일을 하는데 있어서도 누가 어떤 로직으로 무슨 패키지, 함수를 사용해서 짜느냐에 따라서 복잡도나 연산속도가 이렇게 크게 차이가 날 수 있구나 하는 좋은 예제가 될 것 같습니다. 이런게 프로그래밍의 묘미이겠지요? ^^  June Young Lee 님께 엄지척! ^^b



# by June Young Lee


library(data.table)


# 0이 세번 연속으로 들어 있는 아무 벡터 생성

vec <- c(0,0,0,3,10,2,3,0,4,0,0,0,1,2,50,4,0,0,32,1,0,0,0,1,1)


# data.table함수인 rleid이용하여 연속인 행들을 구분하는 idx1 컬럼 생성 

dt <- data.table(v1=vec, idx1=rleid(vec))


# idx1 기준으로 갯수를 세어 N 컬럼 생성 

dt[,N:=.N, by=idx1]


# 0이 세번 연속으로 나온 그룹(=N컬럼변수가 3인)을 idx2로 체크하기 

dt[v1==0&N==3,idx2:=1L]


# split 하기 위한 기준 벡터를 마찬가지로 rleid함수를 이용하여 idx3로 생성


dt[,idx3:=rleid(idx2)]


# data.table의 split 함수 적용하고, lapply 적용하여 v1 칼럼만 추출 

res <- lapply(split(dt, by="idx3"), function(x) x[,v1])

res

# $`1`

# [1] 0 0 0

# $`2`

# [1] 3 10 2 3 0 4

# $`3`

# [1] 0 0 0

# $`4`

# [1] 1 2 50 4 0 0 32 1

# $`5`

# [1] 0 0 0

# $`6`

# [1] 1 1


# 0이 3번 연속으로 나온 놈들을 남겨두도록 작성한 이유는, 

# 위치확인 & 확인용입니다. 

# 필요없으면, 아래 정도의 코드를 추가하면 되겠네요.


res2 <- res[!unlist(lapply(res, function(x) length(x)==3&sum(x)==0))]

res2

# $`2`

# [1] 3 10 2 3 0 4

# $`4`

# [1] 1 2 50 4 0 0 32 1

# $`6`

# [1] 1 1

 


많은 도움이 되었기를 바랍니다. 


이번 포스팅이 도움이 되셨다면 아래의 '공감~'를 눌러주세요. 



728x90
반응형
Posted by Rfriend
,

페이스북의 KRUG (Korean R User Group) 에서 2017.11.18일 주말 퀴즈로 아래의 시각화를 푸는 문제가 있어서 재미로 풀어보았습니다. 


처음엔 금방 코드 짤 것으로 예상했는데요, 출제자분께서 중간 중간 장애물을 심어놓으셔서 제 예상보다 좀 더 걸렸네요. 


문제 풀면 KRUG 운영자분께서 스타벅스 기프티콘 주신다고 하는데요, 기대되네요. ^___^



# KRUG's plot quiz, as of 18th NOV. 2017


library(ggplot2)

#install.packages("dplyr")

library(dplyr)

str(mtcars)


# making 'model' variable

mtcars$model <- rownames(mtcars)


# ordering by cyl, hp

mtcars_ord <- arrange(mtcars[,c('model', 'cyl', 'hp')], cyl, desc(hp))


# marking an inflection point within cluster : threshold >= 40

mtcars_cyl <- c(4, 6, 8)

mtcars_ord_2 <- data.frame()


for (i in 1:length(mtcars_cyl)) {

  

  mtcars_tmp <- subset(mtcars_ord, subset = (cyl == mtcars_cyl[i]))

  

  for (j in 1:nrow(mtcars_tmp)) {

    if (j != nrow(mtcars_tmp) & mtcars_tmp$hp[j] - mtcars_tmp$hp[j+1] >= 40) {

      mtcars_tmp$hp_outlier[j] = '1_outlier'

    } else {

      mtcars_tmp$hp_outlier[j] = '2_normal'

    }

  }

  

  mtcars_ord_2 <- rbind(mtcars_ord_2, mtcars_tmp)

  rm(mtcars_tmp)

}


# converting cyl variable type from numeric to factor

mtcars_ord_2$cyl_cd <- paste0("cyl :", mtcars_ord_2$cyl)


model_order <- mtcars_ord_2$model[order(mtcars_ord_2$cyl_cd, 

                                        mtcars_ord_2$hp, 

                                        decreasing = FALSE)]


mtcars_ord_2$model <- factor(mtcars_ord_2$model, levels = model_order)



# drawing cleveland dot plot

ggplot(mtcars_ord_2, aes(x = hp, y = model)) +

  geom_point(size = 2, aes(colour = hp_outlier)) +

  scale_colour_manual(values = c("red", "black")) + 

  theme_bw() +

  facet_grid(. ~ cyl_cd, scales = "free_y", space = "free_y") +

  xlim(0, max(mtcars_ord_2$hp)) +

  geom_hline(yintercept = nrow(mtcars_ord_2[mtcars_ord_2$cyl == 4,]) + 0.5, 

             colour = "black", linetype = "dashed", size = 0.5) +

  geom_hline(yintercept = nrow(mtcars_ord_2) - 

               nrow(mtcars_ord_2[mtcars_ord_2$cyl == 8,]) + 0.5, 

             colour = "black", linetype = "dashed", size = 0.5) +

  theme(legend.position = 'none')

 




R Korea - KRUG(Korean R User Group) 에 문제 출제해주신 정우준님께서 나중에 정답지 올려주신 코드도 아래에 같이 공유합니다. 제가 짠 코드보다 한결 간결하네요. 



library(data.table)
library(dplyr)
library(ggplot2)

mtcars %>%
mutate(car.name=rownames(.)) %>%
arrange(cyl, hp) %>%
mutate(order.key=1:n()) -> data

data %>%
ggplot(aes(x=hp, y=reorder(car.name, order.key))) +
geom_point(
colour=case_when(
data$car.name %in% c('Ferrari Dino','Maserati Bora') ~ 'red', 
TRUE ~ 'black')) +
geom_hline(yintercept = 11.5, linetype='dashed') +
geom_hline(yintercept = 18.5, linetype='dashed') +
facet_wrap(~ cyl, labeller = label_both) +
scale_x_continuous(limits=c(0,max(data$hp))) +
theme_bw() +
theme(axis.title.y=element_blank())

 






728x90
반응형
Posted by Rfriend
,

문자열이나 숫자를 특정 형식으로 길이를 지정해주면 데이터를 출력했을 때 깨끗하게 정리가 되어 보이기 때문에 가독성이 좋아집니다. 


혹은 데이터가 특정 형식(format)으로 DB에 이미 지정이 되어 있어서 데이터 간 병합이나 join을 하기 위해 특정 형식으로 데이터를 표준화 해주어야 할 경우가 있습니다. 


이번 포스팅에서는 {base} package의 sprintf() 함수를 사용해서 


 - (1) 문자열을 매개변수 width 길이로 만들고, 빈 자리는 '0'으로 채우기 : sprintf("%05d", var)


 - (2) 소수점 숫자(numeric)의 자리수를 지정해주기 : sprintf(".5f", var)


하는 방법에 대해서 알아보겠습니다. 


이번 포스팅의 함수 sprintf()는 데이터 전처리할 때 종종 사용하는 편이예요. 



 (1) 문자열을 특정 길이로 만들고, 빈 자리수만큼 '0'을 채우기 : sprintf("%05d", var)





1자리, 2자리, 3자리, 4자리를 가진 데이터를 가지고 예제로 사용할 간단한 DataFrame을 만들어보겠습니다. 



> # making a sample DataFrame

> df <- data.frame(var1 = c(1, 11, 111, 1111))

> df

  var1

1    1

2   11

3  111

4 1111

 




위의 예제 데이터셋을 가지고, 칼럼 var1의 데이터를 


- '1 자리수를 가진 문자열'로 만들되, '1자리수가 안되면 모자라는 자리수 만큼'0'으로 채우기'

- '2 자리수를 가진 문자열'로 만들되, '2자리수가 안되면 모자라는 자리수 만큼'0'으로 채우기'

- '3 자리수를 가진 문자열'로 만들되, '3자리수가 안되면 모자라는 자리수 만큼'0'으로 채우기'

- '4 자리수를 가진 문자열'로 만들되, '4자리수가 안되면 모자라는 자리수 만큼'0'으로 채우기'

- '5 자리수를 가진 문자열'로 만들되, '5자리수가 안되면 모자라는 자리수 만큼'0'으로 채우기'


를 해보겠습니다. 


만약 매개변수 자리수보다 데이터의 길이가 더 크다면 '0'이 채워지지는 않습니다.  아래의 예제의 결과를 View(df)로 해서 보면 원래의 변수 var1과 sprintf() 함수를 사용해서 만든 var1_01d 변수의 데이터 출력 형식이 다른 것을 알 수 있습니다. 


그리고 class 함수로 데이터 형식을 살펴보니 원래 변수 var1은 숫자형(numeric)이지만 sprintf() 함수로 만든 새로운 변수는 요인형(factor)의 문자열로 바뀌어 있음을 알 수 있습니다. 



> #-------------------------

> # (1) sprintf(%03d, var) : Format number as fixed width, with leading zeros

> df <- transform(df, 

+                 var1_01d = sprintf("%01d", var1), 

+                 var1_02d = sprintf("%02d", var1), 

+                 var1_03d = sprintf("%03d", var1), 

+                 var1_04d = sprintf("%04d", var1), 

+                 var1_05d = sprintf("%05d", var1))

> df

  var1 var1_01d var1_02d var1_03d var1_04d var1_05d

1    1        1       01      001     0001    00001

2   11       11       11      011     0011    00011

3  111      111      111      111     0111    00111

4 1111     1111     1111     1111     1111    01111



> View(df)



> sapply(df, class)

     var1  var1_01d  var1_02d  var1_03d  var1_04d  var1_05d

"numeric"  "factor"  "factor"  "factor"  "factor"  "factor"




 (2) 소수점 숫자(numeric)의 자리수를 지정해주기 : sprintf(".5f", var)


무리수인 자연상수 e의 소수점 10째 자리까지의 수를 대상으로 sprintf("%.5f", e) 함수를 사용해서 소수점의 자리수를 설정해보겠습니다. "%.숫자f"의 숫자 만큼 소수점을 표시해주는데요, 반올림을 해서 표시해줍니다. 아래의 예제를 보시면 금방 이해할 수 있을 것입니다. 



> #-------------------------

> # (3) sprintf("%.5f", x) : formatting decimal point, 

> e <- c(2.7182818284) # mathematical constant, the base of the natural logarithm

> sprintf("%.0f", e)

[1] "3"

> sprintf("%.1f", e)

[1] "2.7"

> sprintf("%.2f", e)

[1] "2.72"

> sprintf("%.3f", e)

[1] "2.718"

> sprintf("%.5f", e)

[1] "2.71828"

> sprintf("%.10f", e)

[1] "2.7182818284"

 




아래의 예시는 sprintf("%숫자.f, e)로 '숫자' 부분에 매개변수로 정수 부분의 자리수를 지정해주는 예시입니다. 소수점의 자리도 모두 포함해서 '숫자' 부분 매개변수만큼의 길이로 표시 형식을 맞추어줍니다. 



> e <- c(2.7182818284) # mathematical constant, the base of the natural logarithm

> sprintf("%1.1f", e)

[1] "2.7"

> sprintf("%2.1f", e)

[1] "2.7"

> sprintf("%3.1f", e)

[1] "2.7"

> sprintf("%5.1f", e)

[1] "  2.7"

> sprintf("%10.1f", e)

[1] "       2.7"

>  



많은 도움 되었기를 바랍니다. 

이번 포스팅이 도움이 되었다면 아래의 '공감~'를 꾸욱 눌러주세요. ^^





728x90
반응형
Posted by Rfriend
,

이번 포스팅에서는 R ggplot2 패키지의 coord_fixed(ratio = number) 옵션을 사용해서 그래프의 크기 (가로, 세로 비율)를 조정하는 방법을 소개하겠습니다. 


1 ~ 4의 정수 좌표를 가지는 X 축과 

1 ~ 4의 정수 좌표를 가지는 Y 축을 가지는 

가상의 데이터를 사용해서 예를 들어보겠습니다. 


X축이 Y축이 1:1 비율인 그래프가 되겠습니다. 



[ 가상 데이터셋 생성 ]



#==========================

# Rssizing the plot

#==========================


install.packages("ggplot2")

library(ggplot2)


# X, Y coordinate and segments(A, B category) data set

my.df <- data.frame(XCoord = c(1, 1, 1, 2, 2, 2, 3, 3, 4, 4), 

                    YCoord = c(1, 2, 4, 1, 3, 4, 2, 4, 1, 4), 

                    Seg = c("A", "A", "A", "A", "B", "A", "B", "B", "B", "B"))





X와 Y좌표별로 Seg. 변수의 "A"는 검정색, "B"는 흰색으로 색깔을 지정해서 Heatmap을 그려보겠습니다. 

X좌표와 Y좌표가 1~4 범위를 동일하게 가지고 있으므로 크기에 대한 설정없이 디폴트 세팅으로 그래프를 그리면 아래 처럼 정사각형 1:1 비율로 그래프가 그려집니다. 



[ 그림 1 ] 원본 그래프 (Original Plot) : 가로축과 세로축이 1:1



# Original plot

ggplot(my.df, aes(x=XCoord, y=YCoord, fill=Seg)) +

  geom_tile(colour="gray80") +

  scale_fill_manual(values = c("black", "white")) +

  ggtitle("Original Heatmap by X4*Y4 size")






[ 그림 2 ] 가로축과 세로축의 비율을 1:2 로 설정하기 : coord_fixed(ratio = 2)


[그림 1]에서 원본 이미지가 가로축과 세로축이 1:1 비율의 정사각형 그래프였는데요, 이를 가로:세로 비율을 1:2로 세로가 가로의 2배 비율인 그래프(가로:세로 = 1:2)로 바꾸어 주려면 coord_fixed(ratio = 2) 를 설정해주면 됩니다. 



# Resized plot using coord_fixed(ratio = number)

ggplot(my.df, aes(x=XCoord, y=YCoord, fill=Seg)) +

  geom_tile(colour="gray80") +

  scale_fill_manual(values = c("black", "white")) +

  coord_fixed(ratio = 2) +

  ggtitle("Heatmap : Resized X:Y axis size with 1:2 ratio")







[ 그림 3 ] 가로축과 세로축의 비율을 2:1 로 설정하기 : coord_fixed(ratio = 0.5)


가로와 세로축 비율이 1:1인 원본 이미지 [그림 1] 을 가로가 세로축의 2배인 그래프 (가로:세로 = 2:1)로 바꾸고 싶다면 coord_fixed(ratio = 0.5) 로 설정해주면 됩니다. 



# Resized plot using coord_fixed(ratio = number)

ggplot(my.df, aes(x=XCoord, y=YCoord, fill=Seg)) +

  geom_tile(colour="gray80") +

  scale_fill_manual(values = c("black", "white")) +

  coord_fixed(ratio = 0.5) +

  ggtitle("Heatmap : Resized X:Y axis size with 2:1 ratio")









아래는 EBImage 패키지의 resize() 함수를 사용해서 png 이미지 파일로 출력할 때 이미지 크기를 (a) 특정 가로, 세로 크기로 설정해주는 방법과 (b) 비율로 설정해주는 방법입니다. 

R code는 stackoverflow 의 답변 중에서 aoles 님께서 달아놓은 것인데요, 코드 그대로 인용해서 소개합니다. ( * R code 출처 : https://stackoverflow.com/questions/35786744/resizing-image-in-r )


#==============
# Image resize using EBImage package

# installing EBImage package
source("http://bioconductor.org/biocLite.R")
biocLite("EBImage")


# resizing image using EBImage package's resize() function

library("EBImage")

x <- readImage(system.file("images", "sample-color.png", package="EBImage"))


# width and height of the original image
dim(x)[1:2]


# scale to a specific width and height
y <- resize(x, w = 200, h = 100)


# scale by 50%; the height is determined automatically so that
# the aspect ratio is preserved
y <- resize(x, dim(x)[1]/2)


# show the scaled image
display(y)


# extract the pixel array
z <- imageData(y)


# or
z <- as.array(y)

 



많은 도움이 되었기를 바랍니다. 

이번 포스팅이 도움이 되었다면 아래의 '공감~'를 꾸욱 눌러주세요. 



728x90
반응형
Posted by Rfriend
,

보통 외부 데이터 불러오기 할 때 {utils} package의 read.table() 함수를 사용하곤 합니다. 


크기가 작은 데이터라면 별 문제를 못느낄 텐데요, 만약 데이터 사이즈가 수 메가, 기가 단위의 큰 데이터라면 데이터를 불러들이는데 너무 오랜 시간이 걸려서 문제가 될 수 있습니다. 


대용량 데이터 처리에 아주 뛰어난 성능을 발휘하는 data.table 패키지의 fread() 함수를 사용하면 큰 용량의 외부 데이터도 빠르게 불러올 수 있습니다. 


(물론 R은 메모리에 데이터를 올려놓고 처리/분석을 하므로 하둡에서 말하는 수테라급의 대용량에는 필적을 못하구요, 분산병렬처리도 아니긴 합니다. 이 포스팅에서 말하는 대용량은 책보고 공부할 때 사용하는 수십, 수백개 row 를 가진 예제 데이터 대비 실전에서 사용하는 수십만, 수백만, 수천만 row 데이터를 말하는 것입니다. ^^;)


아래에 간단한 샘플 데이터를 만들어서 {utils} 패키지의 read.table() 함수와 {data.table} 패키지의 fread() 함수의 데이터 불러오는데 소요되는 시간을 비교해보았습니다. 



[ 외부 데이터 읽어오기 : {utils} 패키지 read.table() 함수 vs. {data.table} 패키지 fread(0 함수 ]




1. 샘플 데이터 만들기 : 1 백 만개 row, 변수 2개를 가지는 데이터 프레임



# generating large scaled data

my_data <- data.frame(var1 = rnorm(n = 1000000, mean = 0, sd = 1), 

                      var2 = rnorm(n = 1000000, mean = 2, sd = 3))

 



> str(my_data)

'data.frame': 1000000 obs. of  2 variables:

 $ var1: num  -0.556 1.787 0.498 -1.967 0.701 ...

 $ var2: num  1.669 0.597 4.452 1.405 6.936 ...

 



# exporting to text file

write.table(my_data, 

            "/Users/Desktop/R/my_data.txt",

            sep = "|",

            row.names = FALSE, 

            quote = FALSE)

 




2. {utils} 패키지의 read.table() 함수를 사용해서 my_data.txt 불러오기


system.time() 함수로 데이터를 불어오는데 소요된 시간을 재어보았더니 7.287초가 나왔습니다. 

(매번 할 때마다 소요 시간이 조금씩 차이가 날 수는 있습니다)



# reading text file : (1) read.table() of {utils} package

> system.time(my_data_readtable <- read.table("/Users/Desktop/R/my_data.txt",

+                                             sep = "|", 

+                                             header = TRUE, 

+                                             stringsAsFactors = FALSE))

   user  system elapsed 

  7.161   0.100   7.287

 




3. {data.table} 패키지의 fread() 함수를 사용해서 my_data.txt 불러오기


data.table 패키지는 기본 패키지가 아니므로 먼저 별도 설치(install.packages) 및 호출(library)이 필요합니다. 

(매번 할 때마다 소요 시간이 조금씩 차이가 날 수는 있습니다)



# reading text file : (2) fread() of {data.table} package

install.packages("data.table")

library(data.table)

 



system.time() 함수로 my_data를 불러오는데 걸린 시간을 재어봤더니 0.256초가 걸렸습니다. 



> system.time(my_data_fread <- fread("/Users/Desktop/R/my_data.txt", 

+                                    sep = "|", 

+                                    header = TRUE, 

+                                    stringsAsFactors = FALSE))

   user  system elapsed 

  0.242   0.014   0.256

 




1백만 행을 가진 데이터프레임을 읽어오는데 있어, 앞서 read.table() 함수가 7.287 초 걸렸던데 반해, fread() 함수는 0.256 초밖에 걸리지 않았습니다.  fread() 함수는 read.table() 함수를 사용했을 때 대비 약 96.5% 정도 속도가 더 적게 걸린 것입니다.  놀랍지요?!!! 



> 0.256/7.287

[1] 0.03513106

 



R 은 대용량 데이터에는 맥을 못춰라고 지레 평가절하하기 보다는 {data.table} 패키지의 fread() 함수로 대용량 데이터 불러오기 속도 문제를 공략해보시지요. 


많은 도움이 되었기를 바랍니다. 

이번 포스팅이 도움이 되었다면 아래의 '공감~'을 꾸욱 눌러주세요. ^^


728x90
반응형
Posted by Rfriend
,

(X축) 시간의 흐름에 따른 (Y축) 값의 추세, 변화 분석 및 탐색을 하는데 시계열 선 그래프(time series plot, line graph)를 많이 이용합니다. 


 이번 포스팅에서는 R ggplot2 패키지로 시계열 선그래프를 그리고, 거기에 세로선을 추가하는 작업을 해보겠습니다. 


ggplot2 에서 세로선을 추가할 때 geom_vline() 함수를 사용하는데요, 이게 시계열 데이터의 경우는 as.numeric() 함수를 사용해서 시계열 데이터를 숫자형 데이터로 변환을 해주어야 에러가 안나고 제대로 세로선이 그려집니다. 


이거 몰라서 한참을 구글링하면서 애 좀 먹었습니다. ^^;


간단한 시계열 데이터를 만들어서 예를 들어보겠습니다. 




> ##======================================================

> ## adding multiple vertical lines at time-series plot using R ggplot2

> ##======================================================

> # making time series data

> dt <- c("20170609100000", "20170609100100", "20170609100200", 

+         "20170609100300", "20170609100400", "20170609100500")

> val <- c(5.2, 3.4, 3.9, 6.3, 4.7, 5.6)

> dt_val <- data.frame(dt, val)

> dt_val <- transform(dt_val, 

+                     dt = as.POSIXct(dt, 

+                                     format = '%Y%m%d%H%M%S', 

+                                     origin = "1970-01-01", 

+                                     tz = "UTC"))

> dt_val

                   dt val

1 2017-06-09 10:00:00 5.2

2 2017-06-09 10:01:00 3.4

3 2017-06-09 10:02:00 3.9

4 2017-06-09 10:03:00 6.3

5 2017-06-09 10:04:00 4.7

6 2017-06-09 10:05:00 5.6

 




R ggplot2 패키지의 geom_line() 함수를 사용해서 시계열 선그래프를 그려보겠습니다. 



> # making time series plot

> library(ggplot2)

> ggplot(dt_val, aes(x = dt, y = val)) +

+   geom_line(size=1, color = "blue") + 

+   ggtitle("Time-series plot")

 




R ggplot2로 세로선을 추가할 때는 geom_vline(xintercept = x) 함수를 추가해주면 됩니다. 하지만 xintercept 에 들어가는 값이 날짜, 시간 포맷의 데이터일 경우 아래 처럼 에러가 납니다. 



> # To add vertical line at time series plot

> # Error in Ops.POSIXt((x - from[1]), diff(from)) : '/' not defined for "POSIXt" objects

> ggplot(dt_val, aes(x = dt, y = val)) +

+   geom_line(size = 1, color = "blue") +

+   geom_vline(xintercept = dt_val$dt[3], color =  "red", linetype = 2) +

+   ggtitle("Adding vertical line at time-series plot using geom_vline()")

Error in Ops.POSIXt((x - from[1]), diff(from)) : 

  '/' not defined for "POSIXt" objects

 




R ggplot2 시계열 선그래프에 X축이 날짜, 시간 포맷의 시계열 데이터인 경우 특정 날짜/시간에 세로선을 추가하기 위해서는 as.numeric(x) 함수를 사용해서 숫자형 데이터로 포맷을 바꾸어 주어야 합니다



> # Use as.numeric() function at xintercept

> ggplot(dt_val, aes(x = dt, y = val)) +

+   geom_line(size = 1, color = "blue") +

+   geom_vline(xintercept = as.numeric(dt_val$dt[3]), color = "red", linetype = 2) + # as.numeric() transformation

+   ggtitle("Adding vertical line at time-series plot using geom_vline() and as.numeric() transformation")

 







만약 복수의 세로선을 추가하고 싶다면 아래의 예제를 참고하세요. 만약 3번째와 5번째 x변수의 날짜/시간에 세로선을 추가하고 싶다면 dataset$variable[c(3, 5)] 처럼 indexing을 해서 xintercept 에 넣어주면 됩니다. 

(세로선 2개가 그려지기는 했는데요, 하단에 빨간색으로 "HOW_BACKTRACK environmental varialbe"이라는 경고메시지가 떴습니다. -_-; )



> # adding "Multiple" vertical lines

> ggplot(dt_val, aes(x = dt, y = val)) +

+   geom_line(size = 1, color = "blue") +

+   geom_vline(xintercept = as.numeric(dt_val$dt[c(3,5)]), color = "red", linetype = 2) +

+   ggtitle("Adding multiple vertical lines at time-series plot using geom_vline()")

HOW_BACKTRACE environmental variable.


 




이번에는 세로선을 그릴 기준 날짜/시간 데이터를 다른 데이터프레임에서 가져와야 하는 경우를 예로 들어보겠습니다. 먼저 세로선의 기준이 되는 xintercept 에 들어갈 날짜/시간 정보가 들어있는 data frame 을 만들어보죠. 



> # adding multiple vertical lines with another data frame

> dt_2 <- c("20170609100150", "20170609100430")

> val_2 <- c("yes", "yes")

> dt_val_2 <- data.frame(dt_2, val_2)

> dt_val_2 <- transform(dt_val_2, 

+                       dt_2 = as.POSIXct(dt_2, 

+                                         format = '%Y%m%d%H%M%S', 

+                                         origin = "1970-01-01", 

+                                         tz = "UTC"))

> dt_val_2

                 dt_2 val_2

1 2017-06-09 10:01:50   yes

2 2017-06-09 10:04:30   yes

 




R ggplot2 시계열 선그래프를 그린 원본 데이터프레임(아래 예제에서는 dt_val)과는 다른 데이터프레임(아래 예제에서는 dt_val_2)의 날짜/시간 데이터를 사용해서 복수의 세로선을 그려보겠습니다.  두 개의 세로선이 그려지기는 했는데요, "HOW_BACKTRACE environmental variable"이라는 빨간색 경고 메시지가 떴습니다. 그런데, 예전에는 에러 메시지 뜨면서 안그려졌었는데, 블로그 쓰려고 다시 해보니 그려지기는 하는군요. ^^; 



> # time series plot with multiple vertical lines from another data frame

> ggplot(dt_val, aes(x = dt, y = val)) +

+   geom_line(size = 1, color = "blue") +

+   geom_vline(xintercept = as.numeric(dt_val_2$dt_2), color = "red", linetype = 2) +

+   ggtitle("Time-seires plot with multiple vertical line from another dataframe")

HOW_BACKTRACE environmental variable.




위의 예제처럼 했는데 혹시 Error: Aesthetics must be either length 1 or the same as the data (6): xintercept 와 같은 에러 메시지가 뜨고 그래프가 안그려진다면 아래처럼 geom_vline(data = dataframe, xintercept = ... ) 처럼 데이터를 가져오는 데이터프레임을 명시해주면 문제가 해결됩니다.  이걸 몰라서 또 한참을 고민하고, 구글링하고, 참 애먹었던 적이 있습니다. -_-;



> # time series plot with multiple vertical lines from another data frame(2)

> ggplot(dt_val, aes(x = dt, y = val)) +

+   geom_line(size = 1, color = "blue") +

+   geom_vline(data = dt_val_2, xintercept = as.numeric(dt_val_2$dt_2), color = "red", linetype = 2) +

+   ggtitle("Time-series plot with multiple vertical lines from another dataframe 2")



 



많은 도움이 되었기를 바랍니다. 


이번 포스팅이 도움이 되었다면 아래의 '공감~'를 꾸욱 눌러주세요. ^^



728x90
반응형
Posted by Rfriend
,

지난번 포스팅에서는 범주형 특성 데이터, 텍스트 문서의 거리를 측정하는 지표 중에서 


 - 자카드 거리 (Jaccard distance)


 - 코사인 거리 (Cosine distance)


에 대해서 알아보았습니다. 


이번 포스팅에서는 두 문자열의 거리(distance between two strings of characters), 비유사도(dissimilarity)를 측정하는데 사용하는 편집 거리(edit distance), 혹은 다른 이름으로 Levenshtein metric 에 대해서 알아보겠습니다. 


편집거리(edit distance)는 데이터 항목이 놓인 순서(order)가 중요한 문자열(strings of characters, 예: 주소, 전화번화, 이름 스펠링)이나 서열(sequence, 예 : 염색체 염기서열)의 (비)유사도를 측정하는데 유용하게 사용할 수 있습니다. 


편집거리 (edit distance, Levenshtein metric) 는 두 문자열에서 하나의 문자열을 다른 문자열과 똑같게 만들기 위해서 최소로 필요로 하는 편집 회수(문자 추가, 제거, 위치 변경)를 계산합니다. 


아래에 간단한 예를 들어서 설명해보겠습니다. 



[ 편집 거리 예시 (example of edit distance, Levenshtein Metric) ]




아래처럼 사람 이름을 입력한 두 개의 문자열이 있다고 가정해보겠습니다. 

  • 문자열 1 (character string 1): Shawn Henry
  • 문자열 2 (character string 2): Shan Hennyy


'문자열 2'를 편집해서 '문자열 1'로 변환할 때 필요한 최소한의 조치를 생각해보면, 


(편집 조치 1) '문자열 2'의 4번째 위치에 'w'를 추가 (insert a 'w')

(편집 조치 2) '문자열 2'의 8번째 위치에 'n'을 'r'로 교체 (replace an 'n' with a 'r')

(편집 조치 3) '문자열 2'의 10번째 위치에 있는 'y'를 삭제 (delete the last 'y')


와 같이 3번의 편집 조치가 필요합니다.  따라서 '문자열 1'과 '문자열 2'의 편집 거리는 3입니다. 



'문자열 1'을 편집해서 '문자열 2'로 변환할 때 필요한 최소한의 조치를 생각해보면, 


(편집 조치 1) '문자열 1'의 4번째 위치의 'w'를 삭제 (delete a 'w')

(편집 조치 2) '문자열 1'의 9번째 위치의 'r'을 'n'으로 교체 (replace a 'r' with an 'n')

(편집 조치 3) '문자열 1'의 11번째 위치에 'y'를 추가 (insert an 'y')


이므로, 이렇게 계산해도 역시 '문자열 1'과 '문자열 2'의 편집 거리는 3입니다. 





이제 R 의 stringdist package를 사용해서 편집 거리 (edit distance, Levenshtein metric)를 계산해보겠습니다. 


(1) stringdist 패키지 설치 및 불러오기



# installing and loading of stringdist package

install.packages("stringdist")

library(stringdist)

 




(2) 문자열 편집 거리(edit distance, Levenshtein metric) 계산: stringdist()


문자열 "shawn henry"와 "shan hennyy", "show hurry" 문자열 간의 편집거리를 각각 계산해보겠습니다. 



> # to compute string edit distances

> # default method is 'osa', which is Optimal string alignment, (restricted Damerau-Levenshtein distance)

> stringdist(c("shawn henry"), c("shan hennyy", "show hurry"))

[1] 3 4

 



"shawn henry"와 "show hurry"의 편집거리를 계산하기 위해, 'show hurry'를 'shawn henry'로 변환하기 위한 최소 편집 조치를 살펴보면


(편집 조치 1) 'o'를 'a'로 변경 =>  shaw hurry

(편집 조치 2) 'n'을 추가   => shawn hurry

(편집 조치 3) 'u'를 'e'로 변경 => shawn herry

(편집 조치 4) 'r'을 'n'으로 변경 => shawn henry  (끝)


이므로, 편집거리는 4가 됩니다. 




(3) 여러개의 문자열 간의 편집 거리 (edit distance) 계산 결과를 행렬로 만들기: stringdistmatrix()


R stringdist 패키지에 들어있는 간단한 예제를 인용해서 예를 들어보겠습니다. 



> # to compute a dist object of class dist

> # => can be used by clustering algorithms such as stats::hclust

> stringdistmatrix(c("foo","bar","boo","baz"))

  1 2 3

2 3    

3 1 2  

4 3 1 2

> str_dist_mat <- as.matrix(stringdistmatrix(c("foo","bar","boo","baz")))

> str_dist_mat

  1 2 3 4

1 0 3 1 3

2 3 0 2 1

3 1 2 0 2

4 3 1 2 0

 




(4) 가장 유사한 문자열의 위치 찾기: amatch()


stringdist 패키지에는 'hello' 문자열과 편집 거리(edit distance, Levenshtein metric)가 가장 짧은 문자열의 위치를 찾아주는 amatch() 함수가 있습니다.  아래 예처럼 maxDist=2 라고 설정하면 편집 거리가 2를 넘어서는 문자열은 무시하게 됩니다.  동일 최소 편집거리 문자열이 여러개 있으면 앞에 위치한 문자열의 위치를 제시해줍니다. 



> # Approximate string matching

> # amatch returns the position of the closest match of x in table

> # by default, the OSA algorithm is used 

> # : Optimal string aligment (restricted Damerau-Levenshtein distance)

> amatch(c("hello"),c("hillu","hala","hallo", "hi"),maxDist=2)

[1] 3

 


- 'hello' 문자열과 'hillu' 문자열 간 편집 거리는 2 ('i'를 'e'로 교체, 'u'를 'o'로 교체), 

- 'hello' 문자열과 'hala' 문자열 간의 편집 거리는 3 ('a'를 'e'로 교체, 'l' 추가, 'a'를 'o'로 교체, 단, maxDist=2 이므로 고려 대상에서 제외됨), 

- 'hello' 문자열과 'hallo' 문자열 간의 편집 거리는 1 ('a'를 'e'로 교체)


이므로 편집 거리가 가장 짧은 'hallo' 의 3 을 반환합니다. 



* reference: stringdist package manual ( https://cran.r-project.org/web/packages/stringdist/stringdist.pdf)



많은 도움이 되었기를 바랍니다. 


이번 포스팅이 도움이 되었다면 아래의 '공감~'를 꾸욱 눌러주세요. ^^



728x90
반응형
Posted by Rfriend
,

예전 포스팅에서는 연속형 변수들 간의 거리를 측정하는 Measure로서 맨하탄 거리, 유클리드 거리, 표준화 거리, 마할라노비스 거리 등에 대해서 소개하였습니다. 


이전 포스팅에서는 명목형 데이터를 원소로 가지는 두 집합 X, Y의 특징들 간의 공통 항목들의 비율 (교집합의 개수 / 합집합의 개수)을 가지고 두 집합 간 유사성을 측정하는 Jaccard Index 와 (1 -  Jaccard Index)로 두 집합 간 거리(비유사성)을 측정하는 Jaccard Distance에 대해서 알아보았습니다. 


이번 포스팅에서는 문서를 유사도를 기준으로 분류 혹은 그룹핑을 할 때 유용하게 사용할 수 있는 코사인 거리(Cosine Distance)에 대해서 소개하겠습니다. 


코사인 거리를 계산할 때는 먼저 문서(Document, Text)에 포함된 단어들을 단어별로 쪼갠 후에, 단어별로 개수를 세어 행렬로 만들어주는 전처리가 필요합니다. (대소문자 처리라든지, 일상적으로 쓰이는 별로 중요하지 않은 단어 처리라든지... 이게 좀 시간이 오래걸리고, 단어 DB랑 처리 노하우가 필요한 부분입니다)


이번 포스팅에서는 이런 전처리가 다 되어있다고 가정하고, 코사인 거리 (혹은 코사인 유사도)의 정의와 계산 방법, R로 자동계산하는 방법을 소개하는데 집중하겠습니다. 


아래의 '참고 1'에서와 같이 코사인 유사도(Cosine Similarity)는 두 개의 문서별 단어별 개수를 세어놓은 특징 벡터 X, Y 에 대해서 두 벡터의 곱(X*Y)을 두 벡터의 L2 norm (즉, 유클리드 거리) 의 곱으로 나눈 값입니다. 


그리고 코사인 거리(Cosine Distance)는 '1 - 코사인 유사도(Cosine Similarity)' 로 계산합니다. 

(유사도 측정 지표인 Jaccard Index 와 비유사도 측정 지표인 Jaccard Distance 와 유사합니다)



[ 참고 1 : 코사인 유사도 (Cosine Similarity) vs. 코사인 거리 (Cosine Distance) ]





위의 공식만 봐서는 쉽게 이해가 안갈 수도 있을 것 같은데요, 아주 간단한 예를 가지고 좀더 자세하게 설명해 보겠습니다. 


Document 1, Document 2, Document 3 라는 3개의 문서가 있다고 해보겠습니다. 

그리고 각 문서에 'Life', 'Love', 'Learn' 이라는 3개의 단어가 포함되어 있는 개수를 세어보았더니 다음과 같았습니다. 



[ Table 1 : 3개의 문서별 단어별 출현 회수 (number of presence by words in each documents) ]


                           Corpus 

 Text

Life

Love 

Learn 

 Document 1

 1

0

 Document 2

 4

7

 Document 3

 40

70 

30

(예 : Document 2에서는 'Life'라는 단어가 4번, 'Love'라는 단어가 7번, 'Learn'이라는 단어가 3번 출현함(포함됨))



위의 'Table 1'의 각 문서별 출현하는 단어별 회수를 특징 벡터로 하는 벡터를 가지고 'Document 1'과 'Document 2' 간의 코사인 거리(Cosine Distance)를 사용해서 각 문서 간 비유사도를 계산해보겠습니다. 



[ 참고 2 : 'Document 1'과 'Document 2' 간의 코사인 거리 (cosine distance b/w doc. 1 and doc. 2) ]





코사인 거리(Cosine Distance)를 계산할 때 사용하는 코사인 유사도(Cosine Similarity) 의 분자, 분모를 보면 유추할 수 있는데요, 두 특징 벡터의 각 차원이 동일한 배수로 차이가 나는 경우에는 코사인 거리는 '0'이 되고 코사인 유사도는 '1'이 됩니다. 


위의 'Table 1'의 예에서 'Document 2'와 'Document 3'의 각 단어 (Life, Love, Learn)별 출현 회수가 동일하게 '10배'씩 차이가 나고 있는데요, 바로 이런 경우를 말하는 것입니다. Document 23 가 Document 2보다 쪽수가 더 많고 두꺼워서 각 단어별 출현 빈도는 더 높을 지 몰라도 각 단어가 출현하는 비율은 좀더 얇은 Document 2나 더 두꺼운 Document 3가 동일(유사)하므로 두 문서는 유사한 특성을 가지고 있다고 코사인 거리는 판단하는 것입니다. 이처럼 단위에 상관없이 코사인 거리를 사용할 수 있으므로 꽤 편리하고 합리적입니다. 



[ 참고 3 : 'Document 2'과 'Document 3' 간의 코사인 거리 (cosine distance b/w doc. 2 and doc. 3]





이제부터는 R의 proxy package의 dist(x, method = "cosine") 함수를 사용해서 코사인 거리를 구하는 방법을 소개합니다



(1) proxy 패키지를 설치하고 불러오기



## installing and loading proxy package

install.packages("proxy")

library(proxy)

 




(2) 문서별 단어별 출현 회수를 특징 벡터로 가지는 행렬 (Term Document Matrix) 만들기


위에서 설명했던 3개 문서의 'Life', 'Love', 'Learn'의 3개 단어 예제를 그대로 사용합니다. 



> # making Term Document Matrix

> Doc_1 <- c(1, 0, 5)

> Doc_2 <- c(4, 7, 3)

> Doc_3 <- c(40, 70, 30)

> Doc_corpus <- rbind(Doc_1, Doc_2, Doc_3) # matrix

> colnames(Doc_corpus) <- c("Life", "Love", "Learn")

> Doc_corpus

      Life Love Learn

Doc_1    1    0     5

Doc_2    4    7     3

Doc_3   40   70    30

 




(3) proxy 패키지의 dist(x, method = "cosine") 함수로 코사인 거리 계산하고, as.matrix() 함수를 사용해서 코사인 거리 계산 결과를 행렬로 반환하기



> # calculating cosine distance between documents using proxy package

> cosine_dist_Doc_mat <- as.matrix(dist(Doc_corpus, method = "cosine"))

> cosine_dist_Doc_mat

          Doc_1     Doc_2     Doc_3

Doc_1 0.0000000 0.5668373 0.5668373

Doc_2 0.5668373 0.0000000 0.0000000

Doc_3 0.5668373 0.0000000 0.0000000

 



위의 코사인 거리 계산 결과를 세로로 긴 형태 (long format) 로 저장하려면 아래의 for loop 문과 indexing을 사용한 코드를 참고하시기 바랍니다.



n <- ncol(cosine_dist_Doc_mat) # number of columns
col_nm <- colnames(cosine_dist_Doc_mat) # column names
r <- 1 # row position number
cosine_dist_long <- data.frame() # blank data.frame to store the results

for (i in 1:(n-1)) {
  for (j in (i+1):n){
    cosine_dist_long[r, 1] <- col_nm[i]
    cosine_dist_long[r, 2] <- col_nm[j]
    cosine_dist_long[r, 3] <- cosine_dist_Doc_mat[i, j]
    r <- r+1
  }
}

cosine_dist_long
# V1    V2        V3
# 1 Doc_1 Doc_2 0.5668373
# 2 Doc_1 Doc_3 0.5668373
# 3 Doc_2 Doc_3 0.0000000

 





proxy package를 사용하지 않을 거면, 위의 '참고 1'의 공식을 사용하여 아래처럼 함수를 직접 짜서 코사인 거리를 계산할 수도 있습니다. 참고하세요. 



> # cosine distance function

> cosine_Dist <- function(x){

+   as.dist(1 - x%*%t(x)/(sqrt(rowSums(x^2) %*% t(rowSums(x^2))))) 

+ }

> cosine_Dist(Doc_corpus)

          Doc_1     Doc_2

Doc_2 0.5668373          

Doc_3 0.5668373 0.0000000

 



많은 도움이 되었기를 바랍니다. 


이번 포스팅이 도움이 되었다면 아래의 '공감 ~ '를 꾸욱 눌러주세요. ^^


다음 포스팅에서는 문자열 편집거리(edit distance, Levenshtein metric)에 대해서 알아보겠습니다. 



728x90
반응형
Posted by Rfriend
,

연속형 변수에 대한 비유사성 측도(dissimilarity measure)로서 매우 다양한 측도가 있는데요, 예전 포스팅에서 맨하탄 거리(Manhattan distance), 유클리드 거리(Euclidean distance), 표준화 거리(Standardized distance), 마할라노비스 거리(Mahalanobis distance) 에 대해서 알아보았습니다. (=> http://rfriend.tistory.com/199 , http://rfriend.tistory.com/201)


이번 포스팅에서는 범주형 데이터에 대해서 비유사성을 측정하는 지표로 Jaccard distance 를 소개하겠습니다. 


Jaccard distance 는 비교 대상의 두 개의 객체를 특징들의 집합(sets of characteristics)으로 간주합니다. 기본 개념이나 표기법이 집합론(set theory)에 기반을 두고 있습니다. 


Jaccard Index는 유사성 측도이고, 1에서 Jaccard Index값을 뺀 Jaccard distance는 비유사성 측도입니다. 


특징들의 두 개의 집합 X, Y가 있다고 했을 때, Jaccard Index는 집합 X와 집합 Y의 교집합(Intersection)의 원소의 개수()를 집합 X와 집합 Y의 합집합(Union)의 원소의 개수()로 나눈 값입니다.   따라서 Jaccard Index는 0~1 사이의 값을 가집니다. 


참고로, 표기는 집합론에서는 원소의 개수를 나타낼 때 사용하는 표기법이며, 다 아시겠지만, 는 교집합, 는 합집합을 의미합니다. 

Jaccard Distance 는 1 에서 Jaccard Index를 뺀 값입니다. ()


만약 두 집합의 합집합과 교집합이 서로 비슷하다면 자카드 지수는 거의 1에 근접(즉, 매우 유사)할 것이구요, 자카드 거리는 거의 0에 근접(즉, 매우 거리가 가깝다는 뜻, 즉 유사)할 것입니다. 


자카드 거리는 "두 집합에 공통으로 공유되는 항목은 중요한 반면에, 두 집합에서 모두 존재하지 않는 항목에 대해서는 무시해도 되는 상황, 문제"에 적합한 비유사성 측도입니다. 비교 대상이 되는 두 집합의 합집합, 교집합에 해당되는 않는 항목(item)은 그냥 제껴버리고 무시해버립니다. 


그 동안 군집분석을 소개하면서 비유사성 측도로서 거리(Distance)를 사용해왔는데요, 여기서도 Jaccard Distance를 가지고 예를 들어서 소개하고, R 로 실습도 해보겠습니다.  



[그림 1] 자카드 지표 & 자카드 거리 (Jaccard Index & Jaccard Distance)





이해를 쉽게 하기 위해서 아주 간단한 예를 하나 들어보겠습니다. 


5개의 상자가 있는데요, 거기에는 빨강, 노랑, 파랑 색깔의 공이 들어있다고 해봅시다. 그리고 각 상자별로 들어있는 공의 색깔을 가지고 상자들 끼리의 비유사성을 Jaccard 거리로 재보도록 하겠습니다. 



 -. 상자 1 = {노랑}

 -. 상자 2 = {노랑}

 -. 상자 3 = {빨강, 노랑, 파랑}

 -. 상자 4 = {빨강, 노랑}

 -. 상자 5 = {파랑}

 



(1) '상자 1'과 '상자 2'의 합집합(union)의 개수는 |{노랑}| = 1 이구요, 교집합(intersection)의 개수는 |{노랑}| =  1 이므로, 자카드 거리(상자 1, 상자 2) = 1 - (1/1) = 0 입니다. 


(2) '상자 1'과 '상자 3'의 합집합의 개수는 |{빨강, 노랑, 파랑}| = 3 이구요, 교집합의 개수는 |{노랑}| =  1 이므로, 자카드 거리(상자 1, 상자 3) = 1 - (1/3) = 약 0.667 입니다. 


(3) '상자 1'과 '상자 4'의 합집합의 개수는 |{빨강, 노랑}| = 2 이며, 교집합의 개수는 |{노랑}| =  1 이므로, 자카드 거리(상자 1, 상자 4) = 1 - (1/2) = 0.5 입니다. 


(4) '상자 1'과 '상자 5'의 합집합의 개수는 |{노랑, 파랑}| =  2 이며, 교집합의 개수는 |{NA}| = 0 이므로, 자카드 거리(상자 1, 상자 5) = 1 - (0/2) = 1 입니다. 


(5) '상자 3'과 '상자 4'의 합집합의 개수는 |{빨강, 노랑, 파랑}| = 3 이구요, 교집합의 개수는 |{빨강, 노랑}| = 2 이므로, 자카드 거리(상자 3, 상자 4) = 1 - (2/3) = 약 0.333 입니다. 


(6) '상자 3'과 '상자 5'의 합집합의 개수는 |{빨강, 노랑, 파랑}| = 3, 교집합의 개수는 |{파랑}| =  1 이므로, 자카드 거리(상자 3, 상자 5) = 1 - (1/3) = 약 0.667 입니다. 


(7) '상자 4'와 '상자 5'의 합집합의 개수는 |{빨강, 노랑, 파랑}| =  3 이며, 교집합의 개수는 |{NA}| = 0 이므로, 자카드 거리(상자 4, 상자 5) = 1 - (0/3) = 1 입니다. 






이를 R의 proxy package를 사용해서 풀어보겠습니다. 


먼저 proxy package를 설치하고 불러오도록 합니다. 



#===========================================

# distance(dissimilarity) calculation using proxy package

#===========================================


> install.packages("proxy")

> library(proxy)

 




proxy package는 2017년 초에 CRAN에 등록이 된 따끈따근한 패키지인데요, 총 49개의 proximity 지표(similarity measures, distance measures) 가 들어있습니다. 



> # show available proximities

> pr_DB

An object of class "registry" with 49 entries.

> summary(pr_DB)

* Similarity measures:

Braun-Blanquet, Chi-squared, Cramer, Dice, Fager, Faith, Gower, Hamman, Jaccard,

Kulczynski1, Kulczynski2, Michael, Mountford, Mozley, Ochiai, Pearson, Phi, Phi-squared,

Russel, Simpson, Stiles, Tanimoto, Tschuprow, Yule, Yule2, correlation, cosine, eDice,

eJaccard, simple matching


* Distance measures:

Bhjattacharyya, Bray, Canberra, Chord, Euclidean, Geodesic, Hellinger, Kullback,

Levenshtein, Mahalanobis, Manhattan, Minkowski, Podani, Soergel, Wave, Whittaker,

divergence, fJaccard, supremum





proxy package의 Jaccard 클래스에 대해서 간략한 설명을 살펴보면 아래와 같습니다. binary 형태의 데이터에 대한 (비)유사성 척도라고 되어 있습니다.  그리고 (FALSE, FALSE) pairs 에 대해서는 고려하지 않고 무시하며, 비교 대상의 두 객체 집합의 합집합과 교집합을 비교한다고 되어 있습니다. 


> names(pr_DB)

 [1] "get_field"              "get_fields"             "get_field_names"       

 [4] "set_field"              "entry_exists"           "get_entry"             

 [7] "get_entries"            "get_entry_names"        "set_entry"             

[10] "modify_entry"           "delete_entry"           "n_of_entries"          

[13] "get_field_entries"      "get_permissions"        "restrict_permissions"  

[16] "seal_entries"           "get_sealed_entry_names" "get_sealed_field_names"


> pr_DB$get_entry("Jaccard")

      names Jaccard, binary, Reyssac, Roux

        FUN R_bjaccard

   distance FALSE

     PREFUN pr_Jaccard_prefun

    POSTFUN NA

    convert pr_simil2dist

       type binary

       loop FALSE

      C_FUN TRUE

    PACKAGE proxy

       abcd FALSE

    formula a / (a + b + c)

  reference Jaccard, P. (1908). Nouvelles recherches sur la distribution florale. Bull.

            Soc. Vaud. Sci. Nat., 44, pp. 223--270.

description The Jaccard Similarity (C implementation) for binary data. It is the proportion

            of (TRUE, TRUE) pairs, but not considering (FALSE, FALSE) pairs. So it compares

            the intersection with the union of object sets.

 




위의 상자 5개의 공 색깔 예제를 R로 실습해 보기 위해서 아래 처럼 5개의 행(row)은 상자를 나타내고, 3개의 열(column)은 색깔(순서대로 빨강, 노랑, 파랑)을 나타내는 걸로 하겠습니다. 그리고 각 상자별 빨강, 노랑, 파랑 색깔의 공이 있으면 ' 1(TRUE)'을 입력하고, 공이 없으면 '0(FALSE)'을 입력해서 행렬(matrix)을 만들어보겠습니다. proxy package가 타카드 거리를 계산할 수 있도록 binary 형태의 데이터셋을 만드는 것입니다. 



> # making binary dataset as a matrix

> x <- matrix(c(0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1), 

+             byrow = TRUE, 

+             ncol = 3)

> x

     [,1] [,2] [,3]

[1,]    0    1    0

[2,]    0    1    0

[3,]    1    1    1

[4,]    1    1    0

[5,]    0    0    1 





dist(x, method = "Jaccard") 함수를 사용해서 Jaccard distance를 계산해보겠습니다.  위의 예에서 손으로 푼 결과와 동일한 값들이 나왔습니다. 



> # Jaccard distance

> dist(x, method = "Jaccard")

          1         2         3         4

2 0.0000000                              

3 0.6666667 0.6666667                    

4 0.5000000 0.5000000 0.3333333          

5 1.0000000 1.0000000 0.6666667 1.0000000

 




아래처럼 cross Jaccard distances 를 계산하려면 dist(x, x, method = "Jaccard") 처럼 행렬 x 를 두번 입력해주면 됩니다. 



> # cross Jaccard distances

> dist(x, x, method = "Jaccard")

     [,1]      [,2]      [,3]      [,4]      [,5]     

[1,] 0.0000000 0.0000000 0.6666667 0.5000000 1.0000000

[2,] 0.0000000 0.0000000 0.6666667 0.5000000 1.0000000

[3,] 0.6666667 0.6666667 0.0000000 0.3333333 0.6666667

[4,] 0.5000000 0.5000000 0.3333333 0.0000000 1.0000000

[5,] 1.0000000 1.0000000 0.6666667 1.0000000 0.0000000

 




proxy package에 비해서는 조금 비효율적이기는 하지만 stats package 의 dist(x, method = "binary")함수를 사용해서도 Jaccard distance를 계산할 수 있습니다. 



> # using stats package (less efficient than proxy package)

> as.matrix(stats::dist(x, method = "binary"))

          1         2         3         4         5

1 0.0000000 0.0000000 0.6666667 0.5000000 1.0000000

2 0.0000000 0.0000000 0.6666667 0.5000000 1.0000000

3 0.6666667 0.6666667 0.0000000 0.3333333 0.6666667

4 0.5000000 0.5000000 0.3333333 0.0000000 1.0000000

5 1.0000000 1.0000000 0.6666667 1.0000000 0.0000000

 



많은 도움 되었기를 바랍니다. 

이번 포스팅이 도움이 되었다면 아래의 '공감~' 단추를 꾸욱 눌러주세요. ^^


다음번 포스팅에서는 코사인 거리(Cosine Distance),  문자열 편집 거리(edit distance, Levenshtein metric)를 알아보겠습니다. 




728x90
반응형
Posted by Rfriend
,

프로젝트 과제, 세부 업무 별로 시작 시점과 끝 시점을 선으로 그어서 한 눈에 일정 관리를 할 수 있도록 도와주는 시각화 기법으로 간트 차트(Gantt Chart)를 많이 사용합니다. 


간트 차트가 일정 관리 측면에서는 매우 강력한 시각화 도구이다 보니 간트 차트를 쉽고 빠르게 그릴 수 있도록 도와주는 '뉴간트메이커 간트 차트', '차트 스쿨 2.0', 'GanttProject', 'Online Gantt Chart' 등의 전문 소프트웨어가 있습니다. 


R을 가지고도 간트 차트를 그릴 수 있는데요, 이번 포스팅에서는 R의 timevis 패키지를 사용해서 간트 차트를 그리는 방법을 알아보겠습니다. 


R로 간트 차트를 그리려고 반나절 이상을 골머리를 앓다가 timevis 패키지를 발견하고서 얼마나 반가웠는지 모릅니다. 그리고 timevis 패키지를 사용해보니 제공하는 기능이 매우 놀라웠습니다. 들인 노력 대비 산출물이 매우 세련되 보이거든요. interactive 기능도 제공합니다. ^^b  timevis 패키지는 vis.js 의 timeline module 과 htmlwidgets R package 를 근간으로 해서 만들어졌다고 하는걸 보니 java script 기반의 패키지를 가지고 R 바인딩해놓은 같습니다. 


timevis 패키지는 Dean Attali 라는 분이 오픈 소스로 개발했는데요, R-Shiny founder라고 자기소개에 나와있네요. 요즘 탐색적 데이터 분석(Exploratory Data Analysis)하는데 R-Shiny 사용해보면서 감탄하고 있는데요, R-Shiny app에 timevis 로 그린 간트차트도 추가해서 이쁘게 app하나 만들었더니 간지 나더라구요. Dean Attali 개발자님께 이래저래 고마운 마음 전합니다. ^^b


아래 포스팅은 Deam Attali의 Git-Hub(https://github.com/daattali/timevis) 페이지와 R ?timevis 도움말의 예제 코드를 거의 수정없이 인용해서 작성하였구요, 그래프의 화면 캡쳐와 동영상을 추가해서 처음 사용하시는 분의 이해를 조금 더 돕는다는 취지로 작성을 해보았습니다. 



1. timevis 패키지 설치 및 로딩



##---------------------------------

## gantt chart by timevis package

##---------------------------------


# reference : https://github.com/daattali/timevis


# install timevis package

install.packages("timevis")

 




2. 날짜 데이터 입력 없는 상태에서 timeline 형태 살펴보기 


아래 timeline의 가운데 빨간 선은 시스템 날짜(Sys.Date) 입니다. 



# minimum view of timeline without any data at system time

library(timevis)

timevis()

 






3. 특정 날짜(Item), 혹은 기간(Range) 데이터를 입력한 간트 차트 (Gantt Chart) 그리기


timevis 패키지에서 사용하는 데이터셋이 데이터프레임(DataFrame)이라는 점이 원천 데이터를 거의 손볼 필요없이 그대로 사용할 수 있어서 저는 매우 좋더군요.  아래의 R script 처럼 'id', 'content', 'start', 'end'라는 칼럼이 데이터프레임에 포함되어 있으면 됩니다. 


  • id : 인덱싱(indexing) 할 때 사용
  • content : 간트 차트에 포함될 내용
  • start : 시작 시간 (년-월-일, 혹은 년-월-일 시간:분:초 포맷)
  • end : 끝 시간 (년-월-일, 혹은 년-월-일 시간:분:초 포맷)


start은 반드시 날짜, 혹은 날짜&시간 데이터가 들어가야만 에러가 안나구요, end 칼럼에는 NA 결측값으로 비워두어도 상관없습니다. end 칼럼에도 일시 데이터가 들어가면 start ~ end 의 기간(range)의 timeline 이 선으로 길게 그려집니다. 



# adding data to timevis() by DataFrame

data <- data.frame(

  id      = c(1:4),

  content = c("Item_First"  , "Item_Second"  ,"Ranged_First", "Ranged_Second"),

  start   = c("2017-05-26", "2017-05-27 01:30:00", "2017-05-27 05:00:00", "2017-05-30"),

  end     = c(NA          , NA                   , "2017-05-28 15:00:00", "2017-05-31 03:10:00")

)


# view of Gantt chart

timevis(data)

 






4. 데이터프레임의 각 칼럼 데이터 형태


input으로 사용되는 DataFrame의 각 칼럼의 데이터 행태를 살펴보면 id는 정수형(integer), content, start, end는 요인형(factor) 입니다.  혹시 데이터프레임 만들어서 timevis() 함수 적용했는데 그래프가 안그려지고 에러가 나면 content, start, end 칼럼의 데이터 형태가 요인형(factor)인지 확인해보시기 바라며, 혹시 문자형(character)으로 되어 있으면 as.factor() 를 사용해서 요인형으로 변환 후에 timevis() 를 다시 적용해보시기 바랍니다. 



> # checking data type

> sapply(data, class)

       id      content      start        end 

"integer"  "factor"  "factor"  "factor"

 




5. Zoom-in, Zoom-out, 좌-우 이동하는 동적 시각화


우측 상단에 있는 '+' 단추를 누르면 'Zoom-in'이 되어 더 짧은 기간으로 현미경의 눈으로 심화해서 간트 차트를 그려줍니다 (아래 그림 예시).  반대로 '-' 단추를 누르면 'Zoom-out'이 되어 높은 하늘 위의 새의 눈으로 더 넓은 기간의 간트 차트를 보여줍니다. 


 





커서로 timeline 을 클릭한 후에 좌, 우로 끌고 가면 간트 차트가 동적으로 움직이며, 마우스 휠을 사용해서도 Zoom-in, Zoom-out 을 할 수가 있습니다.  동적으로 움직이는 신기한(?) 그래프를 단 한 줄의 R script (즉, timevis(data) 로 끝) 로 만든 것입니다.  말로 설명하려니 감흥이 덜할 것 같은데요, 아래 동영상 참고하세요. 





6. Zoom 단추 숨기기, 편집 기능 설정, timeline 높이 설정


  • showZoom = FALSE   : 우측 상단의 Zoom 단추 숨기기  ( <= 이거 없어도 마우스 휠 사용하면 됨)
  • options = list(editable = TRUE)  :  TRUE 이면 timeline bar를 커서로 선택했을 때 색이 바뀌며, 'X' 표시를 누르면 간트 차트에서 사라짐 
  • options = list(height = "300px")  : timeline 높이를 하드 코딩으로 설정 ( <= 이거 굳이 하드코딩 안해줘도 알아서 유동적으로 높이 잘 조정해 줌) 


# hide the zoom buttons, options for editable, height

timevis(data, 

            showZoom = FALSE, 

            options = list(editable = TRUE, 

                                  height = "300px"))


 




7. %>% chain operator, 일정 추가(add Item), 디폴트 일정 선택(set Selected Item)


  • timevis() %>% : chain operator  (dplyr 패키지 사용해본 분이라면 익숙하실 듯)
  • setItems(data.frame(id, content, start, end)) : id, content, start, end(optional) 로 이루어진 원본 데이터셋
  • addItem(list(id, content, start, end)) : 개별 일정을 추가하고 싶을 때 사용
  • setSelection("1") : 간트 차트가 화면에 떴을 때 처음 선택이 되게 하고 싶은 id 를 지정 (아래 예에서는 "1"번의 "one" item 이 색깔이 바뀌어 있고, editable = TRUE 로 설정했으므로 'X' 표시가 같이 나타남)


# %>% operator, set editable Options, add Item, set Selected Item

timevis() %>%

  setItems(data.frame(

    id = 1:2,

    content = c("one", "two"),

    start = c("2017-05-28", "2017-05-30")

  )) %>%

  setOptions(list(editable = TRUE)) %>%

  addItem(list(id = 3, content = "three", start = "2017-05-29")) %>%

  setSelection("1") 





8. 그룹(group)으로 묶어서 간트 차트 구성하기


업무의 특성(예: 컨설팅, 개발), 프로젝트 단계(예 : Phase 1, Phase 2), 조직(예: 설계팀, 개발팀, 지원팀) 등 특정 기준에 따라서 Item 들을 그룹으로 묶어서 간트 차트를 그리고 싶을 때가 있습니다.  이 기능을 잘 사용하면 간트 차트를 좀더 구조화해서 보여줄 수 있으므로 일목요연하게 시각화하는데 매우 유용합니다. 



# using the groups feature to group together multiple items into different buckets

timevis(

  data = data.frame(

    start = c(Sys.Date(), Sys.Date(), Sys.Date() + 1, Sys.Date() + 2),

    content = c("one", "two", "three", "four"), 

    group = c(1, 2, 1, 2)),

  groups = data.frame(id = 1:2, content = c("Group_1", "Group_2"))

)

 




9. timevis() 간트 차트를 RShiny 에 연동


RShiny 에도 timevis() 패키지를 사용해서 간트 차트, timeline을 삽입할 수 있습니다.  RShiny 문법에 대해서는 이 포스팅에서 설명하자면 너무 길어지게 되므로 생략하겠구요, 동적 문서(Dynamic Document) 카테고리에서 별도로 나중에 포스팅하겠습니다. 



# RShiny


library(shiny)


data <- data.frame(

  id = 1:3,

  start = c("2015-04-04", "2015-04-05 11:00:00", "2015-04-06 15:00:00"),

  end = c("2015-04-08", NA, NA),

  content = c("<h2>Vacation!!!</h2>", "Acupuncture", "Massage"),

  style = c("color: red;", NA, NA)

)


ui <- fluidPage(

  timevisOutput("appts"),

  div("Selected items:", textOutput("selected", inline = TRUE)),

  div("Visible window:", textOutput("window", inline = TRUE)),

  tableOutput("table")

)


server <- function(input, output) {

  output$appts <- renderTimevis(

    timevis(

      data,

      options = list(editable = TRUE, multiselect = TRUE, align = "center")

    )

  )

  

  output$selected <- renderText(

    paste(input$appts_selected, collapse = " ")

  )

  

  output$window <- renderText(

    paste(input$appts_window[1], "to", input$appts_window[2])

  )

  

  output$table <- renderTable(

    input$appts_data

  )

}


shinyApp(ui, server)


 



[Reference] https://github.com/daattali/timevis


많은 도움 되었기를 바랍니다. 


이번 포스팅이 도움이 되셨다면 아래의 '공감~'를 꾸욱 눌러주세요. ^^



728x90
반응형
Posted by Rfriend
,