Dodaj przycisk odświeżania strony za pomocą R Shiny

Question

Tworzę aplikację i muszę dodać przycisk do odświeżenia strony (ta sama funkcja, aby nacisnąć F5). Czy jest ktoś, kto może udostępnić fragment kodu, aby go zaimplementować?

Wielkie dzięki!

Answer 1

Mam bardzo proste i przyjemne rozwiązanie , ale nie będzie działać dla pliku wejściowego .

Oto rozwiązanie, które będzie działać na wszystkich wejściach wyjątkiem wejścia plików :

UPDATE 2017: to rozwiązanie nie działa na wejściach plików przez pierwsze 2 lata, ale to robi teraz.

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

Po naciśnięciu przycisku „Odśwież”, wszystkie wejścia zostaną zresetowane do wartości początkowych.

Jednak pliki wejściowe są bardzo dziwne i trudno je "zresetować". See here. Możesz zhackować trochę JavaScript, aby spróbować prawie zresetować pole wejściowe, jeśli chcesz. Oto jak można przeprowadzić rzeczywistą odświeżania strony:

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

Wsparcie oba te rozwiązania wykorzystują pakiet pisałem shinyjs

Answer 2

Mam listę wejście rozwijaną:

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

Zestaw opcji jest oparty na tabeli w bazie danych. Powinien się zmienić po dodaniu lub usunięciu rekordu z tabeli.

Kiedy eksperymentowałem z funkcją resetowania lub odświeżania, zestaw do wyboru nie odzwierciedlał zmian i zawsze był taki Jednak, gdy użyję przycisku "przeładuj" dostarczonego przez przeglądarkę, zestaw ustawień zostanie natychmiast zaktualizowany. Zastanawiam się, czy masz rozwiązanie resetowania/odświeżania, które jest równoważne z przyciskiem "przeładuj" przeglądarki.

Podałem tutaj mój kod, który nie zadziała, ale da ci pojęcie, co chcę zrobić.

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