# Correlation and Dependence

It is well known that 0 dependence implies 0 correlation, while 0 correlation does not imply 0 dependence. I have a paper here illustrating nonlinear correlation coefficients from relationship subsets of the joint distribution. I have another paper here demonstrating that dependence is the average absolute value of the subset correlation coefficients.

The following partial moment functions are needed for the correlation coefficient:

CLPM = function(n, x, y, target.x = mean(x), target.y = mean(y)){
output <- vector("numeric", length(x))
for (i in 1:length(x)){
if (x[i]<target.x & y[i]<target.y )
output[i]<- (((target.x-x[i])^n)*((target.y -y[i])^n))
}

clpm = (sum(output)/length(x))
return(clpm)
}

CUPM = function(n, x, y, target.x = mean(x), target.y = mean(y)){
output <- vector("numeric", length(x))
for (i in 1:length(x)){
if (x[i]>target.x & y[i]>target.y)
output[i]<- (((x[i]-target.x)^n)*((y[i]-target.y)^n))
}

cupm = (sum(output)/length(x))
return(cupm)
}

DLPM = function(n, x, y, target.x = mean(x), target.y = mean(y)){
output <- vector("numeric", length(x))
for (i in 1:length(x)){
if (x[i]>target.x & y[i]<target.y)
output[i]<- (((x[i]-target.x)^n)*((target.y-y[i])^n))
}

dlpm = (sum(output)/length(x))
return(dlpm)
}

DUPM = function(n, x, y, target.x = mean(x), target.y = mean(y)){
output <- vector("numeric", length(x))
for (i in 1:length(x)){
if (x[i]<target.x & y[i]>target.y)
output[i]<- (((target.x-x[i])^n)*((y[i]-target.y)^n))
}

dupm = (sum(output)/length(x))
return(dupm)
}


And the subsetting function:

partition_map = function(x, y,order= ceiling(log10(length(x))), degree=1){

temp_df = data.frame(x=x, y=y)
temp_df[,'temp_part'] = 'p'
temp_df[,'master_part'] = 'p'

if(order >1){
for(i in 1:(order-1)){

for(item in unique(temp_df$master_part)){ tmp_xbar = mean(temp_df[temp_df$master_part == item,'x'])
tmp_ybar = mean(temp_df[temp_df$master_part == item, 'y']) temp_df[temp_df$x >= tmp_xbar & temp_df$y >= tmp_ybar & temp_df$master_part == item,'temp_part'] = paste(temp_df[temp_df$x >= tmp_xbar & temp_df$y >= tmp_ybar & temp_df$master_part == item,'master_part'], 0, sep = '') temp_df[temp_df$x <= tmp_xbar & temp_df$y >= tmp_ybar & temp_df$master_part == item,'temp_part'] = paste(temp_df[temp_df$x <= tmp_xbar & temp_df$y >= tmp_ybar & temp_df$master_part == item,'master_part'], 1, sep = '') temp_df[temp_df$x >= tmp_xbar & temp_df$y <= tmp_ybar & temp_df$master_part == item,'temp_part'] = paste(temp_df[temp_df$x >= tmp_xbar & temp_df$y <= tmp_ybar & temp_df$master_part == item,'master_part'], 2, sep = '') temp_df[temp_df$x <= tmp_xbar & temp_df$y <= tmp_ybar & temp_df$master_part == item,'temp_part'] = paste(temp_df[temp_df$x <= tmp_xbar & temp_df$y <= tmp_ybar & temp_df$master_part == item,'master_part'], 3, sep = '') } temp_df[,'master_part'] = temp_df[, 'temp_part'] } } return(temp_df[, c('x', 'y', 'master_part')]) }  Yielding the correlation coefficient: VN_rho = function(x, y,order= ceiling(log10(length(x))), degree=1){ if(order==1){return("Please Increase the Order Specification")} partitioned_df = partition_map(x, y,order,degree) clpm = numeric(0) cupm = numeric(0) dlpm = numeric(0) dupm = numeric(0) for(item in unique(partitioned_df$master_part)){
sub_x = partitioned_df[partitioned_df$master_part == item, 'x'] sub_y = partitioned_df[partitioned_df$master_part == item, 'y']
clpm = c(clpm, CLPM(degree, sub_x, sub_y))
cupm = c(cupm, CUPM(degree, sub_x, sub_y))
dlpm = c(dlpm, DLPM(degree, sub_x, sub_y))
dupm = c(dupm, DUPM(degree, sub_x, sub_y))

}

nonlin_cor = (sum(clpm) +sum(cupm) -sum(dlpm) -sum(dupm))/(sum(clpm)+sum(cupm)+sum(dlpm)+sum(dupm))

return(nonlin_cor)

}


And finally the dependence measure:

VN_dep = function(x, y,order= ceiling(log10(length(x))), degree=1){

partitioned_df = partition_map(x, y,order,degree)

clpm = numeric(0)
cupm = numeric(0)
dlpm = numeric(0)
dupm = numeric(0)
rhos = numeric(0)

for(item in unique(partitioned_df$master_part)){ sub_x = partitioned_df[partitioned_df$master_part == item, 'x']
sub_y = partitioned_df[partitioned_df$master_part == item, 'y'] clpm = c(clpm, CLPM(degree, sub_x, sub_y)) cupm = c(cupm, CUPM(degree, sub_x, sub_y)) dlpm = c(dlpm, DLPM(degree, sub_x, sub_y)) dupm = c(dupm, DUPM(degree, sub_x, sub_y)) } for(i in 1:order){ rhos[i] = abs((clpm[i]+cupm[i]-dlpm[i]-dupm[i]) / (clpm[i]+cupm[i]+dlpm[i]+dupm[i])) } plot(x,y) m<- rbind(VN_rho(x, y,order,degree),sum(na.omit(rhos))/length(na.omit(rhos))) rownames(m) = c("Correlation","Dependence") print(m) return(sum(na.omit(rhos))/length(na.omit(rhos))) }  A quick confirmation test yields: set.seed(123) x=rnorm(1000) y=x^2  Degree 0 case: VN_dep(x,y,degree=0) [,1] Correlation 0.007131858 Dependence 0.890496479  Degree 1 case (default degree, distances matter): VN_dep(x,y) [,1] Correlation 0.1380487 Dependence 0.9986242  It also works on the spherical distribution, illustrated below. Generated by: set.seed(123) df <- data.frame(x=runif(5000, -1, 1), y=runif(5000, -1, 1)) df <- subset(df, (x^2 + y^2 <= 1 & x^2 + y^2 >= 0.95)) VN_dep(df$x,df\$y)
[,1]
Correlation 0.05515558
Dependence  0.99773177


I would like to know if there would be any computational benefit from combining all of the routines into a single function or is it best to keep them separate. Also, if any of the steps could use a more efficient syntax.