안녕하세요! 이번 포스팅에서는 상관계수에 대해 좋은 논문이 있어서 간단하게 소개드립니다.
캐글이나 데이콘에서 데이터 탐색 파트를 살펴보면 Pearson 상관계수나, Spearman 상관계수를 많이 사용하더라고요.
두 상관계수 모두 훌륭한 측정치로 두 변수가 선형적이거나 단조관계일 때 수치적으로 잘 나타낼 수 있습니다.
하지만, 두 상관계수 모두 변수가 대칭적인 관계나 주기적인 패턴을 보이고 있는 경우에는 효과적이지 않은데요!
이런 경우 오늘 소개할 XI Correlation을 사용하여 효과적으로 나타낼 수 있으며 아래 PPT를 확인해주세요!
0. Correlation 소개
0123456
1. 시각화 함수 작성
우선 R로 작성한 함수는 ("x"와 "y" 변수가 있는) 데이터 프레임이 주어졌을 때, 기존에 많이 사용하는 Pearson, Spearman, Kendall 상관계수와 논문에서 소개하는 XI Correlation을 출력하도록 아래와 같이 함수를 작성했습니다.
특히 XI Correlation 같은 경우에는 위 발표자료에서 소개한 것 처럼 동점(Tie) 유무에 따라 계산 방법이 달라지므로 중복을 판단하는 duplicated 함수를 사용해야 합니다.
또한, ggplot2의 그래프를 반한하도록 하였으며 LOESS(Local Regression) Smoothing을 사용하여 추세를 알 수 있도록 하였습니다.
- cor_all : 데이터가 포함된 리스트를 받아 Pearson, Spearman, Kendall, XI Correlation을 계산하고 시각적으로 표현하는 함수
- dfcor : 시뮬레이션 용 데이터셋("df"로 지정)과 (Optional) 상관계수("correlation"로 지정)가 포함된 리스트
- df : 시뮬레이션 용 데이터셋으로 dfcor에 포함되어 있으며 "x"와 "y" 이름으로 두 변수를 포함한 데이터프레임
- correlation : (Optional) 이론적으로 계산된 상관계수의 값
library(tidyverse)
library(XICOR)
library(gridExtra)
cor_all <- function(dfcor, group=NULL, spline=T, print=F){
df <- dfcor$df
correlation <- as.character(round(dfcor$correlation,4))
# Calculate Correlations
pearson = cor(df$x, df$y, method = "pearson")
spearman = cor(df$x, df$y, method = "spearman")
kendall = cor(df$x, df$y, method = "kendall")
duplication <- df$x %>% duplicated() %>% sum()
xicorr = XICOR::xicor(x=df$x, y=df$y, ties = duplication)
# Anotation
corr_text <- str_c(
"Pearson(Theoretical): ", round(pearson, 4),
"(", str_replace_na(correlation, replacement = "NA"),")", "\n",
"Spearman(Kendall): ", round(spearman, 4), "(", round(kendall, 4),")","\n",
"XI: ", round(xicorr, 4))
if(!is.null(group)){
p <- ggplot(data=df, mapping=aes(x=x, y=y, group=group, color = group))}
else{p <- ggplot(data=df, mapping=aes(x=x, y=y))}
p <- p + geom_point(color = "grey40", size = 2)
if(spline) p <- p + geom_smooth(method = "loess", formula = "y~x", color = "red")
# 그래프에 상관계수 추가
p <- p + annotate("text", x = min(df$x), y = Inf,
label = corr_text, hjust = 0, vjust = 1.2)
if(print){
print(sprintf("두 변수의 Pearson Correaltion : %.4f", pearson))
print(sprintf("두 변수의 Spearman Correaltion : %.4f", spearman))
print(sprintf("두 변수의 Kendall tau : %.4f", kendall))
print(sprintf("두 변수의 XI Correlation : %.4f", xicorr))
print(p)}
return(invisible(list("pearson" = pearson, "spearman" = spearman, "kendall" = kendall,
"plot" = p)))}
2. 선형 관계 (Linear Relationship)
선형관계에 있는 데이터 셋을 아래와 같이 구현하였으며 오차항에 있는 분산을 통해서 밀집도를 조절할 수 있습니다.
### 1) 선형관계(강한), 선형관계(중간), 선형관계(약한), 선형관계(매우약한)
make_linear_df <- function(n=100, min=0, max=1, mulitple = 1, sd = 1){
df <- tibble(
x = runif(n=n, min=min, max=max),
y = mulitple*x + rnorm(n=n, sd=sd))
tmp1 <- (max-min)^2/12*mulitple
tmp2 <- sqrt((max-min)^2/12) * sqrt((max-min)^2/12*mulitple^2 + sd^2)
cat("Theoretical Perason Correlation :", round(tmp1/tmp2, 4))
return(invisible(list(df=df, correlation=tmp1/tmp2)))}
# Dataset
df1 <- make_linear_df(n=500, min=0, max=5, mulitple = 5, sd=0.2)
p1 <- cor_all(df1, spline=T)
df2 <- make_linear_df(n=500, min=0, max=5, mulitple = 5, sd=1)
p2 <- cor_all(df2, spline=T)
df3 <- make_linear_df(n=500, min=0, max=5, mulitple = 5, sd=5)
p3 <- cor_all(df3, spline=T)
df4 <- make_linear_df(n=500, min=0, max=5, mulitple = 5, sd=25)
p4 <- cor_all(df4, spline=T)
# Visualization
grid.arrange(p1$plot, p2$plot, p3$plot, p4$plot)
다양한 값으로 시뮬레이션을 진행할 수 있으며 위 예시 코드에서 생성한 데이터 셋은 아래와 같은 분포를 가집니다.
$X \sim U(0, 5)$일때 $Y = 5X + E$ $(단, E \sim N(0, sd^2))$
선형관계인 만큼 Pearson, Spearman, Kendall의 상관계수를 사용해서 파악할 수 있으며 오차항의 산포도가 큰 경우에는 직관적으로 파악할 수 있는 것처럼 모든 상관계수의 값이 낮게 나옴을 확인할 수 있습니다.
3. 지수관계(Exponential Relationship)
지수관계에 있는 데이터 셋을 아래와 같이 구현하였으며 오차항에 있는 분산을 통해서 밀집도를 조절할 수 있습니다.
이론적인 피어슨 상관계수 값은 Distribution Function Technique(https://moogie.tistory.com/108)를 이용해서 계산하였습니다.
make_exponential_df <- function(n=100, min_unif=1, max_unif=5, multiple = 1, std = 1){
### Make Toy set
df <- tibble(
x = runif(n=n, min=min_unif, max=max_unif),
y = multiple*exp(x) + rnorm(n=n, mean = 0, sd=std))
### Correlation Get
## X ~ U(a, b) (단, 편의상 a>0)
# E[X] = (a+b)/2
# V[X] = (b-a)^2/12
ex <- (min_unif + max_unif)/2
vx <- (max_unif - min_unif)^2/12
## Y = ce^X + Z (단, 편의상 Z ~ N(0, std^2), std isn't stochastic)
# E[Y] = cE[e^X] + E[Z] = cE[e^X] = cE[K]
# V[Y] = E[Y^2] - E[Y]^2 = E[c^2exp(X)^2 + 2cexp(X)Z + Z^2] - E[Y]^2
# = c^2E[K^2] + 2cE[KZ] + E[Z^2] - E[Y]^2 (K = e^X)
# = c^2E[K^2] + 2cCov[K,Z] + E[Z^2] - c^2E[K]^2
# = c^2E[K^2] + 2cE[(K-E(K))Z] + E[Z^2] - c^2E[K]^2 (Z^2)
# F_K(k) = P(K < k) = P(e^X < k) = P(X < ln(k)) = F_X(ln(k)) = (ln(k)-a)/(b-a)
# f_K(k) = d/dk F_K(k) = 1/(k*(b-a)) (e^a<k<e^b)
ek <- integrate(f=function(x, a, b) exp(x)/(b-a),
lower = min_unif, upper = max_unif,
a=min_unif, b=max_unif)$value # E[K]
ek2 <- integrate(f=function(k, a, b) k^2/(k*(b-a)),
lower = exp(min_unif), upper = exp(max_unif),
a = min_unif, b = max_unif)$value # E[K^2]
ez2 <- std^2 # E[Z^2] = Var[Z] + E[Z]^2 = Var[Z] (Z ~ N(0, std^2)로 제한함)
covkz <- pracma::integral2(fun=function(k, z, ek, a=min_unif, b=max_unif){
((k-ek)*z) * (1/(k*(b-a))) * (1/sqrt(2*pi*std^2)*exp(-z^2/(2*std^2)))},
xmin = exp(min_unif), xmax = exp(max_unif),
ymin = -1e18, ymax = 1e18, ek=ek)$Q
vy <- multiple^2*ek2 + 2*multiple*covkz + ez2 - multiple^2*ek^2
## Corr(X, Y) = Cov(X, Y)/(sd(X)*sd(Y))
# X and Z are independent so, Cov(X, Y) = Cov(X, ce^X + Z) = Cov(X, ce^X)
# = E[X*ce^X] - E[X]E[ce^X] = cE[X*e^X]-cE[X]E[K]
exex <- integrate(f = function(x, a=min_unif, b=max_unif){x*exp(x)/(b-a)},
lower = min_unif, upper = max_unif)$value
sd_x <- sqrt(vx)
sd_y <- sqrt(vy)
corr <- multiple*(exex-ex*ek)/(sd_x*sd_y)
cat("Theoretical Perason Correlation :", round(corr, 4), "\n")
return(invisible(list(df=df, correlation=corr)))}
위 함수를 사용해서 다양한 데이터 셋을 생성할 수 있으며 아래 코드에서는 다음과 같은 분포(식)을 가정하고 있습니다.
$X \sim U(-1, 3)$일때, $Y = 2e^X + E$ (단, $E \sim N(0, std^2)$)
지수적인 관계는 단조 관계로 Pearson 상관계수도 꽤 잘 나타내지만 Spearman이나 Kendall이 좀 더 효과적인 것을 확인할 수 있으며 오차항의 산포도가 작은 경우에는 XI 상관계수도 효과적인 것을 확인할 수 있습니다.
# Dataset
df1 <- make_exponential_df(n=1000, min_unif = -1, max_unif = 3, multiple = 2, std = 0.2)
p1 <- cor_all(df1, spline=T)$plot
df2 <- make_exponential_df(n=1000, min_unif = -1, max_unif = 3, multiple = 2, std = 1)
p2 <- cor_all(df2, spline=T)$plot
df3 <- make_exponential_df(n=1000, min_unif = -1, max_unif = 3, multiple = 2, std = 5)
p3 <- cor_all(df3, spline=T)$plot
df4 <- make_exponential_df(n=1000, min_unif = -1, max_unif = 3, multiple = 2, std = 25)
p4 <- cor_all(df4, spline=T)$plot
gridExtra::grid.arrange(p1, p2, p3, p4)
4. 이차(Quadratic)함수 관계
이차함수 관계에 있는 데이터 셋을 아래와 같이 구현하였으며 오차항에 있는 분산을 통해서 밀집도를 조절할 수 있습니다.
이론적인 피어슨 상관계수 값은 마찬가지로 Distribution Function Technique(https://moogie.tistory.com/108)를 이용해서 계산하였습니다.
make_squared_df <- function(n=100, min_unif=-2,
max_unif=2, multiple=1, move_y = 0, std=1){
### Make Toy set
# X ~ U(a, b)
# Y = cx^2 + d + Z (Z ~ N(0, sigma^2))
df <- tibble(
x = runif(n=n, min=min_unif, max=max_unif),
y = multiple*x^2 + move_y + rnorm(n=n, sd=std))
### Correlation Get
## X ~ U(a, b)
# E[X] = (a+b)/2
# V[X] = (b-a)^2/12
ex <- (min_unif + max_unif)/2
vx <- (max_unif - min_unif)^2/12
## Y = cX^2 + d + Z (Z ~ N(0, sigma^2))
# E[Y] = cE[X^2] + d + E[Z] = cE[X^2] + d
ey <- integrate(f=function(x, a, b) x^2/(b-a),
lower = min_unif, upper = max_unif,
a=min_unif, b=max_unif)$value * multiple + move_y # E[Y]
# V[Y] = E[Y^2] - E[Y]^2 = E[c^2x^4 + 2cdX^2 + 2cZX^2 + d^2 + 2dZ + Z^2] - E[Y]^2
# = c^2*E[X^4] + 2cdE[X^2] + d^2 + sigma^2 - E[Y]^2
ex4 <- integrate(f=function(x, a, b) x^4/(b-a),
lower = min_unif, upper = max_unif,
a = min_unif, b = max_unif)$value
ex2 <- integrate(f=function(x, a, b) x^2/(b-a),
lower = min_unif, upper = max_unif,
a = min_unif, b = max_unif)$value
vy <- multiple^2*ex4 + 2*multiple*move_y*ex2 + move_y^2 + std^2 - ey^2
## Corr(X, Y) = Cov(X, Y)/(sd(X)*sd(Y))
# X and Z are independent so, Cov(X, Y) = Cov(X, cX^2 + d + Z) = Cov(X, cX^2)
# = E[cX^3] - E[X]E[cX^2] = cE[X^3] - cE[X]E[X^2]
ex3 <- integrate(f = function(x, a=min_unif, b=max_unif){x^3/(b-a)},
lower = min_unif, upper = max_unif)$value
sd_x <- sqrt(vx)
sd_y <- sqrt(vy)
corr <- (multiple*ex3 - multiple*ex*ex2) / (sd_x * sd_y)
cat("Theoretical Perason Correlation :", round(corr, 4), "\n")
return(invisible(list(df=df, correlation=corr)))}
위 함수를 사용해서 다양한 데이터 셋을 생성할 수 있으며 아래 코드에서는 다음과 같은 분포(식)을 가정하고 있습니다.
$X \sim U(-2, 2)$일때, $Y = 3X^2 - 2 + E$ (단, $E \sim N(0, std^2)$)
아래 그래프에서 확인할 수 있는 것 처럼 Y축 대칭입니다. 실제로 관계가 있음에도 불구하고 이론적인 Pearson 상관계수는 0입니다.
이런 경우 Pearson, Spearman, Kendall의 상관계수는 관계가 있음에도 선형적이거나 단조적인 관계만을 찾으므로 0에 가까운 값이 나와 크게 쓸모가 없습니다.
다만, 논문에서 제시한 XI Correlation 같은 경우에는 오차항의 산포도가 작은 경우에 높은 값을 보여 특정한 관계가 있음을 암시하고 있습니다.
# Dataset
df1 <- make_squared_df(n = 200, min_unif = -2, max_unif = 2, multiple = 3, move_y = -2, std = 0.2)
p1 <- cor_all(df1, spline = T)$plot
df2 <- make_squared_df(n = 200, min_unif = -2, max_unif = 2, multiple = 3, move_y = -2, std = 1)
p2 <- cor_all(df2, spline = T)$plot
df3 <- make_squared_df(n = 200, min_unif = -2, max_unif = 2, multiple = 3, move_y = -2, std = 5)
p3 <- cor_all(df3, spline = T)$plot
df4 <- make_squared_df(n = 200, min_unif = -2, max_unif = 2, multiple = 3, move_y = -2, std = 10)
p4 <- cor_all(df4, spline = T)$plot
# Visualization
gridExtra::grid.arrange(p1, p2, p3, p4)
### 4) 이차식(강함), 이차식(보통), 이차식(약함)
df1 <- make_squared_df(n = 200, min_unif = -1, max_unif = 3, multiple = 2, move_y = -5, std = 0.2)
p1<- cor_all(df1, spline = T)$plot
df2 <- make_squared_df(n = 200, min_unif = -1, max_unif = 3, multiple = 2, move_y = -5, std = 1)
p2 <- cor_all(df2, spline = T)$plot
df3 <- make_squared_df(n = 200, min_unif = -1, max_unif = 3, multiple = 2, move_y = -5, std = 5)
p3 <- cor_all(df3, spline = T)$plot
df4 <- make_squared_df(n = 200, min_unif = -1, max_unif = 3, multiple = 2, move_y = -5, std = 10)
p4 <- cor_all(df4, spline = T)$plot
gridExtra::grid.arrange(p1, p2, p3, p4)
5. 주기(Sin)함수 관계
시계열 데이터와 같이 주기관계에 있는 데이터 셋을 아래와 같이 구현하였으며 오차항에 있는 분산을 통해서 밀집도를 조절할 수 있습니다.
이론적인 피어슨 상관계수 값은 마찬가지로 Distribution Function Technique(https://moogie.tistory.com/108)를 이용해서 계산하였습니다.
### 5) Sin함수(강함), Sin함수(보통), Sin함수(약함)
make_sin_df <- function(n=100, min_unif=0, max_unif=2*pi, multiple=1, std=1){
### Make Toy set
# X ~ U(a, b)
# Y = csin(X) + Z (Z ~ N(0, sigma^2))
df <- tibble(
x = runif(n=n, min=min_unif, max=max_unif),
y = multiple*sin(x) + rnorm(n=n, sd=std))
### Correlation Get
## X ~ U(a, b)
# E[X] = (a+b)/2
# V[X] = (b-a)^2/12
ex <- (min_unif + max_unif)/2
vx <- (max_unif - min_unif)^2/12
## Y = csin(X) + Z (Z ~ N(0, sigma^2))
# E[Y] = cE[sin(X)] + E[Z] = cE[sin(X)]
esinx <- integrate(f=function(x, a, b) sin(x)/(b-a),
lower = min_unif, upper = max_unif,
a=min_unif, b=max_unif)$value # E[sin(X)]
# V[Y] = E[Y^2] - E[Y]^2 = E[c^2sin(X)^2 + 2cZsin(X) + Z^2] - E[Y]^2
# = c^2*E[sin(X) ^2] + sigma^2 - c^2E[sin(X)]^2
esinx2 <- integrate(f=function(x, a, b) sin(x)^2/(b-a),
lower = min_unif, upper = max_unif,
a = min_unif, b = max_unif)$value
vy <- multiple^2 * esinx2 + std^2 - multiple^2*esinx^2
## Corr(X, Y) = Cov(X, Y)/(sd(X)*sd(Y))
# X and Z are independent so, Cov(X, Y) = Cov(X, csin(X)+ Z) = Cov(X, csin(X))
# = cE[Xsin(X)] - cE[X]E[sin(X)]
exsinx <- integrate(f = function(x, a=min_unif, b=max_unif){x*sin(x)/(b-a)},
lower = min_unif, upper = max_unif)$value
sd_x <- sqrt(vx)
sd_y <- sqrt(vy)
corr <- (multiple*exsinx - multiple*ex*esinx) / (sd_x * sd_y)
cat("Theoretical Perason Correlation :", round(corr, 4), "\n")
return(invisible(list(df=df, correlation=corr)))
}
위 함수를 사용해서 다양한 데이터 셋을 생성할 수 있으며 아래 코드에서는 다음과 같은 분포(식)을 가정하고 있습니다.
$X \sim U(0, 4\pi)$일때, $Y = 2sin(X) + E$ (단, $E \sim N(0, std^2)$)
Quadratic의 경우와 마찬가지로 실제 관계가 있음에도 Pearson, Spearman, Kendall의 상관계수는 비교적 낮은 값을 가지는 것을 확인할 수 있습니다. 반면에 XI Correlation 같은 경우에는 오차항의 산포도가 작을수록 다른 경우와 마찬가지로 높은 값을 가지는 것을 확인할 수 있죠.
# Dataset
df1 <- make_sin_df(n = 500, std = 0.02, max_unif = 4*pi, multiple = 2)
p1 <- cor_all(df1, spline = T)$plot
df2 <- make_sin_df(n = 500, std = 0.1, max_unif = 4*pi, multiple = 2)
p2 <- cor_all(df2, spline = T)$plot
df3 <- make_sin_df(n = 500, std = 0.5, max_unif = 4*pi, multiple = 2)
p3 <- cor_all(df3, spline = T)$plot
df4 <- make_sin_df(n = 500, std = 2.5, max_unif = 4*pi, multiple = 2)
p3 <- cor_all(df4, spline = T)$plot
grid.arrange(p1, p2, p3, p4)
Referenece
- Chatterjee, S. (2022). A New Coefficient of Correlation. arXiv preprint arXiv:2209.10618.
- A New Coefficient of Correlation, Tim Sumner, Toward Data Science
(https://towardsdatascience.com/a-new-coefficient-of-correlation-64ae4f260310)
'AI > Machine Learning' 카테고리의 다른 글
| [Regression & Classifcation] Decision Tree (0) | 2024.04.03 |
|---|---|
| [ISLR] 5. 붓스트랩(Bootstrap) (0) | 2023.04.05 |
| [ISLR] 5. 교차검증(Cross-Validation) (0) | 2023.04.04 |
| [ISLR] 4. 분류(Classifiction) With R Using Tidymodels (0) | 2023.03.31 |
| [ISLR] 4. 분류모델의 성과지표(Performance Metric) (0) | 2023.03.31 |