Программа 26, с. 131 Кирсанов М.Н. Графы в Maple , М.: Физматлит 2007
Наибольшее паросочетание в графе
| > | restart: with(networks):with(LinearAlgebra): |
Процедура поиска матрицы паросочетания
| > | BipartCard:=proc(A) |
| > | global B; |
| > | local i,j,X,Y,nxt,Usl,else1,C,C1,R,j1,nj,nf1, |
| > | nof1r,is1c,cnv1; |
Процедура подсчета 1 в строке х
| > | nof1r:=proc(x) local i,j; |
| > | i:=0: for j to n do |
| > | if B[x,j]=1 then i:=i+1 fi: |
| > | od: i; |
| > | end proc: |
Процедура поиска помеченного столбца без 1
| > | is1c:=(x)->not is(1 in convert(Column(B,x),set)) and R[x]<>0: |
Процедура преобразование в матрицу
| > | cnv1:=(x)->convert(x,Matrix): |
| > | X:={$1..n}: Y:={$1..n}: |
| > | for i to n do |
| > | for j to n do |
| > | if A[i,j]=0 then B[i,j]:=`*`: fi; |
| > | if i in X and j in Y and A[i,j]=1 then B[i,j]:=A[i,j]: |
| > | X:=X minus {i}: Y:=Y minus {j}: fi: |
| > | od; |
| > | od: |
| > | nxt:=true: |
| > | while nxt do |
| > | C:=[seq(0,i=1..n)]: |
| > | R:=[seq(0,i=1..n)]: |
| > | Usl:=true; |
Первоначальные метки строк
| > | while Usl do |
| > | for i to n do |
| > | if nof1r(i)=0 then C[i]:=`*`; fi; |
| > | od; |
Метки столбцов
| > | for i to n do |
| > | if C[i]<>0 then |
| > | for j to n do |
| > | if B[i,j]=0 and R[j]=0 then R[j]:=i; fi; |
| > | od; |
| > | fi; |
| > | od; |
| > | C1:=C; |
Метки строк
| > | for j to n do |
| > | if R[j]<>0 then |
| > | for i to n do |
| > | if B[i,j]=1 and C[i]=0 then C[i]:=j; fi; |
| > | od; |
| > | fi; |
| > | od: |
Проверка зацикливания
| > | Usl:=not Equal(cnv1(C),cnv1(C1)); |
| > | od: |
| > | nxt:=false: |
Поиск помеченного столбца без 1
| > | for j to n do |
| > | if is1c(j) then nxt:=true: j1:=j; fi; |
| > | od; |
| > | if nxt then |
| > | j:=j1; i:=0; nj:=0; else1:=true; |
| > | while else1 do |
| > | i:=i+1: |
| > | while B[i,j1]<>0 do i:=i+1; od; #Поиск 0 по столбцу |
| > | B[i,j1]:=1; # Вместо 0 |
| > | nf1:=nof1r(i); |
| > | # В новой строке находим другую 1 |
| > | while nf1=2 do |
| > | j:=1: while B[i,j]<>1 or j=j1 do j:=j+1; od; |
| > | nj:=R[j]; |
| > | if nj=0 # Если столбец без метки |
| > | then |
| > | B[i,j1]:=0;# Вместо ошибочной 1 |
| > | nf1:=1;# Для выхода из цикла |
| > | else |
| > | B[nj,j]:=1; # Перенесли 1 по адресу из столбца j |
| > | B[i,j]:=0; # Вместо 1 |
| > | nf1:=nof1r(nj); |
| > | i:=nj; else1:=false; |
| > | fi; |
| > | od; |
| > | od; |
| > | fi;#if nxt |
| > | od: |
| > | B:=subs(`*`=0,B); |
| > | end proc: |
| > | save BipartCard, "C:\\bipart.m"; |