社区 › 几何算法 › 匈牙利算法求最大匹配问题问题

mahuan1279 发表于 2020-2-6 19:04:35

匈牙利算法求最大匹配问题问题

_$ (setq x 4 y 6 pdlst '((1 2)(1 4)(2 1)(2 5)(3 2)(4 1)(4 3)(4 5)(4 6)));;;X中有4个节点，Y中有6个节点 ,如果X中的1和Y中的2有关联，则将'(1 2)置入pdlst中
(setq n (max x y))   
(defun fnlst (nn)
(setq i nn n_lst nil)
(while (> i 0)
      (setq i (- i 1))
      (setq n_lst (cons i n_lst))
   )
)
(setq lst (fnlst (* n n)))                                        ;;;用列表存储关系矩阵，初始化lst   
(defun rc_num (pt)
   (+ (* n (- (car pt) 1)) (cadr pt) -1)
)                                                                  ;;;将坐标（ij）转化为lst中的对应序号
(setq zero_lst (mapcar 'rc_num pdlst))
(setq lst (mapcar '(lambda (x) (if (member x zero_lst) 0 1)) lst))
(defun splst (llst)
(setq lst1 (vl-sort llst '<) n_sum (length llst))
(mapcar '(lambda (x) (list x (- n_sum (length (vl-remove x llst))))) lst1)
)
(defun hx_rcmax (rclst_zero)
(cdr (car (vl-sort
      (append (mapcar '(lambda (x) (list (cadr x) (car x) 0 )) (splst (mapcar 'car rclst_zero)))
             (mapcar '(lambda (x) (list (cadr x) 0 (car x) )) (splst (mapcar 'cadr rclst_zero)))
             )
      '(lambda (ea eb)
                 (> (car ea) (car eb))
              )
                )
   )
)
)
(defun hx_num (rclst_zero)
(cond
       ((= (length rclst_zero) 1) (setq linelst rclst_zero))
       ((and (> (length rclst_zero) 1) (null (vl-remove 0 (mapcar '(lambda (x) (- (cadr x) (cadr (car rclst_zero)))) rclst_zero))))
             (setq linelst (list (list 0 (cadr (car rclst_zero)))))
           )
       ((and (> (length rclst_zero) 1) (null (vl-remove 0 (mapcar '(lambda (x) (- (car x) (car (car rclst_zero)))) rclst_zero))))
             (setq linelst (list (list (car (car rclst_zero)) 0)))
           )
       (t (progn
                 (setq hx (hx_rcmax rclst_zero))
                       (if (> (car hx) (cadr hx))
                             (setq linelst (cons hx (hx_num (vl-remove nil (mapcar '(lambda (x) (if (= (car hx) (car x)) nil x)) rclst_zero)))))
                             (setq linelst (cons hx (hx_num (vl-remove nil (mapcar '(lambda (x) (if (= (cadr hx) (cadr x)) nil x)) rclst_zero)))))
                       )
                        )
           )
   )
)
(defun sxlst (hhxlst rrclst0)
   (setq ptlst nil ij (length hhxlst))
   (repeat ij
      (if (> (apply '+ (mapcar '(lambda (x) (* (car x )(cadr x))) hhxlst)) 0)
             (progn
                     (setq pt (car (vl-remove nil (mapcar '(lambda (x) (if (> (* (car x )(cadr x)) 0) x nil)) hhxlst))))
             (setq ptlst (cons pt ptlst))
             (setq rrclst0 (vl-remove nil (mapcar '(lambda (x) (if (or (= (car x) (car pt)) (= (cadr x) (cadr pt))) nil x)) rrclst0)))
                       (if rrclst0
                           (setq hhxlst (hx_num rrclst0))
                          )
            )
                (progn
                     (if (> (car (car hhxlst)) 0)
                             (setq pt (car (vl-sort (vl-remove nil(mapcar '(lambda (x) (if (= (car x) (car (car hhxlst))) x nil)) rrclst0)) '(lambda (ea eb) (< (cadr ea) (cadr eb))))))
                             (setq pt (car (vl-sort (vl-remove nil(mapcar '(lambda (x) (if (= (cadr x) (cadr (car hhxlst))) x nil)) rrclst0)) '(lambda (ea eb) (< (car ea) (car eb))))))               
                       )
             (setq ptlst (cons pt ptlst))
             (setq rrclst0 (vl-remove nil (mapcar '(lambda (x) (if (or (= (car x) (car pt)) (= (cadr x) (cadr pt))) nil x)) rrclst0)))
                       (if rrclst0
                             (setq hhxlst (hx_num rrclst0))
                          )
            )
      )
   )
   ptlst
)
(sxlst (hx_num pdlst) pdlst)
((1 2) (1 4) (2 1) (2 5) (3 2) (4 1) (4 3) (4 5) (4 6))
6
FNLST
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35)
RC_NUM
(1 3 6 10 13 18 20 22 23)
(1 0 1 0 1 1 0 1 1 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
SPLST
HX_RCMAX
HX_NUM
SXLST
((2 5) (4 1) (1 4) (3 2))
_$

mahuan1279 发表于 2020-2-6 22:32:21

_$ (setq x 6 y 7 pdlst '((1 1)(1 2)(1 4)(2 2)(2 5)(3 1)(3 4)(3 7)(4 3)(4 4)(4 6)(5 4)(6 4)));;;X中有4个节点，Y中有6个节点 ,如果X中的1和Y中的2有关联，则将'(1 2)置入pdlst中
(setq n (max x y))   
(defun fnlst (nn)
(setq i nn n_lst nil)
(while (> i 0)
      (setq i (- i 1))
      (setq n_lst (cons i n_lst))
   )
)
(setq lst (fnlst (* n n)))                                        ;;;用列表存储关系矩阵，初始化lst   
(defun rc_num (pt)
   (+ (* n (- (car pt) 1)) (cadr pt) -1)
)                                                                  ;;;将坐标（ij）转化为lst中的对应序号
(setq zero_lst (mapcar 'rc_num pdlst))
(setq lst (mapcar '(lambda (x) (if (member x zero_lst) 0 1)) lst))
(defun splst (llst)
(setq lst1 (vl-sort llst '<) n_sum (length llst))
(mapcar '(lambda (x) (list x (- n_sum (length (vl-remove x llst))))) lst1)
)
(defun hx_rcmax (rclst_zero)
(cdr (car (vl-sort
      (append (mapcar '(lambda (x) (list (cadr x) (car x) 0 )) (splst (mapcar 'car rclst_zero)))
             (mapcar '(lambda (x) (list (cadr x) 0 (car x) )) (splst (mapcar 'cadr rclst_zero)))
             )
      '(lambda (ea eb)
                 (> (car ea) (car eb))
              )
                )
   )
)
)
(defun hx_num (rclst_zero)
(cond
       ((= (length rclst_zero) 1) (setq linelst rclst_zero))
       ((and (> (length rclst_zero) 1) (null (vl-remove 0 (mapcar '(lambda (x) (- (cadr x) (cadr (car rclst_zero)))) rclst_zero))))
             (setq linelst (list (list 0 (cadr (car rclst_zero)))))
           )
       ((and (> (length rclst_zero) 1) (null (vl-remove 0 (mapcar '(lambda (x) (- (car x) (car (car rclst_zero)))) rclst_zero))))
             (setq linelst (list (list (car (car rclst_zero)) 0)))
           )
       (t (progn
                 (setq hx (hx_rcmax rclst_zero))
                       (if (> (car hx) (cadr hx))
                             (setq linelst (cons hx (hx_num (vl-remove nil (mapcar '(lambda (x) (if (= (car hx) (car x)) nil x)) rclst_zero)))))
                             (setq linelst (cons hx (hx_num (vl-remove nil (mapcar '(lambda (x) (if (= (cadr hx) (cadr x)) nil x)) rclst_zero)))))
                       )
                        )
           )
   )
)
(defun sxlst (hhxlst rrclst0)
   (setq ptlst nil ij (length hhxlst))
   (repeat ij
      (if (> (apply '+ (mapcar '(lambda (x) (* (car x )(cadr x))) hhxlst)) 0)
             (progn
                     (setq pt (car (vl-remove nil (mapcar '(lambda (x) (if (> (* (car x )(cadr x)) 0) x nil)) hhxlst))))
             (setq ptlst (cons pt ptlst))
             (setq rrclst0 (vl-remove nil (mapcar '(lambda (x) (if (or (= (car x) (car pt)) (= (cadr x) (cadr pt))) nil x)) rrclst0)))
                       (if rrclst0
                           (setq hhxlst (hx_num rrclst0))
                          )
            )
                (progn
                     (if (> (car (car hhxlst)) 0)
                             (setq pt (car (vl-sort (vl-remove nil(mapcar '(lambda (x) (if (= (car x) (car (car hhxlst))) x nil)) rrclst0)) '(lambda (ea eb) (< (cadr ea) (cadr eb))))))
                             (setq pt (car (vl-sort (vl-remove nil(mapcar '(lambda (x) (if (= (cadr x) (cadr (car hhxlst))) x nil)) rrclst0)) '(lambda (ea eb) (< (car ea) (car eb))))))               
                       )
             (setq ptlst (cons pt ptlst))
             (setq rrclst0 (vl-remove nil (mapcar '(lambda (x) (if (or (= (car x) (car pt)) (= (cadr x) (cadr pt))) nil x)) rrclst0)))
                       (if rrclst0
                             (setq hhxlst (hx_num rrclst0))
                          )
            )
      )
   )
   ptlst
)
(sxlst (hx_num pdlst) pdlst)
((1 1) (1 2) (1 4) (2 2) (2 5) (3 1) (3 4) (3 7) (4 3) (4 4) (4 6) (5 4) (6 4))
7
FNLST
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48)
RC_NUM
(0 1 3 8 11 14 17 20 23 24 26 31 38)
(0 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1)
SPLST
HX_RCMAX
HX_NUM
SXLST
(nil (4 3) (3 1) (2 2) (1 4))
_$

mahuan1279 发表于 2020-2-6 22:34:25

找到网上数据测试了下，发现结果不正确。经分析，删除过程中选择了非0基，匹配数就减少了，结果就不正确。

mahuan1279 发表于 2020-2-8 14:01:58

问题转化为已一非负矩阵（含部分0元素），如何找到关键k个0 元素及其通过该k个0元素的k条线覆盖矩阵中的所有的0元素？k是最大匹配数，可以容易求出。

mahuan1279 发表于 2020-2-9 15:32:43

(setq flst '(4 10 7 5 2 7 6 3 3 3 4 4 4 6 6 3))
(defun fnlst (nn)(setq ii nn nn_lst nil)(while (> ii 0)(setq ii (- ii 1))(setq nn_lst (cons ii nn_lst))))
(defun cp (pdlst)(defun f (ppt llst) (cons(apply '+ (mapcar '(lambda (x) (if (= (car x)(car ppt)) 1 0)) llst))(cons (apply '+ (mapcar '(lambda (x) (if(= (cadr x)(cadr ppt)) 1 0)) llst)) ppt)))(setq vlst nil)
(while pdlst (setq pt (car (vl-sort (mapcar '(lambda (x) (f x pdlst)) pdlst) '(lambda (ea eb)
(cond ((and (= (min (car ea) (cadr ea)) 1) (= (min (car eb) (cadr eb)) 1))(< (max (car ea) (cadr ea)) (max (car eb) (cadr eb))))((and (= (min (car ea) (cadr ea)) 1) (> (min (car eb) (cadr eb)) 1)) '<)((= (+ (car ea) (cadr ea)) (+ (car eb) (cadr eb)))(< (min (car ea) (cadr ea)) (min (car eb) (cadr eb))))(t (< (+ (car ea) (cadr ea)) (+ (car eb) (cadr eb)))))))))(setq pdlst (vl-remove nil (mapcar '(lambda (y) (if (or (= (car y) (caddr pt)) (= (cadr y)(cadddr pt))) nil y)) pdlst)))(setq vlst (cons pt vlst))))(setq lst flst n (length lst) k (fix (sqrt n)))
(setq n_n_lst (mapcar 'list (fnlst n) lst) i 0 j 1)
(defun rowclo (num)(list(+ (/ num k) 1) (+ (rem num k) 1)))
(defun ij_to_num (rclst)(+ (* (- (car rclst) 1) k) (cadr rclst) -1))
(while (< i k)(setq min_num (apply 'min (vl-remove nil (mapcar '(lambda (x y) (if (and (>= (car x) (* i k)) (< (car x) (* (+ i 1) k))) y nil))n_n_lst lst)))) (setq lst (mapcar '(lambda (x y) (if (and (>= (car x) (* i k)) (< (car x) (* (+ i 1) k))) (- y min_num) y))n_n_lst lst)) (setq i (+ i 1)))
(while (<= j k) (setq min_num (apply 'min (vl-remove nil (mapcar '(lambda (x y) (if (= j (cadr (rowclo (car x)))) y nil))n_n_lst lst)))) (setq lst (mapcar '(lambda (x y) (if (= j (cadr (rowclo (car x)))) (- y min_num) y))n_n_lst lst)) (setq j (+ j 1)))
(setq n_n_lst (mapcar 'list (fnlst n) lst) kklst (mapcar '1+ (fnlst k)))
(setq ijlst (apply 'append (mapcar '(lambda (x) (mapcar '(lambda (y) (list x y)) kklst)) kklst)))
(setq zero_lst (vl-remove nil (mapcar '(lambda (x y) (if (= x 0) (rowclo (car y)))) lst n_n_lst)))
(defun funij_num_lst (hhxline_lst) (mapcar '(lambda (x) (cons (apply '+ (mapcar '(lambda (y) (if (= (caddr y) 1) (if (= (car x) (car y)) 1 0) (if (= (cadr x) (cadr y)) 1 0))) hhxline_lst)) x)) ijlst))
(setq hxline_lst (mapcar '(lambda (x) (if (> (car x) (cadr x)) (list (caddr x) (cadddr x) 1 0) (list (caddr x) (cadddr x) 0 1))) (cp zero_lst)))
(while (< (length hxline_lst) k)
    (setq ij_num_lst (funij_num_lst hxline_lst))
        (setq n_n_lst (mapcar 'list (fnlst n) lst))
        (setq min_num (apply 'min (mapcar '(lambda (y) (cadr (nth y n_n_lst))) (mapcar 'ij_to_num (vl-remove nil (mapcar '(lambda (x) (if (= (car x) 0) (cdr x) nil)) ij_num_lst))))))
        (setq lst (mapcar '(lambda (x y)(if (= (car x) 0) (- y min_num) (if (= (car x) 1) y (+ y min_num)))) ij_num_lst lst))
(setq zero_lst (vl-remove nil (mapcar '(lambda (x y) (if (= x 0) (rowclo (car y)))) lst n_n_lst)))
(setq hxline_lst (mapcar '(lambda (x) (if (> (car x) (cadr x)) (list (caddr x) (cadddr x) 1 0)(list (caddr x) (cadddr x) 0 1))) (cp zero_lst))))
(if (and (equal kklst (vl-sort (mapcar 'car hxline_lst) '<)) (equal kklst (vl-sort (mapcar 'cadr hxline_lst) '<)))
    (cons (apply '+ (mapcar '(lambda (y) (nth y flst)) (mapcar '(lambda (x) (ij_to_num (list (car x) (cadr x)))) hxline_lst))) hxline_lst)
    (princ "结果有误！")
)

mahuan1279 发表于 2020-2-9 19:54:24

总结下算法过程：首先将k*k矩阵（可用列表存储）的每行每列减去改行或该列的最小值，得到每行每列至少有1个0的矩阵,至少有k个0。若刚好是k个0，显然就是结果（0所对应的位置）。若0的个数大于k，那么至少有一行或列有2个及以上的0，而我们要求的结果是非同行非同列的k个0*（得到它们的位置），那如何删选0和0*呢？显然，如果一行或一列只有一个0，那我们毫无疑问将该0定为0*。所以我们将每个0（坐标为i，j）所在的行列进行统计，用（i，j，行上0的个数，列上0的个数）表示，如（2，3，3，4）表示位于C23处的0元素所在的行有3个0，所在的列上有4个0，对所有0元素的统计结果排序。优先选择行或列上0的个数最小值为1的0作为0*，如0（2，1，2，2）和0（4，5，1，5）比较，选择0（4，5，1，5）为0*。若两个0元素行列上上均没有1，且行+列相等，取min(行，列)较小的0为0*，如0（2，1，2，4）和0（4，5，3，3）比较，选择0（2，1，2，4）为0*。若行+列不相等，取和值小的0元素作为0*，如0（2，1，2，6）和0（4，5，3，4）比较，选择0（4，5，3，4）为0*，因为选定一个0*后，就要删除所在的行和列上的所有0，选择和值小的0为0*，意味保留的0就多，匹配大的几率就高。按排序先后顺序，选择1个0*，就删除该行该列，对剩下的0再排序，再选一个0*，直至删除完所有的0。选择0*的同时，对应确定一条划线，该条划线的方向由该0*行或列上数值大的一方决定，用（1，0）表示行，用（0，1）表示列，如选定0（2，1，1，5）为0*，则对应的划线计为（2，1，0，1），目的用最少条划线覆盖所有的0。若行列相等，随便定横向或竖向。显然多少个0*对应多少条划线。若最后的0*个数等于k，也就是有k条划线，也就得到答案了。若小于k,则通过增减增加0元素，书上的方法标记行、标记列、找0、找0*描述太绕了，把人都搞晕了。简单方法，根据每个元素坐标跟那些划线的三种关系，不在线上、仅在一条线上、在两条线的交点上，求出不在线上元素的最小值min，然后对应减min（不在线上的元素），不变（仅在一条线上的元素），加上min（在两条划线的交点上的元素），得到新的0元素分部图，按前面算法开始重新逐步选取0*，反复循环，直至找到k个0*。

mahuan1279 发表于 2020-2-9 22:19:47

本帖最后由 mahuan1279 于 2020-2-9 22:27 编辑

对于《匈牙利算法质疑》中的反例（非0元素可取1），检测运行确实会出现死循环情况，因为选定c11为0*（正确的应该选c21），则必然得不到最大分配数，而0（1，1，2，3）和0（2，1，2，3）无法比较，只能尝试选取其中一个为0*，也就是该文所说的不能严格保证结果的正确性（虽然遇到的几率很小）。简言之，不管增加多少限制条件来确定如何选取0*，都迈不过这个坎。

mahuan1279 发表于 2020-2-21 23:40:36

本帖最后由 mahuan1279 于 2020-2-22 00:10 编辑

针对特例情况，选取0作为0*的条件稍作修改：1、如果某行或某列只有一个0，则选取该0作为0*；若无此情况执行2：2、若某行或某列中的0即是行最小值也是列最小值，则选择该0作为0*（注意0之间也有大小之分，一行或一列中靠后的0比靠前的0小），若无此情况则执行3：3、一个0所在的行和列上的0个数之和最少的，则选择该0作为0*。不知是否还存在反例？

查看完整版本: 匈牙利算法求最大匹配问题问题