求数字列表平衡分配的算法

masterlong

一个数字列表元素个数不限
要求分为三个子表
每个子表元素个数不限顺序不限
要求三子表各自求和最接近
有多种解时只需任一解

如 '(2.8 2.5 4.2 4.8 4.8)
最终分为
'(2.8  4.2)  '(2.5  4.8)  '(4.8)

想了半天没有头绪
看各位大侠有何高招

mahuan1279

_$ (defun fen_2 (lst)
  (setq sum (apply '+ lst))
  (setq p (/ sum 2))
  (setq lst (vl-sort (mapcar '(lambda (x) (* 1.0 x)) lst) '>))
  (setq i -1)
  (setq lst1 (mapcar '(lambda (x y)   
                         (progn
                            (setq i (+ i 1))
                            (list (if (> (+ x y) p) x (+ x y))
                                  y   
                                 (if  (> (+ x y) p)
                                                                          (list x)
                                                                          (list  x y)
                                  )
                            )
                         )        
                      )
                      (reverse (cdr (reverse lst)))
                      (cdr lst)
               )
   )
  (while (cdr lst1)
       (setq lst1 (mapcar '(lambda (x y)   
                              (if (> (+ (car x) (cadr y)) p)
                                                              (if (>= (car x)  (car y))
                                                                       x
                                                                           y
                                                                  )
                                                                  (if (> (+ (car x) (cadr y)) (car y))
                                                                       (list
                                                                                (+ (car x) (cadr y))
                                                                                (cadr y)
                                                                                        (cons (cadr y) (last x))
                                                                           )
                                                                           y
                                                                  )
                                                            )
                            )        
                           (reverse (cdr (reverse lst1)))
                           (cdr lst1)
                      )
            )
   )
  (cons sum (cons (car (car lst1)) (cdr (cdr (car lst1)))))
)
(fen_2 '(39 35 27 21 17 3))
FEN_2
(142 69.0 (3.0 27.0 39.0))
_$ (fen_2 '(39 35 27 21 17 13 5 3))
(160 79.0 (17.0 35.0 27.0))
_$  (fen_2 '(39 35 27 27 25 25  23 21 17 3))
(242 121.0 (21.0 23.0 25.0 27.0 25.0))
_$ (fen_2 '(103 97 89 65 41 39 35 27 21 17 3))
(537 268.0 (3.0 65.0 103.0 97.0))
_$

mahuan1279

_$ (defun fen_2(lst)
  (setq sum (apply '+ lst))
  (setq p (/ sum 2))
  (setq lst (vl-sort (mapcar '(lambda (x) (* 1.0 x)) lst) '>))
  (setq lst1 (mapcar '(lambda (x y)   
                            (list
                                  (if (> (+ x y) p) x (+ x y))
                                   y   
                            )        
                      )
                      (reverse (cdr (reverse lst)))
                      (cdr lst)
               )
   )
   (while (cdr lst1)
          (setq lst1 (mapcar '(lambda (x y)   
                                (list
                                  (if (> (+ (car x) (cadr y)) P)
                                                                         (max (car x) (car y))
                                                                                 (if (< (+ (car x) (cadr y)) (car y))
                                                                                     (car y)
                                             (+ (car x) (cadr y))
                                                                                  )
                                                                    )
                                                              (cadr y)
                                                            )
                              )        
                           (reverse (cdr (reverse lst1)))
                           (cdr lst1)
                      )
            )
   )
   (car (car lst1))
)
FEN_2
_$ (fen_2 '(39 35 21 13 7 3))
59.0
_$ (fen_2 '(39 35 27 21 17 3))
69.0
_$

lanjqka

;; (3up 10 '(1 2 3 4 5 6 7 8 9 10 11 12 13 13 13))
;; ((9 3 7 3 7 11) (4 8 13 5 2 1 6) (4 8 13 13))
;; (3up 10 '(100 92 10 76 63 50 13 71 45 33 20 15 9 6 3))
;; ((33 71 100) (10 6 3 15 76 92) (13 9 20 45 50 63))
(defun 3up (N L / Nl L0 L1 La Lb L2 L3)
  ;; (setq N 10)
  (setq Nl (length L))
  (cond ((<= Nl N) (3uall L))
        ((setq L0 (mapcar 'list L (mapcar 'list L)))
         (setq L1 (vl-sort L0 (function (lambda (e1 e2) (> (car e1) (car e2))))))
         (repeat N (setq La (cons (car L1) La)) (setq L1 (cdr L1)))
         (setq Lb (reverse L1))
         (while Lb
           (setq La (cons (list (+ (caar Lb) (caar La)) (append (cadar Lb) (cadar La))) (cdr La)))
           (setq La (vl-sort La (function (lambda (e1 e2) (< (car e1) (car e2))))))
           (setq Lb (cdr Lb))
         )
         (setq L2 (apply 'list (mapcar 'car La)))
         (setq L3 (3u L2))
         (mapcar (function (lambda (l) (apply 'append (mapcar '(lambda (a) (apply 'append (cdr (assoc a La)))) l))))
                 L3
         )
        )
  )
)
;; (3upp '(100 92 10 76 63 50 13 71 45 33 20 15 9 6 3))
;; ((15 45 50 92) (6 3 10 20 63 100) (9 13 33 71 76))
;; (3upp '(100 51 51 49 23 99 98 23 22 18 15 98 95 66 17))
;; ((23 51 99 100) (23 17 22 51 66 98) (15 18 49 95 98))
;; (3upp '(5.4 5.0 4.8 4.2 2.8 2.8 2.8 2.8 2.8 2.8))
;; (((5.4 4.2 2.8) (5.0 4.8 2.8) (2.8 2.8 2.8 2.8)) ...)
;; (3upp '(1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10))
;; ((3 8 4 9 5 2 1 7 6 10) (3 8 4 9 5 2 1 7 6 10) (3 8 4 9 5 2 1 7 6 10))
(defun 3upp (L / N QW Nl I Av Dm D Lr Ls R)
  (setq N 10)
  (setq QW 1E-03)
  (cond ((<= (setq Nl (length L)) N) (3uall L))
        ((setq I (/ Nl 3))
         (setq Av (/ (apply '+ L) 3.0))
         (setq Dm Av)
         (while (or (<= I N) (> Dm (* QW Av)))
           (setq Lr (3up I L))
           (setq Ls (mapcar '(lambda (a) (apply '+ a)) Lr)) ;(print Ls)
           (setq D (apply 'max (mapcar '(lambda (x) (abs (- x Av))) Ls))) ;(princ D)
           (and (< D Dm) (setq Dm D) (setq R Lr))
           (setq I (1+ I))
         )
         R
        )
  )
)

mahuan1279

三子表各自求和最接近，如何定义最接近？假如三组各自和分别为a ,b,c,平均值为P，那么最接近定义可有如下几种：
1、（a-p）^2+(b-p)^2+(c-p)^2最小
2、（a-b）^2+(b-c)^2+(a-c)^2最小

mahuan1279

1、按从大到小排序，n1>n2>n3>n4>……
2、将n1、n2、n3分别放入第一组、第二组、第三组，即{n1}、{n2}、{n3}；
3、从n4开始，依次放进和值最低的那一组，即{n1},{n2},{n3+n4};
4、将n5放进即{n1},{n2},{n3+n4}中和值最小的那一组，对三组和值排序;
5、……
6、最后完成分配。
当然，这样不是最优分配。如（1 2 3 4 5 6 7 8）
程序结果为（8 3） （7 4 1）（6 5 2）.

而最优的结果为（8 4） （7 5） （6 3 2 1）

mahuan1279

1、按从大到小排序，n1>n2>n3>n4>……，p=sum/3，三组分别为空，即{} {} {}
2、将n1分别放入第一组，即{n1}；
3、若n2+n1<=p,则将n2放入第一组，否则放入第二组；
4、依次将n3放入三组，直到放入该组使得该组之和不大于P，转到排放n4；
5……
6、最后一个nk若放入三组均大于P，则将nk放入和值最小的那组。
7、最后完成分配。

备注：当sum能被3除尽时，p=sum/3,如12/3=4,1.5/3=0.5
          当sum不能被3除尽时，p=sum/3向上取数,如14/3=5,1.76/3=0.59

masterlong

以上算法无法得到最优解
比如(5.4 5.0 4.8 4.2 2.8 2.8 2.8 2.8 2.8 2.8)
以上算法得到
((5.4 5.0 2.8)  (4.8 4.2 2.8)  (2.8 2.8 2.8 2.8))
实际最优解应该是
((5.4 4.2 2.8)  (5.0 4.8 2.8)  (2.8 2.8 2.8 2.8))

1291500406

如 '(2.8 2.5 4.2 4.8 4.8)
--> '(2.8  4.2)  '(2.5  4.8)  '(4.8)

看成了两两分配

mahuan1279

masterlong 发表于 2019-11-5 09:37
以上算法无法得到最优解
比如(5.4 5.0 4.8 4.2 2.8 2.8 2.8 2.8 2.8 2.8)
以上算法得到

则将第3条改为若n2+n1=p,则将n2放入第一组；若n2+n1<p且n2+n1+min{ni}<=p,则将n2放入第一组，否则放入第二组。后续都以此类推。

masterlong

这个算法估计还会有问题
因为很可能某一组求和=p时
最终的分组不是最优解

masterlong

必强啊
开动下脑筋啊
你是做电气的
这个问题提出来
你应该能想到是做啥的啊

masterlong

必强貌似是合肥的？
加下QQ
正好有些问题想找人请教下
我的QQ见短消息