diff --git a/server.R b/server.R index 790eb9159905b78ad763f2a30d450d74ca25ea2b..79ee45184f941ac88130309499ea6e9bdb562a12 100644 --- a/server.R +++ b/server.R @@ -578,8 +578,11 @@ shinyServer 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)") + 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")) }) @@ -660,10 +663,12 @@ shinyServer script <- c(script, "tipColor <- NULL") } script <- - c(script, + c( + script, "", "p1 <- ggplot(beta, aes(x = x, y = y, fill = distance))", - "p1 <- p1 + geom_tile()") + "p1 <- p1 + geom_tile()" + ) if (!is.null(checkNull(input$richnessBTitle))) { script <- c(script, glue("p1 <- p1 + ggtitle(\"{input$richnessBTitle}\")")) @@ -755,8 +760,38 @@ shinyServer "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({ @@ -942,8 +977,48 @@ shinyServer "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({