Genetic Algorithm

Genetic Algorithm 
             The genetic algorithm is a classic algorithm, which is a bio-inspired and population-based technology for complex problems.GA mainly includes the phases  of initialization,selection,crossover and mutation. generally we are using Crossover probability and mutation probability as limitations of mutation and cross presses. but in my implementation i used elitism instead of crossover probability       
            Here i'm using following values for the above purpose




  • elitism = 0.7
  • mutation probability = 0.001 
                  with my example i'm going to search what is the maximum value can be given as variable "x" in order to get the maximum value of (15x + x^2) expression.There for i used this as fitness function of my implementation 

This is my code   


;;; UWU/CST/10/0046
;;; UWU/CST/10/0014
;;; fitness function ex: answer= 15x - (x *x)
;;; more reliable untill 10000 as x

(defun fitness (child_int);;fitness function to check fitness
 (- ( * 15 child_int) (* child_int child_int)))

(defun random-item(list);;ramdomly select item from a list
   (nth (random (length list)) list))
;
(defun int-to-binary(intval);;will decode the intiger to 16 bit string
 (let ((binstring  (write-to-string intval :base 2)))
  (when(eq intval nil) (setf binstring "000"))
  (loop while (< (length binstring) 14) 
   do (setf binstring (concatenate 'string "0" binstring)))
  binstring))

(defun mutation(int_child mutation-rate);;generate muted child
 (defun mutant (byte);;mutation procedure
  (let ((mute-gene (char "1" 0)))
   (if (< (random 1.0) mutation-rate) 
    (progn (if (char= byte (char "1" 0)) 
      (progn (setf mute-gene (char "0" 0)) mute-gene)
       mute-gene))
    byte)))

 (let ((child (int-to-binary int_child))) 
  (loop for k from 0 to (- (length child) 1) do
   (setf (char child k) (mutant (char child k))))
  (parse-integer child :radix 2)))


(defun crossover(xA xB);;crossover and produce child
 (let ((b-xA (int-to-binary xA)) (b-xB (int-to-binary xB)) 
  (child (int-to-binary nil)) (random-gene '(#\0 #\1)))
  (loop for y from 0 to (- (length b-xA) 1) do
  (if (char/= (aref b-xA y) (aref b-xB y)) 
   (progn (setf (char child y) (random-item random-gene)))
   (setf (char child y) (char b-xB y))))
  (parse-integer child :radix 2)))
  
(defun list_toarray (list);;convert list to array
 (setq array (make-array (length list) ::initial-contents list))
 array)

(defun maximum (list);;get the maximum of a intiger list
   (reduce #'max list))

(defun get-best-fits(lskt iterations);;select the best fited cromosomes 
 (let ((temp-lst lskt)(arr (list_toarray lskt))
  (best-lst '()) (fitnes-lst '()))
  (loop for y from 0 to (-(length lskt) 1) do 
   (push (fitness (aref arr y)) fitnes-lst))
  (loop for z from 0 to iterations do
    (push (aref arr (-(-(length arr) 1) 
     (position (maximum fitnes-lst) fitnes-lst))) best-lst)
   (setf (nth (position (maximum fitnes-lst) fitnes-lst)
     fitnes-lst) 0))
  best-lst))

(defun main(elitism mutation-rate)
 (let ((pop '()) (population 10) (iterations 3000))
  (setf ne (* population elitism));number of elitism
  (setf nc (/ (- population ne) 2));number of cross over
  (loop while (/= (length pop) population) do
    (pushnew (random 100) pop))
  (loop for x from 1 to iterations do
   (let ((pop2 '()) (xA (random-item pop)) (xB (random-item pop))  
    (pop1 (get-best-fits pop ne)))
     (loop for z from 1 to nc do
      (pushnew (crossover xA xB) pop2)
      (pushnew (crossover xA xB) pop2))
     (let ((mutant (random-item pop2)))
      (loop for p from 1 to nc do
       (setf (nth (position mutant pop2) pop2) 
        (mutation mutant mutation-rate))))
     (setf pop (append pop1 pop2))
     (when (= (random-item pop) (random-item pop) (random-item pop))
       (progn (setf (nth (random (length pop)) pop) (random 100)) 
        (setf (nth (random (length pop)) pop) (random 10000))))))
  (get-best-fits pop 0)));;end of the main function
 

No comments:

Post a Comment