Проблема с именованием переменных отфильтрованных данных в ShinyApp - PullRequest
Новая
       39

Проблема с именованием переменных отфильтрованных данных в ShinyApp

0 голосов
/ 26 декабря 2018

Надеюсь, у вас все хорошо.У меня небольшая проблема с ShinyApps.Я приложил картину того, что мне нужно.Я в основном нацеливаюсь на cyl переменную mtcars данных.Если я нажимаю 4 из него, мне требуются отфильтрованные данные, имеющие 4 вместе с остальными переменными, имеющими четыре , прикрепленные к их именам.Аналогично, если я нажимаю 4 и 6 вместе , мне требуются отфильтрованные данные, имеющие 4 и 6 из cyl вместе с four и six , прикрепленными к остальным именам переменных.Прикрепленная картинка облегчит понимание.Я также прилагаю свои коды.Пожалуйста, ведите меня.Пакет благодарностей заранее:)

enter image description here

data_table<-mtcars

library(shiny)
ui <- fluidPage(

checkboxGroupInput(inputId = "variables", label = "Choose number(s):",
           choices =c("4","6", "8"),
           selected = c("4")),


DT::dataTableOutput("distable"))



server <- function(input, output){

thedata <- reactive({

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

# 
# if(input$variables == '4'){
#   names(data_table)[3:11]<-paste( "four","_" ,names(data_table)[3:11])
# }
# 
# if(input$variables == '6'){
#   names(data_table)[3:11]<-paste( "six","_" ,names(data_table)[3:11])
# }
# 
# if(input$variables == '8'){
#   names(data_table)[3:11]<-paste( "eight","_" ,names(data_table)[3:11])
# }
# 
# 


})


output$distable = DT::renderDataTable({

DT::datatable( filter = "top",  
             {   thedata() # Call reactive thedata()

                              })  

})
}

shinyApp(ui = ui, server = server)

1 Ответ

0 голосов
/ 26 декабря 2018

Использование - 

data_table<-mtcars
library(data.table)
repl <- list("4"="four","6"="six","8"="eight")

library(shiny)
ui <- fluidPage(

  checkboxGroupInput(inputId = "variables", label = "Choose number(s):",
                     choices =c("4","6", "8"),
                     selected = c("4")),


  DT::dataTableOutput("distable"))



server <- function(input, output){

  thedata <- reactive({

    if(input$variables != '0'){
      data_table<-data_table[data_table$cyl %in% input$variables,]
      colnames(data_table) <- gsub(paste( paste("_",sapply(repl, paste),sep=""),collapse="|"),"", colnames(data_table))
      cols <- colnames(data_table)
      suffix <- paste(paste("_", sapply(repl[input$variables],paste), sep=""),collapse="")
      setnames(data_table, old = cols[3:length(cols)], new = paste(cols[3:length(cols)], suffix, sep=""))

    }

    # 
    # if(input$variables == '4'){
    #   names(data_table)[3:11]<-paste( "four","_" ,names(data_table)[3:11])
    # }
    # 
    # if(input$variables == '6'){
    #   names(data_table)[3:11]<-paste( "six","_" ,names(data_table)[3:11])
    # }
    # 
    # if(input$variables == '8'){
    #   names(data_table)[3:11]<-paste( "eight","_" ,names(data_table)[3:11])
    # }
    # 
    # 


  })


  output$distable = DT::renderDataTable({

    DT::datatable( filter = "top",  
                   {   thedata() # Call reactive thedata()

                   })  

  })
}

shinyApp(ui = ui, server = server)

Это обеспечит суффикс для того, что вы хотите.В этом примере mtcars часть cbind невозможна, так как для каждого фильтра имеется различная длина строк, но это даст вам хорошее начало.

Объяснение

Мы используем 

repl <- list("4"="four","6"="six","8"="eight")

для создания начального поиска, чтобы сопоставить input$variables с используемым суффиксом.

После фактической фильтрации в функции thedata здесьвот что происходит - 

colnames(data_table) <- gsub(paste( paste("_",sapply(repl, paste),sep=""),collapse="|"),"", colnames(data_table))

Это для сброса любых предыдущих переименований, которые вы могли сделать.Таким образом, он заменит суффиксы, такие как _four, _six и т. Д., Чтобы вы могли начать заново. 

cols <- colnames(data_table)
  suffix <- paste(paste("_", sapply(repl[input$variables],paste), sep=""),collapse="")

suffix готовит суффикс, который может соответствовать _four, _four_six в зависимости от числавыборок из input$variables

  setnames(data_table, old = cols[3:length(cols)], new = paste(cols[3:length(cols)], suffix, sep=""))

Эта часть в конечном итоге заменяет суффиксы на setnames из data.table библиотеки, которая помогает заменить подмножество имен столбцов в R df.

...