Question

我正在编写一个进行电源模拟的闪亮应用程序。由于可能需要一些时间才能运行，因此我希望在仿真完成后根据用户需要自动下载结果。在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)

可能我很想念某些东西，但是我无法使其正常工作。有人想提供一些见识吗？

R Shiny自动开始下载（带有Navbar页面）

0 个答案: