两数组通过转移、交换数据使得差值接近固定数值

aimisiyou

已知两数组均按降序排列，如S1=[100, 92, 76 ,63 ,50 ,10]，S2=[71,45 ,33 ,20 ,15 ,13 ,9,6,4],
如何通过转移（一个数据从一组移到另一组）、交换（两不同组中的数据一对一交换），使得两组和的差值接近已知数K=17？

aimisiyou

一般思路是先求S1的和值100+92+76+63+50+10=391，S2的和值71+45+33+20+15+13+9+6+4=216，两组差值为S1-S2=391-216=175，要使得调整后的两组和值相差接近17，则S1中移出（175-17）/2=79,而S1中接近79的值是76，故将76从S1移至S2中，两组差值为（391-76）-（216+76）=23.
如果还想获得比23更接近17的两组数，算法就复杂了。一一对比，累加对比，再进行交换……很是繁琐。

aimisiyou

;;;程序中的k等于差值的一半
;;;如要将 '(100 92 76 63 57 50 10)和'(95 82 71 45 33 20 15 13 9 6 4)经过转移、交换数据使得两组差值接近17，则程序如下
;;;;(fen_2 (append '(100 92 76 63 57 50 10) '(95 82 71 45 33 20 15 13 9 6 4)) 8.5)
;;;_$ (fen_2 (append '(100 92 76 63 57 50 10) '(95 82 71 45 33 20 15 13 9 6 4)) 8.5)
;;;(841 428 (13 20 33 45 50 57 63 76 71))
;;;_$
(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))
_$

aimisiyou

很好奇(FEN_2 lst 0)是不是最优解（最优解可能有多个）？如果是，能否证明？如果不是，能否举出反例？

aimisiyou

aimisiyou 发表于 2019-11-12 22:32
很好奇(FEN_2 lst 0)是不是最优解（最优解可能有多个）？如果是，能否证明？如果不是，能否举出反例？

只是较好解，不是最优解。鉴定完毕。
_$ (fen_2  '(35 33 31 27 24 22 17 15 11  9  8 5 ) 0)
(237 116 (11 15 17 22 27 24))
_$

最优的解是（35  33 31 15  5）和（27 24 22 17 11 9 8），和值分别为119和118

WongFoling

打开了额