Фильтр для RenderDatatable

Question

У меня есть простые данные, где мне нужно применить фильтр для renderDatatable (не renderTable).Но я не могу выполнить приведенный ниже код

as <- data.frame(ColA = c("India","USA","Canada","India","USA","Canada","Australia"),ColB=c("A","B","C","D","E","F","G"),ColC=c("Jan","Jan","Mar","Feb","Jan","Apr","Apr"))
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(selectInput("x","Operations",choices = 
                           c("table"),
                         multiple=FALSE,selectize = TRUE),
             (selectInput("ColB","Choices from ColB", choices = as$ColB,
                          multiple=TRUE,selectize = TRUE))),
mainPanel(h6("Here it is"),
          dataTableOutput("message")
)
)
)
server <- function(input, output, session) {
r1 <- reactive({
if(input$x == "table")
{
  tab <- as.data.frame.matrix(table(as$ColC, as$ColA))
  tab <- tab[rownames(tab) %in% input$ColB, ]
}
})
output$message <- renderDataTable({
datatable(r1(), rownames = TRUE)
})
}
shinyApp(ui, server)

Answer 1

Как сказано в комментариях, я установил как реактивный выбор ColC в server.Для этого вам необходимо создать вход ColC в части ui.Затем я удалил второй столбец вашего фрейма данных (ColB) в server.

Более того, вам необходимо преобразовать таблицу в фрейм данных.Для этого вам нужно использовать as.data.frame.matrix, как описано здесь ( Как преобразовать таблицу во фрейм данных ).

Наконец, я заменяю as$ColC на rownames(tab) в части server.Также я добавляю library(DT), чтобы добавить rownames = TRUE в renderDataTable.Вот окончательное решение:

  as <- data.frame(ColA = c("India","USA","Canada","India","USA","Canada","Australia"),ColB=c("A","B","C","D","E","F","G"),ColC=c("Jan","Jan","Mar","Feb","Jan","Apr","Apr"))
library(shiny)
library(DT)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("x","Operations",choices = 
                               c("table"),
                             multiple=FALSE,selectize = TRUE),
                 (selectInput("ColC","Choices from ColC", choices = as$ColC,
                              multiple=TRUE,selectize = TRUE))),
    mainPanel(h6("Here it is"),
              dataTableOutput("message")
    )
  )
)
server <- function(input, output, session) {
  r1 <- reactive({
    if(input$x == "table")
    {
      tab <- as.data.frame.matrix(table(as$ColC, as$ColA))
      tab <- tab[rownames(tab) %in% input$ColC, ]
    }
  })
  output$message <- renderDataTable({
    datatable(r1(), rownames = TRUE)
  })
}
shinyApp(ui, server)

Answer 2

Как сказано в комментариях, я установил как реактивный выбор ColC в server. Для этого вам необходимо создать вход ColC в части ui. Затем я удалил второй столбец вашего фрейма данных (ColB) в server.

Я думаю, что решение вашей проблемы:

as <- data.frame(ColA = c("India","USA","Canada","India","USA","Canada","Australia"),ColB=c("A","B","C","D","E","F","G"),ColC=c("Jan","Jan","Mar","Feb","Jan","Apr","Apr"))
library(shiny)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("x","Operations",choices = 
                               c("table"),
                             multiple=FALSE,selectize = TRUE),
                 (selectInput("ColC","Choices from ColC", choices = as$ColC,
                              multiple=TRUE,selectize = TRUE))),
    mainPanel(h6("Here it is"),
              dataTableOutput("message")
    )
  )
)
server <- function(input, output, session) {
  r1 <- reactive({
    if(input$x == "table")
    {
      tab <- as.data.frame(as[as$ColC %in% input$ColC, ])
      tab <- tab[, -2]
    }
  })
  output$message <- renderDataTable({
    r1()
    })
}
shinyApp(ui, server)

РЕДАКТИРОВАТЬ: вам нужно преобразовать таблицу в кадре данных. Для этого вам нужно использовать функцию as.data.frame.matrix, как описано здесь ( Как преобразовать таблицу во фрейм данных ). Окончательный код:

as <- data.frame(ColA = c("India","USA","Canada","India","USA","Canada","Australia"),ColB=c("A","B","C","D","E","F","G"),ColC=c("Jan","Jan","Mar","Feb","Jan","Apr","Apr"))
library(shiny)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("x","Operations",choices = 
                               c("table"),
                             multiple=FALSE,selectize = TRUE),
                 (selectInput("ColC","Choices from ColC", choices = as$ColC,
                              multiple=TRUE,selectize = TRUE))),
    mainPanel(h6("Here it is"),
              dataTableOutput("message")
    )
  )
)
server <- function(input, output, session) {
  r1 <- reactive({
    if(input$x == "table")
    {
      tab <- as.data.frame.matrix(table(as$ColC, as$ColA))
      tab <- tab[as$ColC %in% input$ColC, ]
    }
  })
  output$message <- renderDataTable({
    r1()
  })
}
shinyApp(ui, server)

РЕДАКТИРОВАТЬ # 2: Я заменяю as$ColC на rownames(tab). Также я добавляю library(DT), чтобы поставить параметр rownames = TRUE в renderDataTable. Вот окончательное решение (я надеюсь на это):

  as <- data.frame(ColA = c("India","USA","Canada","India","USA","Canada","Australia"),ColB=c("A","B","C","D","E","F","G"),ColC=c("Jan","Jan","Mar","Feb","Jan","Apr","Apr"))
library(shiny)
library(DT)
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(selectInput("x","Operations",choices = 
                               c("table"),
                             multiple=FALSE,selectize = TRUE),
                 (selectInput("ColC","Choices from ColC", choices = as$ColC,
                              multiple=TRUE,selectize = TRUE))),
    mainPanel(h6("Here it is"),
              dataTableOutput("message")
    )
  )
)
server <- function(input, output, session) {
  r1 <- reactive({
    if(input$x == "table")
    {
      tab <- as.data.frame.matrix(table(as$ColC, as$ColA))
      tab <- tab[rownames(tab) %in% input$ColC, ]
    }
  })
  output$message <- renderDataTable({
    datatable(r1(), rownames = TRUE)
  })
}
shinyApp(ui, server)