Changing the table in shiny based on the calculated metrics

[PharmD]

Hi! I have a reproducible app here, which after uploading a dataset, can calculate Rsq, RMSE, and MAE, based on the chosen x and y variables.
I would also like to give the user the ability to choose the metrics as well, so right now, when the variables are chosen, all the metrics are calculated, however with the help of the "selectizeInput" the user should be able to choose what metrics are included in the table, so if the user only wants to see "RMSE", so only calculated values for RMSE is shown and generated in the table or if other metrics are chosen both individually or collectively. Is that possible?

library(shiny)
library(DT)
library(caret)
library(dplyr)

allstats <- c("Rsq",
              "RMSE",
              "MAE")





ui <- shinyUI(fluidPage(
  titlePanel("Metrics"),
  tabsetPanel(
    tabPanel("Upload File",
             titlePanel("Uploading Files"),
             sidebarLayout(
               sidebarPanel(
                 fileInput('file1', 'Choose CSV File',
                           accept=c('text/csv', 
                                    'text/comma-separated-values,text/plain', 
                                    '.csv')),
                 tags$br(),
                 checkboxInput('header', 'Header', TRUE),
                 radioButtons('sep', 'Separator',
                              c(Comma=',',
                                Semicolon=';',
                                Tab='\t'),
                              ','),
                 radioButtons('quote', 'Quote',
                              c(None='',
                                'Double Quote'='"',
                                'Single Quote'="'"),
                              '"')
                 
               ),
               mainPanel(
                 tableOutput('contents')
               )
             )
    ),
    tabPanel("Statistics",
             sidebarLayout(
               sidebarPanel(
                 fluidRow(
                   column(6,
                          selectInput('xcol1', 'X Variable', "",width=140)),
                   column(6,
                          selectInput('ycol2', 'Y Variable', "", selected = "",width=140)
                   ),
                   selectizeInput("stat_metrics",label="Statistics to display",choices=allstats,
                                  selected=c("Rsq"),
                                  multiple=TRUE,
                                  options=list(plugins=list('drag_drop','remove_button')))
                   
                   
                 ),
                 fluidRow(
                   actionButton("calculate_1", "Calculate")
                 )
                 
               ),
               mainPanel(
                 DTOutput("table_met")
               )
             )
             
             
    )
    
  )
)
)

server <- shinyServer(function(input, output, session) {
  
  data <- reactive({ 
    req(input$file1) 
    
    inFile <- input$file1 
    
    df <- read.csv(inFile$datapath, header = input$header, sep = input$sep,
                   quote = input$quote)
    
    
    updateSelectInput(session, inputId = 'xcol1', label = 'X Variable',
                      choices = names(df), selected = names(df))
    updateSelectInput(session, inputId = 'ycol2', label = 'Y Variable',
                      choices = names(df), selected = names(df)[2])
    
    return(df)
  })
  
  output$contents <- renderTable({
    data()
  })
  
  
  
  
  
  tableR <- reactive({
    
    summ <-data() %>%
      summarise(
        Rsq = cor(.data[[input$xcol1]], .data[[input$ycol2]])^2,
        RMSE = RMSE(.data[[input$xcol1]], .data[[input$ycol2]]),
        MAE = MAE(.data[[input$xcol1]], .data[[input$ycol2]])
        
        
        
        
      ) %>%
      mutate_if(is.numeric, round, digits=2)
    
  }) |> bindEvent(input$calculate_1)
  
  
  
  
  output$table_met <-renderDT({
    tableR()
  })
  
  
  
  
})

shinyApp(ui, server)

[nirgrahamuk]

I don't see this as particularly a shiny issue, more a general question of how to selectively pick (or drop) columns from tables.

library(tidyverse)

# assume a table of calculations, which have variables to always
# show x1,x2 and selectable choice a,b,c while  x1,x2 may not be
# known beforehand, lets assume we only know that they arent 
# a defined metric in the  set of a,b,c

(calc_df <- data.frame(
  x1=1,
  x2=2,
  a=3,
  b=4,
  c=5
))

(choices <- letters[1:3])

user_selection <-  "b" # could come form an input$whatever

(not_chosen <- setdiff(choices,user_selection))

select(calc_df,
       -all_of(not_chosen))

[PharmD]

Thanks for the explanation, but how can we implement this type of selectivity within the shiny to drop or pick metrics column?

[nirgrahamuk]

looking at your UI code ... I would suggest input$stat_metrics where I indicated input$whatever in place of the static 'b' in my example.