Mercurial > repos > melpetera > corr_table
comparison 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 |
comparison
equal
deleted
inserted
replaced
1:29ec7e3afdd4 | 2:2173ad5e7750 |
---|---|
252 | 252 |
253 # Significance of correlation test ------------------------------------------------------------------ | 253 # Significance of correlation test ------------------------------------------------------------------ |
254 | 254 |
255 if (test.corr == "yes"){ | 255 if (test.corr == "yes"){ |
256 | 256 |
257 pvalue <- vector() | 257 repcorrtest1 <- function(vari1,vari2,corrmeth){ |
258 for (i in 1:dim(tab.corr)[1]){ | 258 suppressWarnings(corrtest <- cor.test(vari2, vari1, method = corrmeth)) |
259 for (j in 1:dim(tab.corr)[2]){ | 259 return(corrtest$p.value) |
260 suppressWarnings(corrtest <- cor.test(tab2[,i], tab1[,j], method = corr.method)) | 260 } |
261 pvalue <- c(pvalue, corrtest$p.value) | 261 repcorrtest2 <- function(stab,ftab,cormeth){ |
262 if (multi.name == "none"){ | 262 listp <- apply(X=ftab,2,repcorrtest1,vari2=stab,corrmeth=cormeth) |
263 if (corrtest$p.value > alpha){ | 263 return(listp) |
264 tab.corr[i,j] <- 0 | 264 } |
265 } | 265 pvalue <- apply(X=tab1,2,repcorrtest2,ftab=tab2,cormeth=corr.method) |
266 } | 266 |
267 } | 267 |
268 } | |
269 | |
270 if(multi.name != "none"){ | 268 if(multi.name != "none"){ |
271 adjust <- matrix(p.adjust(pvalue, method = multi.name), nrow = dim(tab.corr)[1], ncol = dim(tab.corr)[2], byrow = T) | 269 pvalue <- matrix(p.adjust(pvalue, method = multi.name), nrow = dim(tab.corr)[1], ncol = dim(tab.corr)[2]) |
272 tab.corr[adjust > alpha] <- 0 | 270 } |
273 } | 271 |
272 tab.corr[pvalue > alpha] <- 0 | |
273 | |
274 } | 274 } |
275 | 275 |
276 | 276 |
277 # Filter settings ------------------------------------------------------------------------------------ | 277 # Filter settings ------------------------------------------------------------------------------------ |
278 | 278 |
414 round(vect[x+1],3), "]", sep = "")) | 414 round(vect[x+1],3), "]", sep = "")) |
415 } | 415 } |
416 } | 416 } |
417 | 417 |
418 # Assign an interval to each correlation coefficient | 418 # Assign an interval to each correlation coefficient |
419 for (i in 1:dim(melted.tab.corr)[1]){ | |
420 for (j in 1:(length(cl))){ | 419 for (j in 1:(length(cl))){ |
421 if (vect[j] == -1){ | 420 if (vect[j] == -1){ |
422 melted$classe[i][melted$value[i] >= vect[j] | 421 melted$classe[melted$value >= vect[j] & melted$value <= vect[j+1]] <- cl[j] |
423 && melted$value[i] <= vect[j+1]] <- cl[j] | |
424 } else { | 422 } else { |
425 melted$classe[i][melted$value[i] > vect[j] | 423 melted$classe[melted$value > vect[j] & melted$value <= vect[j+1]] <- cl[j] |
426 && melted$value[i] <= vect[j+1]] <- cl[j] | |
427 } | 424 } |
428 } | 425 } |
429 } | 426 |
430 | 427 |
431 # Find the 0 and assign it the white as name | 428 # Find the 0 and assign it the white as name |
432 if (length(which(vect == 0)) == 1) { | 429 if (length(which(vect == 0)) == 1) { |
433 melted$classe[melted$value == 0] <- "0" | 430 melted$classe[melted$value == 0] <- "0" |
434 indic <- which(vect == 0) | 431 indic <- which(vect == 0) |
491 } # End of correlation.tab | 488 } # End of correlation.tab |
492 | 489 |
493 | 490 |
494 # Function call | 491 # Function call |
495 # correlation.tab(tab1.name, tab2.name, param1.samples, param2.samples, corr.method, test.corr, alpha, multi.name, filter, | 492 # correlation.tab(tab1.name, tab2.name, param1.samples, param2.samples, corr.method, test.corr, alpha, multi.name, filter, |
496 # filters.choice, threshold, reorder.var, color.heatmap, type.classes, | 493 # filters.choice, threshold, reorder.var, plot.choice, color.heatmap, type.classes, |
497 # reg.value, irreg.vect, output1, output2) | 494 # reg.value, irreg.vect, output1, output2) |