library(shinydashboard)
library(dplyr)
library(glue)

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"
    )
  }
  
  collapsedBox <- function(data, title = title)  {
    box(
      title = title,
      width = NULL,
      status = "primary",
      collapsible = TRUE,
      collapsed = TRUE,
      data
    )
  }
  
  source({
    "https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R"
  })
  
  source("internals.R")
  
  data16S <- reactive({
    ## BIOM input
    if (input$dataset == "input")
    {
      ## Unhappy path
      if (is.null(input$fileBiom))
        return()
      
      ## Happy path
      ## Import biom
      d <- .import_biom(input)
      
      ## Format tax table
      tax_table(d) <- .format_tax_table(tax_table(d))
      
      ## import metadata and store it in phyloseq object
      sample_data(d) <- .import_sample_data(input, d)
      
      ## Rarefy data
      if (input$rareData) {
        d <- rarefy_even_depth(
          d,
          replace = FALSE,
          rngseed = as.integer(Sys.time()),
          verbose = FALSE
        )
      }
      return(d)
    }
    
    ## Rdata input
    if (input$dataset == "rdata")
    {
      ## .import_from_rdata(input) ## does not work as a function for some reason
      
      ## Happy path
      ne <-
        new.env() ## new env to store RData content and avoid border effects
      if (!is.null(input$fileRData))
        load(input$fileRData$datapath, envir = ne)
      if (class(ne$data) == "phyloseq")
        return(ne$data)
      
      ## Unhappy paths: everything else
      return()
    }
    
    ## Default case
    load("demo/demo.RData")
    return(get(input$dataset))
    
  })
  
  data <- reactiveValues()
  {
    observe({
      if (!is.null(data16S()))
        isolate(data <<- data16S())
    })
  }
  
  scriptHead <- c(
    "# Loading packages",
    "source(\"https://raw.githubusercontent.com/mahendra-mariadassou/phyloseq-extended/master/R/load-extra-functions.R\")",
    "",
    "# Loading data",
    glue(
      "load(\"Easy16S-data.{Sys.Date()}.RData\") # if necessary, adapt the file path"
    ),
    "",
    "# View data",
    "data",
    ""
  )
  
  output$downloadData <- {
    downloadHandler(
      filename = function() {
        paste("Easy16S-data", Sys.Date(), "RData", sep = ".")
      },
      content = function(file) {
        save(data, file = file)
      }
    )
  }
  
  output$downloadUI <- renderUI({
    validate(need(data16S(), ""))
    tags$div(
      style = "text-align:center",
      title = "Download as RData",
      downloadButton("downloadData", "Download", style = "color: black; background-color: gray90")
    )
  })
  
  output$rarefactionMin <- renderText({
    validate(need(input$fileBiom, ""),
             need(input$dataset == "input", ""))
    paste("(min sample =", format(min(sample_sums(data16S(
      
    ))), big.mark = " "), "reads)")
  })
  
  output$phyloseqPrint <- renderPrint({
    validate(
      need(
        data16S(),
        "Firstly, you should select a demo dataset or upload an abundance BIOM file.\nFor example, with Galaxy, a BIOM file can be obtained at the end of FROGS workflow with the 'FROGS BIOM to std BIOM' tool. \nMake sure that the phyloseq object in the RData file is called 'data'."
      )
    )
    data16S()
  })
  
  output$sampledataTable <- renderUI({
    validate(need(sample_data(data16S(), errorIfNULL = FALSE), ""))
    collapsedBox(renderTable({
      (sapply(sample_data(data16S()), class))
    }, rownames = TRUE, colnames = FALSE),
    title = "Class of sample_data")
  })
  
  output$summaryTable <- renderUI({
    validate(need(data16S(), ""))
    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()))
                 )),
        tabPanel("sample_data",
                 #as.data.frame(sapply(sample_data(data16S()), class)),
                 beautifulTable(
                   data.frame(SAMPLE = sample_names(data16S()), sample_data(data16S()))
                 )),
        tabPanel(
          "agglomerate_taxa",
          radioButtons(
            "glomRank",
            label = "Taxonomic rank : ",
            choices = rank_names(data16S()),
            inline = TRUE
          ),
          DT::dataTableOutput("tableGlom")
        )
      )
    )
  })
  
  output$tableGlom <- DT::renderDataTable(server = FALSE, {
    Glom <- tax_glom(data16S(), input$glomRank, NArm=FALSE)
    taxTableGlom <- Glom %>%
      tax_table() %>%
      as.data.frame(stringsAsFactors = FALSE) %>%
      dplyr::select(input$glomRank:1) %>%
      tibble::rownames_to_column()
    otuTableGlom <- Glom %>%
      otu_table() %>%
      as.data.frame(stringsAsFactors = FALSE) %>%
      tibble::rownames_to_column()
    joinGlom <-
      dplyr::left_join(taxTableGlom, otuTableGlom, by = "rowname") %>%
      dplyr::select(-rowname)
    beautifulTable(joinGlom)
  })
  
  output$histUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : ",
      width = NULL,
      status = "primary",
      radioButtons(
        "barFill",
        label = "Taxonomic rank : ",
        choices = rank_names(data16S()),
        inline = TRUE
      ),
      textInput("barTitle",
                label = "Title : ",
                value = "OTU abundance barplot"),
      selectInput(
        "barGrid",
        label = "Subplot : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "barX",
        label = "X : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      collapsedBox(verbatimTextOutput("histScript"), title = "RCode")
    )
  })
  
  output$histScript <- renderText({
    scriptArgs <- c("physeq = data",
                    glue("fill = \"{input$barFill}\""))
    if (!is.null(checkNull(input$barX))) {
      scriptArgs <- c(scriptArgs, glue("x = \"{input$barX}\""))
    }
    if (!is.null(checkNull(input$barTitle))) {
      scriptArgs <- c(scriptArgs, glue("title = \"{input$barTitle}\""))
    }
    script <- c(
      scriptHead,
      "# Plot barplot",
      glue("p <- plot_bar({glue_collapse(scriptArgs, sep=', ')})")
    )
    if (!is.null(checkNull(input$barGrid))) {
      script <- c(script,
                  glue(
                    "p <- p + facet_grid(\". ~ {input$barGrid}\", scales = \"free_x\")"
                  ))
    }
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$histo <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    p <- plot_bar(
      physeq = data16S(),
      fill = input$barFill,
      x = ifelse(is.null(checkNull(input$barX)), "Sample", input$barX),
      title = checkNull(input$barTitle)
    )
    if (!is.null(checkNull(input$barGrid))) {
      p <-
        p + facet_grid(paste(".", "~", input$barGrid), scales = "free_x")
    }
    return(p)
  })
  
  output$histFocusUIfocusRank <- renderUI({
    validate(need(data16S(), ""))
    radioButtons(
      "focusRank",
      label = "Taxonomic rank : ",
      choices = rank_names(data16S())[-length(rank_names(data16S()))],
      inline = TRUE
    )
  })
  
  output$histFocusUIfocusTaxa <- renderUI({
    validate(need(data16S(), ""),
             need(input$focusRank, ""))
    selectInput(
      "focusTaxa",
      label = "Selected taxa : ",
      choices = unique(as.vector(tax_table(data16S(
        
      ))[, input$focusRank])),
      selected = TRUE
    )
  })
  
  output$histFocusUIfocusNbTaxa <- renderUI({
    validate(need(data16S(), ""))
    sliderInput(
      "focusNbTaxa",
      label = "Number of sub-taxa : ",
      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({
    validate(need(data16S(), ""))
    selectInput("focusGrid",
                label = "Subplot : ",
                choices = c("..." = 0, sample_variables(data16S())))
  })
  
  output$histFocusUIfocusX <- renderUI({
    validate(need(data16S(), ""))
    selectInput("focusX",
                label = "X : ",
                choices = c("..." = 0, sample_variables(data16S())))
  })
  
  output$histFocusUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : ",
      width = NULL,
      status = "primary",
      uiOutput("histFocusUIfocusRank"),
      uiOutput("histFocusUIfocusTaxa"),
      uiOutput("histFocusUIfocusNbTaxa"),
      uiOutput("histFocusUIfocusGrid"),
      uiOutput("histFocusUIfocusX"),
      collapsedBox(verbatimTextOutput("histFocusScript"), title = "RCode")
    )
  })
  
  output$histFocusScript <- renderText({
    scriptArgs <- c(
      "physeq = data",
      glue("taxaRank1 = \"{input$focusRank}\""),
      glue("taxaSet1 = \"{input$focusTaxa}\""),
      glue(
        "taxaRank2 = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
      ),
      glue("numberOfTaxa = {input$focusNbTaxa}"),
      glue(
        "fill = \"{rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1]}\""
      )
    )
    if (!is.null(checkNull(input$focusX))) {
      scriptArgs <- c(scriptArgs, glue("x = \"{input$focusX}\""))
    }
    script <- c(
      scriptHead,
      "# Plot filtered barplot",
      glue(
        "p <- plot_composition({glue_collapse(scriptArgs, sep=', ')})"
      )
    )
    if (!is.null(checkNull(input$focusGrid))) {
      script <- c(
        script,
        glue(
          "p <- p + facet_grid(\". ~ {input$focusGrid}\", scales = \"free_x\")"
        )
      )
    }
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$histFocus <- renderPlot({
    validate(
      need(data16S(),
           "Requires an abundance dataset"),
      need(input$focusRank, ""),
      need(input$focusTaxa, "")
    )
    p <- plot_composition(
      physeq = data16S(),
      taxaRank1 = input$focusRank,
      taxaSet1 = input$focusTaxa,
      taxaRank2 = rank_names(data16S())[which(rank_names(data16S()) == input$focusRank) + 1],
      numberOfTaxa = input$focusNbTaxa,
      fill = rank_names(data16S())[which(rank_names(data16S()) == 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({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      selectInput(
        "clustDist",
        label = "Distance : ",
        choices = list(
          "bray",
          "jaccard",
          "unifrac",
          "wunifrac",
          "dpcoa",
          "jsd",
          "euclidean"
        )
      ),
      selectInput(
        "clustMethod",
        label = "Method : ",
        choices = list(
          "ward.D2",
          "ward.D",
          "single",
          "complete",
          "average",
          "mcquitty",
          "median",
          "centroid"
        )
      ),
      selectInput(
        "clustCol",
        label = "Color : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      collapsedBox(verbatimTextOutput("clustScript"), title = "RCode")
    )
  })
  
  output$clustScript <- renderText({
    scriptArgs <- c(
      "physeq = data",
      glue("dist = \"{input$clustDist}\""),
      glue("method = \"{input$clustMethod}\"")
    )
    if (!is.null(checkNull(input$clustCol))) {
      scriptArgs <- c(scriptArgs, glue("color = \"{input$clustCol}\""))
    }
    script <- c(
      scriptHead,
      "# Plot samples clustering",
      glue("p <- plot_clust({glue_collapse(scriptArgs, sep=', ')})")
    )
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$clust <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    plot_clust(
      physeq = data16S(),
      dist = input$clustDist,
      method = input$clustMethod,
      color = checkNull(input$clustCol)
    )
  })
  
  output$richnessAUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      checkboxGroupInput(
        "richnessMeasures",
        label = "Measures : ",
        choices = c(
          "Observed",
          "Chao1",
          "ACE",
          "Shannon",
          "Simpson",
          "InvSimpson",
          "Fisher"
        ),
        selected = c(
          "Observed",
          "Chao1",
          "ACE",
          "Shannon",
          "Simpson",
          "InvSimpson",
          "Fisher"
        ),
        inline = TRUE
      ),
      radioButtons(
        "richnessBoxplot",
        label = "Representation : ",
        choices = list(
          "Dots only" = 1,
          "Dots and boxplot" = 2,
          "Boxplot only" = 3
        ),
        selected = 2,
        inline = TRUE
      ),
      textInput("richnessTitle",
                label = "Title : ",
                value = "Alpha diversity graphics"),
      selectInput(
        "richnessX",
        label = "X : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "richnessColor",
        label = "Color : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "richnessShape",
        label = "Shape : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      collapsedBox(verbatimTextOutput("richnessAScript"), title = "RCode")
    )
  })
  
  output$richnessAScript <- renderText({
    if (!is.null(checkNull(input$richnessMeasures))) {
      measures <-
        glue("measures = c(\"{glue_collapse(input$richnessMeasures, sep='\", \"')}\")")
    } else {
      measures <- NULL
    }
    scriptArgs <- c("physeq = data", measures)
    if (!is.null(checkNull(input$richnessX))) {
      scriptArgs <- c(scriptArgs, glue("x = \"{input$richnessX}\""))
    }
    if (!is.null(checkNull(input$richnessColor))) {
      scriptArgs <-
        c(scriptArgs, glue("color = \"{input$richnessColor}\""))
    }
    if (!is.null(checkNull(input$richnessShape))) {
      scriptArgs <-
        c(scriptArgs, glue("shape = \"{input$richnessShape}\""))
    }
    if (!is.null(checkNull(input$richnessTitle))) {
      scriptArgs <-
        c(scriptArgs, glue("title = \"{input$richnessTitle}\""))
    }
    
    script <- c(
      scriptHead,
      "# Plot boxplot of alpha diversity",
      glue(
        "p <- plot_richness({glue_collapse(scriptArgs, sep=', ')})"
      )
    )
    if (input$richnessBoxplot >= 2) {
      script <- c(script,
                  "p <- p + geom_boxplot()")
    }
    if (input$richnessBoxplot <= 2) {
      script <- c(script,
                  "p <- p + geom_point()")
    }
    script <- c(script, "", "plot(p)")
    script <- c(script, "", "# Tables")
    script <- c(
      script,
      glue(
        "t <- estimate_richness({glue_collapse(c(\"data\", measures), sep=', ')})"
      ),
      "write.table(t, file = \"richness.tsv\", sep = \"\\t\", col.names = NA)"
    )
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$richnessA <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    p <- plot_richness(
      physeq = data16S(),
      x = ifelse(is.null(checkNull(
        input$richnessX
      )), "samples", input$richnessX),
      color = checkNull(input$richnessColor),
      shape = checkNull(input$richnessShape),
      title = checkNull(input$richnessTitle),
      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(data16S(),
                  "Requires an abundance dataset"))
    p(beautifulTable(data.frame(
      SAMPLE = sample_names(data16S()), round(estimate_richness(data16S()), digits = 2)
    )))
  })
  
  output$richnessBUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      selectInput(
        "richnessBOrder",
        label = "Sorting sample : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      textInput("richnessBTitle",
                label = "Title : ",
                value = "Beta diversity heatmap"),
      collapsedBox(verbatimTextOutput("richnessBScript"), title = "RCode")
    )
  })
  
  output$richnessBScript <- renderText({
    script <- c(
      scriptHead,
      "# Plot heatmap of beta diversity",
      glue(
        "beta <- melt(as(distance(data, method = \"{input$richnessBDist}\"), \"matrix\"))"
      ),
      "colnames(beta) <- c(\"x\", \"y\", \"distance\")"
    )
    if (!is.null(checkNull(input$richnessBOrder))) {
      script <- c(
        script,
        glue(
          "new_factor = as.factor(get_variable(data, \"{input$richnessBOrder}\"))"
        ),
        glue(
          "variable_sort <- as.factor(get_variable(data, \"{input$richnessBOrder}\")[order(new_factor)])"
        ),
        "L = levels(reorder(sample_names(data), 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)"
      )
    } else {
      script <- c(script, "tipColor <- NULL")
    }
    script <-
      c(
        script,
        "",
        "p1 <- ggplot(beta, aes(x = x, y = y, fill = distance))",
        "p1 <- p1 + geom_tile()"
      )
    if (!is.null(checkNull(input$richnessBTitle))) {
      script <- c(script,
                  glue("p1 <- p1 + ggtitle(\"{input$richnessBTitle}\")"))
    }
    script <- c(
      script,
      glue(
        "p1 <- p1 + theme(axis.text.x = element_text(angle = 90, hjust = 1, color = tipColor), axis.text.y = element_text(color = tipColor), axis.title.x = element_blank(), axis.title.y = element_blank())"
      )
    )
    script <- c(script, "", "plot(p1 + scale_fill_gradient2())")
    script <- c(script, "", "# Tables")
    script <- c(
      script,
      glue("t <- distance(data, method = \"{input$richnessBDist}\")"),
      "write.table(t, file = \"distance.tsv\", sep = \"\\t\", col.names = NA)"
    )
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$richnessB <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    beta <-
      melt(as(distance(data16S(), method = input$richnessBDist), "matrix"))
    colnames(beta) <- c("x", "y", "distance")
    if (!is.null(checkNull(input$richnessBOrder)))
    {
      new_factor = as.factor(get_variable(data16S(), input$richnessBOrder))
      variable_sort <-
        as.factor(get_variable(data16S(), input$richnessBOrder)[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 + ggtitle(input$richnessBTitle) + 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({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      sliderInput(
        "netwMax",
        label = "Threshold : ",
        min = 0,
        max = 1,
        value = 0.7
      ),
      checkboxInput("netwOrphan",
                    label = "Keep orphans",
                    value = TRUE),
      textInput("netwTitle",
                label = "Title : ",
                value = "Beta diversity network"),
      selectInput(
        "netwCol",
        label = "Color : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "netwShape",
        label = "Shape : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "netwLabel",
        label = "Label : ",
        choices = c(
          "..." = 0,
          "Sample name" = "value",
          sample_variables(data16S())
        )
      ),
      collapsedBox(verbatimTextOutput("networkBScript"), title = "RCode")
    )
  })
  
  output$networkBScript <- renderText({
    scriptArgs <- c("g",
                    "physeq = data",
                    "hjust = 2")
    if (!is.null(checkNull(input$netwCol))) {
      scriptArgs <- c(scriptArgs, glue("color = \"{input$netwCol}\""))
    }
    if (!is.null(checkNull(input$netwShape))) {
      scriptArgs <- c(scriptArgs, glue("shape = \"{input$netwShape}\""))
    }
    if (!is.null(checkNull(input$netwLabel))) {
      scriptArgs <- c(scriptArgs, glue("label = \"{input$netwLabel}\""))
    }
    if (!is.null(checkNull(input$netwTitle))) {
      scriptArgs <- c(scriptArgs, glue("title = \"{input$netwTitle}\""))
    }
    script <- c(
      scriptHead,
      "# Plot samples network",
      glue(
        "g <- make_network(data, distance = \"{input$richnessBDist}\", max.dist = {input$netwMax}, keep.isolates = {input$netwOrphan})"
      ),
      glue("p <- plot_network({glue_collapse(scriptArgs, sep=', ')})")
    )
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$networkB <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    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 = checkNull(input$netwTitle)
    )
    return(p)
  })
  
  output$richnessBTable <- renderUI({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    p(beautifulTable(data.frame(
      SAMPLE = sample_names(data16S()), round(as.matrix(
        distance(data16S(), method = input$richnessBDist)
      ), digits = 2)
    )))
  })
  
  output$rarefactionCurve <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    p <- ggrare(
      physeq = data16S(),
      step = 100,
      #step = input$rarefactionStep,
      color = checkNull(input$rarefactionColor),
      label = checkNull(input$rarefactionLabel),
      se = FALSE
    )
    if (!is.null(checkNull(input$rarefactionGrid))) {
      p <- p + facet_grid(paste(".", "~", input$rarefactionGrid))
    }
    
    if (input$rarefactionMin) {
      p <-
        p + geom_vline(xintercept = min(sample_sums(data16S())),
                       color = "gray60")
    }
    return(p + ggtitle(input$rarefactionTitle))
  })
  
  output$rarefactionCurveUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      # sliderInput(
      #   "rarefactionStep",
      #   label = "Etapes de calcul : ",
      #   min = 1,
      #   max = 1000,
      #   value = 100
      # ),
      checkboxInput("rarefactionMin", label = "Show min sample threshold", value = FALSE),
      textInput("rarefactionTitle",
                label = "Title : ",
                value = "Rarefaction curves"),
      selectInput(
        "rarefactionColor",
        label = "Color : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "rarefactionLabel",
        label = "Label : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "rarefactionGrid",
        label = "Subplot : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      collapsedBox(verbatimTextOutput("rarefactionCurveScript"), title = "RCode")
    )
  })
  
  output$rarefactionCurveScript <- renderText({
    scriptArgs <- c("physeq = data",
                    "step = 100",
                    "se = FALSE")
    if (!is.null(checkNull(input$rarefactionColor))) {
      scriptArgs <-
        c(scriptArgs,
          glue("color = \"{input$rarefactionColor}\""))
    }
    if (!is.null(checkNull(input$rarefactionLabel))) {
      scriptArgs <-
        c(scriptArgs,
          glue("label = \"{input$rarefactionLabel}\""))
    }
    script <- c(
      scriptHead,
      "# Plot rarefaction curves",
      glue("p <- ggrare({glue_collapse(scriptArgs, sep=', ')})")
    )
    if (!is.null(checkNull(input$rarefactionGrid))) {
      script <- c(script,
                  glue("p <- p + facet_grid(\". ~ {input$rarefactionGrid}\")"))
    }
    if (input$rarefactionMin) {
      script = c(
        script,
        "p <- p + geom_vline(xintercept = min(sample_sums(data)), color = \"gray60\")"
      )
    }
    if (!is.null(checkNull(input$rarefactionTitle))) {
      script <- c(script,
                  glue("p <- p + ggtitle({input$rarefactionTitle})"))
    }
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$HeatmapUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      textInput("heatmapTitle",
                label = "Title : ",
                value = "Taxa heatmap by samples"),
      selectInput(
        "heatmapGrid",
        label = "Subplot : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "heatmapX",
        label = "X : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      sliderInput(
        "heatmapTopOtu",
        label = "Show the n most abundant OTU : ",
        min = 1,
        max = ntaxa(data16S()),
        value = 250
      ),
      selectInput(
        "heatmapDist",
        label = "Distance : ",
        selected = "bray",
        choices = list(
          "bray",
          "jaccard",
          "unifrac",
          "wunifrac",
          "dpcoa",
          "jsd",
          "euclidean"
        )
      ),
      selectInput(
        "heatmapMethod",
        label = "Method : ",
        selected = "NMDS",
        choices = list(
          "NMDS",
          "ward.D2",
          "ward.D",
          "single",
          "complete",
          "average",
          "mcquitty",
          "median",
          "centroid"
        )
      ),
      collapsedBox(verbatimTextOutput("heatmapScript"), title = "RCode")
    )
  })
  
  output$heatmapScript <- renderText({
    scriptArgs <-
      c(
        glue(
          "prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$heatmapTopOtu}]), data)"
        ),
        glue("distance = \"{input$heatmapDist}\""),
        glue("method = \"{input$heatmapMethod}\""),
        "low = \"yellow\"",
        "high = \"red\"",
        "na.value = \"white\""
      )
    if (!is.null(checkNull(input$heatmapX))) {
      scriptArgs <-
        c(scriptArgs, glue("sample.order = \"{input$heatmapX}\""))
    }
    if (!is.null(checkNull(input$heatmapTitle))) {
      scriptArgs <-
        c(scriptArgs, glue("title = \"{input$heatmapTitle}\""))
    }
    
    script <- c(
      scriptHead,
      "# Plot heatmap",
      glue("p <- plot_heatmap({glue_collapse(scriptArgs, sep=', ')})")
    )
    if (!is.null(checkNull(input$heatmapGrid))) {
      script <- c(
        script,
        glue(
          "p <- p + facet_grid(\". ~ {input$heatmapGrid}\", scales = \"free_x\")"
        )
      )
    }
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$Heatmap <- renderPlot({
    validate(need(data16S(),
                  "Requires an abundance dataset"))
    p <- plot_heatmap(
      physeq = prune_taxa(names(sort(
        taxa_sums(data16S()), decreasing = TRUE
      )[1:input$heatmapTopOtu]), data16S()),
      distance = input$heatmapDist,
      method = input$heatmapMethod,
      title = checkNull(input$heatmapTitle),
      sample.order = checkNull(input$heatmapX),
      low = "yellow",
      high = "red",
      na.value = "white"
    )
    if (!is.null(checkNull(input$heatmapGrid))) {
      p <-
        p + facet_grid(paste(".", "~", input$heatmapGrid), scales = "free_x")
    }
    return(p)
  })
  
  output$treeUI <- renderUI({
    validate(need(phy_tree(data16S(), errorIfNULL = FALSE), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      radioButtons(
        "treeRank",
        label = "Taxonomic rank captioned : ",
        choices = c(aucun = "",
                    rank_names(data16S()),
                    OTU = "taxa_names"),
        inline = TRUE
      ),
      sliderInput(
        "treeTopOtu",
        label = "Show the n most abundant OTU : ",
        min = 1,
        max = ntaxa(data16S()),
        value = 20
      ),
      checkboxInput("treeRadial", label = "Radial tree", value = FALSE),
      checkboxInput("treeSample", label = "Show samples", value = TRUE),
      textInput("treeTitle",
                label = "Title : ",
                value = "Phylogenetic tree"),
      selectInput(
        "treeCol",
        label = "Color : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "treeShape",
        label = "Shape : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      collapsedBox(verbatimTextOutput("treeScript"), title = "RCode")
    )
  })
  
  output$treeScript <- renderText({
    scriptArgs <- c(
      glue(
        "physeq = prune_taxa(names(sort(taxa_sums(data), decreasing = TRUE)[1:{input$treeTopOtu}]), data)"
      )
    )
    if (input$treeSample) {
      scriptArgs <- c(scriptArgs, "method = \"sampledodge\"")
    } else {
      scriptArgs <- c(scriptArgs, "method = \"treeonly\"")
    }
    if (!is.null(checkNull(input$treeCol))) {
      scriptArgs <- c(scriptArgs, glue("color = \"{input$treeCol}\""))
    }
    if (!is.null(checkNull(input$treeShape))) {
      scriptArgs <- c(scriptArgs, glue("shape = \"{input$treeShape}\""))
    }
    scriptArgs <- c(scriptArgs, "size = \"abundance\"")
    if (!is.null(checkNull(input$treeRank))) {
      scriptArgs <-
        c(scriptArgs, glue("label.tips = \"{input$treeRank}\""))
    }
    scriptArgs <- c(scriptArgs,
                    "sizebase = 5",
                    "ladderize = \"left\"",
                    "plot.margin = 0")
    if (!is.null(checkNull(input$treeTitle))) {
      scriptArgs <- c(scriptArgs, glue("title = \"{input$treeTitle}\""))
    }
    script <- c(
      scriptHead,
      "# Plot phylogenetic tree",
      glue("p <- plot_tree({glue_collapse(scriptArgs, sep=', ')})")
    )
    if (input$treeRadial) {
      script <- c(script,
                  "p <- p + coord_polar(theta = \"y\")")
    }
    script <- c(script, "", "plot(p)")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$tree <- renderPlot({
    validate(
      need(data16S(), "Requires an abundance dataset"),
      need(
        phy_tree(data16S(), errorIfNULL = FALSE),
        "Requires a phylogenetic tree"
      )
    )
    p <- plot_tree(
      physeq = prune_taxa(names(sort(
        taxa_sums(data16S()), decreasing = TRUE
      )[1:input$treeTopOtu]), data16S()),
      method = ifelse(input$treeSample, "sampledodge", "treeonly"),
      color = checkNull(input$treeCol),
      shape = checkNull(input$treeShape),
      size = "abundance",
      label.tips = checkNull(input$treeRank),
      sizebase = 5,
      ladderize = "left",
      plot.margin = 0,
      title = checkNull(input$treeTitle)
    )
    if (checkNull(input$treeRadial)) {
      return(p + coord_polar(theta = "y"))
    } else {
      return(p)
    }
  })
  
  output$acpUI <- renderUI({
    validate(need(data16S(), ""))
    box(
      title = "Setting : " ,
      width = NULL,
      status = "primary",
      checkboxGroupInput(
        "acpAxes",
        label = "Axes : ",
        choices = seq(10),
        selected = c(1, 2),
        inline = TRUE
      ),
      selectInput(
        "acpDist",
        label = "Distance : ",
        selected = "bray",
        choices = list(
          "bray",
          "jaccard",
          "unifrac",
          "wunifrac",
          "dpcoa",
          "jsd",
          "euclidean"
        )
      ),
      selectInput(
        "acpMethod",
        label = "Method : ",
        selected = "MDS",
        choices = list("DCA", "CCA", "RDA", "CAP", "DPCoA", "NMDS", "MDS", "PCoA")
      ),
      textInput("acpTitle",
                label = "Title : ",
                value = "Samples ordination graphic"),
      selectInput(
        "acpLabel",
        label = "Label : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpCol",
        label = "Color : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpShape",
        label = "Shape : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpEllipse",
        label = "Ellipses : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      selectInput(
        "acpRep",
        label = "Barycenters : ",
        choices = c("..." = 0, sample_variables(data16S()))
      ),
      collapsedBox(verbatimTextOutput("acpScript"), title = "RCode")
    )
  })
  
  output$acpScript <- renderText({
    scriptArgs <- c(
      "physeq = data",
      glue(
        "ordination = ordinate(data, method = \"{input$acpMethod}\", distance = \"{input$acpDist}\")"
      ),
      glue("axes = c({glue_collapse(input$acpAxes, sep = ', ')})")
    )
    if (!is.null(checkNull(input$acpCol))) {
      scriptArgs <- c(scriptArgs, glue("color = \"{input$acpCol}\""))
    }
    if (!is.null(checkNull(input$acpShape))) {
      scriptArgs <- c(scriptArgs, glue("shape = \"{input$acpShape}\""))
    }
    if (!is.null(checkNull(input$acpRep))) {
      scriptArgs <- c(scriptArgs, glue("replicate = \"{input$acpRep}\""))
    } else {
      scriptArgs <- c(scriptArgs, glue("replicate = NULL"))
    }
    if (!is.null(checkNull(input$acpLabel))) {
      scriptArgs <- c(scriptArgs, glue("label = \"{input$acpLabel}\""))
    }
    if (!is.null(checkNull(input$acpTitle))) {
      scriptArgs <- c(scriptArgs, glue("title = \"{input$acpTitle}\""))
    }
    script <- c(
      scriptHead,
      "# MultiDimensional scaling",
      glue("p <- plot_samples({glue_collapse(scriptArgs, sep=', ')})")
    )
    if (!is.null(checkNull(input$acpEllipse))) {
      script <- c(
        script,
        glue(
          "p <- p + stat_ellipse(aes_string(group = \"{input$acpEllipse}\"))"
        )
      )
    }
    script <- c(script, "", "plot(p + theme_bw())")
    
    return(glue_collapse(script, sep = "\n"))
  })
  
  output$acp <- renderPlot({
    validate(
      need(data16S(), "Requires an abundance dataset"),
      need(length(input$acpAxes) == 2, "Requires two projections axes")
    )
    p <- plot_samples(
      data16S(),
      ordination = ordinate(
        data16S(),
        method = input$acpMethod,
        distance = input$acpDist
      ),
      axes = as.numeric(input$acpAxes),
      title = checkNull(input$acpTitle),
      color = checkNull(input$acpCol),
      replicate = if (is.null(checkNull(input$acpRep))) {
        NULL
      } else {
        checkNull(input$acpRep)
      },
      shape = checkNull(input$acpShape),
      label = checkNull(input$acpLabel)
    )
    if (!is.null(checkNull(input$acpEllipse))) {
      p <- p + stat_ellipse(aes_string(group = input$acpEllipse))
    }
    return(p + theme_bw())
  })
})