明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 996|回复: 7

[自我挑战] 匈牙利算法求最大匹配问题问题

[复制链接]
发表于 2020-2-6 19:04 | 显示全部楼层 |阅读模式
_$ (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)
)                                                                  ;;;将坐标(i  j)转化为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))
_$

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2020-2-6 22:32 | 显示全部楼层
_$ (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)
)                                                                  ;;;将坐标(i  j)转化为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))
_$

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2020-2-6 22:34 | 显示全部楼层
找到网上数据测试了下,发现结果不正确。经分析,删除过程中选择了非0基,匹配数就减少了,结果就不正确。
 楼主| 发表于 2020-2-8 14:01 | 显示全部楼层
问题转化为已一非负矩阵(含部分0元素),如何找到关键k个0 元素及其通过该k个0元素的k条线覆盖矩阵中的所有的0元素?k是最大匹配数,可以容易求出。
 楼主| 发表于 2020-2-9 15:32 | 显示全部楼层
(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 "结果有误!")
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2020-2-9 19:54 | 显示全部楼层
总结下算法过程:首先将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*。
 楼主| 发表于 2020-2-9 22:19 | 显示全部楼层
本帖最后由 mahuan1279 于 2020-2-9 22:27 编辑

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2020-2-21 23:40 | 显示全部楼层
本帖最后由 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*。不知是否还存在反例?

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 07:23 , Processed in 0.222753 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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