fixed broken apavis due to new apa-object

robinweide · Jan 6, 2017 · 46d8237 · 46d8237
1 parent 0ccbaac
commit 46d8237
Showing 1 changed file with 49 additions and 45 deletions.
diff --git a/R/visualise.APA.ggplot.R b/R/visualise.APA.ggplot.R
@@ -7,58 +7,62 @@
 #' @return A grid object, containing two ggplot-objects.
 #' @export
 visualise.APA.ggplot <- function(APAlist, resolution, title, zCoef = 1, focus = 1, ...){
-  size <- dim(APAlist[[1]])[1]
-  size.banks <- (size-1)/2
-
-  tickLabelDownstream <- as.character(1 *((size.banks/2 * resolution)/1e3))
-  tickLabelUpstream <- as.character(-1 *((size.banks/2 * resolution)/1e3))
-  # Make two dataframes
-  abovePlots <- data.frame(Var1 = integer(),
-                           Var2 = integer(),
-                           value = numeric(),
-                           sample = factor())
+  size <- dim(as.data.frame(APAlist[[1]][1]))[1]
+  size.banks <- (size - 1)/2
+  tickLabelDownstream <- as.character(1 * ((size.banks/2 * 
+                                              resolution)/1000))
+  tickLabelUpstream <- as.character(-1 * ((size.banks/2 * resolution)/1000))
+  abovePlots <- data.frame(Var1 = integer(), Var2 = integer(), 
+                           value = numeric(), sample = factor())
   belowPlots <- abovePlots
-  # Loop trough list and melt
   list.len <- length(APAlist)
   belownames <- vector()
-  for(i in 1:list.len){
-    a <- reshape2::melt(APAlist[[i]])
-    a$sample <- factor(rep(names(APAlist)[i], length(a[,1])))
+  for (i in 1:list.len) {
+    firstMat <- as.data.frame(APAlist[[i]][1]); colnames(firstMat) <- 1:21 ; rownames(firstMat) <- 1:21
+    secondMat <- as.data.frame(APAlist[[focus]][1]); colnames(secondMat) <- 1:21
+    a <- reshape2::melt(as.matrix(firstMat))
+    a$sample <- factor(rep(names(APAlist)[i], length(a[, 1])))
     abovePlots <- rbind(abovePlots, a)
-
-    e <- reshape2::melt(APAlist[[i]]-APAlist[[focus]])
-    e$sample <- rep(paste0(names(APAlist)[focus], ' vs ', names(APAlist)[i] ) , length(e[,1]))
+
+    e <-  melt(as.matrix(firstMat - secondMat))
+    e$sample <- rep(paste0(names(APAlist)[focus], " vs ", 
+                           names(APAlist)[i]), length(e[, 1]))
     belowPlots <- rbind(belowPlots, e)
-    belownames <- c(belownames, paste0(names(APAlist)[focus], ' vs ', names(APAlist)[i] ))
+    belownames <- c(belownames, paste0(names(APAlist)[focus], 
+                                       " vs ", names(APAlist)[i]))
   }
-  # Find best color-limits
-  z <- max( abs( c(  quantile(na.exclude(abovePlots$value), .01) , quantile(na.exclude(abovePlots$value), .99)        )  )   )*zCoef
+  z <- max(abs(c(quantile(na.exclude(abovePlots$value), 0.01), 
+                 quantile(na.exclude(abovePlots$value), 0.99)))) * zCoef
   abovePlots$value[abovePlots$value > z] <- z
-  abovePlots$value[abovePlots$value < (z *-1)] <- (z *-1)
-  # Set focus-sample to column 1
-  abovePlots$sample <- factor(abovePlots$sample, levels = c(levels(abovePlots$sample)[focus], levels(abovePlots$sample)[!levels(abovePlots$sample) %in% levels(abovePlots$sample)[focus]] ))
-  volgorde <- match(names(APAlist),levels(abovePlots$sample))
-  belowPlots$sample <- factor(belowPlots$sample, levels = belownames[volgorde] )
-  # Plot per sample
-  plot1 <- ggplot2::ggplot(abovePlots, ggplot2::aes(Var1, Var2)) + ggplot2::geom_raster(ggplot2::aes(fill = value)) + ggplot2::facet_grid(.~ sample) +
-    ggplot2::coord_fixed() + ggplot2::theme(panel.background = ggplot2::element_rect(fill = "#FAFAFA",colour = NA)) +
-    ggplot2::scale_x_continuous(breaks = c(size*.25,size*.5,size*.75), labels = c(paste0(tickLabelUpstream,"kb"), "3'", paste0(tickLabelDownstream,"kb"))) +
-    ggplot2::scale_y_continuous(breaks = c(size*.25,size*.5,size*.75), labels = c(paste0(tickLabelUpstream,"kb"), "5'", paste0(tickLabelDownstream,"kb"))) +
-    ggplot2::labs(title = title,x = "", y = "", fill = "Contacts ") +
-    ggplot2::scale_fill_distiller(limits = c(0, z), palette = "Spectral")
-  # Find best color-limits
-  z2 <- max( abs( c(  quantile(na.exclude(belowPlots$value), .01) , quantile(na.exclude(belowPlots$value), .99)        )  )   )*zCoef
+  abovePlots$value[abovePlots$value < (z * -1)] <- (z * -1)
+  abovePlots$sample <- factor(abovePlots$sample, levels = c(levels(abovePlots$sample)[focus], 
+                                                            levels(abovePlots$sample)[!levels(abovePlots$sample) %in% 
+                                                                                        levels(abovePlots$sample)[focus]]))
+  volgorde <- match(names(APAlist), levels(abovePlots$sample))
+  belowPlots$sample <- factor(belowPlots$sample, levels = belownames[volgorde])
+
+  plot1 <- ggplot2::ggplot(abovePlots, ggplot2::aes(Var1, Var2)) + 
+    ggplot2::geom_raster(ggplot2::aes(fill = value)) + 
+    ggplot2::facet_grid(. ~ sample) + ggplot2::coord_fixed() + 
+    ggplot2::theme(panel.background = ggplot2::element_rect(fill = "#FAFAFA", colour = NA)) + 
+    ggplot2::scale_x_continuous(breaks = c(size *  0.25, size * 0.5, size * 0.75), labels = c(paste0(tickLabelUpstream,  "kb"), "3'", paste0(tickLabelDownstream, "kb"))) + 
+    ggplot2::scale_y_continuous(breaks = c(size *  0.25, size * 0.5, size * 0.75), labels = c(paste0(tickLabelUpstream,  "kb"), "5'", paste0(tickLabelDownstream, "kb"))) + 
+    ggplot2::labs(title = title, x = "", y = "", fill = "Contacts ") + ggplot2::scale_fill_distiller(limits = c(0,  z), palette = "Spectral")
+
+  z2 <- max(abs(c(quantile(na.exclude(belowPlots$value), 0.01), 
+                  quantile(na.exclude(belowPlots$value), 0.99)))) * zCoef
   belowPlots$value[belowPlots$value > z2] <- z2
-  belowPlots$value[belowPlots$value < (z2 *-1)] <- (z2 *-1)
-  # Plot difference-plots
-  plot2 <- ggplot2::ggplot(belowPlots, ggplot2::aes(Var1, Var2)) +
-    ggplot2::geom_raster(ggplot2::aes(fill = value)) + ggplot2::facet_grid(.~ sample) + ggplot2::coord_fixed()  +
-    ggplot2::scale_fill_gradient2(limits = c(z2*-1,z2), midpoint=0, low="#2166ac", mid="white", high="#b2182b") +
-    ggplot2::theme(panel.background = ggplot2::element_rect(fill = "#FAFAFA",colour = NA))+
-    ggplot2::scale_x_continuous(breaks = c(size*.25,size*.5,size*.75), labels = c(paste0(tickLabelUpstream,"kb"), "3'", paste0(tickLabelDownstream,"kb")))+
-    ggplot2::scale_y_continuous(breaks = c(size*.25,size*.5,size*.75), labels = c(paste0(tickLabelUpstream,"kb"), "5'", paste0(tickLabelDownstream,"kb"))) +
-    ggplot2::labs(x = "", y = "", fill = "Difference")
-  #return(gridExtra::grid.arrange(plot1, plot2, ncol=1))
+  belowPlots$value[belowPlots$value < (z2 * -1)] <- (z2 * -1)
+  plot2 <- ggplot2::ggplot(belowPlots, ggplot2::aes(Var1, Var2)) + 
+    ggplot2::geom_raster(ggplot2::aes(fill = value)) + 
+    ggplot2::facet_grid(. ~ sample) + ggplot2::coord_fixed() +
+    ggplot2::scale_fill_gradient2(limits = c(z2 * -1, z2), midpoint = 0, low = "#2166ac", mid = "white", high = "#b2182b") + 
+    ggplot2::theme(panel.background = ggplot2::element_rect(fill = "#FAFAFA", colour = NA)) + 
+    ggplot2::scale_x_continuous(breaks = c(size *  0.25, size * 0.5, size * 0.75), labels = c(paste0(tickLabelUpstream,  "kb"), "3'", paste0(tickLabelDownstream, "kb"))) + 
+    ggplot2::scale_y_continuous(breaks = c(size *  0.25, size * 0.5, size * 0.75), labels = c(paste0(tickLabelUpstream, "kb"), "5'", paste0(tickLabelDownstream, "kb"))) + 
+    ggplot2::labs(x = "",   y = "", fill = "Difference")
+
   grid::grid.newpage()
-  grid::grid.draw(rbind(ggplot2::ggplotGrob(plot1), ggplot2::ggplotGrob(plot2), size = "last"))
+  grid::grid.draw(rbind(ggplot2::ggplotGrob(plot1), ggplot2::ggplotGrob(plot2), 
+                        size = "last"))
 }