create a data frame based on users input

shiny
1

I was making a linear knapsack optimizer app for daily fantasy sports where the user picks upto 5 players to base the optimization of off and it obviously generates n number of optimal lineups using projections pulled from GitHub. Currently I can select the 5 players but my issue is the optimizer requires a data frame of the 5 players picked by the user and I get this error "Error in as.data.frame.default: cannot coerce class ‘c("reactive.event", "reactiveExpr", "reactive", "function")’ to a data.frame" when I run the app. Any help appreciated.

  library(shiny)
  library(lpSolveAPI)
  library(tidyr)
  library(gdata)
  library(googlesheets4)
  library(dplyr)
  library(readr)
  library(purrr)  
 
  FDprojection<-read_csv("https://raw.githubusercontent.com/NahumKan/data/master/FDprojection.csv")
  
  find_teams_FD <- function(FDprojection, cap, constraint = c("none", "all_diff", "no_opp"), 
                            league = c("FanDuel", "DraftKings"), setplayers = NULL, removeteams = NULL)
  {
    colnames(FDprojection) <- c("ID", "Position", "Player", "Salary", "Team","Opp", "Points", "Value")
    
    
    pg <- ifelse(FDprojection$Position == "PG", 1,0)
    sg <- ifelse(FDprojection$Position == "SG", 1,0)
    sf <- ifelse(FDprojection$Position == "SF", 1,0)
    pf <- ifelse(FDprojection$Position == "PF", 1,0)
    c <- ifelse(FDprojection$Position == "C", 1,0)
    
    lpfantasy <- make.lp(0, nrow(FDprojection))
    
    set.objfn(lpfantasy, FDprojection$Points)
    
    set.type(lpfantasy, seq(1, nrow(FDprojection), by=1), type = c("binary"))
    
    if(league == "FanDuel") {
      add.constraint(lpfantasy, pg, "=", 2)
      add.constraint(lpfantasy, sg, "=", 2)
      add.constraint(lpfantasy, sf, "=", 2)
      add.constraint(lpfantasy, pf, "=", 2)
      add.constraint(lpfantasy, c, "=", 1)
    }
    
    if(league == "DraftKings"){
      dk_total <- pg + sg + sf + pf + c
      add.constraint(lpfantasy, pg, "<=", 3)
      add.constraint(lpfantasy, sg, "<=", 3)
      add.constraint(lpfantasy, sf, "<=", 3)
      add.constraint(lpfantasy, pf, "<=", 3)
      add.constraint(lpfantasy, c, "<=", 2)
      add.constraint(lpfantasy, dk_total, "=", 8)
    }
    
    
    team_names <- levels(factor(FDprojection$Team))
    constraint <- match.arg(constraint)
    
    if(constraint == "no_opp") {
      team_names <- levels(factor(FDprojection$Team))
      for (i in 1:lenght(team_names)) {
        no_two <- ifelse(FDprojection$Team == team_names[i],1,0)
        add.constraint(lpfantasy, no_two, "<=",2)
      }
      for (j in 1:nrow(FDprojection)) {
        no_opposing <- ifelse(FDprojection$Opponent == FDprojection$Team[j], 1,0)
        no_opposing[j] <- 1
        for (k in 1:nrow(FDprojection)) {
          out <- rep(0 , nrow(FDprojection))
          out[j] <- 1
          out[k] <- no_opposing[k]
          add.constraint(lpfantasy, out, "<=",1)
          
        }
      }
    }
    
    if(!is.null(setplayers)){
      if(league == "FanDuel") {
        if((sum(setplayers$Position == "PG") > 2) || (sum(setplayers$Position == "SG") > 2) || (sum(setplayers$Position == "SF") > 2) ||
           (sum(setplayers$Position == "PF") > 2) || (sum(setplayers$Position == "C") > 1))
          stop("One of your position has too many players")
      }
      
      if(league == "DraftKings"){
        if((sum(setplayers$Position == "PG") > 3) || (sum(setplayers$Position == "SG") > 3) || (sum(setplayers$Position == "SF") > 3) ||
           (sum(setplayers$Position == "PF") > 3) || (sum(setplayers$Position == "C") > 2))
          stop("One of your position has too many players")
        
      }
     
    }  
    
    if(!is.null(removeteams)){
      if(nrow(removeteams) != nrow(FDprojection))
        stop("Your team restriction do not match the number of players included in the projection set")
      for (m in 1:ncol(removeteams)) {
        add.constraint(lpfantasy, removeteams[, m], "<=", 8)
      }
    }  
    
    team <- data.frame(matrix(0,1,ncol(FDprojection) + 2))
    colnames(team) <- c(colnames(FDprojection), "TeamSalary", "TeamPoints")
    
    
    team_select <- subset(data.frame(FDprojection, get.variables(lpfantasy)), get.variables.lpfantasy. == 1)
    team_select$get.variables.lpfantasy. <- NULL
    team_select$TeamSalary <- sum(team_select$Salary)
    team_select$TeamPoints <- sum(team_select$Points)
    team <- rbind(team, team_select)
    team <- team[-1,]
    rownames(team) <- NULL
    team
  }
 
  FD_top_teams <- function(FDprojection, num_top, cap, constraint, league, setplayers = FDlock){
    result <- find_teams_FD(FDprojection, cap, constraint = constraint, league = league, setplayers = FDlock)
    restrict <- as.matrix(rep(0,nrow(FDprojection)))
    restrict[match(result$ID, FDprojection$ID), 1] <-1
    j <- 1
    while (j < num_top) {
      resultnew <- find_teams_FD(FDprojection, cap, constraint = constraint, league = league, setplayers = FDlock, removeteams = restrict)
      restrict <- cbind(restrict, rep(0, nrow(restrict)))
      restrict[match(resultnew$ID, FDprojection$ID), j] <- 1
      result <- rbind(result, resultnew)
      j <- j + 1
    }
    TeamNumber <- rep(1:num_top, each = 9)
    result <- cbind.data.frame(result, TeamNumber)
    result
  }
  
  choiceList <- sort(FDprojection$Player) 
  
  
  ui  <- shinyUI(fluidPage(
  #User dropbox
  selectizeInput("Player", "Choose Upto 5 Players", 
                 choices=choiceList, multiple = TRUE, options = list(maxItems =5)),
  tableOutput("Lineups"),
  actionButton("Lineups","Make Lineups")
))
 
 server <- function(input,output){
   
   FDlock <- reactive({
     a <- subset(FDprojection, Player %in% input$Player)
     return(a)
   })
   

   Lineups <- eventReactive(input$Lineups,{
     FD_top_teams(FDprojection,15, 60000, constraint = "none", league = "FanDuel", setplayers =FDlock())
   } ) 
   
  
  output$Lineups <- renderTable({
          Lineups
  })  
 }
 
 shinyApp(ui = ui, server = server)
