How to put a reactive filter on DF for NFL solution

32 Views Asked by At

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

0

There are 0 best solutions below