RGLPKライブラリの条件付き制約R

Question

エクセルを長年使用した後に足をRに浸して質問があります。私は、Rがいかに速いかに徹底的に感銘を受け、Excelを1時間かけて1万回、Rを25,000回、同じシムを4分で実行しました。驚くばかり。

私はRでラインナップオプティマイザを作成しようとしていて、これはRGLPKライブラリが良い選択肢であることを示しています。今日私がどこに行けるのか助けてくれたので、他にも複数の質問がありますが、私はロードブロックに当たっています。他のいくつかのトピックがあります。ここで

Fantasy football linear programming in R with RGLPK

Rglpk - Fantasy Football Lineup Optimiser - Rbind of For Loop Output

Rglpk - Fantasy Football Lineup Optimiser - Forcing the Inclusion of a Player

私の株式オプティマイザはここで

#stock optimal linups solver 

name <- myData$Name 
pos <- myData$Pos 
pts <- myData$Projection 
cost <- myData$Salary 
team <- myData$Team 
opp <- myData$Opp 


num.players <- length(name) 

f <- pts 

var.types <- rep("B", num.players) 

A <- rbind(as.numeric(pos=="QB") 
      , as.numeric(pos=="RB") 
      , as.numeric(pos=="WR") 
      , as.numeric(pos=="TE") 
      , as.numeric(pos=="K") 
      , as.numeric(pos=="D") 
      ,cost) 

dir <- c("==" 
     ,"==" 
     ,"==" 
     ,"==" 
     ,"==" 
     ,"==" 
     ,"<=") 

b <- c(1 
     , 2 
     , 3 
     , 1 
     , 1 
     , 1 
     , 60000) 

library(Rglpk) 

sol <- Rglpk_solve_LP(obj = f 
         , mat = A 
         , dir = dir 
         , rhs = b 
         , types = var.types 
         , max=TRUE) 

myData[sol$solution == 1,] 
sprintf('Cost is:$%i', sum(cost[sol$solution > 0])) 
sprintf('Projected Points is: %f', sol$optimum) 

である私が使用しているデータへのリンクです。 0.01 -

https://www.dropbox.com/s/d5m8jjnq32f0cpe/Week6NFLProjections.csv?dl=0

は、私は、ループのコードは、前のスコアに=目標を設定することにより、複数のラインナップを作成することができる点にもよ。副次的なことに、このプロセスは継続的に進行しているので（たとえばラインナップ＃50）、これは正常であり、これをループするより効率的な方法はありますか？

私の本当の疑問は、もっと広範な制約をどうやって追加するのかということです。ファンタジーフットボールでは、同じチームの選手を「ペアにする」ことが有用であり、どのようにして制約に入れるのか分かりません。

単純なペアリングの例では、私の「最適なラインナップ」が同じチームのDとKを持つように、どのように制約を追加できますか？私は実際にCSVファイルでD + Kを組み合わせるだけでこの問題を回避することができましたが、Rにどのようにコード化するのかに興味があります。

さらに複雑なペアリングのシナリオは、 （3）WR /（1）TEの1つが同じチームにいること。

もう1つは、攻撃側プレイヤーが自分自身の防御と対戦していないことを確認することです。

ご協力いただければ幸いです。これに対する答えはどこにも見つからないようです。

Answer 1

このようなことを試してみてください。状況に合わせて変更するだけで済みます。私は自分のコードからこのダイレクトを取りましたが、基本的には、私が望むプレーヤーを入力し、これらと別のデータフレームを作成します。次に、左のポジションを最適化し、一緒にリンクして最終的なラインナップを作成します。これはループし、ユーザーが望むだけの数のラインナップを提供します。

Inclusions<-readline("Enter players to include into optimal lineups: ") 
Inclusions <- as.character(unlist(strsplit(Inclusions, ","))) 
Inclusions_table<-Data[ Data$Player.Name %in% Inclusions, ] 
Inclusions_no<-nrow(Inclusions_table) 
Data<-Data[ ! Data$Player.Name %in% Inclusions, ] 

Lineup_no<-readline("How many lineups to be generated?: ") 

num.players <- length(Data$Player.Name) 
obj<-Data$fpts 
var.types<-rep("B",num.players) 
subscore<-1000 

Lineups <- list() 
for(i in 1:Lineup_no) 
{ 
matrix <- rbind(as.numeric(Data$Position == "QB"), # num QB 
     as.numeric(Data$Position == "RB"), # num RB 
     as.numeric(Data$Position == "RB"), # num RB 
     as.numeric(Data$Position == "WR"), # num WR 
     as.numeric(Data$Position == "WR"), # num WR 
     as.numeric(Data$Position == "TE"), # num TE 
     as.numeric(Data$Position == "TE"), # num TE 
     as.numeric(Data$Position %in% c("RB", "WR", "TE")), # Num RB/WR/TE 
     as.numeric(Data$Position == "DEF"),# num DEF 
     Data$Salary,Data$fpts) 
direction <- c("==", 
    ">=", 
    "<=", 
    ">=", 
    "<=", 
    ">=", 
    "<=", 
    "==", 
    "==", 
    "<=","<") 
opt_var<-subscore-0.01   
rhs<-c(1-sum(Inclusions_table$Position=="QB"),max(0,2-sum(Inclusions_table$Position=="RB")),4-sum(Inclusions_table$Position=="RB"),max(0,2-sum(Inclusions_table$Position=="WR")),4-sum(Inclusions_table$Position=="WR"),max(0,1-sum(Inclusions_table$Position=="TE")),2-sum(Inclusions_table$Position=="TE"),7-sum(Inclusions_table$Position=="RB")-sum(Inclusions_table$Position=="WR")-sum(Inclusions_table$Position=="TE"),1-sum(Inclusions_table$Position=="DEF"),100000-sum(Inclusions_table$Salary),opt_var) 
sol <- Rglpk_solve_LP(obj = obj, mat = matrix, dir = direction, rhs = rhs, 
        types = var.types, max = TRUE) 
Lineup<-data.frame(Data[sol$solution==1,]) 
subscore<-sum(Lineup$fpts) 
Lineup<-rbind(Lineup,Inclusions_table) 
Lineup<-Lineup[order(Lineup$Position),] 
Salary<-sum(Lineup$Salary) 
Score<-sum(Lineup$fpts) 
print(Lineup) 
print(Salary) 
print(Score) 
Lineups[[i]]<-Lineup 
} 

データは、私のデータセットで、参考のために次のようになります。

 Position    Player.Name  Team Opponent Salary PPG fpts Pos_Rank upper lower Off_Snaps Pct_Off 
1056  TE    A.J. Derby Patriots  Bills 5000 0 0.0000  82  0  0  NA <NA> 
462  RB   Aaron Ripkowski Packers Falcons 6000 1.8 1.3116  75 1.8852 0.01  22  25% 
78   QB   Aaron Rodgers Packers Falcons 19350 20.6 18.4292  1 19.9689 17.2  87 100% 
1466  WR   Adam Humphries Buccaneers Raiders 7650 8.1 9.4808  46 11.2125 7.5664  38  51% 
1808  WR   Albert Wilson  Chiefs  Colts 5000 4.3 5.6673  74 6.2438 4.78  11  21% 
1252  WR  Aldrick Robinson Falcons Packers 5000 3.8 2.9114  96 3.2836 2.0152  10  15% 
636  RB   Alex Collins Seahawks  Saints 6000 2.7 1.5992  69 2.1513 0.41   1  2% 

うまくいけば、あなたに合うように、この例を変更することができます。