2

HI there,

There are several issues with the app. I fixed a few

  1. There is no need for the FDlock() reactive object since it is dependent on the user input and thus can be merged with it (which I did)
  2. Your big function had many places where it used setplayers=FDlock in the arguments list, but FDlock is not defined by default, so I removed it and just kept setplayers
  3. The line add.constraint(lpfantasy, ifelse(setplayers$ID[k] == FDprojection$ID, 1, 0), "=",1) produces an error I do not understand (and is not part of this question) so I commented it out and leave it up to you to fix this

The app now "works", but you'll need to fix issue #3 in order to fully do what you want I think.

library(shiny)
library(lpSolveAPI)
library(tidyr)
library(dplyr)
library(readr)
library(purrr)  

FDprojection<-read_csv("https://raw.githubusercontent.com/NahomKun/data/master/FDprojection.csv")

find_teams_FD <- function(FDprojection, cap, constraint = c("none", "all_diff", "no_opp"), 
                          league = c("FanDuel", "DraftKings"), setplayers = NULL, removeteams = NULL)
{
  colnames(FDprojection) <- c("ID", "Position", "Player", "Salary", "Team","Opp", "Points", "Value")
  
  
  pg <- ifelse(FDprojection$Position == "PG", 1,0)
  sg <- ifelse(FDprojection$Position == "SG", 1,0)
  sf <- ifelse(FDprojection$Position == "SF", 1,0)
  pf <- ifelse(FDprojection$Position == "PF", 1,0)
  c <- ifelse(FDprojection$Position == "C", 1,0)
  
  lpfantasy <- make.lp(0, nrow(FDprojection))
  
  set.objfn(lpfantasy, FDprojection$Points)
  
  set.type(lpfantasy, seq(1, nrow(FDprojection), by=1), type = c("binary"))
  
  if(league == "FanDuel") {
    add.constraint(lpfantasy, pg, "=", 2)
    add.constraint(lpfantasy, sg, "=", 2)
    add.constraint(lpfantasy, sf, "=", 2)
    add.constraint(lpfantasy, pf, "=", 2)
    add.constraint(lpfantasy, c, "=", 1)
  }
  
  if(league == "DraftKings"){
    dk_total <- pg + sg + sf + pf + c
    add.constraint(lpfantasy, pg, "<=", 3)
    add.constraint(lpfantasy, sg, "<=", 3)
    add.constraint(lpfantasy, sf, "<=", 3)
    add.constraint(lpfantasy, pf, "<=", 3)
    add.constraint(lpfantasy, c, "<=", 2)
    add.constraint(lpfantasy, dk_total, "=", 8)
  }
  
  add.constraint(lpfantasy, FDprojection$Salary, "<=", cap)
  lp.control(lpfantasy, sense = 'max')
  
  team_names <- levels(factor(FDprojection$Team))
  constraint <- match.arg(constraint)
  
  if(constraint == "no_opp") {
    team_names <- levels(factor(FDprojection$Team))
    for (i in 1:lenght(team_names)) {
      no_two <- ifelse(FDprojection$Team == team_names[i],1,0)
      add.constraint(lpfantasy, no_two, "<=",2)
    }
    for (j in 1:nrow(FDprojection)) {
      no_opposing <- ifelse(FDprojection$Opponent == FDprojection$Team[j], 1,0)
      no_opposing[j] <- 1
      for (k in 1:nrow(FDprojection)) {
        out <- rep(0 , nrow(FDprojection))
        out[j] <- 1
        out[k] <- no_opposing[k]
        add.constraint(lpfantasy, out, "<=",1)
        
      }
    }
  }
  
  if(!is.null(setplayers)){
    if(league == "FanDuel") {
      if((sum(setplayers$Position == "PG") > 2) || (sum(setplayers$Position == "SG") > 2) || (sum(setplayers$Position == "SF") > 2) ||
         (sum(setplayers$Position == "PF") > 2) || (sum(setplayers$Position == "C") > 1))
        stop("One of your position has too many players")
    }
    
    if(league == "DraftKings"){
      if((sum(setplayers$Position == "PG") > 3) || (sum(setplayers$Position == "SG") > 3) || (sum(setplayers$Position == "SF") > 3) ||
         (sum(setplayers$Position == "PF") > 3) || (sum(setplayers$Position == "C") > 2))
        stop("One of your position has too many players")
      
    }
    
    for (k in 1:nrow(setplayers)) {
      #This line gives en error
      # add.constraint(lpfantasy, ifelse(setplayers$ID[k] == FDprojection$ID, 1, 0), "=",1)
    }
  }  
  
  if(!is.null(removeteams)){
    if(nrow(removeteams) != nrow(FDprojection))
      stop("Your team restriction do not match the number of players included in the projection set")
    for (m in 1:ncol(removeteams)) {
      add.constraint(lpfantasy, removeteams[, m], "<=", 8)
    }
  }  
  
  team <- data.frame(matrix(0,1,ncol(FDprojection) + 2))
  colnames(team) <- c(colnames(FDprojection), "TeamSalary", "TeamPoints")
  
  solve.lpExtPtr(lpfantasy)
  if(solve.lpExtPtr(lpfantasy)!= 0)
    stop("Optimization failed at some point")
  
  
  team_select <- subset(data.frame(FDprojection, get.variables(lpfantasy)), get.variables.lpfantasy. == 1)
  team_select$get.variables.lpfantasy. <- NULL
  team_select$TeamSalary <- sum(team_select$Salary)
  team_select$TeamPoints <- sum(team_select$Points)
  team <- rbind(team, team_select)
  team <- team[-1,]
  rownames(team) <- NULL
  team
}

