Replace download handler to be excel only
This commit is contained in:
147
app.R
147
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"))
|
||||
|
||||
print(paste("zip file complete", zipFile))
|
||||
file.copy("dataset.xlsx", file)
|
||||
|
||||
#print(paste("zip file complete", zipFile))
|
||||
|
||||
setwd(oldDir)
|
||||
unlink(tmp)
|
||||
|
||||
removeModal()
|
||||
},
|
||||
contentType = "application/zip"
|
||||
contentType = "application/xlsx"
|
||||
)
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user