|
[code];;(Powell val con arg arg_limit eps)
(defun Powell (val con arg
arg_limit eps / ss_powell_arg0
ss_powell_1dmin ss_powell_main_function
ss_powell_a0 ss_powell_dfm_lst ss_powell_dfm
ss_powell_x0 ss_powell_f0 ss_powell_x1
ss_powell_f1 ss_powell_x2 ss_powell_f2)
;; --------------------------------------------------------;;
;; Use Powell method to solve solve optimization problems
;;
;; Args:
;; val -- Expressions calculation function
;; con -- Restriction function
;; arg -- A string list of the Parameters's name , such as '( "x1" "x2" ...)
;; arg_limit -- parameters's limits , like '( (-1e14 1e14) (0 1e14) ...)
;; eps -- accuracy
;;
;; by GSLS(SS) 2013.10.6
;;---------------------------------------------------------;;
(defun ss_powell_1dmin (x -xm x0 +xm / f0 fa fb -fm +fm)
;; One-dimensional search
;; This function has not the Powell method .
;; How to change it connect with Gradient direction ?
(set (read x) x0)
(setq f0 (if (con)
(val)
1e99))
(set (read x) -xm)
(setq fa (if (con)
(val)
1e99))
(set (read x) (* 0.5 (+ x0 -xm)))
(setq -fm (if (con)
(val)
1e99))
(set (read x) +xm)
(setq fb (if (con)
(val)
1e99))
(set (read x) (* 0.5 (+ x0 +xm)))
(setq +fm (if (con)
(val)
1e99))
(cond
((or (equal x0 -xm eps) (equal x0 +xm eps))
x0)
((< fa -fm f0 +fm fb)
-xm)
((> fa -fm f0 +fm fb)
+xm)
((and (> fa -fm f0) (< f0 +fm fb))
(ss_powell_1dmin x (* 0.5 (+ x0 -xm)) x0 (* 0.5 (+ x0 +xm))))
((and (> fa -fm) (< -fm f0 +fm fb))
(ss_powell_1dmin x -xm (* 0.5 (+ x0 -xm)) x0))
((and (> fb +fm) (> fa -fm f0 +fm))
(ss_powell_1dmin x x0 (* 0.5 (+ x0 +xm)) +xm))
((and (equal x0 -xm (sqrt eps)) (equal x0 +xm (sqrt eps)))
(/ (+ x0 -xm +xm) 3.))
))
(setq ss_powell_arg0 arg)
(if arg_limit
(mapcar
(function
(lambda (x y)
(cond
((or (not y) (apply (function or) y))
(set (read (strcat x "_limit")) (list -1e14 1e14)))
((not (car y))
(set (read (strcat x "_limit")) (list -1e14 (cadr y))))
((not (cadr y))
(set (read (strcat x "_limit")) (list (car y) 1e14)))
(t (set (read (strcat x "_limit")) y))
)))
arg
arg_limit)
(foreach x arg
(set (read (strcat x "_limit")) (list -1e14 1e14)))
) ;_ x1_limit
(setq ss_powell_x0
(mapcar
(function
(lambda (x)
(*
0.5
(+
(car (eval (read (strcat x "_limit"))))
(cadr (eval (read (strcat x "_limit"))))))))
arg))
(defun ss_powell_main_function (/ ss_powell_i)
(ss-set arg ss_powell_x0)
(setq ss_powell_f0
(if (con)
(val)
1e99))
(setq ss_powell_a0
(mapcar (function (lambda (x)
0.0))
arg)
ss_powell_dfm_lst
nil
ss_powell_i 0)
(mapcar
(function
(lambda (x /
ss_powell_a1_f0 ss_powell_a1_x0
ss_powell_a1_l ss_powell_a1_-xm
ss_powell_a1_+xm ss_powell_a1_ai
ss_powell_a1_f1 )
(setq ss_powell_a1_f0
(if (con) (val)1e99))
(setq ss_powell_a1_x0 (eval (read x)))
(setq ss_powell_a1_l (eval (read (strcat x "_limit"))))
(setq ss_powell_a1_-xm (car ss_powell_a1_l)
ss_powell_a1_+xm (cadr ss_powell_a1_l))
(setq ss_powell_a1_ai
(- (ss_powell_1dmin
x
ss_powell_a1_-xm
ss_powell_a1_x0
ss_powell_a1_+xm)
ss_powell_a1_x0))
(setq ss_powell_a0 (ch-lst ss_powell_a1_ai ss_powell_i ss_powell_a0))
(ss-set arg
(mapcar (function +) ss_powell_x0 ss_powell_a0))
(setq ss_powell_a1_f1
(if (con)
(val)
1e99))
(setq ss_powell_dfm_lst
(cons (- ss_powell_a1_f0 ss_powell_a1_f1) ss_powell_dfm_lst))
(setq ss_powell_i (1+ ss_powell_i))
))
arg)
(setq ss_powell_dfm_lst (reverse ss_powell_dfm_lst))
(setq ss_powell_x1
(mapcar (function +) ss_powell_x0 ss_powell_a0))
(setq ss_powell_x2
(mapcar (function (lambda (x y)
(- (* 2. x) y)))
ss_powell_x1
ss_powell_x0))
(ss-set arg ss_powell_x1)
(setq ss_powell_f1
(if (con)
(val)
1e99))
(ss-set arg ss_powell_x2)
(setq ss_powell_f2
(if (con)
(val)
1e99)))
(ss_powell_main_function)
(while (not (equal ss_powell_x1 ss_powell_x0 eps))
(setq ss_powell_dfm (apply (function max) ss_powell_dfm_lst))
(if
(or (>= ss_powell_f2 ss_powell_f0)
(>= (* (+ ss_powell_f0 ss_powell_f2 (* -2. ss_powell_f1))
(- ss_powell_f0 ss_powell_f1 ss_powell_dfm))
(* 0.5
ss_powell_dfm
(expt (- ss_powell_f0 ss_powell_f2) 2))))
(progn
(if (< ss_powell_f1 ss_powell_f2)
(setq ss_powell_x0 ss_powell_x1)
(setq ss_powell_x0 ss_powell_x2))
;_ (setq ss_powell_dfm_i (vl-sort-i ss_powell_dfm_lst (function >)))
)
(progn;_this is not
(setq ss_powell_i
(car
(vl-sort-i ss_powell_dfm_lst (function >))))
(setq ss_powell_a0
((lambda(/ i)
(setq i -1)
(mapcar
(function (lambda (y)
(setq i (1+ i))
(if (= i ss_powell_i)
y
(* -2. y))))
ss_powell_a0))))
(setq ss_powell_x0 (mapcar (function +) ss_powell_x0 ss_powell_a0))
;_(setq ss_powell_dfm_i (shift(vl-sort-i ss_powell_dfm_lst (function >))))
)
;_(setq ss_powell_x0 ss_powell_x1)
)
;|
(setq arg (mapcar (function (lambda (i)
(nth i arg)))
ss_powell_dfm_i))
(setq ss_powell_x0 (mapcar (function (lambda (i)
(nth i ss_powell_x0)))
ss_powell_dfm_i))|;
(ss_powell_main_function))
(ss-set arg ss_powell_x1)
(setq ss_powell_f1
(if (con)
(val)
1e99))
(list (mapcar (function (lambda (x) (eval(read x)))) ss_powell_arg0) ss_powell_f1))[/code] |
|