我写了一些R代码来生成最佳的梦幻足球阵容（最大化预测得分），该阵容受限于用户输入的花名册大小和基于称为“球员”的数据框架的预算草案，该数据框架由球员、位置、梦幻积分和草案值组成。
这个想法是在起草之前使用这个工具（记住理想的阵容），然后在起草时实时更新它，因为这永远不会按计划进行。
从那里，我希望能够从球员数据集中删除球员（当他们被其他人起草时），并在我起草他们时将球员添加到我的阵容中（这样他们就会出现在每个未来的最佳阵容中）。我已经添加了功能，并且th删除球员按钮似乎工作得相当好（由于某种原因，当您每次输入新球员时，阵容就会消失，但一旦新球员被删除，就会重新出现），但它肯定不会正确地向团队起草球员。我肯定认为这与运行应用程序之前的最后一段代码有关，但我很难思考那里的逻辑。
数据框是：
players <- structure(list(Player = c("Josh Allen", "Patrick Mahomes", "Justin Herbert",
"Lamar Jackson", "Kyler Murray", "Jalen Hurts", "Tom Brady",
"Dak Prescott", "Joe Burrow", "Russell Wilson", "Aaron Rodgers",
"Trey Lance", "Matthew Stafford", "Kirk Cousins", "Derek Carr",
"Tua Tagovailoa", "Justin Fields", "Trevor Lawrence", "Ryan Tannehill",
"Daniel Jones", "Matt Ryan", "Jameis Winston", "Carson Wentz",
"Mac Jones", "Jared Goff", "Zach Wilson", "Davis Mills", "Baker Mayfield",
"Marcus Mariota", "Deshaun Watson", "Mitchell Trubisky", "Geno Smith",
"Drew Lock", "Kenny Pickett", "Jacoby Brissett", "Desmond Ridder",
"Travis Kelce", "Mark Andrews", "Kyle Pitts", "Darren Waller",
"George Kittle", "Dalton Schultz", "T.J. Hockenson", "Dallas Goedert",
"Zach Ertz", "Dawson Knox", "Hunter Henry", "Mike Gesicki", "Pat Freiermuth",
"Cole Kmet", "Irv Smith Jr.", "Noah Fant", "Tyler Higbee", "David Njoku",
"Albert Okwuegbunam", "Gerald Everett", "Robert Tonyan", "Jonathan Taylor",
"Christian McCaffrey", "Derrick Henry", "Austin Ekeler", "Dalvin Cook",
"Joe Mixon", "Najee Harris", "Alvin Kamara", "D'Andre Swift",
"Leonard Fournette", "Saquon Barkley", "Aaron Jones", "Nick Chubb",
"James Conner", "Javonte Williams", "Ezekiel Elliott", "David Montgomery",
"Cam Akers", "Travis Etienne Jr.", "Breece Hall", "J.K. Dobbins",
"Josh Jacobs", "Antonio Gibson", "Elijah Mitchell", "AJ Dillon",
"Cordarrelle Patterson", "Damien Harris", "Miles Sanders", "Clyde Edwards-Helaire",
"Tony Pollard", "Devin Singletary", "Kareem Hunt", "Chase Edmonds",
"Rashaad Penny", "Rhamondre Stevenson", "Kenneth Walker III",
"Melvin Gordon III", "Darrell Henderson Jr.", "James Robinson",
"James Cook", "Dameon Pierce", "Michael Carter", "Jamaal Williams",
"Nyheim Hines", "J.D. McKissic", "Kenneth Gainwell", "Alexander Mattison",
"Isaiah Spiller", "Raheem Mostert", "Mark Ingram II", "Marlon Mack",
"Brian Robinson", "Gus Edwards", "Rex Burkhead", "Rachaad White",
"Khalil Herbert", "Damien Williams", "Tyler Allgeier", "D'Onta Foreman",
"Jerick McKinnon", "Cooper Kupp", "Justin Jefferson", "Ja'Marr Chase",
"Davante Adams", "Stefon Diggs", "Deebo Samuel", "CeeDee Lamb",
"Mike Evans", "Tyreek Hill", "Tee Higgins", "Keenan Allen", "DJ Moore",
"A.J. Brown", "Michael Pittman Jr.", "Mike Williams", "Brandin Cooks",
"Jaylen Waddle", "Diontae Johnson", "Terry McLaurin", "DK Metcalf",
"Courtland Sutton", "Amon-Ra St. Brown", "Darnell Mooney", "Allen Robinson II",
"Marquise Brown", "Amari Cooper", "Gabriel Davis", "Chris Godwin",
"Michael Thomas", "Jerry Jeudy", "Adam Thielen", "JuJu Smith-Schuster",
"Hunter Renfrow", "Rashod Bateman", "Elijah Moore", "Tyler Lockett",
"Christian Kirk", "Robert Woods", "DeVonta Smith", "Drake London",
"Allen Lazard", "Brandon Aiyuk", "Chase Claypool", "Kadarius Toney",
"Tyler Boyd", "Garrett Wilson", "DeVante Parker", "Chris Olave",
"Kenny Golladay", "Jakobi Meyers", "Russell Gage", "Marquez Valdes-Scantling",
"DeAndre Hopkins", "Marvin Jones Jr.", "Treylon Burks", "Michael Gallup",
"Robbie Anderson", "DJ Chark", "Jahan Dotson", "Mecole Hardman"
), Position = c("QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB",
"QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB",
"QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB", "QB",
"QB", "QB", "QB", "QB", "QB", "QB", "TE", "TE", "TE", "TE", "TE",
"TE", "TE", "TE", "TE", "TE", "TE", "TE", "TE", "TE", "TE", "TE",
"TE", "TE", "TE", "TE", "TE", "RB", "RB", "RB", "RB", "RB", "RB",
"RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB",
"RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB",
"RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB",
"RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB",
"RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "RB", "WR",
"WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR",
"WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR",
"WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR",
"WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR",
"WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR", "WR",
"WR", "WR", "WR", "WR"), FantasyPoints = c(445, 410, 407, 348,
351, 359, 354, 364, 402, 368, 353, 347, 349, 335, 366, 325, 297,
313, 273, 283, 302, 284, 275, 296, 291, 0, 247, 286, 276, 0,
0, 0, 0, 269, 0, 0, 252, 231, 206, 171, 185, 177, 174, 169, 169,
171, 139, 131, 170, 170, 162, 129, 162, 119, 130, 126, 130, 340,
285, 260, 278, 277, 271, 277, 247, 271, 225, 247, 249, 230, 196,
268, 205, 199, 213, 231, 220, 177, 176, 159, 178, 185, 155, 181,
157, 190, 177, 164, 156, 166, 169, 179, 158, 129, 147, 99, 158,
176, 150, 100, 157, 128, 156, 124, 98, 95, 75, 90, 136, 80, 82,
143, 128, 0, 147, 97, 63, 326, 337, 308, 299, 269, 267, 271,
242, 243, 241, 239, 243, 242, 244, 209, 220, 233, 239, 221, 198,
221, 209, 220, 209, 218, 178, 224, 183, 186, 203, 188, 164, 207,
211, 202, 173, 188, 163, 199, 171, 181, 182, 140, 170, 175, 144,
142, 164, 147, 131, 170, 160, 182, 136, 153, 157, 152, 148, 175,
144), DraftValue = c(31, 23, 20, 15, 16, 14, 16, 11, 12, 10,
10, 3, 7, 5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 37, 34, 22, 20, 17, 16, 12, 11, 9, 6, 4, 4,
5, 5, 2, 2, 2, 1, 1, 1, 1, 56, 55, 44, 48, 38, 38, 40, 38, 36,
34, 34, 33, 27, 30, 28, 27, 23, 21, 23, 21, 19, 18, 10, 15, 16,
16, 12, 12, 14, 13, 10, 11, 12, 8, 9, 1, 6, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 56, 48, 41,
40, 37, 31, 34, 29, 30, 28, 28, 26, 24, 26, 23, 23, 22, 21, 20,
18, 19, 20, 17, 18, 17, 15, 15, 17, 17, 16, 16, 15, 15, 13, 12,
12, 12, 11, 9, 9, 9, 7, 5, 6, 4, 2, 2, 2, 1, 3, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA,
-177L))
代码如下：
library(shiny)
library(lpSolve)
library(rsconnect)
# 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:", 2, 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:", 1, 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 = TRUE),
actionButton("update", "Update Team"),
selectInput("draft", "Draft Player", choices = c("",as.character(players$Player)), multiple = TRUE),
actionButton("draft_button", "Draft")
),
mainPanel(
tableOutput("team")
)
)
)
# Define the server logic
server <- function(input, output) {
players <- players
# 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)
# 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 the initial optimal lineup
initialLineup <- reactive({
rhs <- reactive({
c(input$num_qb, input$num_rb, input$num_wr, input$num_te, input$num_value, input$num_players)
})
result <- lp("max", obj, con(), dir, rhs(), all.bin = TRUE)
rv$players[result$solution == 1,]
})
# Show the updated optimal team in a table for any constraint change
output$team <- renderTable({
lineupResult()[, c("Player", "Position", "DraftValue", "FantasyPoints")]
})
# Define the function to run when the "update" button is pressed
updateLineup <- eventReactive(input$update, {
removedPlayer <- input$remove
rv$players <- rv$players[rv$players$Player != removedPlayer,]
obj <- rv$players$FantasyPoints
rhs <- reactive({
c(input$num_qb, input$num_rb, input$num_wr, input$num_te, input$num_value, input$num_players)
})
result <- lp("max", obj, con(), dir, rhs(), all.bin = TRUE)
rv$players[result$solution == 1,]
})
# Define the function to run when the "draft player" button is pressed
draftPlayer <- eventReactive(input$draft, {
draftedPlayer <- input$draft_player
draftedPlayers <- rv$players[rv$players$Player == draftedPlayer,]
rv$players <- rv$players[rv$players$Player != draftedPlayer,]
rv$draftedPlayers <- rbind(rv$draftedPlayers, draftedPlayers)
rhs <- reactive({
c(input$num_qb, input$num_rb, input$num_wr, input$num_te, input$num_value, input$num_players)
})
result <- lp("max", obj, con(), dir, rhs(), all.bin = TRUE)
rv$players[result$solution == 1,]
rv$players <- rbind(rv$players, rv$draftedPlayers)
})
# Show the updated optimal team in a table when the "update" button is pressed
output$team <- renderTable({
if (is.null(input$draft_player)) {
if (is.null(input$remove)) {
initialLineup()[, c("Player", "Position", "FantasyPoints", "DraftValue")]
} else {
updateLineup()[, c("Player", "Position", "FantasyPoints", "DraftValue")]
}
} else {
draftPlayer()[, c("Player", "Position", "FantasyPoints", "DraftValue")]
}
})
}
# Run the app
shinyApp(ui, server)
我尝试了一下。我对您的代码进行了相当多的修改以降低其复杂性，但首先我要指出我在重写部分代码之前看到的一些问题。
您的阵容有时会消失然后重新出现的原因是您如何将renderTable链接到您的输入和eventReactives。
输出$team依赖于输入$draft_player和输入$删除。首先，我在你的UI中没有看到输入$draft_player，所以我假设这是输入$draft_button。话虽如此，当删除一个播放器时，当你在select输入中输入一个播放器时，renderTable函数首先失效。但是updateLineup（）依赖于input$update，所以它不会返回任何东西，直到你点击“更新团队”。从而导致延迟。
在draftPlayer表达式中，您没有将obj设置为rv$玩家$FantasyPoint的新值，因此lp（）在具有完整玩家集的父环境中获取obj的值，因此错误。
我注意到的另外一件事是，在这两个函数中，您都返回rv$玩家[结果$解决方案==1，]。就我个人而言，我认为这样做的问题是，无论您自己的选秀选择如何，您总是会输出最优化的完整阵容。直观地说，我认为您会希望返回不包括您已经选秀的位置的最佳阵容。因此，如果已经选秀了QB和2个WR。那么您将返回一个只有6名球员的阵容，因为已经选秀了3名球员。
下面，我写了一些代码，考虑了最后一部分，并减少了输出函数的数量。这对我来说是有意义的，也许我在这里偏离了基础，但希望它与你试图实现的目标是一致的！
如果您有任何问题，请告诉我。
下面代码的目标是将您的选秀选择与优化选择一起包含。当一个球员被选中时，我们需要做一些事情。
const. rhs当一个播放器被移除时，它们只是从播放器池中“移除”，lp将在没有该播放器的情况下运行。
有了新的限制，lp将返回一个新的阵容，其中包含可用球员的数量和尚未使用修改后的草案预算起草的位置。在一个球员被起草或删除后，他们将从选择输入中删除，这样你就不会在将来意外选择他们。
在我的版本中，我有一些限制需要注意。为了简单起见，你一次只能移除或起草一个玩家。由于const. rhs是如何计算的，位置输入的总和必须与首发球员的总数相匹配。我知道这可能是一个问题，因为在第5轮或第6轮之后，我会根据谁有空来讨论是否拿起RB或WR。此外，我建议一旦草稿开始，不要更改任何输入，因为这可能会把事情搞砸。
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)
