R 로 벤다이어그램을 그려보자 VennDiagram 패키지

어떠한 두 그룹의 교차되는 부분의 규모를 표현할 때, 벤다이어그램은 매우 효과적인 방법입니다. 벤다이어그램을 그리기 위해 파워포인트, Keynote 같은 프로그램을 이용할 수 있습니다. 하지만, 실제 수치를 반영해서 원의 크기를 조정하고 싶을 수 있습니다. 이 때, R 의 VennDiagram 패키지를 이용할 수 있습니다. 

코드는 아래와 같습니다. draw.pairwise.venn 함수에 area1, area2, cross.area 에 해당하는 값을 넘겨줍니다. 이 때 주의할 점은 area1, area2 에서는 교차되는 부분을 포함하는 값을 넣어주어야 합니다. 

VennDiagram 패키지를 통한 벤다이어 그램 그리기 

2개 집합 벤다이어그램

• area1 : A
• area2 : B
• cross.area : A∩B

library(VennDiagram)

A <- 1000
B <- 400
C <- 100

# 벤다이어그램 원 내부 수치 있도록 변경 
# scaled = FALSE 로 지정하면, 실제 수치를 고려하지 않은 벤다이어그램을 그려줌
grid.newpage()
v <- draw.pairwise.venn(area1 = A, area2 = B, cross.area = C, 
                        fill = c("light blue", "pink"), 
                        alpha = rep(0.5, 2),
                        fontfamily='Kakao Regular', scaled=TRUE)
grid.draw(v)

# cex = 0 옵션을 통해 벤다이어그램 원 내부 수치 제거
grid.newpage()
v <- draw.pairwise.venn(area1 = A, area2 = B, cross.area = C, 
                        fill = c("light blue", "pink"), 
                        alpha = rep(0.5, 2),
                        fontfamily='Kakao Regular', cex=0, scaled=TRUE)
grid.draw(v)

3개 집합이 있는 벤다이어 그램

library(VennDiagram)

area1 <- 1080
area2 <- 607
area3 <- 367
n12 <- 308
n23 <- 190
n13 <- 175
n123 <- 21

grid.newpage()
overrideTriple = TRUE
v <- draw.triple.venn(
  area1 = area1,
  area2 = area2,
  area3 = area3,
  n12 = n12,
  n23 = n23,
  n13 = n13,
  n123 = n123,
  fill = c("light blue", "pink", 'light green'), 
  alpha = rep(0.5, 3),
  cat.fontfamily='Kakao Regular',
  fontfamily='Kakao Regular', scaled=TRUE
)
grid.draw(v)

sparklyr 에서 bucketing 하기 (기본 R과의 비교)

sparkly 에서는 spark 에서 실행하기 위한 함수들이 존재한다. 물론 그룹별 집계 등의 기본적인 데이터 처리의 경우, dplyr wrapper 를 통해 추가적인 학습 없이도 바로 사용할 수 있지만, 이외의 데이터 처리의 경우 sparklyr 의 고유 함수에 대한 학습이 필요하다. 

본 포스팅에서는 10분위수를 기준으로 변수를 10개의 카테고리로 분류하는 bucketing 작업을 sparklyr 을 통해 해보고 기본 R 과 비교해보았다. 

sparklyr 에서 bucketing 하기

get_spark_connection 의 경우 spark connection 을 잡는 함수인데, 관련해서 이 포스팅을 참고하길 바란다. 이 데이터처리에서 중요함수는 sdf_quantile 과 ft_bucketizer 이다. sdf 는 spark dataframe 의 약자이고, ft는 feature transformation 의 약자이다.

10분위수 구하기: sdf_quantile 을 사용하면 병렬적으로 변수의 quantile 을 구해서 리턴해준다. 이 작업은 데이터를 메모리로 로드후에 R 의 기본 quantile 을 실행하는 것보다 빠르다.

bucket 만들기: ft_bucketizer 는 연속형 변수에 대해 bucketizing 을 해준다. 이 때, 만약 10개의 bucket 으로 나눈다고 하면, splits 에 원소가 11개인 벡터를 전달해주어야한다. 10개의 bucket 으로 나눈다고 하면, 9개의 split point 가 필요한데, 여기에 최소값과 최대값을 추가로 더해 11개라고 볼 수 있다. quantile 함수에서 9개의 decile 과 최대값을 구했으므로, 최소값인 0을 추가로 더해 split 함수에 넣어준다. 

