I have made a shiny app and trying to run as an external application, with the app I should be able to generate plot and download them, its working locally on my pc but when I create it as an app and try running it its not downloading and showing an error file.
can you okease help me
This is my shiny code I used
library(shiny)
library(shinyjs)
library(rsvg)
library(DT)
library(rio)
library(devtools)
library(PRISMA2020)
library(webshot2)
library(pagedown)
library(curl)
library(shinythemes)
template <- read.csv("C:\Users\Lenovo\Desktop\MyApplication\app\www\PRISMA.csv", stringsAsFactors = FALSE)
the_options <- c(
"Not Included",
"Included",
"Not Included",
"Not Included"
)
names(the_options) <- c(
"previous",
"other",
"dbDetail",
"regDetail"
)
ui <-
navbarPage( theme = shinytheme("darkly"),
title = "Meta-Suite",
position = "fixed-top",
tabPanel(
"Create PRISMA diagram",
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
style = "overflow-y:scroll; max-height: 900px; position:relative;",
tags$head(
tags$style(
HTML(
".shiny-split-layout > div { overflow: visible; }"
)
)
),
div(
id = "options",
uiOutput("options")
),
hr(),
actionButton(
"reset",
"Click to reset"
),
hr(),
div(
id = "inputs",
uiOutput("selection")
),
hr(),
h3("Download"),
downloadButton(
outputId = "PRISMAflowdiagramPDF",
"PDF"
),
downloadButton(
outputId = "PRISMAflowdiagramPNG",
"PNG"
),
downloadButton(
outputId = "PRISMAflowdiagramSVG",
"SVG"
),
downloadButton(
outputId = "PRISMAflowdiagramHTML",
"Interactive HTML"
),
downloadButton(
outputId = "PRISMAflowdiagramZIP",
"Interactive HTML (ZIP)"
)
),
mainPanel(
DiagrammeR::grVizOutput(
outputId = "plot1",
width = "100%",
height = "700px"
)
)
)
)
)
server <- function(input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
message(curl::curl_version())
if (identical(Sys.getenv("R_CONFIG_ACTIVE"), "shinyapps")) {
chromote::set_default_chromote_object(
chromote::Chromote$new(chromote::Chrome$new(
args = c("--disable-gpu",
"--no-sandbox",
"--disable-dev-shm-usage",
"--force-color-profile", "srgb")
))
)
}
rv <- shiny::reactiveValues()
observe({
if (is.null(input$data_upload)) {
query <- parseQueryString(session$clientData$url_search)
if (length(query) > 0) {
if ("previous" %in% names(query)) {
if (query$previous == 1) {
the_options["previous"] <- "Included"
} else if (query$previous == 0) {
the_options["previous"] <- "Not Included"
}
}
if ("other" %in% names(query)) {
if (query$other == 1) {
the_options["other"] <- "Included"
} else if (query$other == 0) {
the_options["other"] <- "Not Included"
}
}
if ("dbDetail" %in% names(query)) {
if (query$dbDetail == 1) {
the_options["dbDetail"] <- "Included"
} else if (query$dbDetail == 0) {
the_options["dbDetail"] <- "Not Included"
}
}
if ("regDetail" %in% names(query)) {
if (query$regDetail == 1) {
the_options["regDetail"] <- "Included"
} else if (query$regDetail == 0) {
the_options["regDetail"] <- "Not Included"
}
}
for (i in seq_len(nrow(template))) {
if (!is.null(query[[template[i, "data"]]])) {
template[i, "n"] <- query[[template[i, "data"]]]
}
}
}
rv$data_initial <- template
rv$opts_initial <- the_options
rv$data <- template
rv$opts <- the_options
} else {
rv$data_initial <- read.csv(input$data_upload$datapath)
rv$opts_initial <- the_options
rv$data <- read.csv(input$data_upload$datapath)
rv$opts <- the_options
}
})
observeEvent(
input$reset, {
if (is.null(input$data_upload)) {
rv$data <- template
} else {
rv$data <- read.csv(input$data_upload$datapath)
}
shinyjs::reset("inputs")
shinyjs::reset("options")
}
)
observeEvent(
input$reset_data_upload, {
shinyjs::reset("data_upload")
}
)
output$options <- renderUI({
tagList(
h3("Main options"),
splitLayout(
selectInput(
"previous",
"Previous studies",
choices = c(
"Not Included",
"Included"
),
selected = rv$opts_initial["previous"]
),
selectInput(
"other",
"Other searches for studies",
choices = c(
"Not Included",
"Included"
),
selected = rv$opts_initial["other"]
)
),
splitLayout(
selectInput(
"dbDetail",
"Individual databases",
choices = c(
"Not Included",
"Included"
),
selected = rv$opts_initial["dbDetail"]
),
selectInput(
"regDetail",
"Individual registers",
choices = c(
"Not Included",
"Included"
),
selected = rv$opts_initial["regDetail"]
)
)
)
})
output$selection <- renderUI({
tagList(
h3("Identification"),
conditionalPanel(
condition = "input.previous == 'Included'",
splitLayout(
textInput(
"previous_studies",
label = "Previous studies",
value = rv$data_initial[
which(rv$data_initial$data == "previous_studies"),
"n"
]
),
textInput(
"previous_reports",
label = "Previous reports",
value = rv$data_initial[
which(rv$data_initial$data == "previous_reports"),
"n"
]
)
)
),
splitLayout(
textInput(
"database_results",
label = "Databases",
value = rv$data_initial[
which(rv$data_initial$data == "database_results"),
"n"
]
),
textInput(
"register_results",
label = "Registers",
value = rv$data_initial[
which(rv$data_initial$data == "register_results"),
"n"
]
)
),
conditionalPanel(
condition = "
input.dbDetail == 'Included' || input.regDetail == 'Included'
",
splitLayout(
textInput(
"database_specific_results",
label = "Specific Database Results",
value = rv$data_initial[
which(rv$data_initial$data == "database_specific_results"),
"n"
]
),
textInput(
"register_specific_results",
label = "Specific Register Results",
value = rv$data_initial[
which(rv$data_initial$data == "register_specific_results"),
"n"
]
)
)
),
conditionalPanel(
condition = "input.other == 'Included'",
splitLayout(
textInput(
"website_results",
label = "Websites",
value = rv$data_initial[
which(rv$data_initial$data == "website_results"),
"n"
]
),
textInput(
"organisation_results",
label = "Organisations",
value = rv$data_initial[
which(rv$data_initial$data == "organisation_results"), "n"
]
)
),
textInput(
"citations_results",
label = "Citations",
value = rv$data_initial[
which(rv$data_initial$data == "citations_results"),
"n"
]
)
),
textInput(
"duplicates",
label = "Duplicates removed",
value = rv$data_initial[
which(rv$data_initial$data == "duplicates"),
"n"
]
),
splitLayout(
textInput(
"excluded_automatic",
label = "Automatically excluded",
value = rv$data_initial[
which(rv$data_initial$data == "excluded_automatic"),
"n"
]
),
textInput(
"excluded_other",
label = "Other exclusions",
value = rv$data_initial[
which(rv$data_initial$data == "excluded_other"),
"n"
]
)
),
h3("Screening"),
splitLayout(
textInput(
"records_screened",
label = "Records screened",
value = rv$data_initial[
which(rv$data_initial$data == "records_screened"),
"n"
]
),
textInput(
"records_excluded",
label = "Records excluded",
value = rv$data_initial[
which(rv$data_initial$data == "records_excluded"),
"n"
]
)
),
splitLayout(
textInput(
"dbr_sought_reports",
label = "Reports sought",
value = rv$data_initial[
which(rv$data_initial$data == "dbr_sought_reports"),
"n"
]
),
textInput(
"dbr_notretrieved_reports",
label = "Reports not retrieved",
value = rv$data_initial[
which(rv$data_initial$data == "dbr_notretrieved_reports"),
"n"
]
)
),
conditionalPanel(
condition = "input.other == 'Included'",
splitLayout(
textInput(
"other_sought_reports",
label = "Other reports sought",
value = rv$data_initial[
which(rv$data_initial$data == "other_sought_reports"),
"n"
]
),
textInput(
"other_notretrieved_reports",
label = "Other reports not retrieved",
value = rv$data_initial[
which(rv$data_initial$data == "other_notretrieved_reports"),
"n"
]
)
)
),
splitLayout(
textInput(
"dbr_assessed",
label = "Reports assessed",
value = rv$data_initial[
which(rv$data_initial$data == "dbr_assessed"),
"n"
]
),
textInput(
"dbr_excluded",
label = "Reports excluded",
value = rv$data_initial[
which(rv$data_initial$data == "dbr_excluded"),
"n"
]
)
),
conditionalPanel(
condition = "input.other == 'Included'",
splitLayout(
textInput(
"other_assessed",
label = "Other reports assessed",
value = rv$data_initial[
which(rv$data_initial$data == "other_assessed"),
"n"
]
),
textInput(
"other_excluded",
label = "Other reports excluded",
value = rv$data_initial[
which(rv$data_initial$data == "other_excluded"),
"n"
]
)
)
),
h3("Included"),
splitLayout(
textInput(
"new_studies",
label = "New studies",
value = rv$data_initial[
which(rv$data_initial$data == "new_studies"),
"n"
]
),
textInput(
"new_reports",
label = "New reports",
value = rv$data_initial[
which(rv$data_initial$data == "new_reports"),
"n"
]
)
),
conditionalPanel(
condition = "input.previous == 'Included'",
splitLayout(
textInput(
"total_studies",
label = "Total studies",
value = rv$data_initial[
which(rv$data_initial$data == "total_studies"),
"n"
]
),
textInput(
"total_reports",
label = "Total reports",
value = rv$data_initial[
which(rv$data_initial$data == "total_reports"),
"n"
]
)
)
)
)
})
observeEvent(input$previous_studies, {
rv$data[
which(rv$data$data == "previous_studies"),
"n"
] <- input$previous_studies
})
observeEvent(input$previous_reports, {
rv$data[
which(rv$data$data == "previous_reports"),
"n"
] <- input$previous_reports
})
observeEvent(input$register_results, {
rv$data[
which(rv$data$data == "register_results"),
"n"
] <- input$register_results
})
observeEvent(input$database_results, {
rv$data[
which(rv$data$data == "database_results"),
"n"
] <- input$database_results
})
observeEvent(input$database_specific_results, {
rv$data[
which(rv$data$data == "database_specific_results"),
"n"
] <- input$database_specific_results
})
observeEvent(input$register_specific_results, {
rv$data[
which(rv$data$data == "register_specific_results"),
"n"
] <- input$register_specific_results
})
observeEvent(input$website_results, {
rv$data[
which(rv$data$data == "website_results"),
"n"
] <- input$website_results
})
observeEvent(input$organisation_results, {
rv$data[
which(rv$data$data == "organisation_results"),
"n"
] <- input$organisation_results
})
observeEvent(input$citations_results, {
rv$data[
which(rv$data$data == "citations_results"),
"n"
] <- input$citations_results
})
observeEvent(input$duplicates, {
rv$data[
which(rv$data$data == "duplicates"),
"n"
] <- input$duplicates
})
observeEvent(input$excluded_automatic, {
rv$data[
which(rv$data$data == "excluded_automatic"),
"n"
] <- input$excluded_automatic
})
observeEvent(input$excluded_other, {
rv$data[
which(rv$data$data == "excluded_other"),
"n"
] <- input$excluded_other
})
observeEvent(input$records_screened, {
rv$data[
which(rv$data$data == "records_screened"),
"n"
] <- input$records_screened
})
observeEvent(input$records_excluded, {
rv$data[
which(rv$data$data == "records_excluded"),
"n"
] <- input$records_excluded
})
observeEvent(input$dbr_sought_reports, {
rv$data[
which(rv$data$data == "dbr_sought_reports"),
"n"
] <- input$dbr_sought_reports
})
observeEvent(input$dbr_notretrieved_reports, {
rv$data[
which(rv$data$data == "dbr_notretrieved_reports"),
"n"
] <- input$dbr_notretrieved_reports
})
observeEvent(input$other_sought_reports, {
rv$data[
which(rv$data$data == "other_sought_reports"),
"n"
] <- input$other_sought_reports
})
observeEvent(input$other_notretrieved_reports, {
rv$data[
which(rv$data$data == "other_notretrieved_reports"),
"n"
] <- input$other_notretrieved_reports
})
observeEvent(input$dbr_assessed, {
rv$data[
which(rv$data$data == "dbr_assessed"),
"n"
] <- input$dbr_assessed
})
observeEvent(input$dbr_excluded, {
rv$data[
which(rv$data$data == "dbr_excluded"),
"n"
] <- input$dbr_excluded
})
observeEvent(input$other_assessed, {
rv$data[
which(rv$data$data == "other_assessed"),
"n"
] <- input$other_assessed
})
observeEvent(input$other_excluded, {
rv$data[
which(rv$data$data == "other_excluded"),
"n"
] <- input$other_excluded
})
observeEvent(input$new_studies, {
rv$data[
which(rv$data$data == "new_studies"),
"n"
] <- input$new_studies
})
observeEvent(input$new_reports, {
rv$data[
which(rv$data$data == "new_reports"),
"n"
] <- input$new_reports
})
observeEvent(input$total_studies, {
rv$data[
which(rv$data$data == "total_studies"),
"n"
] <- input$total_studies
})
observeEvent(input$total_reports, {
rv$data[
which(rv$data$data == "total_reports"),
"n"
] <- input$total_reports
})
observeEvent(input$previous, {
rv$opts["previous"] <- input$previous
})
observeEvent(input$other, {
rv$opts["other"] <- input$other
})
observeEvent(input$dbDetail, {
rv$opts["dbDetail"] <- input$dbDetail
})
observeEvent(input$regDetail, {
rv$opts["regDetail"] <- input$regDetail
})
proxy <- DT::dataTableProxy("mytable")
observeEvent(
input$mytable_cell_edit, {
info <- input$mytable_cell_edit
i <- info$row
j <- info$col + 4L
v <- info$value
rv$data[i, j] <- shiny::coerceValue(v, rv$data[i, j])
replaceData(
proxy,
rv$data,
resetPaging = FALSE,
rownames = FALSE)
})
thank_you_modal <- modalDialog(
easyClose = TRUE,
title = "Thank You",
"Thank you for using the PRISMA Flow Diagram tool.
Your flow diagram is being downloaded.",
hr(),
"Please remember to cite the tool as: ",
br(),
"Citation.",
tags$a(
href = "https://www.rasconsortium.org/"
)
)
plot <- reactive({
data <- PRISMA2020::PRISMA_data(rv$data)
if (rv$opts["previous"] == "Included") {
include_previous <- TRUE
} else {
include_previous <- FALSE
}
if (rv$opts["other"] == "Included") {
include_other <- TRUE
} else {
include_other <- FALSE
}
if (rv$opts["dbDetail"] == "Included") {
detail_databases <- TRUE
} else {
detail_databases <- FALSE
}
if (rv$opts["regDetail"] == "Included") {
detail_registers <- TRUE
} else {
detail_registers <- FALSE
}
shinyjs::runjs(
paste0(
'const nodeMap = new Map([["node1","',
rv$data[which(rv$data$data == "identification"), "boxtext"],
'"], ["node2","',
rv$data[which(rv$data$data == "screening"), "boxtext"],
'"], ["node3","',
rv$data[which(rv$data$data == "included"), "boxtext"],
'"]])',
"n",
"createLabels(nodeMap)"
)
)
plot <- PRISMA2020::PRISMA_flowdiagram(
data,
fontsize = 12,
font = "Helvetica",
interactive = TRUE,
previous = include_previous,
other = include_other,
side_boxes = TRUE,
detail_databases = detail_databases,
detail_registers = detail_registers
)
})
output$plot1 <- DiagrammeR::renderDiagrammeR({
plot <- plot()
})
output$PRISMAflowdiagramPDF <- downloadHandler(
filename = "prisma.pdf",
content = function(file) {
showModal(
thank_you_modal
)
PRISMA2020::PRISMA_save(plot(),
filename = file, filetype = "PDF")
}
)
output$PRISMAflowdiagramPNG <- downloadHandler(
filename = "prisma.png",
content = function(file) {
showModal(
thank_you_modal
)
PRISMA2020::PRISMA_save(plot(),
filename = file, filetype = "PNG")
}
)
output$PRISMAflowdiagramSVG <- downloadHandler(
filename = "prisma.svg",
content = function(file) {
showModal(
thank_you_modal
)
PRISMA2020::PRISMA_save(plot(),
filename = file, filetype = "SVG")
}
)
output$PRISMAflowdiagramHTML <- downloadHandler(
filename = "prisma.html",
content = function(file) {
showModal(
thank_you_modal
)
PRISMA2020::PRISMA_save(plot(),
filename = file, filetype = "html")
}
)
output$PRISMAflowdiagramZIP <- downloadHandler(
filename = "prisma.zip",
content = function(file) {
showModal(
thank_you_modal
)
PRISMA2020::PRISMA_save(plot(),
filename = file, filetype = "zip")
}
)
}
shinyApp(ui = ui, server = server)
I followed this method to convert my shiny app into an external application.
https://github.com/wleepang/DesktopDeployR
thank you for your time
ROHIT GANDUBOINA is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.