Solving Problem of 8 Queens using genetic algorithm in Clojure.
حل مساله 8 وزیر توسط الگوریتم ژنتیک
Source Code is on my Github : [https://github.com/zorvan/N-Queens]
; Written by Amin Razavi , Dec 2015
; Amirkabir University of Technology (Tehran Polytechnic)
(ns core
(:require [clojure.math.numeric-tower :only (abs) :as tower])
(:require [clojure.set :only (difference) :as Set])
(:gen-class))
; Produce a Random Gene
(defn init-gene [NumQueens GENE]
(reduce #(assoc % %2 (rand-int NumQueens)) GENE (range (count GENE))))
; [It's Optional] Placing two queens in the same place is not allowed (at least at the beginning!)
(defn validate-chromosome [chromosome]
(let [SetRange (set (range (count chromosome)))]
(loop [distchrom (distinct chromosome)]
(if (= (count distchrom) (count chromosome)) (vec (sort distchrom))
(recur (conj distchrom [(first (Set/difference SetRange (set (map first distchrom))))
(first (Set/difference SetRange (set (map second distchrom))))]))))))
; Initialize Genes in the Chromosome
(defn init-chromosome [chromosome]
(let [GENE (first chromosome)
NUMQ (count chromosome)]
(reduce #(assoc % %2 (init-gene NUMQ GENE)) chromosome (range (count chromosome)))))
(defn codiagonal? [q1 q2]
(if ( = (tower/abs (- (first q1 ) (first q2))) (tower/abs (- (second q1) (second q2)))) true false))
(defn cocolumn? [q1 q2]
(if (= (first q1) (first q2)) true false))
(defn corow? [q1 q2]
(if (= (second q1) (second q2)) true false))
(defn fitness [chromosome]
(let [N (count chromosome)]
(reduce +
(for [i (range N) j (range N) :when (> j i)]
(let [q1 (get chromosome i) q2 (get chromosome j)]
(if (or (= q1 q2) (corow? q1 q2) (cocolumn? q1 q2) (codiagonal? q1 q2)) 1 0))))))
(defn update-fitness [chromosome]
(let [fc (first chromosome)]
(vector fc (fitness fc))))
(defn init-population [population]
(let [RN (range (count population))
ipop (reduce #(update-in % [%2 0] init-chromosome) population RN)]
(vec (sort-by #(second %) < (reduce #(update % %2 update-fitness) ipop RN)))))
; sequence of partial sum of Fitnesses (last number in the seq is sum of all fitnesses)
(defn SumFit [population]
(let [Fits (map second population)]
(rest (reduce #(conj % (+ %2 (last %))) [0] Fits))))
; Probability of selection is proportional to fitness
(defn ChooseParent [population]
(let [SFQ (reverse (SumFit population))
RND (rand-int (first SFQ))]
(dec (count (take-while #(> % RND) SFQ)))))
; an Auxiliary function for selecting parents
(defn AuxSelectParent [population]
(let [P1 (ChooseParent population)
P2 (ChooseParent population)]
(if (= P1 P2) [P1 (ChooseParent population)] [P1 P2])))
; n pairs of parents will be choosen
(defn Select-Parents [population n]
(repeatedly n #(AuxSelectParent population)))
(defn Select-Mutants [population PopNum MutationRate]
(if (zero? MutationRate) [(rand-int PopNum)]
(vec (take MutationRate (repeatedly #(rand-int PopNum))))))
; Mutate a chromosome (random gene & random value for coordinates)
(defn mutate [chromosome]
(let [genes (first chromosome)
N (count genes)
rndgene (rand-int N)
rndcoordinates [(rand-int N) (rand-int N)] ]
(update-fitness [(assoc genes rndgene rndcoordinates) 28])))
; Cross-over two chromosomes
(defn xover [chrom1 chrom2]
(let [N (count chrom1)
node (inc (rand-int N)) cnode (- N node)
intercombine (concat (take node chrom1) (take-last cnode chrom2) (take-last cnode chrom1) (take node chrom2))]
[[(vec (take N intercombine)) 0]
[(vec (take-last N intercombine)) 0]]))
; generate children
(defn Children [population Parents]
(reduce into [] (pmap #(xover (get-in population [(first %) 0]) (get-in population [(second %) 0])) Parents)))
; Produce New (Crossover) Children + Old Population
(defn New-Population [population XoverRate]
(into population
(pmap update-fitness
(Children population (Select-Parents population XoverRate)))))
; Apply Mutation Operator on the New Populatuion
(defn Mutate-Population [population PopNum MutationRate]
(vec (sort-by #(second %) < (reduce #(update % %2 mutate) population (Select-Mutants population PopNum MutationRate)))))
; if the boolean "dynamic" is true => population will grow with XOVER-RATE
; if the boolean "dynamic" is false => population will remain CTEPOP
(defn Generation [population PopNum XoverRate MutationRate dynamic CTEPOP]
(let [mutedpop (Mutate-Population (New-Population population XoverRate) PopNum MutationRate)]
(if (true? dynamic) mutedpop (vec (take CTEPOP mutedpop)))))
; MAIN LOOP
(defn -main [& args]
(if (empty? args)
(print "Wrong Input arguments! \n USAGE : 'Number of Queens' 'Number of Chromosomes' 'Crossover-Rate[0.0-1.0]' 'Mutation Rate[0.02-0.1]'")
(let [[NUM-QUEENS NUM-CHROMOSOMES XOVER-RATE MUTATION-RATE] args
XR (* XOVER-RATE NUM-CHROMOSOMES)
MR (* MUTATION-RATE NUM-CHROMOSOMES)
MAXFIT (/ (* NUM-QUEENS (dec NUM-QUEENS)) 2)
GENE [0 0] ; Gene = Position Coordinates of each queen on the board
CHROMOSOME (vec (repeatedly NUM-QUEENS #(vec GENE))) ; Chromosome = Board Configuration = Positions of Queens on the Board
POPULATION (vec (repeatedly NUM-CHROMOSOMES #(vec [CHROMOSOME MAXFIT])))]
(time
(loop [i 1 NewPop (Generation (init-population POPULATION) NUM-CHROMOSOMES XR MUTATION-RATE false NUM-CHROMOSOMES)]
(if (zero? (second (first NewPop)))
(print "GOT IT! at" i "th iteration:" (first (first NewPop)) "population=" (count NewPop) "\n\t=>")
(if (apply = (map first (take 5 NewPop)))
(print "LOCAL MIN! at" i "th iteration, fitness value=" (second (first NewPop)) "population=" (count NewPop) "\n\t=>")
(if (> i 500)
(print "TIMEOUT! fitness value=" (second (first NewPop)) "population=" (count NewPop) "\n\t=>")
(recur (inc i) (Generation NewPop NUM-CHROMOSOMES XR MR false NUM-CHROMOSOMES))))))))))
; Functional Version of Main
; (first (filter #(zero? (second (first %))) (iterate #(Generation % 0.2 0.2 false 10) (init-population p))))