there's some I do
;;;产生单个随机数
;;;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)
)
)
)
)
