设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 算法与数据结构 › 采用交叉熵算法求解0-1背包问题
12下一页
返回列表 发新帖
查看: 2834|回复: 19

[研讨] 采用交叉熵算法求解0-1背包问题

[复制链接]
aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
发表于 2020-12-11 14:38:45 | 显示全部楼层 |阅读模式

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
本帖最后由 aimisiyou 于 2020-12-11 14:40 编辑

算法如图。据说交叉熵算法比模拟退火算法的鲁棒性还强，运行结果比较稳定，可以一试。
bb1.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-11 16:48:34 | 显示全部楼层
本帖最后由 aimisiyou 于 2020-12-11 16:49 编辑

_$ (setq plst '(0.5 0.5 0.5 0.5 0.5 0.5))
(defun rnd ()
  (*(rem (getvar "cputicks") 1e4) 1e-4)
)
(defun xfun(lst)
  (mapcar '(lambda (x) (if (> (rnd) x) 1 0)) lst)
)
(setq xlst nil)
(repeat 10
  (setq xlst (cons (xfun plst) xlst))
)
(0.5 0.5 0.5 0.5 0.5 0.5)
RND
XFUN
nil
((1 0 1 1 0 1) (0 1 0 0 1 1) (1 0 0 1 0 1) (0 0 1 0 1 1) (1 0 0 1 0 1) (1 0 1 0 1 1) (1 0 1 1 0 1) (0 1 0 1 0 1) (1 0 1 0 1 1) (1 0 1 0 1 1))
_$
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-14 23:03:02 | 显示全部楼层
(defun c:tt()
(setq w_tol 385  wlst '(24  14  45  40  35  19  27  72  66  62  25  83  42  55  71  59  45)    ;;;各物品重量
                        clst '(70  38  93  80  70  36  38  99  89  77  30  94  43  49  62  48  29))   ;;;各物品价值
(setq n (length wlst) m 1000  r 0.998 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))
)
(apply 'max vlst)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-15 10:02:10 | 显示全部楼层
(defun c:tt()
(setq w_tol 700  wlst '(24   39   26   10   25   75   8   31  37   48   46    18   49   12    50    92    200    145    95   65)    ;;;各物品重量
                        clst '(100   120  70 26 60  150  16 60 70  90  78  30  80  19 75  120  240  160 100  25))   ;;;各物品价值
(setq n (length wlst) m 3000  r 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))
)
(apply 'max vlst)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-15 10:09:55 | 显示全部楼层
本帖最后由 aimisiyou 于 2020-12-15 10:11 编辑

将m调整成为5000，分别运行10次
命令:
命令: tt
1284

命令:
命令: tt
1284

命令:
命令: tt
1284

命令:
命令: tt
1254

命令:
命令: tt
1259

命令:
命令: tt
1284

命令:
命令: tt
1254

命令:
命令: 'VLIDE
命令:
命令: tt
1254

命令:
命令: tt
1284
命令:
命令: tt
1259


有5次命中最优解1284，其余解也较优，结果整体比较稳定。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-15 10:28:45 | 显示全部楼层
_$  (defun c:tt()
(setq w_tol 223  wlst '(10   35   45   18   12   55   30   48 77   24   90    90   65   12    10 )    ;;;各物品重量
                        clst '(20  70  80 30 20  90  48 68 105  32  120  100  70  30 9 ))   ;;;各物品价值
(setq n (length wlst) m 5000  r 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))
)
(apply 'max vlst)
)

命令: 'VLIDE
命令:
命令: tt
390

命令:
命令: tt
390

命令:
命令: 'VLIDE
命令:
命令: tt
390


a1.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-15 10:42:57 | 显示全部楼层
(setq w_tol 600  wlst '(10   4   29   39  45   50   108  8 37   42  82    146  26   76   48 99 105 200 131 78 )    ;;;各物品重量
                        clst '(10  68  81 92 100 200 14 60 65  120  205 34 90 56 105 80 150  80  45  26 ))


命令:
命令: tt
1392

命令:
命令: tt
1361

命令:
命令: tt
1361

命令:
命令: tt
1361

命令:
命令: tt
1361

命令:
命令: tt
1361

命令:
命令: tt
1392


a2.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-15 12:26:12 | 显示全部楼层
这组数据有些特别。运行多次，基本都是1024，虽说运行时间快且与最优解1042相差仅为1.7%，但与最优解无缘就很遗憾（就算增大样本容量、增大r，减小误差值也无济于事）。
a4.png

点评

aimisiyou
(defun c:tt() (setq w_tol 878 wlst '(44 46 90 72 91 40 75 35 8 54 78 40 77 15 61 17 75 29 75 63) ;;;各物品重量 clst '(92 4 43 83 84 68  详情 回复 发表于 2020-12-16 12:30
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-15 13:03:19 | 显示全部楼层
本帖最后由 aimisiyou 于 2020-12-15 13:09 编辑


(defun c:tt()
(setq w_tol 1000  clst '(220 208 195 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)    ;;;各物品重量
                        wlst '(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 5000  r 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.00001)
(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))
)
(apply 'max vlst)
)


m1.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-16 00:10:01 | 显示全部楼层
;;;采取精英保留策略，可大大提高最优解的命中几率
(defun c:tt()
(setq w_tol 700  wlst '(24   39   26   10   25   75   8   31  37   48   46    18   49   12    50    92    200    145    95   65)    ;;;各物品重量
                        clst '(100   120  70 26 60  150  16 60 70  90  78  30  80  19 75  120  240  160 100  25))   ;;;各物品价值
(setq n (length wlst) m 3000  r 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
(1284 698 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0))

命令:
命令: tt
(1284 698 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0))

命令:
命令: tt
(1284 698 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 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))

命令:
命令: tt
(1284 698 (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0))

命令:
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-16 12:30:52 | 显示全部楼层
aimisiyou 发表于 2020-12-15 12:26
这组数据有些特别。运行多次，基本都是1024，虽说运行时间快且与最优解1042相差仅为1.7%，但与最优解无缘就 ...

(defun c:tt()
(setq w_tol 878  wlst '(44   46   90  72 91 40  75  35  8   54  78   40   77   15    61    17    75  29   75   63)    ;;;各物品重量
                        clst '(92  4  43 83 84 68  92 82 6  44 32  18 56  83 25  96  70  48 14  58))   ;;;各物品价值
(setq n (length wlst) m 3000  r 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
(1037 874 (1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 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))

命令:
命令: 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))

命令:
命令: tt
(1037 863 (1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 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))
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-21 23:21:25 | 显示全部楼层
(setq w_tol 1000  wlst '(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 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))
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-25 00:12:36 | 显示全部楼层
本帖最后由 aimisiyou 于 2020-12-25 00:17 编辑

(setq w_tol 3820  
      wlst '(54 95 36 18  4 71 83 16 27 84 88 45 94 64 14 80  4 23 75 36
             90 20 77 32 58  6 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 86  1 64 32 60
             42 45 34 22 49 37 33  1 78 43 85 24 96 32 99 57 23  8 10 74
             59 89 95 40 46 65  6 89 84 83  6 19 45 59 26 13  8 26  5  9)     ;;;各物品重量
      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 100  99  98  97  94  94  93  91  80  74  73  72  63  63  62
              61  60  56  53  52  50  48  46  40  40  35  28  22  22  18  15  12  11   6   5));;;各物品价值

;;;已知最优解  15170/3820

命令: tt
(15093 3818 (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 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0
1 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 0))

命令:
命令: tt
(15116 3811 (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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0))

命令:
命令: tt
(15128 3819 (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 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
1 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 0))

命令:
命令: tt
(14907 3818 (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 1 1 1 1 1 0 1 1 1 1 0 1 1 1 1 1 1 1 1
1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 0))

命令:
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-25 07:23:40 | 显示全部楼层
_$ (defun tt()
(setq w_tol 3820  
      wlst '(54 95 36 18  4 71 83 16 27 84 88 45 94 64 14 80  4 23 75 36
             90 20 77 32 58  6 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 86  1 64 32 60
             42 45 34 22 49 37 33  1 78 43 85 24 96 32 99 57 23  8 10 74
             59 89 95 40 46 65  6 89 84 83  6 19 45 59 26 13  8 26  5  9)     ;;;各物品重量
      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 100  99  98  97  94  94  93  91  80  74  73  72  63  63  62
              61  60  56  53  52  50  48  46  40  40  35  28  22  22  18  15  12  11   6   5))  ;;;各物品价值
(setq n (length wlst) m 5000  r 0.98 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) (+ (* 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
)(repeat 5 (progn (princ (car (tt))) (princ " ")))
TT
15163 15163 15163 15150 15163 " "
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

aimisiyou

已领礼包: 1883个

财富等级: 堆金积玉
 楼主| 发表于 2020-12-25 07:27:23 | 显示全部楼层
本帖最后由 aimisiyou 于 2020-12-25 07:31 编辑

_$ (defun tt()
(setq w_tol 3820  
      wlst '(54 95 36 18  4 71 83 16 27 84 88 45 94 64 14 80  4 23 75 36
             90 20 77 32 58  6 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 86  1 64 32 60
             42 45 34 22 49 37 33  1 78 43 85 24 96 32 99 57 23  8 10 74
             59 89 95 40 46 65  6 89 84 83  6 19 45 59 26 13  8 26  5  9)     ;;;各物品重量
      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 100  99  98  97  94  94  93  91  80  74  73  72  63  63  62
              61  60  56  53  52  50  48  46  40  40  35  28  22  22  18  15  12  11   6   5))  ;;;各物品价值
(setq n (length wlst) m 1000  r 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) (+ (* 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
)(repeat 5 (progn (princ (car (tt))) (princ " ")))
nil
TT
15163 15128 15150 15158 15163 " "


可见，r的取值不是越大越好，而是与m有一定关系时效果才好。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-22 09:43 , Processed in 0.561196 second(s), 63 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表