bucket 이름 만들기: ft_bucketizer 함수에는 아쉽게도 bucket 의 label 을 지정하는 방법이 없다. 단지 index 만 만들어줄 뿐이다. 따라서 index 와 label 을 매핑하는 데이터프레임을 따로 만들어서 해결해볼 수 있다. quantile 의 개수만큼 seq_along 을 통해 인덱스를 만들고, names 함수를 통해 벡터의 이름을 구해서 bucket_df 라는 데이터프레임을 만든 후에, 이를 데이터와 조인하여 bucket 의 label 을 만들 수 있다. 

library(tidyverse)
library(sparklyr)

sc <- get_spark_connection()

cars <- copy_to(sc, cars, "cars", overwrite=TRUE)

val_quantile <- sdf_quantile(cars %>% filter(speed > 0), column = "speed", probabilities = seq(0.1, 1, 0.1))

val_quantile
#    10%       20%       30%       40%       50%       60%       70%       80%       90%      100% 
#   15900     27000     35000     49900     63800     86200    113800    158310    246000 608623010 

names(val_quantile)

bucket_df <- data.frame(bucket_index = seq_along(val_quantile) - 1, bucket = names(val_quantile))
colnames(bucket_df) <- c("speed_index", "speed_cat")

# bucketing: 10분위수 총 9개와 함께, 최솟값, 최댓값을 벡터로 만들어 전달. (총 원소가 11개인 벡터)
cars <- ft_bucketizer(cars,
                        input_col = "speed",
                        output_col = "speed_index",
                        splits = c(0,val_quantile))

# spark dataframe 으로 변경
bucket_df <- sdf_copy_to(sc, bucket_df, "bucket_df", overwrite = TRUE)
cars <- left_join(cars, bucket_df, by = "speed_index")
cars %>% select(speed, speed_index, speed_cat) %>% sample_n(50)

기본 R 에서 10분위 bucketing 하기

기본 R dml

val_quantile <- quantile(cars %>% filter(speed > 0) %>% pull(speed), probs=seq(0.1, 1, 0.1))
val_quantile
# 10%  20%  30%  40%  50%  60%  70%  80%  90% 100% 
#   8.9 11.0 12.7 14.0 15.0 17.0 18.3 20.0 23.1 25.0 


cars$speed_cat <- if_else(cars$speed == 0, "X", 
                          as.character(cut(cars$speed, breaks = c(0,  val_quantile), labels = names(val_quantile))))
cars %>% sample_n(50)

# speed dist speed_cat
# 1     14   60       40%
# 2     13   26       40%
# 3     19   36       80%
# 4     13   34       40%
# 5     12   24       30%
# 6      4   10       10%

R Standard evaluation 과 Tidy evaluation

R 에서 특정 데이터프레임(df) 를 특정 열(var1,var2) 로 정렬하기 위해서는 아래와 같이 할 수 있습니다.

df %>% arrange(var1, var2)

Standard evaluation 

그런데 변수 이름이 동적인 경우, 즉 열 이름이 항상 같지 않고 코드 런타임에 결정되는 경우에는 표준 평가(Standard Evaluation, SE) 방법을 사용해야 합니다.

var1 <- "col1"
var2 <- "col2"

df %>% arrange(!!sym(var1), !!sym(var2))

Tidy evaluation

tidy evaluation 의 경우 rlang 의 {{}} (curly-curly) operation 을 사용하는 방법입니다. 그런데, 이 방법은 함수 안에서만 사용할 수 있습니다. 즉, tidy evaluation 도 동일한 기능을 수행하지만, 아래와 같이 함수 안에서만 사용할 수 있다는 제한점이 있습니다. 

my_function <- function(df, var){
  df %>% arrange({{var}})
}

R - 롱테일 분포의 히스토그램 그리기

실무를 하다보면 롱테일 분포를 많이 접하게 됩니다. 예를 들어서, 어떠한 이커머스 서비스에서 "구매 금액" 이라는 변수를 살펴보면, 대부분의 유저는 구매금액이 0~1만원 사이에 들어있지만, 일부 유저는 구매금액이 몇 백만원 심지어는 몇 억원에 이르는 경우를 심심찮게 볼 수 있습니다. 극심한 right-skewed 분포 (또는 롱테일 분포)의 예라고 볼 수 있습니다. 

이러한 롱테일 분포에 일반적인 히스토그램을 적용하게 되면 꼬리가 너무 길어져 가시성이 좋지 않습니다. 이런 경우에 특정 cutff 지점을 정해 따로 범주를 만들곤 합니다. 예를 들어, 구매금액이 백만원 이상인 유저는 '100만원 이상' 이라는 bucket 을 따로 만드는 것이죠. 꼬리 부분이 너무 길기 때문에 이 부분을 따로 모으는 것입니다. 

