Format table output in R shiny based on user inputs

shiny
1

I have a table being display in a shiny app. I want to format the tables based on the values and color it accordingly. I have seen the formattable area coloring where based on the range of the values it defines the breaks and then color gradients are generated which are applied to the table. What I want to do is allow the user to fill the min and max value and depending on it the values in the table will be colored. So if the values range from 1-20 and if the user inputs are 5 and 15 , values below 5 and above 15 shouldnt have any color gradients applied to them. Below is the code of how I am doing currently using formatable area formatting.

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(DT)

sidebar <- dashboardSidebar(
  sidebarMenu(id = "tab",
              menuItem("1", tabName = "1")
  )
)
body <-   ## Body content
  dashboardBody(box(width = 12,fluidRow(
    fluidRow(  column(
      width = 3,  textInput("text1", label = h5("Min"), value = "Enter min")),
      column(
        width = 3, textInput("text2", label = h5("Max"), value = "Enter max"))),
    DT::dataTableOutput("op")
  )))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {
  df <- data.frame(month = c("mazda 3", "mazda cx5", "mazda 6","mazda miata","honda civic","honda accord"),
                   april = c(.1,.2,.3,.3,.4,.5),
                   may = c(.3,.4,.5,.2,.1,.5),
                   june = c(.2,.1,.5,.1,.2,.3))

  brks <- reactive({ quantile(df$april, probs = seq(.05, .95, .05), na.rm = TRUE)})
  clrs <- reactive({ round(seq(255, 175, length.out = length(brks()) + 1), 0) %>%
  {paste0("rgb(",.,",", ., ",255 )")}})

  df_format<- reactive ({datatable(df,options = list(searching = FALSE,pageLength = 15, lengthChange = FALSE))%>%
           formatStyle(names(df),backgroundColor = styleInterval(brks(), clrs()))})

  output$op <-renderDataTable({
    df_format()
  })

}

shinyApp(ui = ui, server = server)
1 Like