R/my.cor.R

In michaelkardas/temp.functions2:

#' Tests the significance of a correlation between two or more independent measures.
#' @param dv1 Measure 1.
#' @param dv2 Measure 2.
#' @keywords correlation
#' @export
#' @examples
#' my.cor(csv$learn,csv$prepare)

my.cor <- function(dv1, dv2, iv=NULL, alternative = c("two.sided", "less", "greater"),method = c("pearson", "kendall", "spearman"),exact = NULL, conf.level = 0.95, continuity = FALSE) {
  library(psychometric); library(stringr); options(scipen=999)

  # Wrong data frame warning. (Note that multiplying two columns leads to errors in the code below, so I remove several characters including "*" from the arguments using gsub for purposes of returning appropriate warnings.)
  fargs <- as.list(match.call(expand.dots = TRUE)); for (i in 1:length(fargs)) {fargs[i] <- gsub("*","",fargs[i],fixed=T); fargs[i] <- gsub("-","",fargs[i],fixed=T); fargs[i] <- gsub(" ", "", fargs[i],fixed=T)};  fargs2 <- NULL; for (i in 2:length(fargs)) {if(is.na(str_locate_all(pattern=coll('$'),toString(fargs[i][[1]]))[[1]][1])==F|is.na(str_locate_all(pattern=coll('['),toString(fargs[i][[1]]))[[1]][1])==F) {fargs2 <- c(fargs2,substr(fargs[2][[1]],1,str_locate_all(pattern=coll('$'),toString(fargs[i][[1]]))[[1]][1]-1))}; {fargs2 <- c(fargs2,substr(fargs[2][[1]],1,str_locate_all(pattern=coll('['),toString(fargs[i][[1]]))[[1]][1]-1))}}; fargs2 <- fargs2[!is.na(fargs2)]; if(length(fargs2)>=2) {for (i in 2:length(fargs2)) {if(fargs2[i-1]!=fargs2[i]) {warning("WARNING: Multiple data frames entered as function arguments.")}}}

  if(is.null(dv1)==F) {dv1 <- as.numeric(dv1)}
  if(is.null(dv2)==F) {dv2 <- as.numeric(dv2)}


  if(is.null(iv)==T) {
    # correlations
    a <- cor.test(dv1, dv2, alternative = alternative, method = method, exact = exact, conf.level = conf.level, continuity = continuity)

    # confidence intervals
    b <- CIr(a$estimate,n=length(dv1),level=conf.level)


    if(a$p.value < .001) {
      writeClipboard(paste(" # ","r = ",my.rd(a$estimate,2),", t(",a$parameter,") = ",my.rd0(a$statistic,2),", p < .001, 95% CI = [",my.rd(b[1],2),", ",my.rd(b[2],2),"]",sep=""))
      return(cat(" # ","r = ",my.rd(a$estimate,2),", t(",a$parameter,") = ",my.rd0(a$statistic,2),", p < .001, 95% CI = [",my.rd(b[1],2),", ",my.rd(b[2],2),"]",sep=""))
    }

    else {
      writeClipboard(paste(" # ","r = ",my.rd(a$estimate,2),", t(",a$parameter,") = ",my.rd0(a$statistic,2),", p = ",my.rd(a$p.value,3),", 95% CI = [",my.rd(b[1],2),", ",my.rd(b[2],2),"]",sep=""))
      return(cat(" # ","r = ",my.rd(a$estimate,2),", t(",a$parameter,") = ",my.rd0(a$statistic,2),", p = ",my.rd(a$p.value,3),", 95% CI = [",my.rd(b[1],2),", ",my.rd(b[2],2),"]",sep=""))
    }
  }

  if(is.null(iv)==F) {
    # compute all t tests, effect sizes & SD, for each level of "by", before re-formatting

    iv <- factor(iv)
    df <- data.frame(dv1,dv2,iv)
    nivs <- nlevels(iv)
    a.list <- as.list(rep(0,nivs)) # to store results of the correlation tests
    b.list <- as.list(rep(0,nivs)) # to store confidence intervals for each correlation test

    for (i in 1:nivs) {
      temp <- subset(df,iv==levels(iv)[i])
      a.list[[i]] <- cor.test(temp$dv1, temp$dv2, alternative = alternative, method = method, exact = exact, conf.level = conf.level, continuity = continuity)
      b.list[[i]] <- CIr(a.list[[i]]$estimate,n=length(temp$dv1),level=conf.level)
    }

    clip <- ""
    for (i in 1:nivs) {
      if(a.list[[i]]$p.value < .001) {clip <- paste(clip,"# ",levels(iv)[i],": r = ",my.rd(a.list[[i]]$estimate,2),", t(",a.list[[i]]$parameter,") = ",my.rd0(a.list[[i]]$statistic,2),", p < .001", ", 95% CI = [",my.rd(b.list[[i]][1],2),", ",my.rd(b.list[[i]][2],2),"]","\n",sep="")}
      if(a.list[[i]]$p.value >= .001) {clip <- paste(clip,"# ",levels(iv)[i],": r = ",my.rd(a.list[[i]]$estimate,2),", t(",a.list[[i]]$parameter,") = ",my.rd0(a.list[[i]]$statistic,2),", p = ",my.rd(a.list[[i]]$p.value,3),", 95% CI = [",my.rd(b.list[[i]][1],2),", ",my.rd(b.list[[i]][2],2),"]","\n",sep="")}
    }
    writeClipboard(clip)

    return(for (i in 1:nivs) {
      if(a.list[[i]]$p.value < .001) {cat("# ",levels(iv)[i],": r = ",my.rd(a.list[[i]]$estimate,2),", t(",a.list[[i]]$parameter,") = ",my.rd0(a.list[[i]]$statistic,2),", p < .001", ", 95% CI = [",my.rd(b.list[[i]][1],2),", ",my.rd(b.list[[i]][2],2),"]","\n",sep="")}
      if(a.list[[i]]$p.value >= .001) {cat("# ",levels(iv)[i],": r = ",my.rd(a.list[[i]]$estimate,2),", t(",a.list[[i]]$parameter,") = ",my.rd0(a.list[[i]]$statistic,2),", p = ",my.rd(a.list[[i]]$p.value,3),", 95% CI = [",my.rd(b.list[[i]][1],2),", ",my.rd(b.list[[i]][2],2),"]","\n",sep="")}
    })
  }
}
############################ ADAPTING THIS CODE FOR OSF ################################
# (1) Remove warnings that you inserted just for yourself
# (2) Remove comments marked as notes to self
# (3) Remove sections of code that assume multiple==T, UNLESS you plan to post the "multiple" function
################################# VALIDATION NOTES #####################################
##### Cases to validate (validated 16/12/27 in R via cor.test)
# (1) Two separate DV's
# (2) One DV grouped by other DV's
# (3) Double check p values for correlations (since even small samples seem statistically significant)