R 코드로는 다음과 같이 작성해볼 수 있습니다. 포인트는 raw 데이터에 적용하는 geom_hist 를 사용하는 것이 아니라, 집계 데이터를 먼저 만든 후, geom_bar 를 통해 히스토그램을 그리는 것입니다. 그리고, 집계 데이터를 만들기 위해 cut 함수를 사용합니다. 

R 코드

• anal_table 데이터 프레임의 value 컬럼이 histogram 을 그리고자하는 변수입니다.

top_1_percent <- quantile(anal_table$value, 0.99, na.rm=T) # 상위 1% 경계값 찾기

# bucket size 동적으로 설정
bucket_size <- 10^ceiling(log10(top_1_percent)) # 초기 bucket size

# while loop를 통해 bucket size 조정
while(TRUE) {
  breaks <- seq(0, top_1_percent, by = bucket_size) # 상위 1% 까지의 bucket  
  if(length(breaks) > 100) break # bucket 개수가 100개 이상이면 loop 탈출
  bucket_size <- bucket_size / 10 # bucket size 재조정
}

labels <- breaks
cutoff <- max(labels)+bucket_size
# 기본적으로 break 에서 좌측을 포함하지 않고 우측을 포함함(include lowest 를 통해 가장 좌측은 포함)
# right=FALSE 를 통해 우측을 포함하지 않게 지정
anal_table$bucket <- cut(anal_table$value, breaks = seq(0, cutoff, by = bucket_size), 
                         include.lowest = TRUE, 
                         right=FALSE,
                         labels = labels)

# bucket 이 없는 경우는, cutoff 이상인 경우로, 따로 만든 bucket 에 속하도록 바꾸어줌 
anal_table <- anal_table %>% mutate(bucket = if_else(is.na(bucket), as.character(ceiling(cutoff)), bucket))
anal_table$bucket <- factor(anal_table$bucket, levels = c(labels, ceiling(cutoff)))

summary_data <- anal_table %>% group_by(bucket) %>% count()
summary_data

summary_data <- summary_data %>% mutate(var_name = var_name)

val_quantile <- quantile((anal_table %>% select(value) %>% pull), probs=seq(0.1, 1, 0.1))

quantile_keys <- names(val_quantile)
quantile_values <- unname(val_quantile)

df_quantile <- data.frame(t(quantile_values))
colnames(df_quantile) <- quantile_keys

df_avg <- anal_table %>% summarize(avg = mean(value))
df_quantile <- cbind(df_quantile, df_avg)
df_quantile <- df_quantile %>% mutate(var_name = var_name)

total_ticks <- 10  

breaks <- pretty_breaks(n = total_ticks)(range(as.numeric(as.character(summary_data$bucket))))
ggplot(summary_data, aes(x = as.numeric(as.character(bucket)), y = n)) +     
  scale_y_continuous(labels = scales::label_comma()) +     
  geom_bar(stat = "identity", fill = "black") +    
  labs(x = "X", y = "Y") +    
  scale_x_continuous(breaks = breaks,  # breaks는 pretty_breaks를 사용해 계산된 값
                     labels = breaks) +   # labels도 breaks를 사용
  theme_bw(base_size = 10, base_family = "Kakao Regular") +    
  ggtitle("Histogram from Binned Data") +      
  theme(plot.margin = margin(0.5, 0.5, 0.5, 0.5, "cm")) +  
  geom_vline(aes(xintercept = df_quantile$avg), colour = "red") +  
  annotate("text", x = df_quantile$avg, y = max(summary_data$n),  
           label = paste("평균 =", round(df_quantile$avg, 2)),  
           vjust = 2, color = "black", size=3)

결과 히스토그램

• 위 코드를 통해 아래와 같이 지정된 bucket size 를 가지며, 상위 1% 이상은 하나의 bucket 으로 묶은 깔끔한 히스토그램을 그릴 수 있습니다.

위 코드에는 몇 가지 포인트가 있습니다. bucket size(bin)과 xtick 의 개수를 동적으로 결정한 부분인데요. 이 부분 코드를 좀 더 살펴보겠습니다. 

bucket size 를 동적으로 결정하기

• bucket 의 개수가 최소 100개가 되도록 하며, bucket size 가 1, 10, 100, 1000 처럼 10의 지수형태로 만드는 방법은 아래와 같습니다. 
• 또한 cut 함수의 labels 를 통해 label 을 이쁘게 만들어줍니다. 예를 들어 label 이 100이라고 하면, (100~199 사이의 bucket 을 의미하는 등)

# while loop를 통해 bucket size 조정
while(TRUE) {
  breaks <- seq(0, top_1_percent, by = bucket_size) # 상위 1% 까지의 bucket  
  if(length(breaks) > 100) break # bucket 개수가 100개 이상이면 loop 탈출
  bucket_size <- bucket_size / 10 # bucket size 재조정
}

