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

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

Evgeniy , Nice Guy !
I finally found a teacher