Question

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

非常感谢！

Answer 1

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

这是一个适用于所有输入~~的解决方案，除了文件输入~~：

更新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")
    })
  }
))

按“刷新”时，所有输入都将重置为初始值。

~~但文件输入非常奇怪，很难“重置”它们。 See here。如果你愿意的话，你可以一起破解一些JavaScript来尝试几乎重置一个输入字段。~~这是你如何执行实际的页面刷新：

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

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

Answer 2

我有一个下拉列表输入：

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

选择集基于数据库中的表。在我从表中添加或删除记录后，它应该会改变。

当我尝试使用重置或刷新功能时，选择集无法反映更改并始终保持不变。但是，当我使用＆＃34;重新加载＆＃34;浏览器提供的按钮，选择集将立即更新。我想知道你是否有一个重置/刷新解决方案，相当于＆＃34; reload＆＃34;浏览器的按钮。

我在这里提供了我的代码，这些代码不起作用，但会让你知道我想做什么。

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))

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

2 个答案: