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

  设两人的坐标(x1,y1)和(x2,y2) 。
  如果[img]http://www.chinaschool.org/aosai/lwjl/images/02-0221-03.gif[/img] ,意味着Cupid的箭射程不够。
  下面说一下判断两个人连线段上是否有第三者。
  设另一个人的坐标是(x3,y3) 。
先考虑这三个是否共线,就是考察行列式[img]http://www.chinaschool.org/aosai/lwjl/images/02-0221-05.gif[/img]是否成立。如果三个人共线再考虑(x3,y3)是否在(x1,y1)和(x2,y2)的连线段上,即考察
  (i) 如果[img]http://www.chinaschool.org/aosai/lwjl/images/02-0221-08.gif[/img]是否成立;
  (ii) [img]http://www.chinaschool.org/aosai/lwjl/images/02-0221-09.gif[/img]如果是否成立。
[小结]
  该题很容易看出图论模型。这是考察基本功和熟练度的题目。

[参考程序]

{$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.