logo标签列表

使用R Shiny添加页面刷新按钮

rshiny
13

我正在制作一款应用程序，需要添加一个刷新页面的按钮（与按下F5键具有相同功能）。是否有人可以分享一段代码来实现它？

非常感谢！

1
与浏览器中的刷新按钮相比，它会有哪些不同之处？ - Rorschach
请详细说明您所说的“刷新”是什么意思 - 您是要进行页面刷新，还是只想让所有输入返回到它们的初始状态？ - DeanAttali
实际上，我希望所有的输入都回到初始值。我有一个上传输入框，但我不知道如何将其重置为空值。所以我想刷新页面可能是一种捷径。@daattali，你有任何想法吗？谢谢！ - Mark Zhou
2个回答
18

我有一个非常简单而且好用的解决方案，但它不适用于文件输入。

这里有一个对于所有输入都有效，但不包括文件输入的解决方案：

更新2017年：在前两年中，这个解决方案对于文件输入无效，但现在它已经可行了。

library(shiny)
library(shinyjs)
runApp(shinyApp(
  ui = fluidPage(
    shinyjs::useShinyjs(),
    div(
      id = "form",
      textInput("text", "Text", ""),
      selectInput("select", "Select", 1:5),
      actionButton("refresh", "Refresh")
    )
  ),
  server = function(input, output, session) {
    observeEvent(input$refresh, {
      shinyjs::reset("form")
    })
  }
))

当您按下“刷新”按钮时，所有输入将被重置为它们的初始值。这是评论中海报实际想做的事情。

但是文件输入非常奇怪，很难“重置”它们。在这里查看。如果您愿意，可以尝试使用一些JavaScript来几乎重置输入字段。

但是，为了完整起见，您也可以刷新整个页面。最简单的方法是使用session$reload()。您还可以使用{shinyjs}来完成：

library(shiny)
library(shinyjs)
runApp(shinyApp(
  ui = fluidPage(
    shinyjs::useShinyjs(),
    shinyjs::extendShinyjs(text = "shinyjs.refresh_page = function() { location.reload(); }", functions = "refresh_page"),
    textInput("text", "Text", ""),
    actionButton("refresh", "Refresh")
  ),
  server = function(input, output, session) {
    observeEvent(input$refresh, {
      shinyjs::js$refresh_page()
    })
  }
))

免责声明：这两种解决方案都使用了我编写的软件包shinyjs

谢谢，daattali。我会尝试在我的应用程序中使用它。顺便问一下，我们回到我之前提出的按钮问题。你知道如何将URL添加到属性中吗？例如，如果我点击一个按钮，它会在浏览器中打开该URL？ - Mark Zhou
1
你不能只使用一个简单的<a>标签吗？tags$a(href = "http://www.google.com", "点击我") - DeanAttali
@daattali。感谢您的帮助。您在上面提到这应该适用于任何内容，但不包括文件输入。请问您能否确认它是否适用于radioButtons()吗？谢谢。 - jpinelo
它适用于单选按钮，您可以轻松尝试。 - DeanAttali
错误：shinyjs：extendShinyjs：必须提供“functions”参数。有关更多详细信息，请参阅“？extendShinyjs”的文档。 - kraggle
1
我有一个下拉列表输入：

selectInput("domain", label = h4("Domain:"), choices = Domain, selected = CurrentDomain)

