Merge remote-tracking branch 'helpers/master'

.gitignore

@@ -0,0 +1,11 @@
+.Rproj.user
+.Rhistory
+.RData
+shinyapps
+
+[._]*.s[a-w][a-z]
+[._]s[a-w][a-z]
+*.un~
+Session.vim
+.netrwhist
+*~

DESCRIPTION

@@ -0,0 +1,22 @@
+Package: nasbMicrotaskViewerHelpers
+Type: Package
+Title: Helpers
+Version: 1.01
+Date: 2015-01-27
+Author: Maciej Szymkiewicz
+Maintainer: Maciej Szymkiewicz <[email protected]>
+Description:  NASB 2015 microtask viewer helper functions
+License: MIT
+Depends: R (>= 2.10),
+    data.table,
+    ggvis
+Imports: Rcpp (>= 0.11.4),
+    GeoDE,
+    httr,
+    tidyr,
+    dplyr,
+    stringi,
+    preprocessCore,
+    logging
+Suggests: testthat,
+    shiny

LICENSE

@@ -0,0 +1,22 @@
+The MIT License (MIT)
+
+Copyright (c) 2015 Maciej Szymkiewicz
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+

NAMESPACE

@@ -0,0 +1,3 @@
+import(data.table)
+importFrom(dplyr, "%>%")
+exportPattern("^[[:alpha:]]+")

R/chdir.R

@@ -0,0 +1,91 @@
+#' Prepare chdir results for plotting
+#' @param results numeric vector extracted from pchdir results
+#' @param n numeric max number of genes to keep
+#' @return data.frame
+#'
+prepare_results <- function(results, n=40) {
+    results <- head(results, n)
+    data.frame(
+        g = factor(
+            names(results),
+            names(results)[order(abs(results), decreasing=TRUE)]
+        ),
+        v = results
+    )
+}
+
+#' Extract downregulated genes from results
+#' @param results numeric vector extracted from pchdir results
+#' @return data.frame
+#'
+prepare_down_genes <- function(results) {
+    prepare_results(results, length(results)) %>% dplyr::filter(v < 0)
+}
+
+#' Extract upregulated genes from results
+#' @param results numeric vector extracted from pchdir results
+#' @return data.frame
+#'
+prepare_up_genes <- function(results) {
+    prepare_results(results, length(results)) %>% dplyr::filter(v > 0)
+}
+
+
+#' Plot top genes from chdirAnalysis
+#' @param results data frame returned from prepare_results 
+#' @return ggvis plot
+#'
+plot_top_genes <- function(results) {
+
+    properties_x <- ggvis::axis_props(
+        axis=list(stroke=NULL), 
+        ticks = list(stroke = NULL),
+        labels=list(angle=-90, fontSize = 12, align='right'),
+        title=list(fontSize=14, dx=-35)
+    )
+
+    properties_y <- ggvis::axis_props(
+        labels=list(fontSize=12), title=list(fontSize=14, dy=-35)
+    )
+
+    ggvis(results, ~g, ~v) %>% 
+        ggvis::layer_bars(width = 0.75) %>%
+        ggvis::scale_numeric('y', domain = c(min(results$v), max(results$v))) %>%
+        ggvis::add_axis('y', grid=FALSE, title = 'Coefficient', properties = properties_y) %>%
+        ggvis::add_axis('x', grid=FALSE, offset = 10, title = '', properties = properties_x)
+}
+
+
+#' Preprocess input to chdirAnalysis
+#'
+#' @param datain see GeoDE::chdirAnalysis
+#' @return data.frame
+#'
+preprocess_chdir_input <- function(datain) {
+    datain %>%
+        dplyr::rename_(IDENTIFIER=as.symbol(colnames(datain)[1])) %>%
+        dplyr::group_by(IDENTIFIER) %>%
+        dplyr::summarise_each(dplyr::funs(mean))
+}
+
+
+#' chdirAnalysis wrapper. Redirects plots to /dev/null and handles data aggregation
+#'
+#' @param datain see GeoDE::chdirAnalysis
+#' @param sampleclass see GeoDE::chdirAnalysis
+#' @param gammas see GeoDE::chdirAnalysis
+#' @param nnull see GeoDE::chdirAnalysis
+#'
+chdir_analysis_wrapper <- function(datain, sampleclass, gammas, nnull) {
+    on.exit(dev.off())
+    png('/dev/null')
+    GeoDE::chdirAnalysis(
+        # Group by gene label and compute mean
+        datain,
+        sampleclass=sampleclass,
+        CalculateSig=TRUE,
+        gammas=gammas,
+        nnull=nnull
+    )
+}
+

R/datain.R

