-
Notifications
You must be signed in to change notification settings - Fork 3
/
Genetic Algorithm - DFS Optimization.R
117 lines (98 loc) · 4.21 KB
/
Genetic Algorithm - DFS Optimization.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#Genetic algorithm to optimize daily fantasy sports lineup
#Author: Matt Brown email: Matthew.brown.iowa@gmail.com
#
#The algorithm takes a csv of player names, positions, salaries and expected points scored and generates an optimal lineup based
#based on the constraints in the evaluation function.
#
#The algorithm can be used across a variety of similar knapsack optimization type problems.
#
#Note: This does not always generate the optimal lineup. Adjusting the parameters can help you get close to optimal.
#Please see my other repository "lpsolve - DFS Lineup Optimization" for code that will always generate an optimal lineup.
library(parallel)
library(doParallel)
library(GA)
#Simple genetic algorithm
dataset<-read.csv("Rotogrinders MLB Projections 6 15 2016.csv", stringsAsFactors = FALSE)
dataset$position <- as.factor(dataset$position)
str(dataset)
table(dataset$position)
salarylimit <- 50000
#Set initial population
#Ensure that the intitial population meets all the criteria in the evaluation function
initialPopul <- rep(0,nrow(dataset))
initialPopul[8]<-1
initialPopul[24]<-1
initialPopul[7]<-1
initialPopul[23]<-1
initialPopul[4]<-1
initialPopul[5]<-1
initialPopul[10]<-1
initialPopul[3]<-1
initialPopul[18]<-1
initialPopul[125]<-1
#View initial population and initial population values
sum(dataset$salary[initialPopul==1])
sum(dataset$fpts[initialPopul==1])
dataset$player[initialPopul==1]
dataset$position[initialPopul==1]
#Define fitness function to ensure that solutions meet criteria
evalFunc <- function(x) {
current_solution_salary <- x %*% dataset$salary
current_solution_fpts <- x %*% dataset$fpts
if(sum(dataset$position[x==1] == "1B") == 0 &&
sum(dataset$position[x==1] == "1B/2B") ==0 &&
sum(dataset$position[x==1] == "1B/3B") ==0 &&
sum(dataset$position[x==1] == "1B/OF") ==0 &&
sum(dataset$position[x==1] == "1B/SS") ==0 &&
sum(dataset$position[x==1] == "1B/C") ==0 )
return(0)
if(sum(dataset$position[x==1] == "2B") == 0 &&
sum(dataset$position[x==1] == "1B/2B") ==0 &&
sum(dataset$position[x==1] == "2B/3B") ==0 &&
sum(dataset$position[x==1] == "2B/OF") ==0 &&
sum(dataset$position[x==1] == "2B/SS") ==0 &&
sum(dataset$position[x==1] == "2B/C") ==0 )
return(0)
if(sum(dataset$position[x==1] == "3B") == 0 &&
sum(dataset$position[x==1] == "1B/3B") ==0 &&
sum(dataset$position[x==1] == "2B/3B") ==0 &&
sum(dataset$position[x==1] == "3B/OF") ==0 &&
sum(dataset$position[x==1] == "3B/SS") ==0 &&
sum(dataset$position[x==1] == "3B/C") ==0 )
return(0)
if(sum(dataset$position[x==1] == "SS") == 0 &&
sum(dataset$position[x==1] == "1B/SS") ==0 &&
sum(dataset$position[x==1] == "2B/SS") ==0 &&
sum(dataset$position[x==1] == "OF/SS") ==0 &&
sum(dataset$position[x==1] == "3B/SS") ==0 &&
sum(dataset$position[x==1] == "C/SS") ==0 )
return(0)
if(sum(dataset$position[x==1] == "C") == 0 &&
sum(dataset$position[x==1] == "1B/C") ==0 &&
sum(dataset$position[x==1] == "2B/C") ==0 &&
sum(dataset$position[x==1] == "3B/C") ==0 &&
sum(dataset$position[x==1] == "C/OF") ==0 &&
sum(dataset$position[x==1] == "C/SS") ==0 )
return(0)
if( sum(x)>10 ||
current_solution_salary > salarylimit ||
sum(dataset$position[x==1] =="1B")>1 ||
sum(dataset$position[x==1] =="2B")>1 ||
sum(dataset$position[x==1] =="3B")>1 ||
sum(dataset$position[x==1] =="SS")>1 ||
sum(dataset$position[x==1] =="OF")>3 ||
sum(dataset$position[x==1] =="C") >1 ||
sum(dataset$position[x==1] =="SP")>2)
return(0) else return(current_solution_fpts)
}
#Run gnetic algorithm
#Modify the parameters to find more optimal solutions
GAmodel <-ga(type="binary",nBits = nrow(dataset), fitness=evalFunc,
suggestions = initialPopul, popSize=100, monitor = TRUE,
pmutation = .6, pcrossover = .9,
maxiter=1000, parallel= TRUE, names = dataset$player)
#View the solution
sol <-summary(GAmodel)$solution
dataset[sol==1]
#Plot of solution progress
plot(GAmodel)