明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1328|回复: 16

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

[复制链接]
发表于 2015-8-28 15:33 | 显示全部楼层 |阅读模式
如题,我希望将一组数字分为两组,每组项数没有限制,只要求和尽量相近或者相等。比如‘(5 5 4 4 3)->'(5 5) '(4 4 3)
发表于 2015-8-29 16:42 | 显示全部楼层
llsheng_73 发表于 2015-8-29 16:24
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))

分成三组怎么破
回复 支持 0 反对 1

使用道具 举报

发表于 2019-11-12 17:39 | 显示全部楼层
本帖最后由 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)
                                                                          (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))
_$

发表于 2015-8-28 18:17 | 显示全部楼层
把所有数字相加得到和。
再顺次加列表内数字,当新的和与总和的一半接近时,可得到两个表。
 楼主| 发表于 2015-8-28 21:46 | 显示全部楼层
自顶下,希望各位高手能看到
发表于 2015-8-29 14:05 | 显示全部楼层
以前xyp折腾过类似的,穷举
发表于 2015-8-29 16:24 | 显示全部楼层
本帖最后由 llsheng_73 于 2015-8-29 16:29 编辑

  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.   )


  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. )

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

点评

这while被你用的太出神入化了  发表于 2015-8-29 16:48
 楼主| 发表于 2015-8-29 17:26 | 显示全部楼层
llsheng_73 发表于 2015-8-29 16:24
_$ (tt '(5 5 4 4 3))==>((5 5) (4 4 3))

感谢73哥,最近一直在想这个,还是要多学习啊
 楼主| 发表于 2015-8-29 17:26 | 显示全部楼层
伪书虫86 发表于 2015-8-29 16:42
分成三组怎么破

三组貌似就是3DP了,太复杂了吧
 楼主| 发表于 2015-8-29 17:40 | 显示全部楼层
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))都比这个解好吧
发表于 2015-8-29 18:00 | 显示全部楼层
王与韩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.   )

(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))

点评

楼主要求的是按相近的数字分组,应该先对表排序再分组。  发表于 2015-8-30 08:04
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 18:34 , Processed in 0.230459 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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