Reputation: 105
DF1, DF2, and DF3 are the three data frames I have (in options). While picking DF3 from the second dataset, I'd want to highlight the value "600.00" from the column "Salary" of the 7th Row in Green color in the background in that particular cell. What's the most efficient method to do it in R? Since I'm new to Shiny, could someone please help me?
Below is my Code:
library(shiny)
DF1 <- data.frame(
emp_id = c(1:5),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
salary = c(623.3,515.2,611.0,735.0,844.25))
DF1
DF2 <- data.frame(
emp_id = c(1:6),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))
DF3 <- data.frame(
emp_id = c(1:7),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))
shinyApp(
ui = tagList(
navbarPage(
fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
column(6, selectInput("dataset2", "Choose second dataset:",
choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
),
# Button
downloadButton("downloadData5", "Download")
),
mainPanel(
fluidRow(column(6, tableOutput("table1")),
column(6, tableOutput("table2"))
)
)
),
server = function(input, output,session) {
datasetInput1 <- reactive({
switch(input$dataset1,
"DF1" = DF1,
"DF2" = DF2,
"DF3" = DF3)
})
datasetInput2 <- reactive({
switch(input$dataset2,
"DF1" = DF1,
"DF2" = DF2,
"DF3" = DF3)
})
output$table1 <- renderTable({
datasetInput1()
})
output$table2 <- renderTable({
datasetInput2()
})
}
)
shinyApp(ui, server)
Upvotes: 2
Views: 912
Reputation: 2816
If you don't mind using DT
, you can color the background of that cell in the second display.
library(DT)
shinyApp(
ui = tagList(
navbarPage(
fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
column(6, selectInput("dataset2", "Choose second dataset:",
choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
),
# Button
downloadButton("downloadData5", "Download")
),
mainPanel(
fluidRow(column(6, dataTableOutput("table1")),
column(6, dataTableOutput("table2"))
)
)
),
server = function(input, output,session) {
DF1 <- data.frame(
emp_id = c(1:5),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
salary = c(623.3,515.2,611.0,735.0,844.25))
DF2 <- data.frame(
emp_id = c(1:6),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))
DF3 <- data.frame(
emp_id = c(1:7),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))
datasetInput1 <- reactive({
switch(input$dataset1,
"DF1" = DF1,
"DF2" = DF2,
"DF3" = DF3)
})
datasetInput2 <- reactive({
switch(input$dataset2,
"DF1" = DF1,
"DF2" = DF2,
"DF3" = DF3)
})
output$table1 <- renderDataTable({
datasetInput1()
})
output$table2 <- renderDataTable({
if(input$dataset2 != "SelectDataSet ") {
# Get the dataset
d = datasetInput2()
# Add a column specifying the background color: light green if
# salary = 600; nothing otherwise
d$background.color = ifelse(d$salary == 600, "lightgreen", NA)
# Output the DataTable; hide the new 4th column we just created
# but use it to specify the background color of the "salary"
# column
d %>%
datatable(options = list(columnDefs = list(list(targets = 4,
visible = F)))) %>%
formatStyle("salary",
backgroundColor = styleEqual(d$salary,
d$background.color))
}
})
}
)
This method will apply the green color to any salary of 600. You can adjust the condition to whatever it actually needs to be (e.g., just Christian's salary, or just the last row, or something like that). There are options to remove the search box and other interactive pieces if you prefer.
Upvotes: 1
Reputation: 41260
You could use kableExtra which allows to define each cell individually with cell_spec
:
library(shiny)
library(kableExtra)
DF1 <- data.frame(
emp_id = c(1:5),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
salary = c(623.3,515.2,611.0,735.0,844.25))
DF1
DF2 <- data.frame(
emp_id = c(1:6),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex"),
salary = c(623.3,515.2,611.0,729.0,843.25, 243.5))
DF3 <- data.frame(
emp_id = c(1:7),
emp_name = c("Rick","Dan","Michelle","Ryan","Gary", "Alex", "Christan"),
salary = c(623.3,515.2,611.0,729.0,843.25, 243.5, 600.0))
# Define specific cell spec
DF3$salary <- cell_spec(DF3$salary, background = c(rep("white",6), "green"))
shinyApp(
ui = tagList(
navbarPage(
fluidRow(column(6, selectInput("dataset1", "Choose first dataset:",
choices = c("SelectDataSet ", "DF1", "DF2", "DF3"))),
column(6, selectInput("dataset2", "Choose second dataset:",
choices = c("SelectDataSet ", "DF1", "DF2", "DF3")))
),
# Button
downloadButton("downloadData5", "Download")
),
mainPanel(
fluidRow(column(6, tableOutput("table1")),
column(6, tableOutput("table2"))
)
)
),
server = function(input, output,session) {
datasetInput1 <- reactive({
switch(input$dataset1,
"DF1" = DF1,
"DF2" = DF2,
"DF3" = DF3)
})
datasetInput2 <- reactive({
switch(input$dataset2,
"DF1" = DF1,
"DF2" = DF2,
"DF3" = DF3)
})
output$table1 <- function() {
req(datasetInput1() )
datasetInput1() %>%
knitr::kable("html",escape = F) %>% kable_styling()
}
output$table2 <- function() {
req(datasetInput2() )
datasetInput2() %>%
knitr::kable("html",escape = F) %>% kable_styling()
}
}
)
shinyApp(ui, server)
Upvotes: 2