采用交叉熵算法求解0-1背包问题
(defun c:tt()(setq w_tol 700wlst '(24 39 26 10 25 75 8 3137 48 46 18 49 12 50 92 200 145 95 65) ;;;各物品重量
clst '(100 12070 26 6015016 60 709078308019 75120240160 10025)) ;;;各物品价值
(setq n (length wlst) m 3000r 0.9995 pflst nil pslst nil)
(repeat n
(setq pflst (cons 0.5 pflst))
(setq pslst (cons 1.0 pslst))
)
(defun rnd ()
(*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
(mapcar '(lambda (x) (if (< (rnd) x) 1 0)) lst)
)
(defun check(lst)
(setq s 0 c 0)
(mapcar '(lambda (x y) (if (<= (setq s (+ s (* x y))) w_tol) (progn (setq c s) y)(progn (setq s c) 0))) wlst lst)
)
(while (> (apply 'max (mapcar '(lambda (x y) (abs (- y x))) pflst pslst)) 0.0001)
(setq xlst nil)
(repeat m
(setq xlst (cons (xfun pflst) xlst))
)
(setq xlst (mapcar 'check xlst))
(setq vlst (mapcar '(lambda (x) (apply '+ (mapcar '* x clst))) xlst))
(setq pt (nth (fix (* r m))
(mapcar 'cadr (vl-sort (mapcar '(lambda (x) (list (float x) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))
)
)
(setq evlst (mapcar '(lambda (y) (if (>= y pt) 1 0)) vlst) en (float (apply '+ evlst)))
(setq pslst (mapcar '(lambda (k) (/ k en)) (mapcar '(lambda (z) (apply '+ (mapcar '* z evlst)))(apply 'mapcar (cons 'list xlst)))))
(setq pflst (mapcar '(lambda (x y) (+ (* 0.6 x) (* 0.4 y))) pslst pflst))
)
(setq xxlst (car (vl-remove nil (mapcar '(lambda (x) (if (= (apply 'max vlst) (apply '+ (mapcar '*x clst))) x nil)) xlst))))
(list (apply '+ (mapcar '* clst xxlst))
(apply '+ (mapcar '* wlst xxlst))
xxlst
)
)
命令: tt
(1259 697 (1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0))
命令:
命令: tt
(1259 697 (1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0))
命令:
命令: tt
(1259 697 (1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0))
命令:
命令: tt
(1259 697 (1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0))
命令:
命令: tt
(1264 685 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 0))
命令:
命令: tt
(1284 698 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0))
命令:
本帖最后由 mahuan1279 于 2021-1-7 11:51 编辑
(defun tt()
(setq w_tol 7718
clst '(597 596 593 586 581 568 567560 549 548 547 529 529 527 520 491 482 478 475 475 466 462 459 458 454 451 449 443 442 421 410 409 395 394 390 377 375 366361 347 334 322 315 313 311 309296 295 294 289 285 279 277 276 272 248 246 245 238 237 232 231 230 225 192 184 183 176 174 171 169 165 165 154 153 150 149 147 143 140 138 134 132 127 124 123 114 111 104 89 74 63 62 58 55 48 27 22 12 6 220 208 198 192 180 180 165 162 160 158 155 130 125 122 120 118 115 110 105 101 100 100 98 96 95 90 88 82 80 77 75 73 72 7069 66 65 63 60 58 56 50 30 20 15 10 8 5 3 1)
wlst '(54 18310682 30 58 71166117 190 90 191 205 128 110 89 63 6 140 86 30 91 156 31 70 199 142 98 178 16 140 31 24 197 101 73 169 73 92 159 71 102 144 151 27 131 209 164 177 177 129 146 17 53 164 146 43 170 180 171 130 183 5 113 207 57 13 163 20 63 12 24 9 42 6 109 170 108 46 69 43175 81 5 34 146 148 114 160 174 156 82 47 126 102 83 58 34 21 14 80 82 85 70 72 70 66 50 55 25 50 55 40 48 50 32 22 60 30 32 40 38 35 32 25 28 30 22 25 30 45 30 60 50 20 65 20 25 30 10 20 25 15 10 10 10 4 4 2 1))
(setq n (length wlst) m 1000r 0.9 pflst nil pslst nil)
(repeat n
(setq pflst (cons 0.5 pflst))
(setq pslst (cons 1.0 pslst))
)
(defun rnd ()
(*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
(mapcar '(lambda (x) (if (< (rnd) x) 1 0)) lst)
)
(defun check(lst)
(setq s 0 c 0)
(mapcar '(lambda (x y) (if (<= (setq s (+ s (* x y))) w_tol) (progn (setq c s) y)(progn (setq s c) 0))) wlst lst)
)
(setq valst '(0 0))
(while (> (apply 'max (mapcar '(lambda (x y) (abs (- y x))) pflst pslst)) 0.001)
(setq xlst nil)
(repeat m
(setq xlst (cons (xfun pflst) xlst))
)
(setq xlst (mapcar 'check xlst))
(setq vlst (mapcar '(lambda (x) (apply '+ (mapcar '* x clst))) xlst))
(setq pt (nth (fix (* r m))
(mapcar 'cadr (vl-sort (mapcar '(lambda (x) (list (float x) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))
)
)
(setq evlst (mapcar '(lambda (y) (if (>= y pt) 1 0)) vlst) en (float (apply '+ evlst)))
(setq pslst (mapcar '(lambda (k) (/ k en)) (mapcar '(lambda (z) (apply '+ (mapcar '* z evlst)))(apply 'mapcar (cons 'list xlst)))))
(setq pflst (mapcar '(lambda (x y z) (+ (* 0.9 x) (* 0.075 y) (* 0.025 z))) pslst pflst ylst))
(setq ylst (car (vl-remove nil (mapcar '(lambda (x) (if (= (apply 'max vlst) (apply '+ (mapcar '*x clst))) x nil)) xlst))))
(setq vblst (list (apply '+ (mapcar '* clst ylst))
(apply '+ (mapcar '* wlst ylst))
ylst
)
)
(if (> (car vblst) (car valst))
(setq valst vblst)
)
)
valst
)
_$ (repeat 5 (progn (princ (tt)) (princ " ")))
(29631 7718 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)) (29589 7717 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 1 0)) (29283 7710 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)) (29531 7715 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)) (29220 7718 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0)) " "
_$ _$(defun tt()
(setq w_tol 3820
wlst '(54 95 36 184 71 83 16 27 84 88 45 94 64 14 804 23 75 36
90 20 77 32 586 14 86 84 59 71 21 30 22 96 49 81 48 37 28
6 84 19 55 88 38 51 52 79 55 70 53 64 99 61 861 64 32 60
42 45 34 22 49 37 331 78 43 85 24 96 32 99 57 238 10 74
59 89 95 40 46 656 89 84 836 19 45 59 26 138 2659) ;;;各物品重量
clst '(297 295 293 292 291 289 284 284 283 283 281 280 279 277 276 275 273 264 260 257
250 236 236 235 235 233 232 232 228 218 217 214 211 208 205 204 203 201 196 194
193 193 192 191 190 187 187 184 184 184 181 179 176 173 172 171 160 128 123 114
113 107 105 101 100 1009998979494939180747372636362
616056535250484640403528222218151211 6 5));;;各物品价值
(setq n (length wlst) m 1000r 0.9 pflst nil pslst nil)
(repeat n
(setq pflst (cons 0.5 pflst))
(setq pslst (cons 1.0 pslst))
)
(defun rnd ()
(*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
(mapcar '(lambda (x) (if (< (rnd) x) 1 0)) lst)
)
(defun check(lst)
(setq s 0 c 0)
(mapcar '(lambda (x y) (if (<= (setq s (+ s (* x y))) w_tol) (progn (setq c s) y)(progn (setq s c) 0))) wlst lst)
)
(setq valst '(0 0))
(while (> (apply 'max (mapcar '(lambda (x y) (abs (- y x))) pflst pslst)) 0.001)
(setq xlst nil)
(repeat m
(setq xlst (cons (xfun pflst) xlst))
)
(setq xlst (mapcar 'check xlst))
(setq vlst (mapcar '(lambda (x) (apply '+ (mapcar '* x clst))) xlst))
(setq pt (nth (fix (* r m))
(mapcar 'cadr (vl-sort (mapcar '(lambda (x) (list (float x) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))
)
)
(setq evlst (mapcar '(lambda (y) (if (>= y pt) 1 0)) vlst) en (float (apply '+ evlst)))
(setq pslst (mapcar '(lambda (k) (/ k en)) (mapcar '(lambda (z) (apply '+ (mapcar '* z evlst)))(apply 'mapcar (cons 'list xlst)))))
(setq pflst (mapcar '(lambda (x y z) (+ (* 0.75 x) (* 0.15 y) (* 0.1 z))) pslst pflst ylst))
(setq ylst (car (vl-remove nil (mapcar '(lambda (x) (if (= (apply 'max vlst) (apply '+ (mapcar '*x clst))) x nil)) xlst))))
(setq vblst (list (apply '+ (mapcar '* clst ylst))
(apply '+ (mapcar '* wlst ylst))
ylst
)
)
(if (> (car vblst) (car valst))
(setq valst vblst)
)
)
valst
)(repeat 10 (progn (princ (car (tt))) (princ " ")))
TT
15163 15163 15163 15163 15163 15163 15163 15163 15163 15163 " "
_$ mahuan1279 发表于 2020-12-16 13:10
;;;采取精英保留策略,可大大提高最优解的命中几率
(defun c:tt()
(setq w_tol 878wlst '(44 46 ...
_$ (defun tt()
(setq w_tol 878wlst '(44 46 9072 91 4075358 5478 40 77 15 61 17 7529 75 63) ;;;各物品重量
clst '(92443 83 84 6892 82 644 3218 5683 25967048 1458)) ;;;各物品价值
(setq n (length wlst) m 1000r 0.9 pflst nil pslst nil)
(repeat n
(setq pflst (cons 0.5 pflst))
(setq pslst (cons 1.0 pslst))
)
(defun rnd ()
(*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
(mapcar '(lambda (x) (if (< (rnd) x) 1 0)) lst)
)
(defun check(lst)
(setq s 0 c 0)
(mapcar '(lambda (x y) (if (<= (setq s (+ s (* x y))) w_tol) (progn (setq c s) y)(progn (setq s c) 0))) wlst lst)
)
(setq valst '(0 0))
(while (> (apply 'max (mapcar '(lambda (x y) (abs (- y x))) pflst pslst)) 0.001)
(setq xlst nil)
(repeat m
(setq xlst (cons (xfun pflst) xlst))
)
(setq xlst (mapcar 'check xlst))
(setq vlst (mapcar '(lambda (x) (apply '+ (mapcar '* x clst))) xlst))
(setq pt (nth (fix (* r m))
(mapcar 'cadr (vl-sort (mapcar '(lambda (x) (list (float x) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))
)
)
(setq evlst (mapcar '(lambda (y) (if (>= y pt) 1 0)) vlst) en (float (apply '+ evlst)))
(setq pslst (mapcar '(lambda (k) (/ k en)) (mapcar '(lambda (z) (apply '+ (mapcar '* z evlst)))(apply 'mapcar (cons 'list xlst)))))
(setq pflst (mapcar '(lambda (x y z) (+ (* 0.75 x) (* 0.15 y) (* 0.1 z))) pslst pflst ylst))
(setq ylst (car (vl-remove nil (mapcar '(lambda (x) (if (= (apply 'max vlst) (apply '+ (mapcar '*x clst))) x nil)) xlst))))
(setq vblst (list (apply '+ (mapcar '* clst ylst))
(apply '+ (mapcar '* wlst ylst))
ylst
)
)
(if (> (car vblst) (car valst))
(setq valst vblst)
)
)
valst
)(repeat 10 (progn (princ (car (tt))) (princ " ")))
TT
1042 1042 1042 1042 1042 1042 1042 1042 1042 1042 " "
_$ 为钻研精神点赞,耶
;;;采取精英保留策略,可大大提高最优解的命中几率
(defun c:tt()
(setq w_tol 878wlst '(44 46 9072 91 4075358 5478 40 77 15 61 17 7529 75 63) ;;;各物品重量
clst '(92443 83 84 6892 82 644 3218 5683 25967048 1458)) ;;;各物品价值
(setq n (length wlst) m 5000r 0.9995 pflst nil pslst nil)
(repeat n
(setq pflst (cons 0.5 pflst))
(setq pslst (cons 1.0 pslst))
)
(defun rnd ()
(*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
(mapcar '(lambda (x) (if (< (rnd) x) 1 0)) lst)
)
(defun check(lst)
(setq s 0 c 0)
(mapcar '(lambda (x y) (if (<= (setq s (+ s (* x y))) w_tol) (progn (setq c s) y)(progn (setq s c) 0))) wlst lst)
)
(setq valst '(0 0))
(while (> (apply 'max (mapcar '(lambda (x y) (abs (- y x))) pflst pslst)) 0.0001)
(setq xlst nil)
(repeat m
(setq xlst (cons (xfun pflst) xlst))
)
(setq xlst (mapcar 'check xlst))
(setq vlst (mapcar '(lambda (x) (apply '+ (mapcar '* x clst))) xlst))
(setq pt (nth (fix (* r m))
(mapcar 'cadr (vl-sort (mapcar '(lambda (x) (list (float x) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))
)
)
(setq evlst (mapcar '(lambda (y) (if (>= y pt) 1 0)) vlst) en (float (apply '+ evlst)))
(setq pslst (mapcar '(lambda (k) (/ k en)) (mapcar '(lambda (z) (apply '+ (mapcar '* z evlst)))(apply 'mapcar (cons 'list xlst)))))
(setq pflst (mapcar '(lambda (x y) (+ (* 0.6 x) (* 0.4 y))) pslst pflst))
(setq ylst (car (vl-remove nil (mapcar '(lambda (x) (if (= (apply 'max vlst) (apply '+ (mapcar '*x clst))) x nil)) xlst))))
(setq vblst (list (apply '+ (mapcar '* clst ylst))
(apply '+ (mapcar '* wlst ylst))
ylst
)
)
(if (> (car vblst) (car valst))
(setq valst vblst)
)
)
valst
)
命令: tt
(1042 878 (1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 1 0 1))
命令:
命令: tt
(1037 863 (1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 1 0 1))
命令:
命令: tt
(1042 878 (1 0 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 1 0 1)) 点个赞 目前的水平还看不懂,只能纯支持一下了。
(setq w_tol 1000wlst '(80 82 85 70 72 7066 50 55 25 50 55 40 48 50 32 22 60 30 32 40 38 35 32 25 28 30 22 50 30 45 30 60 50 20 65 20 25 30 10 20 25 15 10 10 10 4 4 2 1) ;;;各物品重量
clst '(220 208 198 192 180 180 165 162 160 158 155 130 125 122 120 118 115 110 105 101 100 100 98 96 95 90 88 82 80 77 75 73 72 70 69 66 65 63 60 58 56 50 30 20 15 10 8 5 3 1))
命令:
命令: tt
(3096 1000 (1 1 0 1 0 1 0 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0
1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0))
命令:
命令: tt
(3082 1000 (1 1 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0 0
1 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0))
命令:
命令: 'VLIDE
命令:
命令: tt
(3096 1000 (1 0 0 1 0 1 1 1 1 1 1 0 1 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0 0
1 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0)) mahuan1279 发表于 2020-12-21 23:23
(setq w_tol 1000wlst '(80 82 85 70 72 7066 50 55 25 50 55 40 48 50 32 22 60 30 32 40 38 35 32...
_$ (defun tt()
(setq w_tol 1000wlst '(80 82 85 70 72 7066 50 55 25 50 55 40 48 50 32 22 60 30 32 40 38 35 32 25 28 30 22 50 30 45 30 60 50 20 65 20 25 30 10 20 25 15 10 10 10 4 4 2 1) ;;;各物品重量
clst '(220 208 198 192 180 180 165 162 160 158 155 130 125 122 120 118 115 110 105 101 100 100 98 96 95 90 88 82 80 77 75 73 72 70 69 66 65 63 60 58 56 50 30 20 15 10 8 5 3 1)) ;;;各物品价值
(setq n (length wlst) m 1000r 0.97 pflst nil pslst nil)
(repeat n
(setq pflst (cons 0.5 pflst))
(setq pslst (cons 1.0 pslst))
)
(defun rnd ()
(*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
(mapcar '(lambda (x) (if (< (rnd) x) 1 0)) lst)
)
(defun check(lst)
(setq s 0 c 0)
(mapcar '(lambda (x y) (if (<= (setq s (+ s (* x y))) w_tol) (progn (setq c s) y)(progn (setq s c) 0))) wlst lst)
)
(setq valst '(0 0))
(while (> (apply 'max (mapcar '(lambda (x y) (abs (- y x))) pflst pslst)) 0.001)
(setq xlst nil)
(repeat m
(setq xlst (cons (xfun pflst) xlst))
)
(setq xlst (mapcar 'check xlst))
(setq vlst (mapcar '(lambda (x) (apply '+ (mapcar '* x clst))) xlst))
(setq pt (nth (fix (* r m))
(mapcar 'cadr (vl-sort (mapcar '(lambda (x) (list (float x) x)) vlst) '(lambda (ea eb) (< (car ea) (car eb)))))
)
)
(setq evlst (mapcar '(lambda (y) (if (>= y pt) 1 0)) vlst) en (float (apply '+ evlst)))
(setq pslst (mapcar '(lambda (k) (/ k en)) (mapcar '(lambda (z) (apply '+ (mapcar '* z evlst)))(apply 'mapcar (cons 'list xlst)))))
(setq pflst (mapcar '(lambda (x y z) (+ (* 0.55 x) (* 0.375 y) (* 0.075 z))) pslst pflst ylst))
(setq ylst (car (vl-remove nil (mapcar '(lambda (x) (if (= (apply 'max vlst) (apply '+ (mapcar '*x clst))) x nil)) xlst))))
(setq vblst (list (apply '+ (mapcar '* clst ylst))
(apply '+ (mapcar '* wlst ylst))
ylst
)
)
(if (> (car vblst) (car valst))
(setq valst vblst)
)
)
valst
)(repeat 10 (progn (princ (car (tt))) (princ " ")))
TT
3097 3097 3097 3097 3084 3097 3097 3096 3096 3093 " " 为钻研精神点赞,耶
页:
[1]
2