Восстановите входные значения с помощью блестящей закладки URL и повторите расчеты - PullRequest
0 голосов
/ 22 февраля 2019

Итак, у меня есть сценарий использования блестящего приложения, в котором пользователи могут ввести какое-то значение, и при нажатии кнопки «Выполнить» оно запустит модель и отобразит значения в таблице.Теперь, когда я нажимаю на закладку, она фиксирует входные значения.И когда я нажимаю на закладку восстановления, она заполняет входные значения.Что я хочу сделать, это после того, как он восстановит входные значения, он также должен снова запустить модель и заполнить значения в таблице.Вкратце, в закладке восстановления необходимо заполнить значения и нажать кнопку запуска, чтобы запустить модель. Как этого можно достичь?

Ниже приведен код для закладки:

library(shiny)
library(RSQLite)
library(data.table)

ui <- function(request) {
  fluidPage(
    DT::dataTableOutput("x1"),
    column(
      12,
      column(3,tags$div(title="forecast", numericInput("budget_input", label = ("Total Forecast"), value = 2))),
      column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")),
      column(2, bookmarkButton(id="bookmarkBtn"))),
    column(2, actionButton("opt_run", "Run")),
    DT::dataTableOutput("urlTable", width = "100%"),
    tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
  )
}

server <- function(input, output, session) {

   con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
  myBookmarks <- reactiveValues(urlDF = NULL)

  observeEvent(input$bookmarkBtn, {
    session$doBookmark()
  })

  observeEvent(input$opt_run, {
    output$x1 = renderDT(df %>% mutate(Current  = as.numeric(Current)*(input$budget_input)), selection = 'none', editable = TRUE)
  })

  if(dbExistsTable(con, "Bookmarks")){
    tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
    myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
  } else {
    myBookmarks$urlDF <- NULL
  }

  session$onSessionEnded(function() {
    tmpUrlDF <- isolate({myBookmarks$urlDF})
    if(!is.null(tmpUrlDF)){
       dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
    }
     dbDisconnect(con)
  })

  setBookmarkExclude(c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked"))

  df <- data.table(Channel = c("A", "B","C"),
                   Current = c("2000", "3000","4000"),
                   Modified = c("2500", "3500","3000"),
                   New_Membership = c("450", "650","700"))

  output$x1 = renderDT(df, selection = 'none', editable = TRUE)

  onBookmarked(fun=function(url){
    if(!url %in% myBookmarks$urlDF$URL){
      if(is.null(myBookmarks$urlDF)){
        myBookmarks$urlDF <- unique(data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")), by="URL")
      } else {
        myBookmarks$urlDF <- unique(rbindlist(list(myBookmarks$urlDF, data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")))), by="URL")
      }
    }
  })

  output$urlTable = DT::renderDataTable({
    req(myBookmarks$urlDF)
    myBookmarks$urlDF[User %in% Sys.getenv("USERNAME")]
  }, escape=FALSE)

}
enableBookmarking(store = "url")
shinyApp(ui, server)

1 Ответ

0 голосов
/ 22 февраля 2019

Моим первым инстинктом было то, что вам, вероятно, нужно использовать onRestore(), как предложил @AndrewTaylor.Но после попытки запустить ваш код было очевидно, что проблема здесь решается простым исправлением реактивности в коде.

Вот ваш код с двумя небольшими правками: во-первых, был определен вывод $ x1дважды, поэтому я удалил второй, который не использовал никаких реактивных значений.Во-вторых, я переместил первый вывод $ x1, чтобы он находился за пределами наблюдающего события, и заставил его срабатывать только при нажатии кнопки.Как правило, вы не должны определять выход внутри наблюдателя, если только это не частный случай, когда он является обязательным, но способ, которым это было сделано здесь, вызывает неправильную реактивность.Исправление это все, что вам нужно.

Кроме того, необходимо загрузить пакеты DT и dplyr, чтобы сделать код полностью воспроизводимым.

library(shiny)
library(RSQLite)
library(data.table)
library(DT)
library(dplyr)

ui <- function(request) {
  fluidPage(
    DT::dataTableOutput("x1"),
    column(
      12,
      column(3,tags$div(title="forecast", numericInput("budget_input", label = ("Total Forecast"), value = 2))),
      column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")),
      column(2, bookmarkButton(id="bookmarkBtn"))),
    column(2, actionButton("opt_run", "Run")),
    DT::dataTableOutput("urlTable", width = "100%"),
    tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
  )
}

server <- function(input, output, session) {

  con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
  myBookmarks <- reactiveValues(urlDF = NULL)

  observeEvent(input$bookmarkBtn, {
    session$doBookmark()
  })

  observeEvent(input$opt_run, {
    cat('HJE')
  })

  output$x1 <- DT::renderDataTable({
    input$opt_run
    isolate({
      datatable(
        df %>% mutate(Current  = as.numeric(Current)*(input$budget_input)), selection = 'none', editable = TRUE
      )
    })
  })

  if(dbExistsTable(con, "Bookmarks")){
    tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
    myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
  } else {
    myBookmarks$urlDF <- NULL
  }

  session$onSessionEnded(function() {
    tmpUrlDF <- isolate({myBookmarks$urlDF})
    if(!is.null(tmpUrlDF)){
      dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
    }
    dbDisconnect(con)
  })

  setBookmarkExclude(c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked"))

  df <- data.table(Channel = c("A", "B","C"),
                   Current = c("2000", "3000","4000"),
                   Modified = c("2500", "3500","3000"),
                   New_Membership = c("450", "650","700"))

  onBookmarked(fun=function(url){
    if(!url %in% myBookmarks$urlDF$URL){
      if(is.null(myBookmarks$urlDF)){
        myBookmarks$urlDF <- unique(data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")), by="URL")
      } else {
        myBookmarks$urlDF <- unique(rbindlist(list(myBookmarks$urlDF, data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")))), by="URL")
      }
    }
  })

  output$urlTable = DT::renderDataTable({
    req(myBookmarks$urlDF)
    myBookmarks$urlDF[User %in% Sys.getenv("USERNAME")]
  }, escape=FALSE)

}
enableBookmarking(store = "url")
shinyApp(ui, server)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...