请教各位数字按和分成两组的问题
如题，我希望将一组数字分为两组，每组项数没有限制，只要求和尽量相近或者相等。比如‘(5 5 4 4 3)->'(5 5) '(4 4 3)llsheng_73 发表于 2015-8-29 16:24 static/image/common/back.gif
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))
分成三组怎么破 本帖最后由 mahuan1279 于 2019-11-12 17:50 编辑
(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)
(listx 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)
(listx 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))
_$
把所有数字相加得到和。
再顺次加列表内数字，当新的和与总和的一半接近时，可得到两个表。 自顶下，希望各位高手能看到 以前xyp折腾过类似的，穷举 本帖最后由 llsheng_73 于 2015-8-29 16:29 编辑
(defun tt(lst / a b l)
(setq a(/(apply'+ lst)2.))
(while(<(+(apply'+(setq b(car lst)lst(cdr lst) l(cons b l)))(car lst))a))
(list(reverse l)lst)
)
(defun tt(lst / a b l)
(setq a(/(apply'+ lst)2.))
(while(<(apply'+(setq b(car lst)lst(cdr lst)l(cons b l)))a))
(list(reverse(cdr l))(cons(car l)lst))
)
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3)) llsheng_73 发表于 2015-8-29 16:24 static/image/common/back.gif
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))
感谢73哥，最近一直在想这个，还是要多学习啊 伪书虫86 发表于 2015-8-29 16:42 static/image/common/back.gif
分成三组怎么破
三组貌似就是3DP了，太复杂了吧 llsheng_73 发表于 2015-8-29 16:24 static/image/common/back.gif
_$ (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))都比这个解好吧 王与韩1 发表于 2015-8-29 17:40 static/image/common/back.gif
试了一下，应该有点问题，(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 ...
要所谓最优的话那就复杂了哟。。。想着都 头大，不过，随便分几组的倒是弄了一个，当然同样不是最优解
(defun tt(lst n / a b l c)
(setq a(/(apply'+ lst)n 1.))
(repeat(1- n)
(setq l nil)
(while(<(+(apply'+(setq b(car lst)lst(cdr lst) l(cons b l)))(car lst))a))
(if(<(abs(-(apply'+ l)a))(abs(-(+(car lst)(apply'+ l))a)))
(setq c(cons l c))
(setq c(cons(cons(car lst)l)c)lst(cdr lst))))
(append(mapcar'reverse(reverse c))(list lst))
)
(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))
页:
[1]
2