Select appropriate columns from table based on multiple input

Question

I built a small app in R's shiny package that displays some columns from selected dataframe based on the input IDs/Names. My dummy data looks like this (code below):

ID1 ID2 ID3 ID4  Client Amount
1   NA  333 3344 John   100
1   88  NA  3344 John   200
1   86  777 8888 Mike   300
3   66  987 4545 Dyke   400
4   11  123 3636 Vike   500

Notice, that ID1 may have more than one record per ID, as well as ID4 and Client but multiple records with same ID4 or Client can not have different ID1. Ideally, I would like to manipulate data on server side based on ID1 or ID4 (other records can be matched to both of them).

So I built 6 inputs, 4 numeric inputs for IDs, and 2 for text inputs for Client name (list, and text input), and would like to do the following:

if there is no input for ID1, take the last input in order (eg. if there is input for Client text, Client list, ID2 and ID3 select ID3), and match it to ID4 unless its ID4.

then if there is input for ID1 output table based on ID1 input, and if no input for ID1 then output table based on ID4.

My only solution is to "bruteforce" it, as I am novice in programming, but because I want to display 20 tables, it would be crazy code (I know) and I guess there must be an elegant solution to it. Code>

ui.R:

#ui.R
library(shiny)
dataset = data.frame(ID1 = c(1,1,1,3,4), ID2 = c(NA,88,86,66,11), 
                     ID3 = c(333,NA,777,987,123), ID4 = c(3344,3344,8888,4545, 3636), 
                     Client = c("John", "John", "Mike", "Dyke", "Vike"), 
                     Amount = c(100,200,300,400,500))

shinyUI(bootstrapPage(
    headerPanel("Tabsets"),
    sidebarPanel(
        textInput('clientN', 'Client Name'),
        selectInput('client', 'Client', c('None','John','Mike', 'Dyke', 'Vike')),
        numericInput('id2', 'ID 2'),
        numericInput('id3', 'ID 3'),
        numericInput('id4', 'ID 4'),
        numericInput('id1', 'ID 1')
    ),
    mainPanel(
        tabsetPanel(
            tabPanel("1", tableOutput("tableA")),
            tabPanel("2", tableOutput("tableA"))
    ))))

server.R

#server.R
library(shiny)
dataset = data.frame(ID1 = c(1,1,1,3,4), ID2 = c(NA,88,86,66,11), 
                     ID3 = c(333,NA,777,987,123), ID4 = c(3344,3344,8888,4545, 3636), 
                     Client = c("John", "John", "Mike", "Dyke", "Vike"), 
                     Amount = c(100,200,300,400,500))

shinyServer(function(input, output) {

    select <- reactiveTable(function() {
        sel <- 0
        if (input$clientN != NA)
            sel <- 1
        if (input$client != 'None')
            sel <- 2
        if (input$id2 > 0)
            sel <- 3
        if (input$id3 > 0)
            sel <- 4
        if (input$id3 > 0)
            sel <- 5
        if (input$id1 > 0)
            sel <- 6
        sel
    })

    output$tableA <- reactiveTable(function() {
        if(select == 0)
            table <- dataset

        if(select == 1)
            table = dataset[dataset$Client == input$clientN, c('Client','Amount')]

        if(select == 2)
            table = dataset[dataset$Client == input$client, c('Client','Amount')]

        if(select == 3)
            table = dataset[dataset$ID2 == input$id2, c('Client','Amount')]

        if(select == 4)
            table = dataset[dataset$ID3 == input$id3, c('Client','Amount')]

        if(select == 5)
            table = dataset[dataset$ID4 == input$id4, c('Client','Amount')]

        if(select == 6)
            table = dataset[dataset$ID1 == input$id1, c('Client','Amount')]

    table
    })
})

But how do I actually make in one function whether input exists in ID1 or other Inputs, and if only in Inputs other than ID1 map them to ID4, and then in another function output table by ID4 unless there is input for ID1 in which case output table by ID1?

I think this is also general programming problem rather than language specific or package specific, so if you could explain in anyway, I could implement in R.

Jan Jan · Accepted Answer · 2021-02-07T12:36:03

You can do something like that when you access the input widgets and data frame columns by [[inputId]] and [["column"]] respectively.

The sample app's comments should explain what happens.

# https://stackguides.com/questions/15532049/select-appropriate-columns-from-table-based-on-multiple-input

#ui.R
library(shiny)

dataset = data.frame(ID1 = c(1,1,1,3,4), ID2 = c(NA,88,86,66,11),
                     ID3 = c(333,NA,777,987,123), ID4 = c(3344,3344,8888,4545, 3636),
                     Client = c("John", "John", "Mike", "Dyke", "Vike"),
                     Amount = c(100,200,300,400,500))

ui <- shinyUI(fluidPage(

  headerPanel("Tabsets"),
  sidebarPanel(
    textInput('clientN', 'Client Name'),
    selectInput('client', 'Client', c(unique(dataset[["Client"]])), ""),
    numericInput('id2', 'ID 2', 0, min = 0),
    numericInput('id3', 'ID 3', 0, min = 0),
    numericInput('id4', 'ID 4', 0, min = 0),
    numericInput('id1', 'ID 1', 0, min = 0, max = max(dataset[["ID1"]]))
  ),
  mainPanel(
    tabsetPanel(
      tabPanel("1", tableOutput("tableA"))#,
      #tabPanel("2", tableOutput("tableB"))
    ))
))


#server.R
server <- function(input, output, session) {
  IsInputValid <- function(inputId) {
    Value <- input[[inputId]]
    # Sort out values with no (valid = truthy) value
    if (!isTruthy(Value)) return(FALSE)

    # Verify if value makes sense
    if (is.numeric(Value))
      return( Value > 0 )
    else if (is.character(Value))
      return( Value %in% trimws(dataset[["Client"]]) )
  }

  # Returns a list that contains the selectors needed to create the needed subset of `dataset`
  # The two vectors ant the top define the names of the input widgets `InpOrder` and the
  # columns of `dataset` that these inputs shall be mapped to.
  # You can use arbitrary vectors for different tables
  select <- reactive({
    ColumnMap <- c("Client", "Client", "ID2", "ID3", "ID4", "ID1")
    InpOrder  <- c("client", "clientN", "id2", "id3", "id4", "id1")

    # Loop through all the input elements specified in `InpOrder` and find out if they
    # have a meaningful value. `Index` is `TRUE`/`FALSE` after this operation.
    Index <- vapply(InpOrder, IsInputValid, logical(1))
    # Determine the last input element with the highest index in `InpOrder`. 
    Index <- as.integer(Index) * 1:length(InpOrder)

    if (sum(Index) == 0)
      return(NULL)
    else
      return(list(value = InpOrder[max(Index)], column = ColumnMap[max(Index)]))
  })

  # Render `dataset`
  output$tableA <- renderTable({
    # use complete data set if there is no valid selector
    if (!isTruthy(select())) return(dataset)

    # Select the proper subset
    table <- dataset[dataset[[select()$column]] == input[[select()$value]], c('Client','Amount')]
    # Remove rows that are all `NA`
    table <-  table[rowSums(is.na(table[ , 0:ncol(table)])) < ncol(table), ]

    return(table)
  })
}

shinyApp(ui, server)

Special note: I had to switch "client" and "clientN" because the selectInput always returns a valid value and would always trump "client". I also had to change a few shiny statements that have been deprecated.

Select appropriate columns from table based on multiple input

1 Answers