Добавьте кнопку обновления страницы с помощью R Shiny

Я делаю приложение, и мне нужно добавить кнопку для обновления страницы (та же функция, чтобы нажать F5). Кто-нибудь может поделиться фрагментом кода для его реализации?

Спасибо большое!

6
r shiny

2 ответов

у меня есть очень простое и хорошее решение но это не будет работать для ввода файла.

вот решение, которое будет работать для всех входов кроме входного файла:

UPDATE 2017: это решение не работало на файловых входах в течение первых 2 лет, но теперь работает.

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 вместе, чтобы попытаться почти сбросить поле ввода, если хотите. вот как вы бы выполнить фактическое обновление страницы:

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

7

у меня есть выпадающий список: 

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