@@ -0,0 +1,133 @@
+#' Prepare input for density plot 
+#'
+#' @param datain data.table with genenames in first columns and samples in following
+#' @return data.frame 
+#'
+prepare_density_plot_input <- function(datain) {
+    if(is.null(datain)) { return() }
+
+    # Rename first column to identifier
+    datain %>% dplyr::rename_(identifier = as.symbol(colnames(datain)[1])) %>%
+    # Convert to long
+    tidyr::gather(sample, value, -identifier) %>%
+    # Ugly and slow but works for now    
+    as.data.frame()
+}
+
+#' Create density plots for input data
+#' 
+#' @param datain data.table with genenames in first columns and samples in following
+#' @return ggvis
+#'
+plot_density <- function(datain) {
+    properties_y <- ggvis::axis_props(labels=list(fontSize=12), title=list(fontSize=12, dy=-35))
+    properties_x <- ggvis::axis_props(labels=list(fontSize=12), title=list(fontSize=12, dx=-35))
+    # Create plot 
+    datain %>%
+    ggvis::ggvis(~value) %>% ggvis::group_by(sample) %>%
+    ggvis::layer_densities(stroke = ~sample, fill := NA) %>%
+    ggvis::add_axis('y',  properties=properties_y) %>%
+    ggvis::add_axis('x',  properties=properties_x)
+}
+
+
+#' Check if datain is a valid es. Experimental.
+#' 
+#' @param datain data.frame
+#' @return single logical value with message attribute
+#'
+datain_is_valid <- function(datain) {
+    not_all_numeric <- function(x) !all(sapply(x, is.numeric))
+    valid <- TRUE
+
+    if(is.null(datain) || !is.data.frame(datain)) {
+        valid <- FALSE
+        attributes(valid)$message <- 'To select samples you have to upload valid dataset.'
+    } else if (ncol(datain) < 5) {
+        valid <- FALSE
+        attributes(valid)$message <- 'You need at least four samples to run Characteristic Direction Analysis'
+    } else if(
+        datain %>% 
+            dplyr::select_(-1) %>%
+            not_all_numeric()
+    ) {
+        valid <- FALSE
+        attributes(valid)$message <- 'Your dataset contains non-numeric entries'
+    }
+    valid
+}
+
+
+#' log2 transform expression data
+#' 
+#' @param datain data.frame
+#' @return data.frame where columns 2:ncol are log2 transformed
+#'
+datain_log2_transform <- function(datain) {
+    adjust <- function(x) { x + 1e-21 }
+    data.table(
+        datain %>% dplyr::select_(1),
+        datain %>% dplyr::select_(-1) %>% adjust() %>% log2()
+    )
+}
+
+
+#' quantile normalize expression data
+#'
+#' @param datain data.frame
+#' @param add_noise logical should we add random noise after quantile normalization
+#' @return data.frame where columns 2:ncol are quantile normalized
+#'
+datain_quantile_normalize <- function(datain, add_noise=TRUE) {
+    add_noise <- if(add_noise) { function(x) x + runif(length(x), 0, 1e-12) } else { identity }
+
+    setNames(
+        data.table(
+            datain %>% dplyr::select_(1),
+            datain %>% dplyr::select_(-1) %>% as.matrix() %>%
+            preprocessCore::normalize.quantiles() %>% 
+            # Ugly workaround for issue with GeoDE 
+            # TODO Remove as soon as possible 
+            as.data.frame() %>% 
+            dplyr::mutate_each(dplyr::funs(add_noise))
+        ),
+        colnames(datain)
+    )
+}
+
+
+#' Filter datain
+#'
+#' @param datain data.frame 
+#' @param id_filter icu regex or NULL
+#' @return data.table
+#'
+datain_filter <- function(datain, id_filter=NULL) {
+    opts_regex <- stringi::stri_opts_regex(case_insensitive=TRUE)
+
+    if(!is.null(id_filter))  {
+        datain %>%
+            dplyr::rename_(IDENTIFIER=as.symbol(colnames(datain)[1])) %>%
+            dplyr::filter(!stringi::stri_detect_regex(IDENTIFIER, id_filter, opts_regex=opts_regex))
+    } else {
+        datain
+    }
+}
+
+
+#' Apply preprocesing steps to expression data
+#'
+#' @param datain data.frame 
+#' @param log2_transform logical
+#' @param quantile_normalize logical
+#' @param id_filter icu regex or NULL
+#' @return data.table
+#'
+datain_preprocess <- function(datain, log2_transform=FALSE, quantile_normalize=FALSE, id_filter=NULL) {
+    log2_f <- if(log2_transform) { datain_log2_transform } else { identity }
+    quant_norm_f <- if(quantile_normalize) { datain_quantile_normalize } else { identity }
+
+    datain %>% datain_filter(id_filter=id_filter) %>% log2_f() %>% quant_norm_f() %>% na.omit()
+}
+
+

R/geode_utils.R

@@ -0,0 +1,27 @@
+#' Extract ith element of characteristic
+#' direction properties list from
+#' chdirAnalysis results
+#"
+#' @param chdir chdirAnalysis output
+#' @param i integer 
+#' @return matrix #{number of genes} * 1 matrix
+#'
+chdir_props <- function(chdir, i=1) {
+    chdir$chdirprops$chdir[[i]]
+}
+
+
+#' Extract ith element of the results list from
+#' chdirAnalysis results
+#'
+#' @param chdir chdirAnalysis output
+#' @param i integer 
+#' @return vector of length <= #{number of genes}
+#'
+chdir_results <- function(chdir, i=1) {
+    chdir$results[[i]]
+}
+
+
+
+

R/misc.R

@@ -0,0 +1,24 @@
+#' Prepare input for Enrichr form
+#'
+#' @param chdir_results data.frame as returned from prepare_results
+#' @return character 
+#'
+prepare_enrichr_input <- function(chdir_results) {
+    paste(apply(chdir_results %>% dplyr::mutate(v = abs(v)), 1, paste, collapse=','), collapse = '\n')
+}
+
+
+#' Download file if required and return path to directory
+#'
+#' @param sigs_path character
+#' @param choice character
+#' @return character
+#'
+get_path <- function(sigs_path, choice) {
+    if(stringi::stri_startswith_fixed(sigs_path, 'http')) {
+        download.file(file.path(sigs_path, choice), file.path(tempdir(), choice))
+        file.path(tempdir(), choice)
+    } else {
+        file.path(sigs_path, choice)
+    }
+}