mise en ligne des scripts

f61f2c17 · Midoux Cedric · 6a79ffcb · f61f2c17
Commit f61f2c17 authored Mar 27, 2018 by Midoux Cedric
--- a/server.R
+++ b/server.R
+library(shinydashboard)
+shinyServer
+(function(input, output, session)
+{
+  checkNull <- function(x) {
+    if (!exists(as.character(substitute(x)))) {
+      return(NULL)
+    } else if (is.null(x)) {
+      return(NULL)
+    } else if (length(x) > 1) {
+      return(x)
+    }
+    else if (x %in% c(0, "", NA, "NULL")) {
+      return(NULL)
+    } else {
+      return(x)
+    }
+  }
+  beautifulTable <- function(data)  {
+    DT::datatable(
+      data = data,
+      rownames = FALSE,
+      filter = "top",
+      extensions = c("Buttons", "ColReorder", "FixedColumns"),
+      options = list(
+        dom = "lBtip",
+        pageLength = 10,
+        lengthMenu = list(c(10, 25, 50, 100,-1), list('10', '25', '50', '100', 'All')),
+        buttons = list(
+          'colvis',
+          list(
+            extend = 'collection',
+            buttons = c('copy', 'csv', 'excel', 'pdf'),
+            text = 'Download'
+          )
+        ),
+        colReorder = TRUE,
+        scrollX = TRUE,
+        fixedColumns = list(leftColumns = 1, rightColumns = 0)
+      ),
+      width = "auto",
+      height = "auto"
+    )
+  }
+  source(
+    "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
+  )
+  data16S <- reactive({
+    if (input$biomFormat == "std")
+    {
+      d <- import_biom(
+        BIOMfilename = input$fileBiom$datapath,
+        treefilename = input$fileTree$datapath,
+        refseqfilename = input$fileSeq$datapath
+      )
+    } else if (input$biomFormat == "frogs") {
+      d <- import_frogs(
+        biom = input$fileBiom$datapath,
+        treefilename = input$fileTree$datapath,
+        refseqfilename = input$fileSeq$datapath
+      )
+    }
+    colnames(tax_table(d)) <-
+      c("Kingdom",
+        "Phylum",
+        "Class",
+        "Order",
+        "Family",
+        "Genus",
+        "Species")
+    tax_table(d)[grep("unknown ", tax_table(d))] <- NA
+    #tax_table(d)[grep("Unclassified", tax_table(d))] <- NA
+    if (!is.null(input$fileMeta)) {
+      if (input$CSVsep == "excel") {
+        sample_data(d) <-
+          RcmdrMisc::readXL(input$fileMeta$datapath,
+                            rownames = TRUE,
+                            header = TRUE)
+      } else {
+        sample_data(d) <- read.csv(
+          input$fileMeta$datapath,
+          header = TRUE,
+          sep = input$CSVsep,
+          row.names = 1,
+          na.strings = NA
+        )
+      }
+    } else {
+      n <- data.frame(sample_names(d) , row.names = sample_names(d))
+      names(n) <- "sample_names"
+      sample_data(d) <- n
+    }
+    if (input$rareData) {
+      d <- rarefy_even_depth(
+        d,
+        replace = FALSE,
+        rngseed = as.integer(Sys.time()),
+        verbose = FALSE
+      )
+    }
+    return(d)
+  })
+  output$rarefactionMin <- renderText({
+    if (!is.null(input$fileBiom)) {
+      paste("(min sample =", format(min(sample_sums(data16S(
+      ))), big.mark = " "), "reads)")
+    } else {
+      paste("(min sample =", 0, "reads)")
+    }
+  })
+  output$rarefaction <- renderText({
+    if (input$rareData) {
+      "<font color=\"#FF0000\"><b> Vous travaillez acctuellement avec des données raréfiés </b></font>"
+    }
+  })
+  output$phyloseqPrint <- renderPrint({
+    validate(
+      need(
+        !is.null(input$fileBiom),
+        "Merci de commencer par importer un fichier d'abondance au format BIOM. Celui-ci peut etre obtenu a l'issue du workflow FROGS avec l'operation 'FROGS BIOM to std BIOM'"
+      )
+    )
+    data16S()
+  })
+  output$summaryTable <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    box(
+      title = "Tables",
+      width = NULL,
+      status = "primary",
+      tabsetPanel(
+        tabPanel("otu_table",
+                 beautifulTable(
+                   data.frame(OTU = taxa_names(data16S()), otu_table(data16S()))
+                 )),
+        tabPanel("tax_table",
+                 beautifulTable(
+                   data.frame(OTU = taxa_names(data16S()), tax_table(data16S()))
+                 )),
+        if (!is.null(input$fileMeta)) {
+          tabPanel("sample_data",
+                   beautifulTable(data.frame(
+                     SAMPLE = sample_names(data16S()), sample_data(data16S())
+                   )))
+        }
+      )
+    )
+  })
+  output$histUI <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    box(
+      title = "Paramètres",
+      width = NULL,
+      status = "primary",
+      selectInput(
+        "barFill",
+        label = "Niveau taxo :",
+        choices = rank_names(data16S())
+      ),
+      if (!is.null(input$fileMeta))
+      {
+        selectInput(
+          "barGrid",
+          label = "Regroupement :",
+          choices = c("..." = 0, sample_variables(data16S()))
+        )
+      },
+      if (!is.null(input$fileMeta))
+      {
+        selectInput("barX",
+                    label = "X :",
+                    choices = c("..." = 0, sample_variables(data16S())))
+      }
+    )
+  })
+  output$histo <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    p <- plot_bar(
+      physeq = data16S(),
+      fill = input$barFill,
+      x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX)
+    )
+    if (!is.null(checkNull(input$barGrid))) {
+      p <-
+        p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
+    }
+    return(p)
+  })
+  output$histFocusUIfocusRank <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    radioButtons(
+      "focusRank",
+      label = "Niveau taxo :",
+      choices = list(
+        "Kingdom" = 1,
+        "Phylum" = 2,
+        "Class" = 3,
+        "Order" = 4,
+        "Family" = 5,
+        "Genus" = 6
+      ),
+      inline = TRUE,
+      selected = 1
+    )
+  })
+  output$histFocusUIfocusTaxa <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    selectInput(
+      "focusTaxa",
+      label = "Taxa :",
+      choices = unique(as.matrix(as.data.frame(
+        tax_table(data16S())
+      )[, as.integer(input$focusRank)])),
+      selected = TRUE
+    )
+  })
+  output$histFocusUIfocusNbTaxa <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    sliderInput(
+      "focusNbTaxa",
+      label = "Nombre de sous-taxons :",
+      min = 0,
+      #max = sum(tax_table(tax_glom(data16S(), rank_names(data16S())[1+as.integer(input$focusRank)]))[, as.integer(input$focusRank)]==input$focusTaxa)
+      max = 30
+      ,
+      value = 10
+    )
+  })
+  output$histFocusUIfocusGrid <- renderUI({
+    if (is.null(input$fileBiom) && is.null(input$fileMeta))
+      return()
+    selectInput(
+      "focusGrid",
+      label = "Regroupement :",
+       choices = c("..." = 0, sample_variables(data16S()))
+    )
+  })
+  output$histFocusUIfocusX <- renderUI({
+    if (is.null(input$fileBiom) && is.null(input$fileMeta))
+      return()
+    selectInput("focusX",
+                label = "X :",
+                 choices = c("..." = 0, sample_variables(data16S())))
+  })
+  output$histoFocus <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    p <- plot_composition(
+      physeq = data16S(),
+      taxaRank1 = rank_names(data16S())[as.integer(input$focusRank)],
+      taxaSet1 = input$focusTaxa,
+      taxaRank2 = rank_names(data16S())[as.integer(input$focusRank) + 1],
+      numberOfTaxa = input$focusNbTaxa,
+      fill = rank_names(data16S())[as.integer(input$focusRank) + 1],
+      x = ifelse(is.null(checkNull(input$focusX)), "Sample", input$focusX)
+    )
+    if (!is.null(checkNull(input$focusGrid))) {
+      p <-
+        p + facet_grid(paste(".", "~", input$focusGrid), scales = "free_x")
+    }
+    return(p)
+  })
+  output$clustUI <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    box(
+      title = "Paramètres",
+      width = NULL,
+      status = "primary",
+      selectInput(
+        "clustDist",
+        label = "Distance :",
+        choices = list(
+          "bray",
+          "jaccard",
+          "unifrac",
+          "wunifrac",
+          "dpcoa",
+          "jsd",
+          "euclidean"
+        )
+      ),
+      selectInput(
+        "clustMethod",
+        label = "Methode :",
+        choices = list(
+          "ward.D2",
+          "ward.D",
+          "single",
+          "complete",
+          "average",
+          "mcquitty",
+          "median",
+          "centroid"
+        )
+      ),
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "clustCol",
+          label = "Couleur :",
+           choices = c("..." = 0, sample_variables(data16S()))
+        )
+      }
+    )
+  })
+  output$clust <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    plot_clust(
+      physeq = data16S(),
+      dist = input$clustDist,
+      method = input$clustMethod,
+      color = checkNull(input$clustCol)
+    )
+  })
+  output$richnessAUI <- renderUI({
+    if (is.null(input$fileBiom)) {
+      return()
+    }
+    box(
+      title = "Paramètres",
+      width = NULL,
+      status = "primary",
+      checkboxGroupInput(
+        "richnessMeasures",
+        label = "Mesures :",
+        choices = c(
+          "Observed",
+          "Chao1",
+          "ACE",
+          "Shannon",
+          "Simpson",
+          "InvSimpson",
+          "Fisher"
+        ),
+        selected = c(
+          "Observed",
+          "Chao1",
+          "ACE",
+          "Shannon",
+          "Simpson",
+          "InvSimpson",
+          "Fisher"
+        ),
+        inline = TRUE
+      ),
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "richnessX",
+          label = "X :",
+           choices = c("..." = 0, sample_variables(data16S()))
+        )
+      },
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "richnessColor",
+          label = "Couleur :",
+           choices = c("..." = 0, sample_variables(data16S()))
+        )
+      },
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "richnessShape",
+          label = "Forme :",
+           choices = c("..." = 0, sample_variables(data16S()))
+        )
+      },
+      radioButtons(
+        "richnessBoxplot",
+        label = "Representation :",
+        choices = list(
+          "Points seuls" = 1,
+          "Boxplot et points" = 2,
+          "Boxplot seul" = 3
+        ),
+        selected = 2,
+        inline = TRUE
+      )
+    )
+  })
+  output$richnessA <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    p <- plot_richness(
+      physeq = data16S(),
+      x = ifelse(is.null(checkNull(
+        input$richnessX
+      )), "samples", input$richnessX),
+      color = checkNull(input$richnessColor),
+      shape = checkNull(input$richnessShape),
+      measures = checkNull(input$richnessMeasures)
+    )
+    if (input$richnessBoxplot >= 2) {
+      p <- p + geom_boxplot()
+    }
+    if (input$richnessBoxplot <= 2) {
+      p <- p + geom_point()
+    }
+    return(p)
+  })
+  output$richnessATable <- renderUI({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    p(beautifulTable(data.frame(
+      SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
+    )))
+  })
+  output$richnessBUI <- renderUI({
+    if (is.null(input$fileMeta)) {
+      return()
+    }
+    box(
+      title = "Paramètres",
+      width = NULL,
+      status = "primary",
+      selectInput(
+        "richnessOrder",
+        label = "Ordre de tri des echantillons :",
+         choices = c("..." = 0, sample_variables(data16S()))
+      )
+    )
+  })
+  output$richnessB <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    beta <-
+      melt(as(distance(data16S(), method = input$richnessBDist), "matrix"))
+    colnames(beta) <- c("x", "y", "distance")
+    if (!is.null(checkNull(input$richnessOrder)))
+    {
+      new_factor = as.factor(get_variable(data16S(), input$richnessOrder))
+      variable_sort <-
+        as.factor(get_variable(data16S(), input$richnessOrder)[order(new_factor)])
+      L = levels(reorder(sample_names(data16S()), as.numeric(new_factor)))
+      beta$x <- factor(beta$x, levels = L)
+      beta$y <- factor(beta$y, levels = L)
+      palette <- hue_pal()(length(levels(new_factor)))
+      tipColor <-
+        col_factor(palette, levels = levels(new_factor))(variable_sort)
+    }
+    p <-
+      ggplot(beta, aes(x = x, y = y, fill = distance)) + geom_tile()
+    p <- p + theme(
+      axis.text.x = element_text(
+        angle = 90,
+        hjust = 1,
+        color = checkNull(tipColor)
+      ),
+      axis.text.y = element_text(color = checkNull(tipColor)),
+      axis.title.x = element_blank(),
+      axis.title.y = element_blank()
+    )
+    return(p + scale_fill_gradient2())
+  })
+  output$networkBUI <- renderUI({
+    if (is.null(input$fileBiom)) {
+      return()
+    }
+    box(
+      title = "Paramètres",
+      width = NULL,
+      status = "primary",
+      sliderInput(
+        "netwMax",
+        label = "Cutoff :",
+        min = 0,
+        max = 1,
+        value = 0.7
+      ),
+      checkboxInput("netwOrphan",
+                    label = "Garder les points orphelins",
+                    value = TRUE),
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "netwCol",
+          label = "Couleur :",
+           choices = c("..." = 0, sample_variables(data16S()))
+        )
+      },
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "netwShape",
+          label = "Forme :",
+           choices = c("..." = 0, sample_variables(data16S()))
+        )
+      },
+      if (!is.null(input$fileMeta)) {
+        selectInput(
+          "netwLabel",
+          label = "Label :",
+          choices = c(
+            select = "",
+            "Sample name" = "value",
+            sample_variables(data16S())
+          )
+        )
+      }
+    )
+  })
+  output$networkB <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    g <- make_network(
+      data16S(),
+      distance = input$richnessBDist,
+      max.dist = input$netwMax,
+      keep.isolates = input$netwOrphan
+    )
+    p <- plot_network(
+      g,
+      physeq = data16S(),
+      color = checkNull(input$netwCol),
+      shape = checkNull(input$netwShape),
+      label = checkNull(input$netwLabel),
+      hjust = 2,
+      title = NULL
+    )
+    return(p)
+  })
+  output$richnessBTable <- renderUI({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    p(beautifulTable(data.frame(
+      SAMPLE = sample_names(data16S()), round(as.matrix(
+        distance(data16S(), method = input$richnessBDist)
+      ), digits = 2)
+    )))
+  })
+  output$rarefactionCurve <- renderPlot({
+    validate(need(
+      !is.null(input$fileBiom),
+      "Merci d'importer un fichier d'abondance"
+    ))
+    p <- ggrare(
+      physeq = data16S(),
+      step = input$rarefactionStep,
+      color = checkNull(input$rarefactionColor),
+      se = FALSE
+    )
+    if (!is.null(checkNull(input$rarefactionGrid))) {
+      p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
+    }
+    if (!input$rareData)
+    {
+      if (input$rarefactionMin) {
+        p <-
+          p + geom_vline(xintercept = min(sample_sums(data16S())),
+                         color = "gray60")
+      }
+    }
+    return(p)
+  })
+  output$rarefactionCurveUI <- renderUI({
+    if (is.null(input$fileBiom))
+      return()
+    box(
+      title = "Paramètres",
+      width = NULL,
+      status = "primary",
+      sliderInput(
+        "rarefactionStep",
+        label = "Etapes de calcul :",
+        min = 1,