请教各位数字按和分成两组的问题

王与韩1

如题，我希望将一组数字分为两组，每组项数没有限制，只要求和尽量相近或者相等。比如‘(5 5 4 4 3)->'(5 5) '(4 4 3)

伪书虫86

llsheng_73 发表于 2015-8-29 16:24
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))

分成三组怎么破

mahuan1279

(defun fen_2 (lst k)
  (setq sum (apply '+ lst))
  (setq p1 (- (/ sum 2) k))
  (setq p2 (+ (/ sum 2) k))
  (setq lst (mapcar 'cadr(vl-sort (mapcar '(lambda (x) (cons (* x 1.0) (list x))) lst) '(lambda (ea eb) (>= (car ea) (car eb))))))
  (setq lst1 (mapcar '(lambda (x y)   
                         (progn
                            (list (if (> (+ x y) p1) x (+ x y))
                                  y   
                                 (if  (> (+ x y) p1)
                                                                          (list x)
                                                                          (list  x y)
                                  )
                            )
                         )        
                      )
                      (reverse (cdr (reverse lst)))
                      (cdr lst)
               )
   )
    (setq lst2 (mapcar '(lambda (x y)   
                         (progn
                            (list (if (> (+ x y) p2) x (+ x y))
                                  y   
                                 (if  (> (+ x y) p2)
                                                                          (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)) p1)
                                                              (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)
                      )
            )
   )
  (while (cdr lst2)
       (setq lst2 (mapcar '(lambda (x y)   
                              (if (> (+ (car x) (cadr y)) p2)
                                                              (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 lst2)))
                           (cdr lst2)
                      )
            )
   )
  (if (<= (- sum (* 2 (cadr (car lst1))))
          (- (* 2 (cadr (car lst2))) sum)
          )
     (setq va (cons sum (cons (car (car lst1)) (cdr (cdr (car lst1))))))
     (setq va (cons sum (cons (car (car lst2)) (cdr (cdr (car lst2))))))
  )
  va
)

_$ (FEN_2 '(5.12 3.62 3.02 3.92 3.32 3.12) 0)
(22.12 10.86 (3.32 3.92 3.62))
_$ (FEN_2 '(6.32 5.12 3.62 3.02 3.92 3.32 3.12) 0)
(28.44 13.98 (3.12 3.32 3.92 3.62))
_$ (FEN_2 '(7.58 6.32 5.12 3.62 3.02 3.92 3.32 3.12) 0)
(36.02 17.82 (3.92 7.58 6.32))
_$ (FEN_2 '(29 7.58 6.32 5.12 3.62 3.02 3.92 3.32 3.12) 0)
(65.02 32.32 (3.32 29))
_$ (fen_2 '(5 5 4 4 3) 0)
(21 10 (5 5))
_$

mmmmmm

把所有数字相加得到和。
再顺次加列表内数字，当新的和与总和的一半接近时，可得到两个表。

王与韩1

自顶下，希望各位高手能看到

伪书虫86

以前xyp折腾过类似的，穷举

llsheng_73

1. (defun tt(lst / a b l)
   
2.   (setq a(/(apply'+ lst)2.))
   
3.   (while(<(+(apply'+(setq b(car lst)lst(cdr lst) l(cons b l)))(car lst))a))
   
4.   (list(reverse l)lst)
   
5.   )

(defun tt(lst / a b l)<br />   (setq a(/(apply'+ lst)2.))<br />   (while(<(+(apply'+(setq b(car lst)lst(cdr lst) l(cons b l)))(car lst))a))<br />   (list(reverse l)lst)<br />   )

1. (defun tt(lst / a b l)
   
2.   (setq a(/(apply'+ lst)2.))
   
3.   (while(<(apply'+(setq b(car lst)lst(cdr lst)l(cons b l)))a))
   
4.   (list(reverse(cdr l))(cons(car l)lst))
   
5. )

(defun tt(lst / a b l)<br />   (setq a(/(apply'+ lst)2.))<br />   (while(<(apply'+(setq b(car lst)lst(cdr lst)l(cons b l)))a))<br />   (list(reverse(cdr l))(cons(car l)lst))<br /> )

_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))

王与韩1

llsheng_73 发表于 2015-8-29 16:24
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))

感谢73哥，最近一直在想这个，还是要多学习啊

王与韩1

伪书虫86 发表于 2015-8-29 16:42
分成三组怎么破

三组貌似就是3DP了，太复杂了吧

王与韩1

llsheng_73 发表于 2015-8-29 16:24
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))

试了一下，应该有点问题，(tt '(1 2 5 5 4 3))==>((1 2 5) (5 4 3))，((2 3 5) (1 4 5)) ((5 5) (1 2 3 4))都比这个解好吧

llsheng_73

王与韩1 发表于 2015-8-29 17:40
试了一下，应该有点问题，(tt '(1 2 5 5 4 3))==>((1 2 5) (5 4 3))，((2 3 5) (1 4 5)) ((5 5) (1 2 3 4 ...

要所谓最优的话那就复杂了哟。。。想着都 头大，不过，随便分几组的倒是弄了一个，当然同样不是最优解

1. (defun tt(lst n / a b l c)
   
2.   (setq a(/(apply'+ lst)n 1.))
   
3.   (repeat(1- n)
   
4.     (setq l nil)
   
5.     (while(<(+(apply'+(setq b(car lst)lst(cdr lst) l(cons b l)))(car lst))a))
   
6.     (if(<(abs(-(apply'+ l)a))(abs(-(+(car lst)(apply'+ l))a)))
   
7.       (setq c(cons l c))
   
8.       (setq c(cons(cons(car lst)l)c)lst(cdr lst))))
   
9.   (append(mapcar'reverse(reverse c))(list lst))
   
10.   )

(defun tt(lst n / a b l c)<br />   (setq a(/(apply'+ lst)n 1.))<br />   (repeat(1- n)<br />     (setq l nil)<br />     (while(<(+(apply'+(setq b(car lst)lst(cdr lst) l(cons b l)))(car lst))a))<br />     (if(<(abs(-(apply'+ l)a))(abs(-(+(car lst)(apply'+ l))a)))<br />       (setq c(cons l c))<br />       (setq c(cons(cons(car lst)l)c)lst(cdr lst))))<br />   (append(mapcar'reverse(reverse c))(list lst))<br />   )

(TT lst 3)==>((5 5 4) (4 3 2 6) (7 2 1))
(TT lst 4)==>((5 5) (4 4 3) (2 6) (7 2 1))