diff --git a/app.R b/app.R index dcf3116..cebc03f 100644 --- a/app.R +++ b/app.R @@ -81,7 +81,7 @@ ui <- dashboardPage( #menuItem("Habitats", tabName = "3", icon = icon("atlas")), #menuItem("Ingestion", tabName = "3", icon = icon("utensils")), selectInput("modelSelect", "Select MESO model", choices = c(""), selected = NULL, multiple = FALSE), - downloadButton("download", "", icon = icon("download")), + #downloadButton("download", "", icon = icon("download")), uiOutput("pressureList") ) ), @@ -149,8 +149,16 @@ ui <- dashboardPage( actionButton("layer1Slider", "1", icon = icon("sliders-h")) ), column( - width = 5, - strong("Customise sensitivity weightings") + width = 2, + p("Custom sense weighting") + ), + column( + width = 1, + downloadButton("download", "", icon = icon("download")) + ), + column( + width = 2, + p("Download results as Excel workbook") ) ), plotlyOutput("layer1", height = "270px") %>% withSpinner(), @@ -281,7 +289,7 @@ server <- function(input, output, session) { modelList <- getAvailableModels() - calcLikelihood <- function(layer, pressStatus) { + calcLikelihood <- function(layer, pressStatus, forPlotly) { isolate({ @@ -329,21 +337,36 @@ server <- function(input, output, session) { print(paste("Building likelihoods from model, sample dists", length(thisModel$p_es$nodes$name), length(sampleDists))) - return(data.frame( - name = thisModel$p_es$nodes$name, - code = thisModel$p_es$nodes$code, - layer = thisModel$p_es$nodes$layer, - range = c( - apply(sampleDists, 2, min), - means - 2*stdDev, - means - stdDev, - means, - means + stdDev, - means + 2*stdDev, - apply(sampleDists, 2, max) - ), - stringsAsFactors = FALSE - )) + if (forPlotly) { + return(data.frame( + name = thisModel$p_es$nodes$name, + code = thisModel$p_es$nodes$code, + layer = thisModel$p_es$nodes$layer, + range = c( + apply(sampleDists, 2, min), + means - 2*stdDev, + means - stdDev, + means, + means + stdDev, + means + 2*stdDev, + apply(sampleDists, 2, max) + ), + stringsAsFactors = FALSE + )) + } else { + + return(data.frame( + name = thisModel$p_es$nodes$name, + code = thisModel$p_es$nodes$code, + layer = thisModel$p_es$nodes$layer, + means = means, + stdDev = stdDev, + mins = apply(sampleDists, 2, min), + maxes = apply(sampleDists, 2, max), + stringsAsFactors = FALSE + )) + + } } @@ -367,7 +390,7 @@ server <- function(input, output, session) { if (!identical(newStatus, .selections$pressStatus)) { #} || .selections$runOnce) { #.selections$runOnce = FALSE print("Running calc") - .likelihoods$p_es <<- calcLikelihood(0, newStatus) + .likelihoods$p_es <<- calcLikelihood(0, newStatus, TRUE) .selections$pressStatus <<- newStatus } @@ -447,7 +470,7 @@ server <- function(input, output, session) { .resistanceScores["pressSD"] <<- input$l1PressSD print("Running calc") - .likelihoods$p_es <<- calcLikelihood(0, .selections$pressStatus) + .likelihoods$p_es <<- calcLikelihood(0, .selections$pressStatus, TRUE) removeModal() }) @@ -633,64 +656,6 @@ server <- function(input, output, session) { return(FALSE); } - exportOrca <- function (p, file = "plot.png", format = tools::file_ext(file), - scale = NULL, width = NULL, height = NULL, - verbose = FALSE, debug = FALSE, safe = FALSE) - { - if (Sys.which("orca") == "") { - stop("The orca command-line utility is required to use the `orca()` function.\n\n", - "Follow the installation instructions here -- https://github.com/plotly/orca#installation", - call. = FALSE) - } - - b <- plotly_build(p) - - plotlyjs <- b$dependencies[sapply(b$dependencies, function(d) { d$name == "plotly-main" })][[1]] - - if (!isAbsolutePath(plotlyjs$src$file)) { - plotlyjs_file <- NULL - for(n in 1:length(.Library.site)) { - if (!is.null(plotlyjs_file)) { - next - } - f <- paste0(.Library.site[[n]], "/plotly/", plotlyjs$src$file, "/", plotlyjs$script) - if (file.exists(f)) { - plotlyjs_file <- f - } - } - } else { - plotlyjs_file <- file.path(plotlyjs$src$file, plotlyjs$script) - } - - args <- c( - "graph", paste0("'", jsonlite::toJSON( - b$x[c("data", "layout")], - digits = 50, - auto_unbox = TRUE, - force = TRUE, - null = "null", - na = "null" - ), "'"), - "-o", file, - "--format", format, - "--plotlyjs", plotlyjs_file - ) - if (debug) - args <- c(args, "--debug") - if (verbose) - args <- c(args, "--verbose") - if (safe) - args <- c(args, "--safe-mode") - if (!is.null(scale)) - args <- c(args, "--scale", scale) - if (!is.null(width)) - args <- c(args, "--width", width) - if (!is.null(height)) - args <- c(args, "--height", height) - - invisible(system2("orca", args)) - } - output$linkBackgroundData <- downloadHandler( filename = getModelName(), content = function(file) { @@ -700,8 +665,12 @@ server <- function(input, output, session) { ) output$download <- downloadHandler( - filename = function() { paste0("MESO-", format(Sys.time(), "%m%d_%H%M"), ".zip") }, + + + filename = function() { paste0("MESO-", format(Sys.time(), "%m%d_%H%M"), ".xlsx") }, content = function(file) { + print("STARTING download") + showModal( modalDialog( fluidRow( @@ -718,29 +687,33 @@ server <- function(input, output, session) { setwd(tmp) #Get the network graph - l1 <- exportOrca(prepPlot("ba", "Bio-Assemblage"), "layer1.png") - l2 <- exportOrca(prepPlot("op", "Output Processes"),"layer2.png") - l3 <- exportOrca(prepPlot("es", "Ecosystem Services"),"layer3.png") + #l1 <- exportOrca(prepPlot("ba", "Bio-Assemblage"), "layer1.png") + #l2 <- exportOrca(prepPlot("op", "Output Processes"),"layer2.png") + #l3 <- exportOrca(prepPlot("es", "Ecosystem Services"),"layer3.png") #Save pressure list, confidence levels, node and edge tables in xlsx + l <- list( pressures = .selections$pressStatus, nodes = modelList[[.selections$model]]$p_es$nodes, edges = modelList[[.selections$model]]$p_es$edges, - settings = as.data.frame(cbind(names(.resistanceScores), .resistanceScores), stringsAsFactors = FALSE) + settings = as.data.frame(cbind(names(.resistanceScores), .resistanceScores), stringsAsFactors = FALSE), + likelihoods = calcLikelihood(0, .selections$pressStatus, FALSE) ) xl <- write.xlsx(l, "dataset.xlsx") - zipFile <- zipr(file, c("layer1.png", "layer2.png", "layer3.png", "dataset.xlsx")) + #zipFile <- zipr(file, c("dataset.xlsx")) + + file.copy("dataset.xlsx", file) - print(paste("zip file complete", zipFile)) + #print(paste("zip file complete", zipFile)) setwd(oldDir) unlink(tmp) removeModal() }, - contentType = "application/zip" + contentType = "application/xlsx" )