Author Topic: [challenge]General Genetic Algorithm in Lisp  (Read 4812 times)

0 Members and 1 Guest are viewing this topic.

chlh_jd

  • Guest
[challenge]General Genetic Algorithm in Lisp
« on: March 12, 2011, 07:32:32 AM »
hi , all
here's a challenge to write a general GA in lisp, Just like a GGA in MatLab .

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #1 on: March 12, 2011, 07:34:39 AM »
:)

What is GGA in MatLab ?
Can you describe the functionality ?
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #2 on: March 12, 2011, 07:47:33 AM »
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

chlh_jd

  • Guest
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #3 on: March 12, 2011, 07:49:08 AM »
there's some I do
Code: [Select]
;;;产生单个随机数
;;;Generate a single random number
;;;由时间产生随机自然数
;;;Random natural number by the time
;;;(GA-Random-Num 0 99)
(defun GA-Random-Num (Rmi Rma / mid is_go_on)
  (setq is_go_on T)
  (while (and is_go_on
     (setq mid (fix (rem (getvar "CPUTICKS") Rma)))
)
    (if (>= mid Rmi)
      (setq is_go_on NIL)
    )
  )
  mid
)
;;;产生随机-1~1小数
;;;Generate a random decimal from -1 to 1
;;;(GA-Random-1 0 1)
(defun GA-Random-1 (Rmi Rma / mid is_go_on)
  (setq is_go_on T)
  (while (and is_go_on
     (setq mid (rem (getvar "CPUTICKS") (* 2.0 pi)))
)
    (if (>= Rma (sin mid) Rmi)
      (setq is_go_on NIL)
    )
  )
  (sin mid)
)
;;;产生0~LIMA的整数随机数列
;;;generate a 0 ~ LIMA random sequence of integers
(defun GA-Random-Series (Lima / lst i mid)
  (setq lst nil
i   0
  )
  (repeat (1+ Lima)
    (setq mid (GA-Random-1 -1 1)
 lst (cons (cons i mid) lst)
 i   (1+ i)
    )
  )
  (setq lst (vl-sort lst
    (function (lambda (e1 e2)
(< (cdr e1) (cdr e2))
      )
    )
   )
  )
  (mapcar 'car lst)
)
 ;|
(repeat 24
(princ (GA-Random-Series 3))
  )
|;
;;;元素交换
(defun GA-Swap (x y / tmp)
  (setq tmp x)
  (set x (eval y)
       y tmp    
  )
)
;;;保持最优种群函数
;;;to keep optimal population
(defun GA-keep-the-best (population polup / cur_best i polui)
  (setq cur_best 0
i 0
  )
  (repeat (length population)
    (setq polui (nth i population))
    (if (> (fit-fun polui) (fit-fun polup))
      (setq cur_best i
   polup polui
      )
    )
    (setq i (1+ i))
  )
  polup
)
;;;种群置换
;;;Population replacement
(defun GA-elitist (population NVARS /    i
  len      best worst    polui
  polui+1    fit_i fit_i+1    best
  best_mem   worst worst_mem  fit_n
  worst.gene.i best.gene
 )
  (setq i     0
len   (length population)
best  (fit-fun (car population))
worst (fit-fun (car population))
  )
  (repeat (1- len)
    (setq polui  (nth i population)
 polui+1 (nth (1+ i) population)
 fit_i  (fit-fun polui)
 fit_i+1 (fit-fun polui+1)
    )
    (if (> fit_i fit_i+1)
      (progn
(if (>= fit_i best)
 (setq best fit_i
best_mem i
 )
)
(if (<= fit_i+1 worst)
 (setq worst fit_i+1
worst_mem (1+ i)
 )
)
      )
      (progn
(if (<= fit_i worst)
 (setq worst fit_i
worst_mem i
 )
)
(if (>= fit_i+1 best)
 (setq best fit_i+1
best_mem (1+ i)
 )
)
      )
    )
  )
  ;;如果新种群中最好的子代比父代种群中都好,那么从新种群中复制新子代,否则用上一代中最好的个体替换当前种群中选择最差的子代
  ;|If the new offspring population than the best parent population is good, then copy the new offspring from the new population,
or spend the best of a generation of individuals selected to replace the current worst offspring population .
|;
  (setq fit_n (fit-fun (nth (1- len) population)))
  (if (>= best fit_n)
    (progn
      (setq population[best] (nth best_mem population)
   worst.gene.i (GA-get-worst-gene-i population[best])
   best.gene (GA-get-best-gene (nth (1- len) population))
   population[best] (ch-lst best.gene
worst.gene.i
population[best]
)
   population[best_fit] (fit-fun population[best])
      )
    )
    (progn
      (setq population[best] (nth (1- len) population)
   worst.gene.i (GA-get-worst-gene-i population[best])
   best.gene (GA-get-best-gene (nth best_mem population))
   population[best] (ch-lst best.gene
worst.gene.i
population[best]
)
   population[best_fit] (fit-fun population[best])
      )
    )
  )
;;;这里需要处理下,如果新种群较先前最好的种群适应性差,那么用新种群的最好个体替换最优种群的最差个体
  ;|There need to be addressed, if the new population the best population than previously poor adaptability,
then the best individual with the new population replaces the worst individual optimal population
|;
;;;                如果新种群比先前最好的种群适应性好,那么用新种群作为母代,并用原最好种群中最佳个体替换,母代中最差个体
  ;|If the new species is adaptable species than the previous best, then as a mother with a new generation of population
and population with the best individual in the original the best replacement, the mother on behalf of the worst individual
|;
)
;;;-----------------------------------------
;;;选择函数:标准模型的最大化问题纳入精英比例选择 - 可以确保留下来的成员的最优
;|Selection functions: the maximization of the standard model of proportional selection into the elite - to ensure that the members left the optimal
|;
(defun GA-select (population    Nvars    /      sum      i
 fit_lst  fit    rfit_lst rfit_n   p       newpopu
 is_go
)
  ;;计算种群总适合度
  ;_Calculate the total fitness of population
  (setq sum 0.0
i 0
fit_lst nil
  )
  (repeat (length population)
    (setq fit  (fit-fun (nth i population))
 sum  (+ sum fit)
 fit_lst (cons fit fit_lst)
 i  (1+ i)
    )
  )
  ;;计算种群相对适应度
  ;_Calculated the relative fitness of population
  (setq rfit_lst (mapcar (function (lambda (x)
    (/ x sum)
  )
)
(reverse fit_lst)
)
  )
  ;;计算累积适应度
  ;_Calculate the cumulative fitness
  (setq rfit_n (- 1.0 (last rfit_lst)))
  (setq p (GA-Random-1 0 1)
newpopu (GA-Random-Series Nvars)
  )
  (if (< p (car rfit_lst))
    (setq population (ch-lst newpopu population))
    (progn
      (setq i 0
   is_go T
      )
      (while (and is_go (setq rfiti+1 (nth (1+ i) rfit_lst)))
(setq rfiti (nth i rfit_lst))
(if (and (<= rfiti p) (< p rfiti+1))
 (setq population
(ch-lst newpolu i population)
is_go NIL
 )
)
(setq i (1+ i))
      )
    )
  )
  polulation
)
;;;-------------------------------
;;;杂交 Crossover
;;;交配点的选择:选择两个父母参加交叉部分。实现了单点交叉
;_Mating site selection: select two parents to participate in cross-section. To achieve a single point crossover
;;;注意此处为2进制编码 Note that here the binary code
(defun GA-crossover (POPSIZE PXOVER / i fi one end x)
  (setq i  0
fi 0
  )
  (repeat POPSIZE
    (setq x (GA-Random-1 0 1))
    (if (< x PXOVER)
      (progn
(setq fi (1+ fi))
(if (= fi 0) ;_这里有点问题...判别条件似乎不对 There seems little question ... Criterion not
 (setq end (GA-Xover one i))
 (setq one i)
)
      )
    )
    (setq i (1+ i))
  )
  end
)
;;;交叉:执行两个选定的父母交配。
;_Cross: the implementation of the mating of two selected parents.
(defun GA-Xover (a b / Nvars point i mid1 mid2)
  (setq Nvars (length a))
  (if (> Nvars 1)
    (progn
      (if (= Nvars 2)
(setq point 1)
(setq point (GA-Random-Num 0 (1- Nvars)))
      )
      (setq i 0)
      (repeat point
(setq mid1 (nth i a)
     mid2 (nth i b)
)
(GA-Swap mid1 mid2)
(setq a (ch-lst i mid1)
     b (ch-lst i mid2)
)
(setq i (1+ i))
      )
    )
  )
  (list a b)
)
;;;------------------------------------
;;;变异:随机均匀变异。对于变异选定一个变量被替换为这个变量之间的上下界的随机值
;_Variation: Random uniform mutation. Select a variable for the variation of the variables are replaced with random values ??of upper and lower bounds
(defun GA-mutate (population PMUTATION / x)
  (setq i     0
Nvars (length (car population))
  )
  (repeat (length population)
    (setq j   0
 Var (nth i population)
    )
    (repeat NVars
      (setq x (GA-random-1 0 1))
      (if (< x PMUTATION)
(progn
 (setq lbound (GA-lower (nth j Var))
hbound (GA-upper (nth j Var))
 )
 (setq Var (ch-lst (GA-Random-Num lbound hbound) j Var))
)
      )
      (setq j (1+ j))
    )
    (setq population (ch-lst Var i population))
    (setq i (1+ i))
  )
)
;;;written by qj-chen
;;;Edited by GSLS(SS)
(defun ch-lst (new i lst / j len fst mid)
  (if (/= (type i) 'list)
    (cond
      ((minusp i)
       lst
      )
      ((> i (setq len (length lst)))
       lst
      )
      ((> i (/ len 2))
       (reverse (ch-lst new (1- (- len i)) (reverse lst)))
      )
      (t
       (append
(progn
  (setq fst nil)
  (repeat (rem i 4)
    (setq fst (cons (car lst) fst)
  lst (cdr lst)
    )
  )
  (repeat (/ i 4)
    (setq fst (cons (cadddr lst)
    (cons (caddr lst)
  (cons
    (cadr lst)
    (cons
      (car lst)
      fst
    )
  )
    )
      )
  lst (cddddr lst)
    )
  )
  (reverse fst)
)
(list new)
(cdr lst)
       )
      )
    )
    (progn
      (setq j (cadr i)
   i (car i)
      )
      (if j
(progn
 (setq mid (nth i lst))
 (setq mid (ch-lst new j mid))
 (ch-lst mid i lst)
)
(ch-lst new i lst)
      )
    )
  )
)

chlh_jd

  • Guest
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #4 on: March 12, 2011, 07:55:23 AM »
Thank you, CAB, I regret that I can not open the URL you gave , I'll try again .
Hi kerry , GGA = General genetic algorithm

chlh_jd

  • Guest
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #5 on: March 14, 2011, 01:26:58 AM »
Perhaps , it's tedious work ....


pkohut

  • Bull Frog
  • Posts: 482
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #6 on: March 14, 2011, 01:48:07 AM »
Perhaps , it's tedious work ....



There's no scope defined, or data set to work against. It has no FUN factor and it sounds like work.

No thanks.
New tread (not retired) - public repo at https://github.com/pkohut

dgorsman

  • Water Moccasin
  • Posts: 2437
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #7 on: March 14, 2011, 10:21:45 AM »
Genetic algorithms are horrendously complex.  Makes optimizing Delaunay code look like finger painting.   :doa:
If you are going to fly by the seat of your pants, expect friction burns.

try {GreatPower;}
   catch (notResponsible)
      {NextTime(PlanAhead);}
   finally
      {MasterBasics;}

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #8 on: March 14, 2011, 10:46:28 AM »
my variant use genetic algorithm:
(Challenge) To draw the shortest lwpolyline

chlh_jd

  • Guest
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #9 on: March 14, 2011, 12:41:33 PM »
Yes Evgeniy , it work like the genetic way , but it's not Genetic .
so it can't solve most problems , perhaps it can be wroten so easy in other Pro-Languages , but it's so hard in the lisp which it's so closest the AI (Artificial Intelligence) .




ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #10 on: March 14, 2011, 12:47:06 PM »
I often use genetic algorithms, I like them.
Sorry, but this is part of larger projects, not for publication on-line.

If you have any questions, ask - I'll try to help with the application of such algorithms in LISP.
My opinion - lisp is designed for use in its genetic algorithms, they conveniently fall on the lists of iteration or recursion...

chlh_jd

  • Guest
Re: [challenge]General Genetic Algorithm in Lisp
« Reply #11 on: March 16, 2011, 01:17:31 AM »
 :-P
Evgeniy , Nice Guy !
I finally found a teacher  :evil: