问题描述：
　　题目给出男女各ｎ人，要求求出他们的最大费用的完备匹配。
问题分析：
　　根据题意，我们可以把所有的男子看作二分图中左边的点，把女子看作二分图中右边的点。如果第ｉ个男子和第ｊ个女子可以匹配，就连一条从左边第ｉ个点到右边第ｊ个点的弧，弧的费用为他们之间的缘分值。例如样例数据的情况如下：

　　　　输入样例(cupid.in)：
　　　　2
　　　　3
　　　　0 0 Adam
　　　　1 1 Jack
　　　　0 2 George
　　　　1 0 Victoria
　　　　0 1 Susan
　　　　1 2 Cathy
　　　　Adam Cathy 100
　　　　Susan George 20
　　　　George Cathy 40
　　　　Jack Susan 5
　　　　Cathy Jack 30
　　　　Victoria Jack 20
　　　　Adam Victoria 15
　　　　End
　　　
[img]http://www.chinaschool.org/aosai/lwjl/images/02-0220-01.gif[/img]
　　由于题目数据较小(n<＝30)，所以我们可以使用邻接矩阵来储存任意两个男女间的关系。g[i,j]=0表示第ｉ个男子和第ｊ个女子不可能匹配，g[i,j]>0表示第ｉ个男子和第ｊ个女子的匹配费用为g[i,j]。
　　首先必须对输入数据进行分析，转化成邻接矩阵g中的表示方法。设两人坐标为m(x,y),w(x,y)。如果两人不能匹配，这有以下两种情况：

　　1． 两人的距离超过了丘比特箭的射程k。
　　　　即 sqrt(sqr(m(x)-w(x))+sqr(m(y)-w(y)))>k
　　2． 有一个人p(x,y)在两人中间，并且三人在同一直线上
　　　　即 ((p[x]-m[x])*(p[y]-w[y])<=0)and((p[y]-m[y])*(p[y]-w[y])<=0)and
　　　　　　(p[x]-m[x])*(w[y]-m[y])=(p[y]-m[y])*(w[x]-m[x])

注意：
　　如果两人能匹配，则这两个人的小费用为1
　　判断一个人在两个人中间时必须同时判断x,y两个坐标，并且乘积必须是小等零，而不是小于零。

　　反例：(0,0) (1,0) (2,0)
　　每个人的名字无大小写之分
　　读入的两人的关系时，可能男在前也可能女在前
　　在读入数据处理完成之后，就只要求出图的最大费用的完备匹配就可以了。在匹配的算法上，可以使用最大费用最大流或匈牙利算法来解决。

总结：
　　本题在读入数据处理上比较麻烦，在编程时必须考虑可能出现的各种情况。
在最大费用的完备匹配上，由于数据较小，不需要什么优化。利用匈牙利算法，并用链表表示关系，至少可以把N扩大到500。


