[原题描述]
　　给出一些男女之间的缘分值，按一定的规则对若干对男女射箭，求被射中的男女缘分和的最大值。
[问题分析]
　　该题是典型的二部图匹配。
　　设二部图G被划分成{X, Y}，X是男子的点集，Y是女子的点集。如果对于i∈ X和j∈ Y，按规则箭可以射中i和j，则连一条边(i, j)，边的权值是i和j的缘分值。
　　最后，求G的最大权完全匹配。
[关于射箭规则]

　　设两人的坐标和 。
　　如果 ，意味着Cupid的箭射程不够。
　　下面说一下判断两个人连线段上是否有第三者。
　　设另一个人的坐标是 。
先考虑这三个是否共线，就是考察行列式是否成立。如果三个人共线再考虑 是否在和的连线段上，即考察
　　(i) 如果是否成立；
　　(ii) 如果是否成立。
[小结]
　　该题很容易看出图论模型。这是考察基本功和熟练度的题目。

[参考程序]

{$R-,Q-}
const
　MaxN = 29;
　FileIn = 'cupid.in';
　FileOut = 'cupid.out';
var
　G, Flow : array[1..Maxn, 1..Maxn]of Integer;
　Value, Back : array[1..Maxn]of Integer;
　Sum : Word;
　N : Byte;
procedure Initialize;
type
　people = record
　　　Name : string[20];
　　　X, Y : Longint;
　　end;
var
　Lovers : array[1..MaxN, 1..2] of People;
　sex, no : array[1..2]of byte;
　Names : array[1..2]of string[20];
　i, j, v : byte;
　　code : integer;
　x1, y1,
x2, y2, k : longint;
　　　　F : text;
　　　　s : string;
function Upcases(x : string) : string;
var ss : string; i : byte;
begin
　ss := '';
　for i := 1 to length(x) do ss := ss + upcase(x[i]);
　upcases := ss;
end;
procedure GetInfo(z : byte);
var i : byte;
begin
　for i := 1 to n do
　　if lovers[i, 1].name = names[z] then
　　begin
　　　sex[z] := 1;
　　　no[z] := i;
　　　exit;
　　end;
　sex[z] := 2;
　for i := 1 to n do
　　if lovers[i, 2].name = names[z] then
　　begin
　　　no[z] := i;
　　　exit;
　　end;
end;
function Check : boolean;
var j, i : byte;
　x3, y3 : longint;
begin
　check := false;
　for j := 1 to 2 do
　　for i := 1 to n do
　　　if ((j = sex[1]) and (i <> no[1])) or ((j = sex[2]) and (i <> no[2])) then
　　　begin
　　　　x3 := lovers[i, j].X;
　　　　y3 := lovers[i, j].Y;
　　　　if (Y3 - Y2) * (X1 - X2) = (Y1 - Y2) * (X3 - X2) then
　　　　　if (Y1 = Y2)and(Y2 = Y3) then
　　　　　　if (X1 < X3)and(X3 < X2)or(X2 < X3)and(X3 < X1) then exit else begin end
　　　　　else
　　　　　　if (Y1 < Y3)and(Y3 < Y2)or(Y2 < Y3)and(Y3 < Y1) then exit;
　　　end;
　　check := true;
　end;
begin
　assign(f, filein); reset(f);
　readln(f, k);
　k := k * k;
　readln(f, n);
　for j := 1 to 2 do
　　for i := 1 to n do
　　begin
　　　read(f, Lovers[i, j].X, Lovers[i, j].Y);
　　　readln(f, s);
　　　s := copy(s, 2, length(s));
　　　s := Upcases(s);
　　　Lovers[i, j].Name := s;
　　end;
sex[1] := 1; sex[2] := 2;
for i := 1 to n do
　for j := 1 to n do
　begin
　　x1 := lovers[i, 1].X; y1 := lovers[i, 1].Y;
　　x2 := lovers[j, 2].X; y2 := lovers[j, 2].Y;
　　no[1] := i; no[2] := j;
　　if (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2) > k then
　　　g[i, j] := 0
　　else
　　　if Check then
　　　　g[i, j] := 1
　　　else
　　　　g[i, j] := 0
　end;
readln(f, s);
while s <> 'End' do
begin
　i := pos(' ', s); names[1] := upcases(copy(s, 1, i - 1)); delete(s, 1, 　i);
　i := pos(' ', s); names[2] := upcases(copy(s, 1, i - 1)); delete(s, 1, i);
　val(s, v, code);
　for i := 1 to 2 do GetInfo(i);
　if sex[1] = 1 then
　　if g[no[1], no[2]] <> 0 then g[no[1], no[2]] := v else begin end
　　else
　　　if g[no[2], no[1]] <> 0 then g[no[2], no[1]] := v;
　　readln(f, s);
　end;
　close(f);
end;
procedure AddPath(x : byte);
type Each = record
　　　　father : byte;
　　　　value : integer;
　　　end;
var L1, L2 : array[1..MaxN * 2]of Each;
　　Tar : Each;
　i, j, k : byte;
　t : integer;
　changed : boolean;
begin
　for i := 1 to n do
　begin
　　if Value[i] = 0 then L1[i].Value := 0 else L1[i].value := -MaxInt;
　　L2[i].value := -MaxInt;
　end;
　tar.value := -Maxint;
　repeat
　　changed := false;
　　for i := 1 to n do
　　　if L1[i].value <> -Maxint then
　　　　for j := 1 to n do
　　　　　if (flow[i, j] = 0) and (G[i, j] > 0) then
　　　　　　if L1[i].value + G[i, j] > L2[j].value then
　　　　　　begin
　　　　　　　L2[j].value := L1[i].value + G[i, j];
　　　　　　　L2[j].father := i;
　　　　　　　changed := true;
　　　　　　end;
　for j := 1 to n do
　　if L2[j].value <> -Maxint then
　　begin
　　　for i := 1 to n do
　　　　if flow[i, j] = 1 then
　　　　　if L2[j].value - g[i, j] > L1[i].value then
　　　　　begin
　　　　　　L1[i].value := L2[j].value - g[i, j];
　　　　　　L1[i].father := j;
　　　　　　changed := true;
　　　　　end;
　　　if back[j] = 0 then
　　　　if L2[j].value > tar.value then
　　　　　begin
　　　　　　tar.value := L2[j].value;
　　　　　　tar.father := j;
　　　　　end;
　　end;
until not changed;
Sum := Sum + tar.value;
i := tar.father;
back[i] := 1;
k := 2;
while (k <> 1) or (value[i] <> 0) do
begin
　case k of
　　　1 : begin j := L1[i].father; flow[i, j] := 0; end;
　　　2 : begin j := L2[i].father; flow[j, i] := 1; end;
　　end;
　　k := 3 - k; i := j;
　end;
　value[i] := 1;
end;
procedure Coupling;
var F : text; i : byte;
begin
　Sum := 0;
　for i := 1 to n do AddPath(i);
　assign(f, fileout); rewrite(f);
　writeln(f, Sum);
　close(f);
end;
begin
　Initialize;
　Coupling;
end.