Shiny Module renderTable не может обновляться при изменении входной переменной - PullRequest
Новая
       32

Shiny Module renderTable не может обновляться при изменении входной переменной

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

У меня есть флажок и таблица в моем коде. То, что я хочу, это когда пользователь устанавливает флажок, генерируется новый столбец с соответствующим именем.

Пример идеального случая:

enter image description here

Тем не менее, это то, что у меня есть с моим кодом:

enter image description here

Вот мой код: 

lineGraphUI <- function(id) {
  ns <- NS(id)
  tags$div(
    checkboxGroupInput(ns("variable"), "Variables to show:",
                       c("black" = "black",
                         "white" = "white",
                         "asian" = "asian")),
    tableOutput(ns("datatbr"))
  )
}

lineGraph <- function(input, output, session) {
  da <- read.csv(file = "RaceByYearTemplet.csv", header = TRUE)  

  output$datatbr <- renderTable({
    da[c("year",input$variable), drop = FALSE]
  }, rownames = TRUE)
}


navBlockUI <- function(id) {
  ns <- NS(id)
  tags$div(
    tags$div(class = "tabPanel-plotBlock",
             tabsetPanel(type = "tabs",
                         tabPanel("Graph", lineGraphUI(ns("line"))),
                         tabPanel("Line", tablePlotUI(ns("table")))
             )
    ) 
  )
}

navBlock <- function(input, output, session) {
  callModule(lineGraph, "line")

  callModule(tablePlot, "table")
}

Думаю, проблема в том, что блестящий модуль не может быть обновлен, когда установлен флажок? Потому что я попытался поместить тот же самый код прямо в app.R, и он прекрасно работает (как показано на рисунке «идеальный случай» выше).

1 Ответ

0 голосов
/ 09 июня 2019

Это работает так: 

lineGraphUI <- function(id) {
  ns <- NS(id)
  tags$div(
    checkboxGroupInput(ns("variable"), "Variables to show:",
                       c("black" = "black",
                         "white" = "white",
                         "asian" = "asian")),
    tableOutput(ns("datatbr"))
  )
}

lineGraph <- function(input, output, session) {
  da <- iris[1:5,]
  names(da) <- c("black", "white", "asian", "abcd", "year")

  output$datatbr <- renderTable({
    da[, c("year",input$variable), drop = FALSE]
  }, rownames = TRUE)
}

navBlockUI <- function(id) {
  ns <- NS(id)
  tags$div(
    tags$div(class = "tabPanel-plotBlock",
             tabsetPanel(type = "tabs",
                         tabPanel("Graph", lineGraphUI(ns("line")))
             )
    ) 
  )
}

ui <- fluidPage(
  navBlockUI("xxx")
)
navBlock <- function(input, output, session) {
  callModule(lineGraph, "xxx-line")
}

shinyApp(ui, navBlock)
...