Good Day
I found one of your fixes/solution very interesting and useful but I need to add a reactive filter on the initial df "players" to filter it before it hits rv <- reactiveValues(players=players).
I have no idea how to add one I get the error "object of type 'closure' is not subsettable"
The fixes/solution I'm referring to is fixes/solution
library(shiny)
library(lpSolve)
library(purrr)
# Define the UI for the app
ui <- fluidPage(
titlePanel("Fantasy Football Lineup Optimizer"),
sidebarLayout(
sidebarPanel(
numericInput("num_qb", "Enter the number of QBs:", 1, min = 1, max = 5),
numericInput("num_rb", "Enter the number of RBs:", 3, min = 1, max = 5),
numericInput("num_wr", "Enter the number of WRs:", 3, min = 1, max = 5),
numericInput("num_te", "Enter the number of TEs:", 2, min = 1, max = 5),
numericInput("num_value", "Enter your draft budget:", 200),
numericInput("num_players", "Adding in your flex spots, enter the total number of starters:", 9, min = 1, max = 15),
selectInput("remove", "Remove a player:", choices = c("",as.character(players$Player)), multiple = FALSE),
selectInput("draft_player", "Draft Player", choices = c("",as.character(players$Player)), multiple = FALSE),
actionButton("update", "Update Lineup")
),
mainPanel(
tableOutput("team")
)
)
)
# Define the server logic
server <- function(input, output, session) {
players <- players
# New col to indicate if a player has been drafted
players$Drafted = "No"
# Create a new column indicating the player's position
players$QB <- ifelse(players$Position == "QB", 1, 0)
players$RB <- ifelse(players$Position == "RB", 1, 0)
players$WR <- ifelse(players$Position == "WR", 1, 0)
players$TE <- ifelse(players$Position == "TE", 1, 0)
players$Total <- 1
rv <- reactiveValues(players=players)
# Set up reactive table for lineup output
updateLineup = reactiveVal(NULL)
# Define the objective function (maximize fantasy points)
obj <- players$FantasyPoints
# Define the constraints (position limits and draft value limit)
con <- reactive({
matrix(c(
# QB constraint
rv$players$QB,
# RB constraint
rv$players$RB,
# WR constraint
rv$players$WR,
# TE constraint
rv$players$TE,
# Draft value constraint
rv$players$DraftValue,
#Total players constraint
rv$players$Total
), ncol = nrow(rv$players), byrow = TRUE)
})
# Define the variables for the lp
dir <- c("<=", rep(">=",3),"<=","<=")
# Define initial 'const.rhs'
init_rhs <- reactive({
list(
QB = input$num_qb,
RB = input$num_rb,
WR = input$num_wr,
TE = input$num_te,
n_val = input$num_value,
n_players = input$num_players
)
})
# Define reactive 'const.rhs'
rhs = reactiveValues(const = list())
# Run once to get the initial values and set them to reactiveValues
# so they can be changed later
observeEvent(init_rhs(),{
rhs$const = init_rhs()
}, once = TRUE)
# Define the initial optimal lineup
initialLineup <- reactive({
result <- lp("max", obj, con(), dir, init_rhs(), all.bin = TRUE)
rv$players[result$solution == 1,]
})
# Define the function to run when the "update" button is pressed
observeEvent(input$update, {
# Remove player here
if(input$remove != "") {
removedPlayer <- input$remove
rv$players <- rv$players[rv$players$Player != removedPlayer,]
obj <- rv$players$FantasyPoints
}
# Draft player
if(input$draft_player != "") {
draftedPlayer <- input$draft_player
draftedPlayer_details <- rv$players[rv$players$Player == draftedPlayer,]
draftedPlayer_details$Drafted = "Yes"
rv$players <- rv$players[rv$players$Player != draftedPlayer,]
rv$draftedPlayers <- rbind(rv$draftedPlayers, draftedPlayer_details)
obj <- rv$players$FantasyPoints # missing object
# Subtract constraints: position and n_players by 1 and draft budget by the players 'DraftValue'
# Necessary so "result" outputs a table with the remaining positions left
# otherwise it will return an entirely new lineup
rhs$const = purrr::imap(rhs$const, function(cs, nm) {
if(nm == draftedPlayer_details$Position) {cs = cs - 1}
if(nm == "n_players") {cs = cs - 1}
if(nm == "n_val") {cs = cs - draftedPlayer_details$DraftValue}
return(cs)
})
}
# Update select inputs to remove players after "Update Lineup" is clicked
if(input$remove != "" || input$draft_player != "") {
updateSelectInput(session, inputId = "remove", choices = c("",rv$players), selected = "")
updateSelectInput(session, inputId = "draft_player", choices = c("",rv$players), selected = "")
}
# Define result with updated arguments
result <- lp("max", obj, con(), dir, rhs$const, all.bin = TRUE)
# Assign new table to the reactiveVal 'updateLineup'
updateLineup(rbind(rv$draftedPlayers, rv$players[result$solution == 1,]))
})
output$team <- renderTable({
if (input$update == 0) {
initialLineup()[, c("Player", "Position", "FantasyPoints", "DraftValue", "Drafted")]
} else {
updateLineup()[, c("Player", "Position", "FantasyPoints", "DraftValue", "Drafted")]
}
})
}
# Run the app
shinyApp(ui, server)
I would like to add a reactive filter on DraftValue using a sliderInput
I have tried adding a reactive filter but get an error and can't find a solution with my limited knowledge