comparison CorrTable/Corr_Script_samples_row.R @ 2:2173ad5e7750 draft default tip

Uploaded

1:29ec7e3afdd4

  
  # Significance of correlation test  ------------------------------------------------------------------
  
  if (test.corr == "yes"){
    
    pvalue <- vector()
    for (i in 1:dim(tab.corr)[1]){
      for (j in 1:dim(tab.corr)[2]){
        suppressWarnings(corrtest <- cor.test(tab2[,i], tab1[,j], method = corr.method))
        pvalue <- c(pvalue, corrtest$p.value)
        if (multi.name == "none"){
          if (corrtest$p.value > alpha){
            tab.corr[i,j] <- 0
          }
        }
      }
    }
  
    if(multi.name != "none"){
      adjust <- matrix(p.adjust(pvalue, method = multi.name), nrow = dim(tab.corr)[1], ncol = dim(tab.corr)[2], byrow = T)
      tab.corr[adjust > alpha] <- 0
    }
  }  
  
  
  # Filter settings ------------------------------------------------------------------------------------
  

                          round(vect[x+1],3), "]", sep = ""))
      }
    }
    
    # Assign an interval to each correlation coefficient
    for (i in 1:dim(melted.tab.corr)[1]){
      for (j in 1:(length(cl))){
        if (vect[j] == -1){
          melted$classe[i][melted$value[i] >= vect[j] 
                           && melted$value[i] <= vect[j+1]] <- cl[j]
        } else {
          melted$classe[i][melted$value[i] > vect[j] 
                           && melted$value[i] <= vect[j+1]] <- cl[j]
        }
      }
    }
    
    # Find the 0 and assign it the white as name
    if (length(which(vect == 0)) == 1) {
      melted$classe[melted$value == 0] <- "0"
      indic <- which(vect == 0)

  } # End of correlation.tab
  
  
  # Function call
  # correlation.tab(tab1.name, tab2.name, param1.samples, param2.samples, corr.method, test.corr, alpha, multi.name, filter,
  #                             filters.choice, threshold, reorder.var, color.heatmap, type.classes,
  #                             reg.value, irreg.vect, output1, output2)

2:2173ad5e7750

  
  # Significance of correlation test  ------------------------------------------------------------------
  
  if (test.corr == "yes"){
    
	repcorrtest1 <- function(vari1,vari2,corrmeth){
	  suppressWarnings(corrtest <- cor.test(vari2, vari1, method = corrmeth))
	  return(corrtest$p.value)
	}
	repcorrtest2 <- function(stab,ftab,cormeth){
	  listp <- apply(X=ftab,2,repcorrtest1,vari2=stab,corrmeth=cormeth)
	  return(listp)
	}
	pvalue <- apply(X=tab1,2,repcorrtest2,ftab=tab2,cormeth=corr.method)
	
	
    if(multi.name != "none"){
      pvalue <- matrix(p.adjust(pvalue, method = multi.name), nrow = dim(tab.corr)[1], ncol = dim(tab.corr)[2])
    } 
	
	tab.corr[pvalue > alpha] <- 0 
	
  }  
  
  
  # Filter settings ------------------------------------------------------------------------------------
  

                          round(vect[x+1],3), "]", sep = ""))
      }
    }
    
    # Assign an interval to each correlation coefficient
      for (j in 1:(length(cl))){
        if (vect[j] == -1){
          melted$classe[melted$value >= vect[j] & melted$value <= vect[j+1]] <- cl[j]
        } else {
          melted$classe[melted$value > vect[j] & melted$value <= vect[j+1]] <- cl[j]
        }
      }
	
    
    # Find the 0 and assign it the white as name
    if (length(which(vect == 0)) == 1) {
      melted$classe[melted$value == 0] <- "0"
      indic <- which(vect == 0)

  } # End of correlation.tab
  
  
  # Function call
  # correlation.tab(tab1.name, tab2.name, param1.samples, param2.samples, corr.method, test.corr, alpha, multi.name, filter,
  #                             filters.choice, threshold, reorder.var, plot.choice, color.heatmap, type.classes,
  #                             reg.value, irreg.vect, output1, output2)