关于一维下料算法探讨

aws

2. ;探讨一下算法，目的：把一个列表，分割成和是【接近且小于等于15】的多个表。结果追求【总数n少，组合i少】。
   
3. ;目前最优答案是："共计生成了16个表，过滤重复后，共有9种组合"
   
4. ;(((9 4 2) 2) ((10 5) 2) ((12 3) 2) ((7 4 4) 1) ((6 4 4 1) 1) ((13 1) 1) ((8 6) 4) ((14) 2) ((15) 1))
   
5. ;抛砖引玉。
   
6. (defun c:ff(/ ass asslst b i k lst n newlst sum);最直接的办法："共计生成了16个表，过滤重复后，共有10种组合"
   
7.   (setq lst '(14 10 9 4 6 8 4 14 10 9 4 6 8 4 5 6 3 2 1 12 4 6 8 4 5 6 3 2 1 12 13 15 8 7))
   
8.   (setq newlst(vl-sort(mapcar '(lambda(x)(+ x 0.0))lst)'>))
   
9.   (setq sum 0 ass nil asslst nil);---临时总和，元素结果表，元素组合表
   
10.   (while newlst
    
11.     (if(setq b(vl-some '(lambda(x / a)(if(<=(setq a(+ x sum))15)(list x a)))newlst));---查找表里元素有没有符合要求的
    
12.       (progn
    
13.         (setq k(car b)sum(cadr b)ass(cons k ass));---有的话就加入到新表
    
14.         (setq newlst(vl-remove nil(mapcar '(lambda(x)(if(= x k)(setq x nil k nil)x))newlst)));---删掉第一个指定元素
    
15.       )
    
16.       (setq asslst(cons(reverse ass)asslst)sum 0 ass nil);---把组合写入到asslst中
    
17.     )
    
18.   )
    
19.   (setq asslst(cons(reverse ass)asslst));---处理最后一个元素
    
20.   (setq asslst(reverse asslst));((4 4 4 3) (4 4 4 3) (6 6 2 1) (6 6 2 1) (6 8) (8 5) (8 5) (8 7) (14) (14) (12) (12) (10) (10) (9) (9) (15) (13))
    
21.   (setq n(length asslst))
    
22.   (setq i(length(dup-Counts asslst)));(((4 4 4 3) 2) ((6 6 2 1) 2) ((6 8) 1) ((8 5) 2) ((8 7) 1) ((14) 2) ((12) 2) ((10) 2) ((9) 2) ((15) 1) ((13) 1))
    
23.   (print (strcat "共计生成了" (rtos n) "个表，过滤重复后，共有"(rtos i)"种组合"))
    
24.   (princ)
    
25. )
    
26. (defun c:gg(/ ass asslst b i k lst n newlst sum);第二种办法："共计生成了18个表，过滤重复后，共有11种组合"，很显然，这种更不合理了
    
27.   (setq lst '(14 10 9 4 6 8 4 14 10 9 4 6 8 4 5 6 3 2 1 12 4 6 8 4 5 6 3 2 1 12 13 15 8 7))
    
28.   (setq lst(dup-Counts lst));((14 2) (10 2) (9 2) (4 6) (6 5) (8 4) (5 2) (3 2) (2 2) (1 2) (12 2) (13 1) (15 1) (7 1))
    
29.   (setq lst(vl-sort lst '(lambda(x1 x2)
    
30.                            (if(=(cadr x1)(cadr x2));首选数量排序，次选大小排序
    
31.                              (>(car x1)(car x2))
    
32.                              (>(cadr x1)(cadr x2))
    
33.                            )
    
34.                          )));((4 6) (6 5) (8 4) (14 2) (12 2) (10 2) (9 2) (5 2) (3 2) (2 2) (1 2) (15 1) (13 1) (7 1))
    
35.   (setq newlst nil)
    
36.   (foreach x lst
    
37.     (repeat(cadr x)
    
38.       (setq newlst(cons(car x)newlst));---拍平
    
39.     )
    
40.   )
    
41.   (setq newlst(reverse newlst));(4 4 4 4 4 4 6 6 6 6 6 8 8 8 8 14 14 12 12 10 10 9 9 5 5 3 3 2 2 1 1 15 13 7)
    
42.   (setq sum 0 ass nil asslst nil);---临时总和，元素结果表，元素组合表
    
43.   (while newlst
    
44.     (if(setq b(vl-some '(lambda(x / a)(if(<=(setq a(+ x sum))15)(list x a)))newlst));---查找表里元素有没有符合要求的
    
45.       (progn
    
46.         (setq k(car b)sum(cadr b)ass(cons k ass));---有的话就加入到新表
    
47.         (setq newlst(vl-remove nil(mapcar '(lambda(x)(if(= x k)(setq x nil k nil)x))newlst)));---删掉第一个指定元素
    
48.       )
    
49.       (setq asslst(cons(reverse ass)asslst)sum 0 ass nil);---把组合写入到asslst中
    
50.     )
    
51.   )
    
52.   (setq asslst(cons(reverse ass)asslst));---处理最后一个元素
    
53.   (setq asslst(reverse asslst));((4 4 4 3) (4 4 4 3) (6 6 2 1) (6 6 2 1) (6 8) (8 5) (8 5) (8 7) (14) (14) (12) (12) (10) (10) (9) (9) (15) (13))
    
54.   (setq n(length asslst))
    
55.   (setq i(length(dup-Counts asslst)));(((4 4 4 3) 2) ((6 6 2 1) 2) ((6 8) 1) ((8 5) 2) ((8 7) 1) ((14) 2) ((12) 2) ((10) 2) ((9) 2) ((15) 1) ((13) 1))
    
56.   (print (strcat "共计生成了" (rtos n) "个表，过滤重复后，共有"(rtos i)"种组合"))
    
57.   (princ)
    
58. )
    
59. ;---重复元素及其出现次数
    
60. (defun dup-Counts(lst / n newlst x)
    
61.   (setq newlst nil)
    
62.   (while(setq x(car lst))
    
63.     (setq n(length lst))
    
64.     (setq lst(vl-remove x lst))
    
65.     (setq newlst(cons(list x(- n(length lst)))newlst))
    
66.   )
    
67.   (reverse newlst)
    
68. )

;探讨一下算法，目的：把一个列表，分割成和是【接近且小于等于15】的多个表。结果追求【总数n少，组合i少】。<br /> ;目前最优答案是："共计生成了16个表，过滤重复后，共有9种组合"<br /> ;(((9 4 2) 2) ((10 5) 2) ((12 3) 2) ((7 4 4) 1) ((6 4 4 1) 1) ((13 1) 1) ((8 6) 4) ((14) 2) ((15) 1))<br /> ;抛砖引玉。<br /> (defun c:ff(/ ass asslst b i k lst n newlst sum);最直接的办法："共计生成了16个表，过滤重复后，共有10种组合"<br />   (setq lst '(14 10 9 4 6 8 4 14 10 9 4 6 8 4 5 6 3 2 1 12 4 6 8 4 5 6 3 2 1 12 13 15 8 7))<br />   (setq newlst(vl-sort(mapcar '(lambda(x)(+ x 0.0))lst)'>))<br />   (setq sum 0 ass nil asslst nil);---临时总和，元素结果表，元素组合表<br />   (while newlst<br />     (if(setq b(vl-some '(lambda(x / a)(if(<=(setq a(+ x sum))15)(list x a)))newlst));---查找表里元素有没有符合要求的<br />       (progn<br />         (setq k(car b)sum(cadr b)ass(cons k ass));---有的话就加入到新表<br />         (setq newlst(vl-remove nil(mapcar '(lambda(x)(if(= x k)(setq x nil k nil)x))newlst)));---删掉第一个指定元素<br />       )<br />       (setq asslst(cons(reverse ass)asslst)sum 0 ass nil);---把组合写入到asslst中<br />     )<br />   )<br />   (setq asslst(cons(reverse ass)asslst));---处理最后一个元素<br />   (setq asslst(reverse asslst));((4 4 4 3) (4 4 4 3) (6 6 2 1) (6 6 2 1) (6 8) (8 5) (8 5) (8 7) (14) (14) (12) (12) (10) (10) (9) (9) (15) (13))<br />   (setq n(length asslst))<br />   (setq i(length(dup-Counts asslst)));(((4 4 4 3) 2) ((6 6 2 1) 2) ((6 8) 1) ((8 5) 2) ((8 7) 1) ((14) 2) ((12) 2) ((10) 2) ((9) 2) ((15) 1) ((13) 1))<br />   (print (strcat "共计生成了" (rtos n) "个表，过滤重复后，共有"(rtos i)"种组合"))<br />   (princ)<br /> )<br /> (defun c:gg(/ ass asslst b i k lst n newlst sum);第二种办法："共计生成了18个表，过滤重复后，共有11种组合"，很显然，这种更不合理了<br />   (setq lst '(14 10 9 4 6 8 4 14 10 9 4 6 8 4 5 6 3 2 1 12 4 6 8 4 5 6 3 2 1 12 13 15 8 7))<br />   (setq lst(dup-Counts lst));((14 2) (10 2) (9 2) (4 6) (6 5) (8 4) (5 2) (3 2) (2 2) (1 2) (12 2) (13 1) (15 1) (7 1))<br />   (setq lst(vl-sort lst '(lambda(x1 x2)<br />                            (if(=(cadr x1)(cadr x2));首选数量排序，次选大小排序<br />                              (>(car x1)(car x2))<br />                              (>(cadr x1)(cadr x2))<br />                            )<br />                          )));((4 6) (6 5) (8 4) (14 2) (12 2) (10 2) (9 2) (5 2) (3 2) (2 2) (1 2) (15 1) (13 1) (7 1))<br />   (setq newlst nil)<br />   (foreach x lst<br />     (repeat(cadr x)<br />       (setq newlst(cons(car x)newlst));---拍平<br />     ) <br />   )<br />   (setq newlst(reverse newlst));(4 4 4 4 4 4 6 6 6 6 6 8 8 8 8 14 14 12 12 10 10 9 9 5 5 3 3 2 2 1 1 15 13 7)<br />   (setq sum 0 ass nil asslst nil);---临时总和，元素结果表，元素组合表<br />   (while newlst<br />     (if(setq b(vl-some '(lambda(x / a)(if(<=(setq a(+ x sum))15)(list x a)))newlst));---查找表里元素有没有符合要求的<br />       (progn<br />         (setq k(car b)sum(cadr b)ass(cons k ass));---有的话就加入到新表<br />         (setq newlst(vl-remove nil(mapcar '(lambda(x)(if(= x k)(setq x nil k nil)x))newlst)));---删掉第一个指定元素<br />       )<br />       (setq asslst(cons(reverse ass)asslst)sum 0 ass nil);---把组合写入到asslst中<br />     )<br />   )<br />   (setq asslst(cons(reverse ass)asslst));---处理最后一个元素<br />   (setq asslst(reverse asslst));((4 4 4 3) (4 4 4 3) (6 6 2 1) (6 6 2 1) (6 8) (8 5) (8 5) (8 7) (14) (14) (12) (12) (10) (10) (9) (9) (15) (13))<br />   (setq n(length asslst))<br />   (setq i(length(dup-Counts asslst)));(((4 4 4 3) 2) ((6 6 2 1) 2) ((6 8) 1) ((8 5) 2) ((8 7) 1) ((14) 2) ((12) 2) ((10) 2) ((9) 2) ((15) 1) ((13) 1))<br />   (print (strcat "共计生成了" (rtos n) "个表，过滤重复后，共有"(rtos i)"种组合"))<br />   (princ)<br /> )<br /> ;---重复元素及其出现次数<br /> (defun dup-Counts(lst / n newlst x)<br />   (setq newlst nil)<br />   (while(setq x(car lst))<br />     (setq n(length lst))<br />     (setq lst(vl-remove x lst))<br />     (setq newlst(cons(list x(- n(length lst)))newlst))<br />   )<br />   (reverse newlst)<br /> )

欢迎大佬们参与。

mahuan1279

要宕机么？

aws

mahuan1279 发表于 2024-8-31 16:03
要宕机么？

挑战一下咯

mahuan1279

运行速度是不是太慢了？

i小小白i

了解一下 遗传算法