程序：
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T+,V+,X+}
{$M 16384,0,655360}
const input='Cupid.in5';
　　　　output='Cupid.ou5';
var g:array[1..30,1..30]of integer;
　　a,b,fa,fb,ca,cb:array[1..30]of longint;
　　n,k:integer;
{procedure do1(x,y,z:integer);
　begin
　　if (x<=n)and(y>n) then g[x,y-n]:=0;
　　if (x<=n)and(z>n) then g[x,z-n]:=0;
　　if (y<=n)and(z>n) then g[y,z-n]:=0;
　　if (y<=n)and(x>n) then g[y,x-n]:=0;
　　if (z<=n)and(x>n) then g[z,x-n]:=0;
　　if (z<=n)and(y>n) then g[z,y-n]:=0;
　end; }
procedure init;
　var f:text;
　　i,j,z,u1,v1:integer;
　　u,v:string[20];
　　c:char;
　　d:array[1..60]of string[20];
　　e:array[1..60]of record
　　　　　　　　x,y:integer;
　　　　　　　end;
procedure do1(x,y,z:integer);
　begin
　　if ((e[z].x>e[x].x)and(e[z].x<e[y].x))or
　　　　((e[z].y>e[x].y)and(e[z].y<e[y].y)) then
　　　　　if (x<=n)and(y>n) then g[x,y-n]:=0;
　　if ((e[z].x<e[x].x)and(e[z].x>e[y].x))or
　　　　((e[z].y<e[x].y)and(e[z].y>e[y].y)) then
　　　　　if (x<=n)and(y>n) then g[x,y-n]:=0;
　end;
　begin
　　assign(f,input);
　　reset(f);
　　readln(f,k);
　　readln(f,n);
　　for i:=1 to n do
　　　for j:=1 to n do
　　　　g[i,j]:=1;
　　for i:=1 to 2*n do
　　　begin
　　　　readln(f,e[i].x,e[i].y,c,d[i]);
　　　　for j:=1 to length(d[i]) do
　　　　　d[i,j]:=upcase(d[i,j]);
　　　end;
　　repeat
　　　u:='';
　　　v:='';
　　　c:='a';
　　　while not(eof(f))and(c<>' ') do
　　　　begin
　　　　　read(f,c);
　　　　　c:=upcase(c);
　　　　　if c<>' ' then u:=u+c;
　　　　end;
　　　c:='a';
　　　while not(eof(f))and(c<>' ') do
　　　　begin
　　　　　read(f,c);
　　　　　c:=upcase(c);
　　　　　if c<>' ' then v:=v+c;
　　　　end;
　　　readln(f,z);
　　　if u<>'END' then
　　　begin
　　　　for i:=1 to n*2 do
　　　　　begin
　　　　　　if u=d[i] then u1:=i;
　　　　　　if v=d[i] then v1:=i;
　　　　　end;
　　　　if u1<v1 then g[u1,v1-n]:=z
　　　　else g[v1,u1-n]:=z;
　　　end;
　　until(u='END');
　　close(f);
　　for i:=1 to 2*n do
　　　for j:=1 to 2*n do
　　　　for z:=1 to 2*n do
　　　　　if (i<>j)and(j<>k)and(i<>k) then
　　　　　　if (e[z].x=e[i].x)or(e[j].x=e[i].x) then
　　　　　　　if e[j].x=e[z].x then do1(i,j,z)
　　　　　　else
　　　　　else if (e[z].y=e[i].y)or(e[j].y=e[i].y) then
　　　　　　　　　　if e[z].y=e[j].y then do1(i,j,z)
　　　　　　　　　　else
　　　　　　　　else if (e[z].x-e[i].x)/(e[j].x-e[i].x)=(e[z].y-　　　　　　　　　　　　　　　　　　　　　　　e[i].y)/(e[j].y-e[i].y) then do1(i,j,z);
　　for i:=1 to n do
　　　for j:=n+1 to 2*n do
　　　　if sqr(e[i].x-e[j].x)+sqr(e[i].y-e[j].y)>k*k then
　　　　　　g[i,j-n]:=0;
　end;
procedure do2;
　var develop,develops:boolean;
　　　i,j,maxn,max:longint;
　begin
　　fillchar(a,sizeof(a),0);
　　fillchar(b,sizeof(b),0);
　　repeat
　　　develops:=false;
　　　fillchar(fa,sizeof(fa),0);
　　　fillchar(fb,sizeof(fb),0);
　　　fillchar(ca,sizeof(ca),0);
　　　fillchar(cb,sizeof(cb),0);
　　　for i:=1 to n do
　　　　　cb[i]:=-maxint;
　　　for i:=1 to n do
　　　　if a[i]<>0 then ca[i]:=-maxlongint;
　　　repeat
　　　　for i:=1 to n do
　　　　　if ca[i]<>-maxint then
　　　　　　for j:=1 to n do
　　　　　　　if g[i,j]<>0 then
　　　　　　　　if g[i,j]+ca[i]>cb[j] then
　　　　　　　　　begin
　　　　　　　　　　cb[j]:=g[i,j]+ca[i];
　　　　　　　　　　fb[j]:=i;
　　　　　　　　　end;
　　　develop:=false;
　　　for j:=1 to n do
　　　　if b[j]<>0 then
　　　　　if ca[b[j]]<cb[j]-g[b[j],j] then
　　　　　　begin
　　　　　　　develop:=true;
　　　　　　　ca[b[j]]:=cb[j]-g[b[j],j];
　　　　　　　fa[b[j]]:=j;
　　　　　　end;
　　　until not(develop);
　　　maxn:=0;
　　　max:=-maxint;
　　　for i:=1 to n do
　　　　if b[i]=0 then
　　　　　if cb[i]>max then
　　　　　　begin max:=cb[i]; maxn:=i; end;
　　　j:=maxn;
　　　if j<>0 then
　　　　begin
　　　　　develops:=true;
　　　　　repeat
　　　　　　b[j]:=fb[j];
　　　　　　a[fb[j]]:=j;
　　　　　　j:=fb[j];
　　　　　　j:=fa[j];
　　　　　until(j=0);
　　　　end;
　　　until not(develops);
　　end;
procedure pri;
　var i:integer;
　　　s:longint;
　begin
　　s:=0;
　　for i:=1 to n do
　　　　if a[i]<>0 then
　　　　　　s:=s+g[i,a[i]];
　　writeln(s);
　　readln;
　end;
begin
　init;
　do2;
　pri;
end.