匈牙利算法相关问题

aimisiyou

找到原因了。我们先通过每次删除行或列最多的0可以得到最大匹配数，但不知选哪些关键0元素，即匈牙利算法中所谓的0*。程序中尝试选取某一行或某一列中的0作为0*，若选取的不是真正的0*，匹配数就会减少，所以出现错误。

aimisiyou

通过对匈牙利算法的研究，虽然走了很多弯路，但发现了更简单的方法求最大匹配问题，付出总是有回报的。

aisong220

Kkkkkkkkkkkkkkkkkkk

aimisiyou

aisong220 发表于 2020-2-8 00:00
Kkkkkkkkkkkkkkkkkkk

无意义的回帖让人很反感！你不觉得吗？

aimisiyou

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

aimisiyou

编了半天的代码没保存突然死机了，想撞墙的心都有了！！！
只能凭着模糊的记忆力再写一遍了，悲催啊。随时保存真的很重要！！！

aimisiyou

(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))
     )        
  vlst
)
(setq lst flst n (length lst) k (fix (sqrt n)))
(setq n_n_lst (mapcar 'list (fnlst n) lst))
(defun rowclo (num)
   (list  (+ (/ num k) 1) (+ (rem num k) 1))
)
(defun ij_to_num (rclst)
  (+ (* (- (car rclst) 1) k) (cadr rclst) -1)
)
(setq i 0 j 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))
(setq 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)
                                  )
))

aimisiyou

经过一系列挫折，小目标终于实现了。加油！

aimisiyou

(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 "结果有误！")
)

aimisiyou

对最后的结果进行检测，是否是K个非同行非同列的0*，若不是则报错。随机数据运行的结果都没报错。

aimisiyou

总结下算法过程：首先将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*。

aimisiyou

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

wrf610051

请问大师，你8楼上的对应关系我看不明白。我能得到的((1 1)(3 3)(4 4)(5 2)(2 5))，也就是你的((0 0)(2 2)(3 3)(41)(1 4))，我从1开计，你从0开计。

wrf610051

由大师7楼的数据(setq jzlst '((0 1 4 15 1)(4 1 12 27 0)(0 0 17 26 5)(2 0 14 12 0)(0 0 0 0 0)))
得到的结果为：((1 1) (2 5) (3 2) (5 3))

aimisiyou

wrf610051 发表于 2020-2-15 19:47
请问大师，你8楼上的对应关系我看不明白。我能得到的((1 1)(3 3)(4 4)(5 2)(2 5))，也就是你的((0 0)(2 2)( ...

是从0开始的，与nth函数相对应（从0开始）。