New blog tips

2016-08-02-rshiny-expert-image-comparison-app/README.md

@@ -0,0 +1,17 @@
+# R-Shiny app for expertise on microtubule
+This is for expert detection of bundling on random images of cells between two time steps.
+
+This app is presented on the blog: <//statnmap.com/2016-08-02-rshiny-expert-image-comparison-app>
+
+## A Shiny web interface for expert image comparison
+
+I participated to a scientific publication on the analysis of plant cell images. Part of the analysis was to define observation for each cell by visual expertise. The problem is that being able to observe an entire tissue when supposed to give an expertise for each cell biased the cell-centered expertise.
+Thus, I produce separated images of each cell out of the tissue, mixed the images of different plant lines and effects tested on the tissue. I then proposed a R-shiny web interface to randomly show the images to the experts and save their observations. This allowed for a non-biased expertise, as the expert had no information on the origin of the cell shown.
+
+## A download-upload feature to save and continue analysis on shinyapps.io
+
+The expert image comparison was long: 40min for the small analysis and 3h for the complete one. As the shinyapp is freely hosted on the Rstudio shinyapps.io servers, it was not possible to save outputs of a specific session on the server. Thus, the web application has been built such that the experts can download a zip file of their partial expertise and come back later. They were then able to upload the beginning of their expertise and continue their analysis when they wanted. The download/upload feature was a good alternative to the limit of the free hosting service.
+
+You can try this Shinyapp here :
+https://statnmap.shinyapps.io/Visual_Expert/
+* Code may be available on request.

2016-08-02-rshiny-expert-image-comparison-app/Rsource/Global.R

@@ -0,0 +1,55 @@
+# Quantitative cell micromechanics in Arabidopsis
+# Publication: http://onlinelibrary.wiley.com/doi/10.1111/tpj.13290/full
+#
+# Sébastien Rochette
+# https://statnmap.com
+#
+# -- Global environment -- #
+rawWD <- getwd()
+dataWD <- paste0(rawWD, "/data/")
+imgWD <- paste0(dataWD, "imgWD/")
+imgData <- paste0(dataWD, "imgData")
+polyWD <- paste0(dataWD, "polyWD/")
+outWD <- paste0(rawWD, "/outWD_user/")
+outWD_details <- paste0(rawWD, "/outWD_details/")
+
+# Retrieve all image names
+all.cells.names <- unlist(lapply(strsplit(list.files(imgData, full.names = TRUE), 
+                                          split = "_Cell"),function(x) x[1]))
+all.single.names <- unique(all.cells.names)
+# Number of cells for each meristem
+Cell.count <- table(all.cells.names)
+max.Cells <- max(Cell.count)
+
+# Cells that do not exist
+Cell.count.N <- rbind(as.factor(names(Cell.count)), Cell.count)
+Cell.out <- do.call(rbind, apply(Cell.count.N, 2, function(x) {
+  if (x[2] < 80 ) {cbind(x[1], (x[2] + 1):80)} else {NULL}
+})
+)
+
+# User defined variables
+Which.Line <-   c(1,1,1,2,2,2,1,1,1, 1, 1, 1, 1, 1, 1, 1, 3, 3, 3, 3, 3, 3, 2, 2, 2, 2, 4, 4, 4, 4, 4, 4)
+Which.Indent <- c(1,0,0,0,1,1,1,0,0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0)
+
+# Cbind Meristem, Line, Indent
+Meristem <- data.frame(1:length(Which.Line), Which.Line, Which.Indent)
+names(Meristem) <- c("Meristem", "Line", "Indent")
+
+# List all possible cells : Meristem * nb of cells
+all.cells <- cbind(rep(1:length(Which.Line), each = max.Cells),
+                   rep(1:max.Cells, length(Which.Line)))
+
+# Read previous expertises and combine results
+userfiles <- list.files(outWD,full.names = TRUE)[grep("user", list.files(outWD))]
+userdata <- array(dim = c(max.Cells, length(Which.Line), length(userfiles)))
+if (length(userfiles) != 0) {
+  for (i in 1:length(userfiles)) {
+    userdata[,,i] <- as.matrix(read.csv(file = userfiles[i],
+                                        header = TRUE, row.names = 1, sep = ","))
+  }
+}  
+userdata.compare <- t(apply(userdata,1,function(x) apply(x,1, 
+                                                         function(y) sum(y == 1, na.rm = TRUE)/sum(!is.na(y)))))
+userdata.compare[(userdata.compare < 0.5 & !is.na(userdata.compare))] <- 
+  1 - userdata.compare[(userdata.compare < 0.5 & !is.na(userdata.compare))]

2016-08-02-rshiny-expert-image-comparison-app/Rsource/data_preparation.R