labels <- breaks
cutoff <- max(labels)+bucket_size
# 기본적으로 break 에서 좌측을 포함하지 않고 우측을 포함함(include lowest 를 통해 가장 좌측은 포함)
# right=FALSE 를 통해 우측을 포함하지 않게 지정
anal_table$bucket <- cut(anal_table$value, breaks = seq(0, cutoff, by = bucket_size), 
                         include.lowest = TRUE, 
                         right=FALSE,
                         labels = labels)

동적 xtick 의 결정

• 아래 코드는 총 xtick 의 개수를 10개로 고정시키고, 변수에 따라 동적으로 xtick 간격을 조정하는 코드입니다. scalse 라이브러리의 pretty_breaks 라는 함수를 사용합니다. 

library(scales)
total_ticks <- 10  
breaks <- pretty_breaks(n = total_ticks)(range(as.numeric(as.character(summary_data$bucket))))

rstudio server 에서 github copilot 사용하기

rstudio server 환경에서 github copilot 을 사용하려고 보니 아래처럼

Github Copilot integration has been disabled by the administrator 라는 문구가 떴다. 

알아보니, Rstudio Server나 Posit Workbench에서는 관리자 설정 이후 사용이 가능하다고 한다. 

관리자 설정 하는 방법은 아래와 같다. rsession.conf 파일을 열고 copilot-enabled=1 문구를 추가해주면 된다!

cd /etc/rstudio/
sudo vim rsession.conf

이렇게 Enable github copilot 옵션이 잘 나온다. 

폰트 다운로드 후 위치 변경

sudo mv [폰트 파일 이름].ttf /usr/share/fonts/truetype/

extrafont 를 이용해 R 환경에 폰트 설치

library(extrafont)
font_import(prompt=FALSE)  # 폰트 설치 디렉토리를 검색하여 사용 가능한 폰트를 가져옵니다.
fonts()  # 사용 가능한 폰트 목록을 출력합니다.

어떤 컬럼의 값이 아래와 같은 문자열로 저장되어있을 때

["2021_12","2022_3","2022_1","2022_12","2023_4"....] 

해당 문자열 컬럼을 벡터컬럼으로 바꾸고 해당값을 unnest 하는 예시 

하나의 컬럼 값이 벡터형테인 경우 nested 라고 하고, 이를 row 로 변경하는 것을 unnest 라고 한다. 

# 문자열 parsing하여 year와 month로 분리하고 각 row로 만들기

df$dates <- lapply(df$month_ids, function(x) {
  unlist(fromJSON(x, simplifyVector = TRUE))
})
df<- df%>% 
  mutate(month_id = map(dates, str_split, pattern = ",")) %>%
  unnest(month_id)

List 를 이용한 방법

# dictionary 생성
dict <- list(name = "John", age = 30, city = "New York")

# dictionary 사용
dict$name
# [1] "John"

dict$age
# [1] 30

dict$city
# [1] "New York"

vector 를 활용한 방법

ㄴ setNames 함수를 활용

# dictionary 생성
dict <- setNames(c("John", 30, "New York"), c("name", "age", "city"))

# dictionary 사용
dict$name
# [1] "John"

dict$age
# [1] 30

dict$city
# [1] "New York"

hash 함수를 활용한 방법

library(hash)
h <- hash() 
h[['a']] <- 'a'
h[['b']] <- 'b'
h[['c']] <- 'c'
h[['d']] <- 'd'

h[['a']]

R 에서 특정 변수를 카테고리화 하고 싶을 때가 많다. 

다양한 방법이 있지만, 

아래 cut 함수를 사용하는 코드로 0~5, 6~10, 11~15, ... >100 으로 카테고리화가 가능하다. 

cat <- seq(0,100,5)
df$cat <- cut(df$x, breaks = c(cat, Inf), labels = cat)
df$cat <- factor(df$cat, levels=cat)

-> breaks 의 element 보다 labels 의 elements 의 갯수가 1개 적다. 

좀 더 일반적으로는 다음과 같다.

# 예시 데이터 생성
set.seed(123)
data <- data.frame(id = 1:10, value = rnorm(10, mean = 50, sd = 10))

# 카테고리화
data$cat <- cut(data$value, breaks = c(0, 25, 50, 75, 100), labels = c("low", "medium-low", "medium-high", "high"))

Hmisc 의 Lag 변수를 통해 timeseries 데이터의 lag 변수를 만들 수 있다. 

만약, 그룹별 Lag 변수를 만들고 싶으면 dplyr group_by 를 통해 만들 수 있다. 

library(Hmisc)
data <- data %>% group_by(gender, age) %>% mutate(lag = Lag(variable, 1))