Невозможно отобразить несколько столбцов с помощью radioButtons в Shiny - PullRequest
Новая
       65

Невозможно отобразить несколько столбцов с помощью radioButtons в Shiny

0 голосов
/ 27 ноября 2018

Надеюсь, у вас все хорошо.Я сталкиваюсь с проблемой в реактивной части сервера (если еще операторы).При выборе TTS и NTTS с использованием radioButtons мне требуются столбцы из 1: 6 и 7:11 данных mtcars соответственно.Я приложил фотографии, которые соответствуют желаемому результату.Я также приложил свои коды, может кто-нибудь, пожалуйста, выяснить, что с ними не так?Большое спасибо :)

when 'NTTS' selected

when 'TTS' selected

when 'All' is selected

library(shiny)
library(tidyr)
library(dplyr)
library(readr)
library(DT) 

data_table <- mtcars

# Define UI
ui <- fluidPage(
downloadButton('downLoadFilter',"Download the filtered data"),

radioButtons(inputId = "columns", label = "choose variable",
    choices =c("All","TTS", "NTTS"),
    selected = c("All")),

selectInput(inputId = "cyl",
    label = "cyl:",
    choices = c("All",
                unique(as.character(data_table$cyl))),
    selected = "4",
    multiple = TRUE),

selectInput(inputId = "vs",
    label = "vs:",
    choices = c("All",
                unique(as.character(data_table$vs))),
    selected = "1",
    multiple = TRUE),

DT::dataTableOutput('ex1'))

server <- function(input, output) {

thedata <- reactive({

if(input$columns=='All'){
data_table
}

else if  (input$columns== 'TTS'){
data_table<-  data_table[,c(1:6),drop=FALSE]    }

else   
data_table<-  data_table[,c(7:11),drop=FALSE]

if(input$cyl != 'All'){
data_table<-data_table[data_table$cyl %in%   input$cyl,]
}

if(input$vs != 'All'){
data_table<-data_table[data_table$vs %in%  input$vs,]
}

else
data_table })

output$ex1 <- DT::renderDataTable(DT::datatable(filter = 'top',
                                        escape = FALSE, 
                                        options = list(pageLength = 
                                                         10, 
scrollX='500px',autoWidth = TRUE),{
                                                 thedata() # Call reactive 

}))

output$downLoadFilter <- downloadHandler(
filename = function() {
paste('Filtered data-', Sys.Date(), '.csv', sep = '')
},
content = function(path){
write_csv(thedata(),path) # Call reactive thedata() 
})}

shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 27 ноября 2018

Проблема не имеет ничего общего с Shiny или Datatable, это происходит из-за того, как мы помещаем в подмножество и перезаписываем данные.
Если мы вначале подбрасываем в столбцы и перезаписываем data_table, один из vs или cyl будетбольше не присутствует, и фильтрация строк по отсутствующему столбцу приводит к NULL, все строки теряются.

Простое исправление: измените порядок поднабора, сначала отфильтруйте строки, затем столбцы: 

  thedata <- reactive({
    if (!"All" %in% input$cyl) {
      data_table <- data_table[data_table$cyl %in% input$cyl, ]
    }
    if (!"All" %in% input$vs) {
      data_table <- data_table[data_table$vs %in% input$vs, ]
    }
    if (input$columns == "TTS") {
      data_table <- data_table[, c(1:6), drop = FALSE]
    }
    if (input$columns == "NTTS") {
      data_table <- data_table[, c(7:11), drop = FALSE]
    }
    data_table
  })
...