@@ -0,0 +1,52 @@
+# Data preparation for visual expertise
+#
+# Sébastien Rochette
+# https://statnmap.com
+# May 2016
+
+rm(list=ls())
+
+library(sp)
+library(raster)
+
+rawWD <- "~/Rshiny/Visual_Expert/"
+dataWD <- paste0(rawWD,"data/")
+imgWD <- paste0(dataWD,"imgWD/")
+imgData <- paste0(dataWD,"imgData/")
+polyWD <- paste0(dataWD,"polyWD/")
+outWD <- paste0(rawWD,"outWD/")
+
+# Source the image creation function
+source(paste0(rawWD,"Rsource/functions.R"))
+
+
+  # Get all images names
+  split.names <- strsplit(list.files(imgWD),".",fixed=TRUE)
+  all.names <- unique(unlist(lapply(split.names,function(x) paste(x[-length(x)],collapse="."))))
+
+  # List of unique meristem images names (one for all time steps)
+  split.names <- strsplit(all.names,"_")
+  all.single.names <- unique(unlist(lapply(split.names,function(x) paste(x[-length(x)],collapse="_"))))
+  all.single.names <- all.single.names[-grep("T0",all.single.names)] # One cell with "bis" name
+
+  # Number of cells in each meristem
+  Cell.count <- unlist(lapply(seq(1,length(all.names),2),function(x) {
+    load(file=paste0(polyWD,"SpP_",all.names[x],".RData"))
+    length(SpP.save)
+  }))
+
+  # Loop on all meristems and all cells
+  res <- apply(t(1:length(all.single.names)), 2, function(m) { # m <- 1
+    img.names <- all.names[grep(all.single.names[m],all.names)]
+      apply(t(1:Cell.count[m]), 2, function(cell) { # cell <- 1
+      # x11(w = 8*length(img.names), h = 8)
+      jpeg(filename=paste0(imgData,all.single.names[m],"_Cell_",cell,".jpg"),
+        width = 4 * length(img.names), height = 4, units = "cm", pointsize = 5,
+        quality = 100,
+        bg = "white", res = 200)
+        par(mai = c(0.15, 0.2, 0.1, 0.1))
+        ShowCell(img.names = img.names, w.cell = cell, imgWD = imgWD, polyWD = polyWD)
+      dev.off()
+    })
+  })
+

2016-08-02-rshiny-expert-image-comparison-app/Rsource/functions.R

@@ -0,0 +1,102 @@
+# Sébastien Rochette
+# https://statnmap.com/
+# July 2016
+#
+## -- Graph for visual expertise -- ##
+#' Test for cell by cell view
+#'
+#' @param img.names A vector of images to compare
+#' @param w.cell Numeric. The number of the cell to show
+#' @param imgWD Directory where img are stored
+#' @param polyWD Directory where polygon files are stored
+
+ShowCell <- function(img.names, w.cell, imgWD, polyWD) {
+  # x11(w = 8*length(img.names), h = 8)
+  par(mfrow = c(1,length(img.names)),#mai = c(0.5,0.5,0.5,0),
+    cex = 1, xpd = FALSE, bg = "white")
+  for (x in 1:length(img.names)) {
+    load(file = paste0(polyWD,"SpP_",img.names[x],".RData"))
+    SpP <- SpatialPolygons(list(Polygons(list(
+      Polygon(SpP.save@polygons[[w.cell]]@Polygons[[1]]@coords)), "1")))
+    ExtSpP <- extend(extent(SpP), 5)
+    r <- flip(stack(paste0(imgWD,img.names[x], ".png")), "y")
+    r.crop <- crop(r, ExtSpP)
+    r.mask <- mask(r.crop, SpP)
+
+    plotRGB(r.mask, main = paste0("T",x), axes = TRUE)      
+    plot(SpP, border = "red", lwd = 2, add = TRUE)
+  }
+}
+
+#' A function to change the Original checkbox of rshiny
+#' into a nice true/false or on/off switch button
+#' No javascript involved. Only CSS code.
+#' 
+#' To be used with CSS script 'button.css' stored in a 'www' folder in your Shiny app folder
+#' 
+#' @param inputId The input slot that will be used to access the value.
+#' @param label Display label for the control, or NULL for no label.
+#' @param value Initial value (TRUE or FALSE).
+#' @param col Color set of the switch button. Choose between "GB" (Grey-Blue) and "RG" (Red-Green)
+#' @param type Text type of the button. Choose between "TF" (TRUE - FALSE), "OO" (ON - OFF) or leave empty for no text.
+#' @details CSS3 code was found on https://proto.io/freebies/onoff/
+# For CSS3 customisation, refer to this website.
+
+
+switchButton <- function(inputId, label, value=FALSE, col = "GB", type="TF") {
+
+  # color class
+  if (col != "RG" & col != "GB") {
+    stop("Please choose a color between \"RG\" (Red-Green) 
+      and \"GB\" (Grey-Blue).")
+  }
+  if (!type %in% c("OO", "TF", "YN")){
+   warning("No known text type (\"OO\", \"TF\" or \"YN\") have been specified, 
+     button will be empty of text") 
+  }
+  if(col == "RG"){colclass <- "RedGreen"}
+  if(col == "GB"){colclass <- "GreyBlue"}
+  if(type == "OO"){colclass <- paste(colclass,"OnOff")}
+  if(type == "TF"){colclass <- paste(colclass,"TrueFalse")}
+  if(type == "YN"){colclass <- paste(colclass,"YesNo")}
+
+  # No javascript button - total CSS3
+  # As there is no javascript, the "checked" value implies to
+  # duplicate code for giving the possibility to choose default value
+
+  if(value){
+    tagList(
+      tags$div(class = "form-group shiny-input-container",
+        tags$div(class = colclass,
+          tags$label(label, class = "control-label"),
+          tags$div(class = "onoffswitch",
+            tags$input(type = "checkbox", name = "onoffswitch", class = "onoffswitch-checkbox",
+              id = inputId, checked = ""
+            ),
+            tags$label(class = "onoffswitch-label", `for` = inputId,
+              tags$span(class = "onoffswitch-inner"),
+              tags$span(class = "onoffswitch-switch")
+            )
+          )
+        )
+      )
+    )
+  } else {
+    tagList(
+      tags$div(class = "form-group shiny-input-container",
+        tags$div(class = colclass,
+          tags$label(label, class = "control-label"),
+          tags$div(class = "onoffswitch",
+            tags$input(type = "checkbox", name = "onoffswitch", class = "onoffswitch-checkbox",
+              id = inputId
+            ),
+            tags$label(class = "onoffswitch-label", `for` = inputId,
+              tags$span(class = "onoffswitch-inner"),
+              tags$span(class = "onoffswitch-switch")
+            )
+          )
+        )
+      )
+    ) 
+  }
+}