选择集是基于数据库中的表格设置的，当我添加或删除表格中的记录后，它应该发生变化。但是，在尝试您的重置或刷新功能时，选择集无法反映更改并始终保持不变。然而，当我使用浏览器提供的“重新加载”按钮时，选择集将立即更新。我想知道是否有一个等同于浏览器“重新加载”按钮的重置/刷新解决方案。
以下是我的代码示例，它可能无法正常工作，但可以让您了解我的意图。
conn<-odbcDriverConnect(connString)
 SystemInfo<-sqlQuery(conn, 'SELECT * FROM [DQ].[DQSystemInfo]',       stringsAsFactors = FALSE)
 close(conn)

 Domain<-unique(SystemInfo$Domain)
 Domain<-c(Domain,'NEW')
 SubDomain<-unique(SystemInfo$SubDomain[SystemInfo$Domain==Domain[1]])
 SubDomain<-c(SubDomain,'NEW')
 CurrentDomain<-Domain[1]
 CurrentSubDomain<-SubDomain[1]
 SystemInfo1<-SystemInfo[SystemInfo$Domain==CurrentDomain &      SystemInfo$SubDomain==CurrentSubDomain,]

  jsResetCode <- "shinyjs.reset = function() {history.go(0)}"

 shinyApp(


ui = fluidPage(
shinyjs::useShinyjs(),
shinyjs::extendShinyjs(text = "shinyjs.refresh = function() { location.reload(); }"),
#  div(
#      id = "form",
fluidRow(
  column(6, selectInput("domain", label = h4("Domain:"), 
                        choices = Domain, selected = CurrentDomain)),
  column(6,uiOutput("Condition2"))
),

#  fluidRow(column(2, verbatimTextOutput("value"))),

fluidRow(
  column(6, uiOutput("Condition1")),
  column(6,uiOutput("Condition3"))
),

    extendShinyjs(text = jsResetCode),

fluidRow(
  column(2, actionButton("submit", "Save", class="btn btn-primary btn-lg")),
  column(2, actionButton("cancel", "Cancel", class="btn btn-primary btn-

lg")),
      column(2, actionButton("delete", "Delete", class="btn btn-primary btn-lg"))
    )
    #)
  ),




  server = function(input, output) {

    observeEvent(input$domain, {
      if (input$domain=='NEW') {
        shinyjs::disable("domain")
    shinyjs::disable("delete") 
    CurrentSubDomain<-'NEW'

    output$Condition1 = renderUI({
      textInput("domainT",label = "", value = "")
    })

    output$Condition3 = renderUI({
      textInput("subdomainT", label = "",value = "")
    })

})   

  } else {
    CurrentDomain<-input$domain
    SubDomain<-unique(SystemInfo$SubDomain[SystemInfo$Domain==input$domain])
    SubDomain<-c(SubDomain,'NEW')}

  output$Condition2 = renderUI({
    selectInput("subdomain", label = h4("SubDomain:"),
                choices = SubDomain, selected =CurrentSubDomain)
  })

})


observeEvent(input$subdomain, {

  if (input$subdomain=='NEW') {
    shinyjs::disable("domain")  
    shinyjs::disable("subdomain")
    shinyjs::disable("delete") 

    output$Condition3 = renderUI({
      textInput("subdomainT", label = "", value = "")
    })


  } else {
    CurrentSubDomain<-input$subdomain
    conn<-odbcDriverConnect(connString)
    SystemInfo<-sqlQuery(conn, 'SELECT * FROM [DQ].[DQSystemInfo]', stringsAsFactors = FALSE)
    close(conn)
    SystemInfo1<-SystemInfo[SystemInfo$Domain==input$domain & SystemInfo$SubDomain==input$subdomain,]


  }
})


observeEvent(input$submit, {



    conn<-odbcDriverConnect(connString)
    DQ.DQSystemInfo<-SystemInfo[FALSE,c("Domain","SubDomain")]
    DQ.DQSystemInfo[1,]<-c("","","","","","","",0,48)
    DQ.DQSystemInfo$Domain<-ifelse(input$domain=='NEW',input$domainT,input$domain)
    DQ.DQSystemInfo$SubDomain<-input$subdomainT
    varType1 <- c("varchar(20)", "varchar(20)" )
    names(varType1)<-colnames(DQ.DQSystemInfo)
    sqlSave(conn, DQ.DQSystemInfo, append = TRUE, rownames = FALSE, varTypes = varType1)
    close(conn)

  # js$reset()
  #shinyjs::reset("form")
  # js$reset("form")

  conn<-odbcDriverConnect(connString)
  SystemInfo<-sqlQuery(conn, 'SELECT * FROM [DQ].[DQSystemInfo]', stringsAsFactors = FALSE)
  close(conn)

  Domain<-unique(SystemInfo$Domain)
  Domain<-c(Domain,'NEW')
  SubDomain<-unique(SystemInfo$SubDomain[SystemInfo$Domain==Domain[1]])
  SubDomain<-c(SubDomain,'NEW')
  CurrentDomain<-Domain[1]
  CurrentSubDomain<-SubDomain[1]
  SystemInfo1<-SystemInfo[SystemInfo$Domain==CurrentDomain & SystemInfo$SubDomain==CurrentSubDomain,]
  shinyjs::js$refresh()

})

observeEvent(input$cancel, {
  #js$reset()
  #shinyjs::reset("form")
  #js$reset("form")
  shinyjs::js$refresh()
})

observeEvent(input$delete, {
  conn<-odbcDriverConnect(connString)
  delete.query <- paste0("DELETE DQ.DQSystemInfo WHERE Domain='",
                         input$domain,"' and SubDomain='",input$subdomain,"'")
  sqlQuery(conn, delete.query)
  close(conn)

  #js$reset()
  # shinyjs::reset("form")
  # js$reset("form")

  conn<-odbcDriverConnect(connString)
  SystemInfo<-sqlQuery(conn, 'SELECT * FROM [DQ].[DQSystemInfo]', stringsAsFactors = FALSE)
  close(conn)

  Domain<-unique(SystemInfo$Domain)
  Domain<-c(Domain,'NEW')
  SubDomain<-unique(SystemInfo$SubDomain[SystemInfo$Domain==Domain[1]])
  SubDomain<-c(SubDomain,'NEW')
  CurrentDomain<-Domain[1]
  CurrentSubDomain<-SubDomain[1]
  SystemInfo1<-SystemInfo[SystemInfo$Domain==CurrentDomain & SystemInfo$SubDomain==CurrentSubDomain,]
  shinyjs::js$refresh()      
    })

  },options = list(height = 520))
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接