FD_top_teams <- function(FDprojection, num_top, cap, constraint, league, setplayers){
  result <- find_teams_FD(FDprojection, cap, constraint = constraint, league = league, setplayers)
  restrict <- as.matrix(rep(0,nrow(FDprojection)))
  restrict[match(result$ID, FDprojection$ID), 1] <-1
  j <- 1
  while (j < num_top) {
    resultnew <- find_teams_FD(FDprojection, cap, constraint = constraint, league = league, setplayers, removeteams = restrict)
    restrict <- cbind(restrict, rep(0, nrow(restrict)))
    restrict[match(resultnew$ID, FDprojection$ID), j] <- 1
    result <- rbind(result, resultnew)
    j <- j + 1
  }
  TeamNumber <- rep(1:num_top, each = 9)
  result <- cbind.data.frame(result, TeamNumber)
  result
}

choiceList <- sort(FDprojection$Player) 


FD_top_teams(FDprojection,15, 60000, constraint = "none", league = "FanDuel", 
             setplayers = subset(FDprojection, Player %in% NA))


ui  <- shinyUI(fluidPage(
  #User dropbox
  selectizeInput("Player", "Choose Upto 5 Players", 
                 choices=choiceList, multiple = TRUE, options = list(maxItems =5)),
  tableOutput("Lineups"),
  actionButton("Lineups","Make Lineups")
))

server <- function(input,output){
  
  Lineups <- eventReactive(input$Lineups,{
    FD_top_teams(FDprojection,15, 60000, constraint = "none", league = "FanDuel", 
                 setplayers = subset(FDprojection, Player %in% input$Player))
  } )


  output$Lineups <- renderTable({
    Lineups()
  })
}

shinyApp(ui = ui, server = server)

Good luck,
PJ

1 Like
3

Thank you so much, it works exactly how I want it. You have no idea how long this problem kicked my ass.

1 Like
4

Hi

Shiny can be very tricky to debug and confusing when you're learning it, so I'm happy you are able to continue working on it again.

PJ

5

Another question if you don't mind, if I want to perform a function on the lineups generated after every optimization how should I go about it? I tried putting the function inside observEvent but had no luck :frowning:

6

Hi,

Next time it's better to start a new topic if you have a new question, but no worries for now. I'm not really sure what type of function it is you're planning on using, but you should be able to perform any function within the eventReactive and then output its results like this

Lineups <- eventReactive(input$Lineups,{
  
  topTeams = FD_top_teams(
    FDprojection,15, 60000, constraint = "none", league = "FanDuel", 
    setplayers = subset(FDprojection, Player %in% input$Player))
  
   myFunction(topTeams)
   
})

PJ

7

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.