Add 3D model tab (outline colored by distal-to-proximal only)

rajewsky-lab · May 17, 2018 · cdc214f · cdc214f
1 parent b519343
commit cdc214f
Show file tree

Hide file tree

Showing 4 changed files with 42 additions and 14 deletions.
diff --git a/functions.R b/functions.R
@@ -21,7 +21,7 @@
 # file:         functions.R
 # author(s):    Marcel Schilling <marcel.schilling@mdc-berlin.de>
 # created:      2017-02-23
-# last update:  2018-04-10
+# last update:  2018-04-13
 # license:      GNU Affero General Public License Version 3 (GNU AGPL v3)
 # purpose:      define functions for tomo-seq shiny app
 
@@ -30,6 +30,7 @@
 # change log (reverse chronological) #
 ######################################
 
+# 2018-04-13: added 3D model plot function (outline colored by distal-to-proximal only)
 # 2018-04-10: added support for dropout slices
 #             added support to hide smoothing standard errors
 # 2018-04-04: added support for default shifts/stretches from input data
@@ -131,6 +132,7 @@ require(iheatmapr)
 
 # get write.xlsx & read.xlsx
 require(xlsx)
+library(plotly)
 
 
 ##############
@@ -2662,6 +2664,19 @@ generate.heatmap<-
     # end heatmap generation function definition
     }
 
+plot.model3d <- function(outline.data)
+  outline.data %>%
+  plot_ly(x = ~dp, y = ~lr, z = ~dv) %>%
+  add_lines(color = ~dp) %>%
+  layout(title = params$plot.title.model3d,
+         scene = list(xaxis = list(title = params$dplab.model3d),
+                      yaxis = list(title = params$lrlab.model3d),
+                      zaxis = list(title = params$dvlab.model3d),
+                      aspectmode = "data",
+                      camera = list(eye = list(x = params$eye.model3d.dp,
+                                               y = params$eye.model3d.lr,
+                                               z = params$eye.model3d.dv))))
+
 
     ##########################
     # table output functions #

diff --git a/params.R b/params.R
@@ -21,7 +21,7 @@
 # file:         params.R
 # author(s):    Marcel Schilling <marcel.schilling@mdc-berlin.de>
 # created:      2017-02-21
-# last update:  2018-04-12
+# last update:  2018-04-13
 # license:      GNU Affero General Public License Version 3 (GNU AGPL v3)
 # purpose:      define parameters for tomo-seq shiny app
 
@@ -30,6 +30,7 @@
 # change log (reverse chronological) #
 ######################################
 
+# 2018-04-13: added 3D model tab & plot parameters
 # 2018-04-12: disabled single-y-scale by default
 # 2018-04-10: added plot option to show/hide dropout slices
 #             added plot option to show/hide smoothing standard error
@@ -509,15 +510,16 @@ if(!exists("params"))
       ,gene.table.xlsx.export.button.label="Export gene table as XLSX"
 
       # file name to use for gene table XLSX export
-      ,gene.table.xlsx.name="gene_table.xlsx"
+      ,gene.table.xlsx.name = "gene_table.xlsx",
+      model3d.tab.title = "3D model",
 
 
   ##############
   # data paths #
   ##############
 
       # (relative) file path of Rds file with tomo-seq data
-      ,tomoseq.data.file = "tomoseq.data.Rds",
+      tomoseq.data.file = "tomoseq.data.Rds",
 
       shift_stretch.file = "shift_stretch.Rds",
 
@@ -695,7 +697,13 @@ if(!exists("params"))
       ,heatmap.color.values=
 
         # use viridis colors with heatmaply default settings
-        viridis(n=256,alpha=1,begin=0,end=1,option="viridis")
+        viridis(n = 256, alpha = 1, begin = 0, end = 1, option = "viridis"),
 
-      # end parameter list definition
-      )
+
+  plot.title.model3d = "Gonad arm model",
+  dplab.model3d = "distal-proximal [μm from DTC]",
+  lrlab.model3d = "left-right [μm from center]",
+  dvlab.model3d = "dorsal-ventral [μm from center]" ,
+  eye.model3d.dp = 0,
+  eye.model3d.lr = -3,
+  eye.model3d.dv = 1.5)
diff --git a/server.R b/server.R
@@ -74,6 +74,7 @@ require(magrittr)
 
 # get renderIheatmap
 require(iheatmapr)
+library(plotly)
 
 
 #############
@@ -367,6 +368,9 @@ function(
         # end heatmap rendering
         )
 
+    output$model3d <-
+      renderPlotly(plot.model3d(input.data$gonad.model$outline))
+
     # assign gene annotation
     gene.annotation<-
 

diff --git a/ui.R b/ui.R
@@ -21,7 +21,7 @@
 # file:         ui.R
 # author(s):    Marcel Schilling <marcel.schilling@mdc-berlin.de>
 # created:      2017-02-21
-# last update:  2018-04-09
+# last update:  2018-04-13
 # license:      GNU Affero General Public License Version 3 (GNU AGPL v3)
 # purpose:      define front end for tomo-seq shiny app
 
@@ -30,6 +30,7 @@
 # change log (reverse chronological) #
 ######################################
 
+# 2018-04-13: added 3D model tab & plot output panel
 # 2018-04-09: removed sample stretches input panel
 # 2018-04-03: added smoothing point count input panel parameters
 #             added smoothing span input panel parameters
@@ -71,6 +72,7 @@ require(magrittr)
 
 # get iheatmaprOutput
 require(iheatmapr)
+library(plotly)
 
 
 ##############
@@ -519,13 +521,12 @@ fluidPage(
         )
 
       # end heatmap tab panel definition
-      )
-
-    # end tabset panel definition
-    )
+      ),
 
-  # end page definition
-  ) %>%
+    tabPanel(title = params$model3d.tab.title,
+             sidebarLayout(
+               sidebarPanel(),
+               mainPanel(plotlyOutput(outputId = "model3d")))))) %>%
 
 # initialize user interface
 shinyUI