Range correction for correlation with bootstrapped CIs

#function for finding correction correlations with CIs
cRRr_CI = function(x, y, x_SD_U, R = 1000, conf = .95, type = "basic") {
  library(boot);library(psychometric);library(magrittr);library(weights)

  #make df
  data = data.frame(x, y)
  
  #uncorrected r
  v_r = wtd.cors(data[[1]], data[[2]]) %>% as.numeric()
  
  #skin bright SD
  v_SD = sd(data[[1]], na.rm=T)
  
  #corrected r
  v_cr = cRRr(rr = v_r, sdy = v_SD, sdyu = x_SD_U) %>% unlist(use.names = F)
  
  #boot function
  cRRr_func = function(data, i, cor, x_SD_U) {
    
    #sample using i
    data = data[i, ]
    
    #skin bright SD
    v_sample_SD = sd(data[[1]], na.rm=T)
    
    #sample cor
    v_sample_r = wtd.cors(data)[1, 2]
    
    
    #corrected r
    v_cor_r = psychometric::cRRr(rr = v_sample_r, sdy = v_sample_SD, sdyu = x_SD_U)
    
    v_cor_r %>% unlist(use.names = F)
  }
  
  #get CIs
  boot_obj = boot(data = data, statistic = cRRr_func, R = R, cor = v_r, x_SD_U = x_SD_U) %>%
    boot.ci(type = type, conf = conf)
  
  #return results
  c(r = v_r, r_corrected = v_cr, CI_lower = boot_obj[[4]][[4]], CI_upper = boot_obj[[4]][[5]])
}

#example
library(MASS);library(magrittr)
#simulate some data
d_test = mvrnorm(n=1e3, mu = c(0, 0), Sigma = matrix(c(1, .5, .5, 1), nrow=2), empirical = T) %>% as.data.frame()

#add RR version
d_test$V2_RR = d_test$V2
d_test[d_test$V2 > 1, "V2_RR"] = NA #remove values >1

#check effect
cor(d_test, use="pairwise")

#correct and estimate CI via bootstrap
v_res = cRRr_CI(x = d_test$V2_RR, y = d_test$V1, x_SD_U = sd(d_test$V2))
v_res

#analytic CIs
CIr(r = v_res[2], n = 1e3)