我正在编写一个进行电源模拟的闪亮应用程序。由于可能需要一些时间才能运行,因此我希望在仿真完成后根据用户需要自动下载结果。在this stackoverflow response之后,我整理了以下最小工作示例。
# packages
library(shiny)
library(shinythemes)
library(shinyjs)
ex_function <- function(n){
x <- matrix(0, nrow = n, ncol = 1)
withProgress(message = "Conducting simulations", value = 0, {
for(i in 1:n){
x[i,] <- rnorm(1)
Sys.sleep(1)
incProgress(1/n, detail = paste("\n Doing simulation", i, "of", n))
}
})
out <- x
return(out)
}
# define UI
ui <- fluidPage(
useShinyjs(),
theme = shinytheme("spacelab"),
conditionalPanel(
"false", # always hide the download button
downloadButton("downloadData")
),
numericInput(
inputId = "n",
label = "Sample size",
value = 5,
min = 1,
step = 1
),
actionButton("simulate", "Simulate"),
checkboxInput('save_sims', "Save simulations", TRUE)
)
# define server logic
server <- function(input, output, session) {
# intro page
## image
output$intro_image <- renderImage({
filename <- normalizePath(file.path('./images', 'yell_comb.png'))
list(src = filename,
alt = paste("Yellowstone river"),
width = "100%", height = "40%")
}, deleteFile = FALSE)
## test
finalSims <- reactiveVal()
observeEvent(input$simulate, {
tmp <- ex_function(n = input$n)
finalSims(tmp)
if(input$save_sims){
runjs("$('#downloadData')[0].click();")
}
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".Rdata", sep="")
},
content = function(file) {
sims <- finalSims()
save(sims, file = file)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
该示例非常有用,并且在运行后下载ex_function
的结果。但是,当我将导航栏页面添加到小程序时(就像我在自己的应用程序中一样),该页面不再起作用。
# packages
library(shiny)
library(shinythemes)
library(shinyjs)
ex_function <- function(n){
x <- matrix(0, nrow = n, ncol = 1)
withProgress(message = "Conducting simulations", value = 0, {
for(i in 1:n){
x[i,] <- rnorm(1)
Sys.sleep(1)
incProgress(1/n, detail = paste("\n Doing simulation", i, "of", n))
}
})
out <- x
return(out)
}
# define UI
ui <- fluidPage(
useShinyjs(),
theme = shinytheme("spacelab"),
navbarPage(
title = "msocc",
tabPanel(
title = "Introduction"
),
tabPanel(
title = "Credibility Width Analysis",
conditionalPanel(
"false", # always hide the download button
downloadButton("downloadData")
),
numericInput(
inputId = "n",
label = "Sample size",
value = 5,
min = 1,
step = 1
),
actionButton("simulate", "Simulate"),
checkboxInput('save_sims', "Save simulations", TRUE)
),
tabPanel(
title = "Model Fitting"
),
tabPanel(
title = "Analysis and Results"
)
)
)
# define server logic
server <- function(input, output, session) {
# intro page
## image
output$intro_image <- renderImage({
filename <- normalizePath(file.path('./images', 'yell_comb.png'))
list(src = filename,
alt = paste("Yellowstone river"),
width = "100%", height = "40%")
}, deleteFile = FALSE)
## test
finalSims <- reactiveVal()
observeEvent(input$simulate, {
tmp <- ex_function(n = input$n)
finalSims(tmp)
if(input$save_sims){
runjs("$('#downloadData')[0].click();")
}
})
output$downloadData <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".Rdata", sep="")
},
content = function(file) {
sims <- finalSims()
save(sims, file = file)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
可能我很想念某些东西,但是我无法使其正常工作。有人想提供一些见识吗?