I am trying to build out a roster planning sheet for my fantasy baseball dynasty league. We have player contracts, so I am looking to show salary and contract progression for each year. To make this more succinct, I have deleted tabs for years 2-4, and am only showing year 1 and year 5.
I want to highlight cell values in tabs after year 1 (tab 5 in this example) that meet a specific text value. In the column Upd.Contract, any contract with the text "Ext 1" or "Ext 2", I would like to highlight that value or highlight the value in Salary column in the corresponding row.
When I run the code I currently have, the UI displays a blank tab. I had been getting different errors, but I had gotten it to the point where it now just displays nothing. I had the tab working as displaying as a shiny::renderDataTable like tab1, but once I moved it to DT:renderDataTable to do the formatting I can't seem to make it work.
library(shiny)
library(tidyr)
library(dplyr)
library(stringr)
library(DT)
library(formattable)
load("Players.RData")
# Define UI for application
ui <- fluidPage(
titlePanel("Roster Planning Worksheet"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "Team",
label = "Team",
choices = c("Allan","Alex","Carter","Derek","Eddie","Hammy","Jared","Josh","Niska","Ryan C","Ryan D","Urby"),
selected = "Derek"),
selectInput(
inputId = "Sort",
label = "Sort",
choices = c("Salary","Position"),
selected = "Salary"),
p("Rosters as of 12/20/2022")),
mainPanel(
tabsetPanel(
tabPanel("2023",dataTableOutput('tab1')),
tabPanel("2027",dataTableOutput('tab5'))
))))
# Define server logic
server <- function(input, output) {
Contract <- Players %>%
select(Contract) %>%
filter(!grepl("Ama",Contract)&!grepl("yr",Contract)&!grepl("RoS",Contract)) %>%
arrange(Contract) %>%
unique() %>%
mutate(Years = c(3,2,1,0,0,7,6,5,4),Years = as.character(Years),
Sequence = c(5,6,7,8,0,1,2,3,4))
CurrentYear <- 2023
yearlist <- list(2023,2024,2025,2026,2027)
OutputTable <- Players %>%
mutate(Status = case_when(
Status == "MEOW" ~ "Allan",
Status == "AS" ~ "Alex",
Status == "DP" ~ "Niska",
Status == "DEMO-9" ~ "Jared",
Status == "ED $" ~ "Eddie",
Status == "DS" ~ "Derek",
Status == "SLUT" ~ "Ryan C",
Status == "BLUE" ~ "Ryan D",
Status == "COMMISH" ~ "Josh",
Status == "blakskin" ~ "Carter",
Status == "HH" ~ "Hammy",
TRUE ~ Status)) %>%
merge(Contract, by= "Contract",all=T) %>%
filter(!grepl("Ama",Contract)) %>%
mutate_at(vars(Years),~if_else(is.na(.),str_sub(Contract,-2,-1),.)) %>%
mutate(Years = as.numeric(Years),
Remaining = case_when(Years > 7 ~ (2000+Years-CurrentYear),
TRUE ~ Years),
Remaining = case_when(Remaining == -1 ~ 0,
TRUE ~ Remaining)) %>%
mutate(Pos1 = Position) %>%
separate(Pos1,c("Pos1"),sep=',')
for(i in yearlist){
yearcolumns <- case_when(OutputTable$Remaining+2023 >= i ~ OutputTable$Player,
OutputTable$Remaining+2023 <i ~ "")
OutputTable[,ncol(OutputTable)+1] <- yearcolumns
colnames(OutputTable)[ncol(OutputTable)] <- paste0(i)
}
tab1 <- reactive({
a <- input$Team
tab1 <- OutputTable %>%
filter(Status %in% a) %>%
filter(`2023` != "") %>%
arrange(match(Pos1,c("C","1B","2B","3B","SS","LF","CF","RF","UT","SP","RP"))) %>%
select(Player,Position,Age,Contract,Salary)
return(tab1)
})
tab5 <- reactive({
a <- input$Team
tab5output <- OutputTable %>%
mutate(NewContract = Sequence+4) %>%
merge(Contract, by.x = "NewContract", by.y="Sequence",all=T) %>%
rename(Contract = Contract.x,
Upd.Contract = Contract.y) %>%
mutate(Upd.Contract = ifelse(is.na(Upd.Contract),Contract,Upd.Contract)) %>%
filter(Status %in% a) %>%
filter(`2027` != "") %>%
arrange(match(Pos1,c("C","1B","2B","3B","SS","LF","CF","RF","UT","SP","RP"))) %>%
select(Player,Position,Age,Upd.Contract,Salary) %>%
mutate(Age = Age+4,
Salary = case_when(
Upd.Contract == "Arb 1" ~ floor((Salary*1.25)+0.5),
Upd.Contract == "Arb 2" ~ floor((Salary*1.25)*1.25+0.5),
Upd.Contract == "Ext 1" ~ floor(floor(floor((Salary*1.25)+0.5)*1.25+0.5)*1.3+0.5),
Upd.Contract == "Ext 2" ~ floor(floor(floor((Salary*1.25)+0.5)*1.25+0.5)*1.3+0.5),
TRUE ~ Salary
))
return(tab5output)
})
output$tab1 <- shiny::renderDataTable(
{tab1()},
options = list("searching"=FALSE,
"info"=FALSE,
"lengthChange"=FALSE,
"autoWidth"=TRUE,
"ordering"=FALSE,
"paging"=FALSE))
output$tab5 <- DT::renderDataTable(
{tab5output <- tab5()
DT::datatable(tab5output) %>%
formatStyle('Upd.Contract',
backgroundColor = styleEqual(tab5output$Upd.Contract == "Ext 1", c('yellow')
))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Here is a sample of the Output Table which is actually the output from after the for loop is run.
dput(OutputTable1)
structure(list(Contract = c("2yr-23", "3yr-23", "3yr-24", "3yr-24",
"4yr-23", "4yr-24", "4yr-25", "4yr-25", "4yr-25", "Arb 1", "Arb 1",
"Arb 2", "Arb 2", "Ext 1", "QO", "QO", "QO", "Rook2", "Rook2",
"Rook3", "Rook3", "Rook4", "Rook4"), Player = c("Jameson Taillon",
"Gio Urshela", "Joe Ryan", "Stephen Strasburg", "Dylan Bundy",
"Josh Staumont", "Tyler Rogers", "Cedric Mullins", "Jared Walsh",
"Dylan Cease", "Austin Riley", "Jack Flaherty", "Dansby Swanson",
"Trey Mancini", "Gunnar Henderson", "Joc Pederson", "Jeff McNeil",
"Hunter Greene", "Logan Gilbert", "Jorge Mateo", "Michael Kopech",
"Nick Madrigal", "Vladimir Guerrero Jr."), Position = c("SP",
"3B", "SP", "SP", "SP", "RP", "RP", "CF", "1B", "SP", "3B", "SP",
"SS", "1B,LF", "3B", "LF", "2B,LF", "SP", "SP", "SS", "SP", "2B",
"1B"), Status = c("Derek", "Derek", "Derek", "Derek", "Derek",
"Derek", "Derek", "Derek", "Derek", "Derek", "Derek", "Derek",
"Derek", "Derek", "Derek", "Derek", "Derek", "Derek", "Derek",
"Derek", "Derek", "Derek", "Derek"), Age = c(31, 31, 26, 34,
30, 28, 32, 28, 29, 26, 25, 27, 28, 30, 21, 30, 30, 23, 25, 27,
26, 25, 23), Salary = c(1, 1, 16, 20, 6, 6, 4, 25, 18, 10, 9,
8, 16, 9, 78, 10, 16, 8, 9, 10, 5, 8, 6), Score = c(81.45, 58.91,
81.93, 14.46, 67.38, 46.05, 76.75, 82.04, 59.14, 97.45, 84.86,
75.38, 84.42, 60.02, 76.66, 60.65, 61.74, 83.15, 90.31, 64.04,
76.75, 45.58, 87.54), Years = c(23, 23, 24, 24, 23, 24, 25, 25,
25, 3, 3, 2, 2, 1, 0, 0, 0, 6, 6, 5, 5, 4, 4), Sequence = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, 5, 5, 6, 6, 7, 0, 0, 0, 2, 2,
3, 3, 4, 4), Remaining = c(0, 0, 1, 1, 0, 1, 2, 2, 2, 3, 3, 2,
2, 1, 0, 0, 0, 6, 6, 5, 5, 4, 4), Pos1 = c("SP", "3B", "SP",
"SP", "SP", "RP", "RP", "CF", "1B", "SP", "3B", "SP", "SS", "1B",
"3B", "LF", "2B", "SP", "SP", "SS", "SP", "2B", "1B"), `2023` = c("Jameson Taillon",
"Gio Urshela", "Joe Ryan", "Stephen Strasburg", "Dylan Bundy",
"Josh Staumont", "Tyler Rogers", "Cedric Mullins", "Jared Walsh",
"Dylan Cease", "Austin Riley", "Jack Flaherty", "Dansby Swanson",
"Trey Mancini", "Gunnar Henderson", "Joc Pederson", "Jeff McNeil",
"Hunter Greene", "Logan Gilbert", "Jorge Mateo", "Michael Kopech",
"Nick Madrigal", "Vladimir Guerrero Jr."), `2024` = c("", "",
"Joe Ryan", "Stephen Strasburg", "", "Josh Staumont", "Tyler Rogers",
"Cedric Mullins", "Jared Walsh", "Dylan Cease", "Austin Riley",
"Jack Flaherty", "Dansby Swanson", "Trey Mancini", "", "", "",
"Hunter Greene", "Logan Gilbert", "Jorge Mateo", "Michael Kopech",
"Nick Madrigal", "Vladimir Guerrero Jr."), `2025` = c("", "",
"", "", "", "", "Tyler Rogers", "Cedric Mullins", "Jared Walsh",
"Dylan Cease", "Austin Riley", "Jack Flaherty", "Dansby Swanson",
"", "", "", "", "Hunter Greene", "Logan Gilbert", "Jorge Mateo",
"Michael Kopech", "Nick Madrigal", "Vladimir Guerrero Jr."),
`2026` = c("", "", "", "", "", "", "", "", "", "Dylan Cease",
"Austin Riley", "", "", "", "", "", "", "Hunter Greene",
"Logan Gilbert", "Jorge Mateo", "Michael Kopech", "Nick Madrigal",
"Vladimir Guerrero Jr."), `2027` = c("", "", "", "", "",
"", "", "", "", "", "", "", "", "", "", "", "", "Hunter Greene",
"Logan Gilbert", "Jorge Mateo", "Michael Kopech", "Nick Madrigal",
"Vladimir Guerrero Jr.")), row.names = c(NA, -23L), class = "data.frame")
You don't correctly use styleEqual. Try:
styleEqual(c("Ext1", "Ext2"), c("yellow", "green"))
If you want to highlight both the Upd.Contract column and the Salary column with this rule, do:
%>% formatStyle(c("Upd.Contract", "Salary"), valueColumns = "Upd.Contract"), backgroundColor = styleEqual(c("Ext1", "Ext2"), c("yellow", "green")))