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))))