2

Hope you all are well. I'm facing a small problem with ShinyApps. I have attached a picture of what i require. I'm basically targeting cyl variable of mtcars data. If i press 4 from it, i require the filtered data having 4 along-with rest of variables having four attached to their names. Likewise if i press 4 and 6 together, i require filtered data having 4 and 6 of cyl along with four and six attached to rest of variable names. The attached picture will make things easier to understand. I'm attaching my codes as well. Please guide me. Bundle of thanks in advance :)

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)
Doctor
  • 59
  • 1
  • 11
  • for the 4 and 6 part, what if there are different rows for 4 and 6? The output cant be a `cbind` table in that as shown – Vivek Kalyanarangan Dec 26 '18 at 08:15
  • Hi mate, for now we can assume that number of rows are same, we can do cbind as well. If possible could you pl update the codes. Many thanks – Doctor Dec 26 '18 at 08:49

1 Answers1

0

Use -

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)

This will provide the suffix for what you want. For this mtcars example, the cbind part is not possible as there are varying length of rows for each filter, but this will give you a good start.

Explanation

We use

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

for creating an initial lookup to map the input$variables to the suffix to be used.

After the actual filtering in thedata function, here is what happens -

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

This is for resetting any previous renames that you might have done. So it will replace suffixes like _four, _six etc. so you can start over.

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

suffix prepares the suffix which can correspond to _four, _four_six depending upon number of selections coming from input$variables

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

This part does the final replace with the suffixes with setnames from data.table library which helps replace a subset of column names in a R df.

Vivek Kalyanarangan
  • 8,951
  • 1
  • 23
  • 42
  • Thanks a lot mate, really appreciate the effort. But i actually want separate columns for 'four', 'six' and 'eight'. Right now they are concatenating. Is it possible to achieve separate columns. Regards – Doctor Dec 26 '18 at 10:26