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

Uploaded
author melpetera
date Wed, 16 Oct 2019 03:12:55 -0400
parents 29ec7e3afdd4
children
line wrap: on
line diff
--- a/CorrTable/Corr_Script_samples_row.R	Thu Aug 01 11:30:58 2019 -0400
+++ b/CorrTable/Corr_Script_samples_row.R	Wed Oct 16 03:12:55 2019 -0400
@@ -254,23 +254,23 @@
   
   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
-          }
-        }
-      }
-    }
-  
+	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"){
-      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
-    }
+      pvalue <- matrix(p.adjust(pvalue, method = multi.name), nrow = dim(tab.corr)[1], ncol = dim(tab.corr)[2])
+    } 
+	
+	tab.corr[pvalue > alpha] <- 0 
+	
   }  
   
   
@@ -416,17 +416,14 @@
     }
     
     # 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]
+          melted$classe[melted$value >= vect[j] & melted$value <= vect[j+1]] <- cl[j]
         } else {
-          melted$classe[i][melted$value[i] > vect[j] 
-                           && melted$value[i] <= vect[j+1]] <- cl[j]
+          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) {
@@ -493,5 +490,5 @@
   
   # 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,
+  #                             filters.choice, threshold, reorder.var, plot.choice, color.heatmap, type.classes,
   #                             reg.value, irreg.vect, output1, output2)