/ Knapsack problem done with a genetic algorithm
/ Given (i) a knapsack with a certain weight capacity
/ (ii) a collection of items having a weight and a value, 
/ find the  items to put  into the knapsack so that you don't
/ exceed its capacity and you get the maximum possible value.

/ Note that the order does not matter, so can encode as a 
/ string in which we indicate whether the item is in or out.

/ It appears that the simulating annealing trick of making mutation
/ probabilities higher at the beginning than later is a good one. 

/ APPLICATION


/ see how fit a chromosome is
/ negative if impossible because too heavy and otherwise get the value.
/ Application dependent
fit:{[c]
	w: +/weights*c	
	if[w > knapcap; :knapcap - w] / more negative if too weighty
	:+/values*c
}

/ crossover two chromosomes and return them
/ Generic crossover for binary encoding, pair is a pair of chromosomes.
crossover:{[pair]
	c1: pair[0]
	c2: pair[1]
	x: * 1 _draw 0
	if[x > crossoverprob
		:(c1;c2)
	]
	size: #c1
	i: 2 + *1 _draw (size-2)
	newc1: c1[!i],i _ c2
	newc2: c2[!i],i _ c1
	:(newc1; newc2)
}

/ cause a mutation in c with probability prob
/ Generic crossover for binary encoding
mutation:{[c;prob]
	numpos: _ (prob * #c)+0.5
	i: numpos _draw -#c
	c[i]: ~ c[i]
	:c
}

/ generic genetic algorithm
/ mutationprob: 0.1
/ crossoverprob: 0.2
evolve:{[]
  fitvals: fit'chromos
  max: |/fitvals
  imax: fitvals ? max
  bestchromo:: chromos[imax] 
  bestvalue:: fitvals[imax] / assuming the fitness is the value
  newchromos: ,bestchromo / keep this for the future
  choices: chromos _di imax
  fitvals: fitvals _di imax
  / now do selection
  ii: < fitvals
  choices@: ii / order based on fitness
  size: #choices
  x1: choices[ ! _ size % 2]
  x2: (_ size % 2) _ choices
  x: x1, x2, x2
  choices: x[size _draw -#x] / twice the prob of getting fitter chromos
  if[(#choices) > sqchromos
	choices@: !sqchromos
  ]
  / now do crossover
  crosses: ,/(!#choices) ,/:\: (!#choices)
  crosses@: & ~ crosses[;0] = crosses[;1]
  crossindexes: !#crosses / let there be replacment
  ceil:{[x] :[x = _ x; :x; 1 + _ x]}
  crossindexes@: ! _ ceil[numchromos % 2]
  x: ,/crossover'choices[crosses[crossindexes]]
  / now do mutations
  x: mutation[;mutationprob]'x
  newchromos,: x
  if[(1 + (#chromos)) < #newchromos
	newchromos@: ! 1 + (#chromos)
  ]
  :newchromos
}


/ DATA

/ knapsack parameters
numitems: 40
maxweight: 50
maxval: 300
knapcap: _ (numitems * maxweight) % 4
values: numitems _draw maxval
weights: 1 + numitems _draw maxweight

numitems: 4
values: 3 4 5 11
weights: values
knapcap: 12


/ genetic algorithm parameters
numchromos: 60
sqchromos: _ 1 + _sqrt[numchromos] 
bestchromo: numitems # 0
bestvalue: 0
mutationprob: 0.3 / higher seems better. Maybe it should get lower over time.
crossoverprob: 0.4
numgen: 1000 / how many generations to try


/ initialize chromos generically
chromos: ()
do[numchromos
  chromos,: ,numitems _draw 2
]



/ EXECUTION

i: 0
origmut: mutationprob
do[numgen+1
  i+: 1
  mutationprob: (((numgen+1) - i) % (numgen+1)) * origmut
  chromos: evolve[chromos]
  ` 0: ,$bestvalue
]

("Best chromosome: "), ,/$bestchromo
("Best value: "), $bestvalue
("Weight of best: "),$+/weights * bestchromo
("Knapsack capacity: "),$knapcap
("Number of generations: "), $numgen
("Number of chromosomes: "), $numchromos
(`"All weights: ") 
weights
(`"All values: ") 
values
(`"Best weights: ") 
weights[&bestchromo]
(`"Best values: ") 
values[&bestchromo]