Improve heatmaps

Wrap the heatmap personnalisation in wrapper function to ease its use.
Prevent stretching of the scale by the extreme values.
Makes symmetrical scale for positive and negative values.

R/model_manipulation.R

@@ -80,16 +80,29 @@ accuracyPlot <- function(model_description) {
     colnames(mismatch) = colnames(stim_data) = colnames(simulation) = nodes[design$measured_nodes + 1]
     rownames(mismatch) = rownames(stim_data) = rownames(simulation) = treatments
 
+    # Plot a heatmap with a nice scale, i.e symmetrical and not stretched by the extreme values
+    comparisonHeatmap <- function(plotData, plotTitle, stripOut=0.05) {
+        if (stripOut >= 0.5) { stop("Cannot strip more than 50% of the data to generate the color scale") }
+        redData = sort(plotData)[ceiling(length(plotData)*stripOut):floor(length(plotData)*(1-stripOut))]
+        minRed = min(redData, na.rm=T)
+        maxRed = max(redData, na.rm=T)
+        # Symmetrical scale
+        if (minRed > 0 || abs(minRed) < abs(maxRed)) {
+            minRed = -abs(maxRed)
+        } else if (maxRed < 0 || abs(minRed) > abs(maxRed)) {
+            maxRed = abs(minRed)
+        }
+        bk = unique( c(seq(minRed, 0, length=50), seq(0, maxRed, length=50)) )
+        colorScale = c("deepskyblue", colorRampPalette(c("deepskyblue", "black", "red"))(length(bk)-1), "red")
+        bk = c(min(plotData, na.rm=T), bk, max(plotData, na.rm=T))
+        pheatmap(plotData, color=colorScale, breaks=bk, cluster_rows=F, cluster_col=F, display_numbers=T, main=plotTitle)
+    }
     # Comparison of the data and the stimulation in term of error fold change and log fold change
-    bk = unique( c(seq(min(mismatch, na.rm=T), 0, length=50), seq(0, max(mismatch, na.rm=T), length=50)) )
-    pheatmap(mismatch, color=colorRampPalette(c("deepskyblue", "black", "red"))(length(bk)-1), breaks = bk, cluster_rows=F, cluster_col=F, display_numbers = T, main="(data - simulation) / error")
-    bk = unique( c(seq(min(stim_data-simulation, na.rm=T), 0, length=50), seq(0, max(stim_data-simulation, na.rm=T), length=50)) )
-    pheatmap(stim_data-simulation, color=colorRampPalette(c("deepskyblue", "black", "red"))(length(bk)-1), breaks = bk, cluster_rows=F, cluster_col=F, display_numbers = T, main="log2(data/simulation)")
+    comparisonHeatmap(mismatch, "(data - simulation) / error")
+    comparisonHeatmap(stim_data-simulation, "log2(data/simulation)")
     # Log fold changes for the data and the stimulation
-    bk = unique( c(seq(min(stim_data, na.rm=T), 0, length=50), seq(0, max(stim_data, na.rm=T), length=50)) )
-    pheatmap(stim_data, color=colorRampPalette(c("deepskyblue", "black", "red"))(length(bk)-1), breaks = bk, cluster_rows=F, cluster_col=F, display_numbers = T, main="data")
-    bk = unique( c(seq(min(simulation, na.rm=T), 0, length=50), seq(0, max(simulation, na.rm=T), length=50)) )
-    pheatmap(simulation, color=colorRampPalette(c("deepskyblue", "black", "red"))(length(bk)-1), breaks = bk, cluster_rows=F, cluster_col=F, display_numbers = T, main="simulation")
+    comparisonHeatmap(stim_data, "Experimental data")
+    comparisonHeatmap(simulation, "Simulated data")
 }
 
 #' Selection of a minimal model by the removal of non significant links with a Chi^2 test