Изолировать список реактивных data.frames в Shiny - PullRequest
Новая
       14

Изолировать список реактивных data.frames в Shiny

0 голосов
/ 24 марта 2019

Я использую блестящий, чтобы создать список реактивных data.frames, которые я хочу передать в функцию.Функция хорошо работает со списками нереактивных data.frames, но я не могу понять, как 1) изолировать список реактивных data.frames непосредственно перед передачей его в функцию, или 2) передать его в функцию, а затемизолировать data.frames внутри функции.Вывод этой функции будет загружен из блестящего приложения, а не выведен на вывод. 

non_reactive_df_list <- isolate({df_list()})   #throws error because the list isn't reactive, just the dataframes (df_list[[i]]) are reactive

non_reactive_df_list <- map(df_list, isolate)   #doesn't work, and even it if did, there is no trigger/actionButton

То, что я действительно хочу, будет выглядеть так: 

df_list <- eventIsolateListElements(input$actionButton, {df_list}) # where df_list contains reactive elements

Я не знаю, какмного DFS будет в списке.

Используемая мной функция: 

dfList2string <- function(dbList) {
  string <- "**DataFrame String**"
  for (i in seq_along(dbList)) {
    string <- paste(string, names(dbList[i]), sep = '\n\n')
    sub_string <- paste(names(dbList[[i]]), collapse = ', ')
    string <- paste(string, sub_string, sep = '\n')
    for (j in seq(1:nrow(dbList[[i]]))) {
      sub_string <- paste(dbList[[i]][j,], collapse = ', ' )
      string <- paste(string, sub_string, sep = '\n')
    }
  }
  return(string)
}

Если вы хотите пример блестящего приложения, я сделал небольшое блестящее приложение, которое описывает то, что я хочу.Я не включаю код, который не работает, потому что он просто падает (затрудняет поиск и устранение неисправностей) 

    require(shiny)

#make list of two non-reactive dataframes
dfList <- list()
dfList$df1 <-  data.frame(a = rnorm(5, 1),
                   b = rnorm(5, 1))
dfList$df2 <-  data.frame(a = rnorm(5, 3),
                   b = rnorm(5, 3))

ui <- fluidPage(

  fluidRow(
    HTML('<h3>User Inputs</h3>'),
    numericInput('dfmean1', 'select mean df1', value= 1), #user choose mean for df1
    numericInput('dfmean2', 'select mean df2', value= 2), #user choose mean for df2
    HTML('<h3>Reactive df1</h3>'),
    tableOutput('reactive_table1'), #show reactive df1 table for clarity
    HTML('<h3>Reactive df2</h3>'),
    tableOutput('reactive_table2'), #show reactive df2 table for clarity
    HTML('<h3>Button to trigger Isolation of reactive list of df1 and df2</h3>'),
    actionButton('action', 'WriteToText'), #this button should trigger the conversion of reactive_dfList to text string
    HTML('<h3>Example function output using normal list of non-reactive dfs </h3>'),
    verbatimTextOutput('text_table') #this shows output of a function that converts non-reactive dfList to text string
  )
)

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

  #make list of two reactive dataframes
  reactive_dfList <- list() #initiate list to contain the two reactive dfs 1 and 2

  reactive_dfList$df1 <- reactive({
    data.frame(a = rnorm(5, input$dfmean1),
               b = rnorm(5, input$dfmean1))
  })

  reactive_dfList$df2 <- reactive({
    data.frame(a = rnorm(5, input$dfmean2),
               b = rnorm(5, input$dfmean2))
  }) 

  #view the tables of reactive dataframs for clarity
output$reactive_table1 <-  renderTable({ reactive_dfList$df1() })
output$reactive_table2 <-  renderTable({ reactive_dfList$df2() })

#function that converts list of dfs to a text string
dfList2string <- function(dbList) {
  string <- "**DataFrame String**"
  for (i in seq_along(dbList)) {
    string <- paste(string, names(dbList[i]), sep = '\n\n')
    sub_string <- paste(names(dbList[[i]]), collapse = ', ')
    string <- paste(string, sub_string, sep = '\n')
    for (j in seq(1:nrow(dbList[[i]]))) {
      sub_string <- paste(dbList[[i]][j,], collapse = ', ' )
      string <- paste(string, sub_string, sep = '\n')
    }
  }
  return(string)
}

output$text_table <- renderText({
  dfList2string(dfList)
})

}

shinyApp(ui, server)
...