猥琐趣味题∼丘比特的烦恼

[VJ 1169]
描述【来源 CTSC】 随着社会的不断发展，人与人之间的感情越来越功利化。最近，爱神丘比特发现，爱情也已不再是完全纯洁的了。这使得丘比特很是苦恼，他越来越难找到合适的男女，并向他们射去丘比特之箭。于是丘比特千里迢迢远赴中国，找到了掌管东方人爱情的神——月下老人，向他求教。
　　月下老人告诉丘比特，纯洁的爱情并不是不存在，而是他没有找到。在东方，人们讲究的是缘分。月下老人只要做一男一女两个泥人，在他们之间连上一条红线，那么它们所代表的人就会相爱——无论他们身处何地。而丘比特的爱情之箭只能射中两个距离相当近的人，选择的范围自然就小了很多，不能找到真正的有缘人。
　　丘比特听了月下老人的解释，茅塞顿开，回去之后用了人间的最新科技改造了自己的弓箭，使得丘比特之箭的射程大大增加。这样，射中有缘人的机会也增加了不少。
　　情人节(Valentine's day)的午夜零时，丘比特开始了自己的工作。他选择了一组数目相等的男女，感应到他们互相之间的缘分大小，并依此射出了神箭，使他们产生爱意。他希望能选择最好的方法，使被他选择的每一个人被射中一次，且每一对被射中的人之间的缘分的和最大。
　　当然，无论丘比特怎么改造自己的弓箭，总还是存在缺陷的。首先，弓箭的射程尽管增大了，但毕竟还是有限的，不能像月下老人那样，做到“千里姻缘一线牵”。其次，无论怎么改造，箭的轨迹终归只能是一条直线，也就是说，如果两个人之间的连线段上有别人，那么莫不可向他们射出丘比特之箭，否则，按月下老人的话，就是“乱点鸳鸯谱”了。
　　作为一个凡人，你的任务是给出了每对恋人的缘分值及个人的坐标后，运用先进的计算机为丘比特找到最佳的方案。


不知道怎么会想做这题∼我打开时AC人数就是100了∼这意味着我AC也不能留在Who AC？的前一百列表中∼
但是我终究是写了∼
这个代码很不优美。。。

很明显我也不清楚到底什么变量作什么了∼∼∼
由此可见，这个code太WS，只怕会影响众GG及MM的审美情趣，造成错误的OI印象 [其实oi是很hexie很不WS的∼] ∼

额∼从题目可以看出哦∼这就是我在那篇 拍拖模型 中讲的二分图最佳匹配∼显然，这个世界上太多太多的爱情的不幸，大概是因为丘比特不懂KM算法或者费用流吧∼

Code：

//丘比特的烦恼 1169
var
 x,y:array[0..100]of longint;
 nm:array[0..100]of string;
 n,kl,ct,node:longint;
 e,fl:array[0..100,0..100]of longint;
 ed:array[0..500]of longint;
 s1,s2:array[0..500]of longint;
 pre,nd:array[0..100]of longint;
 flow,cost:longint;
 function fp(const t:string):longint;
  var
   i:longint;
  begin
   for i:=1 to 2*n do
    if nm[i]=t then
     exit(I);
   exit(0);
  end;
 function dis(const a,b:longint):extended;
  begin
   exit(sqrt(sqr(x[a]-x[b])+sqr(y[a]-y[b])));
  end;
 function s(const a,b,c:longint):longint;
  var
   x1,x2,y1,y2:longint;
  begin
   x1:=x[b]-x[a]; y1:=y[b]-y[a];
   x2:=x[c]-x[a]; y2:=y[c]-y[a];
   exit( x1*y2-x2*y1 );
  end;
 procedure init1;
  var
   i,a,b,j:longint;
   u,v,w:string;
                        //x:char;
  begin
   fillchar(x,sizeof(x),0);fillchar(y,sizeof(y),0);
   readln(kl,n);
   for i:=1 to 2*n do
    begin
     read(x[i],y[i]);//read(x)
     readln(nm[i]);
     delete(nm[i],1,1);
     nm[i]:=upcase(nm[i]);
    end;
    for i:=1 to n do
    for j:=n+1 to 2*n do
      e[i,j]:=1;
   while not eof do
    begin
     inc(ct);
     readln(u);
     for i:=1 to length(u)do
      if u[i]=' 'then
       break;
     v:=copy(u,i+1,length(u)-i);
     delete(u,i,length(u)-i+1);
     for i:=1 to length(v) do
      if v[i]=' 'then
       break;
     w:=copy(v,i+1,length(v)-i);
     delete(v,i,length(v)-i+1);
     a:=fp(upcase(u));b:=fp(upcase(v));
     if a>b then
      begin i:=a;a:=b;b:=i;end;

     s1[ct]:=a;s2[ct]:=b;
     val(w,ed[ct]);
     //e[a,b]:=ed[ct];
    end;  dec(ct);
  end;
 procedure work;
  var
   i,j,k:longint;
   t:boolean;
  begin
   node:=n*2+1;
   for i:=1 to n do
    for j:=n+1 to 2*n do
    if dis(i,j)<=kl then
     begin
      t:=false;
      for k:=1 to 2*n do
       if (i<>k)and(j<>k)then
       if s(i,j,k)=0 then
       if ((x[k]-x[i])*(x[k]-x[j])<=0)and
        ((y[k]-y[i])*(y[k]-y[j])<=0)then
         begin t:=true;break;end;
      if t then e[i,j]:=-1
      else begin e[i,j]:=1;e[j,i]:=-1;fl[i,j]:=1;end;
     end
    else begin e[i,j]:=-1;{e[j,i]:=-1;fl[i,j]:=1;}end;
   for i:=1 to n do
    begin
     fl[0,i]:=1;
     fl[i+n,node]:=1;
    end;
   for i:=1 to ct do
    if e[s1[i],s2[i]]>=0 then
     begin
      e[s1[i],s2[i]]:=ed[i];
      e[s2[i],s1[i]]:=-ed[i];
      fl[s1[i],s2[i]]:=1;
      fl[s2[i],s1[i]]:=0;
     end
    else begin fl[s1[i],s2[i]]:=-0;{fl[s2[i],s1[i]]:=-1;}end;
  end;
 function blf:boolean;
  var
   i,j,k,inf:longint;
   t,b:boolean;
                        v:array[0..100]of boolean;
  begin      b:=false;
   fillchar(nd,sizeof(nd),128);
   fillchar(pre,sizeof(pre),0);fillchar(v,sizeof(v),0);
   inf:=nd[0];
   nd[0]:=0;  v[0]:=true;
   for i:=1 to node do
    begin
     t:=false;
     for k:=0 to node do if v[k] then
      for j:=0 to node do
       if (fl[k,j]>0) then
       if nd[j]<nd[k]+e[k,j]then
        begin
         nd[j]:=nd[k]+e[k,j];
                                                                        v[j]:=true;
         if j=node then b:=true;
         pre[j]:=k;
         t:=true;
        end;
     if not t then
      break;
    end;
   if b then
   exit(true)
   else exit(false);
  end;
 procedure add(var dt,cost:longint);
  var
   i,j,k:longint;
  begin
                        dt:=maxlongint;cost:=0;
   i:=node;
   while i<>0 do
   begin
    if fl[pre[i],i]<dt then
     dt:=fl[pre[i],i];
    i:=pre[i];
   end;
   i:=node;
   while i<>0 do
    begin
     inc(cost,e[pre[i],i]*dt);
     dec(fl[pre[i],i],dt);
     inc(fl[i,pre[i]],dt);
     i:=pre[i];
    end;
  end;
 procedure mincf;
  var
   i,j,dt,ct:longint;
  begin            //flow:=0;
   while blf do
    begin   //dt:=0;ct:=0;
     add(dt,ct);
     //inc(dt,ct);
     inc(flow,dt);
     inc(cost,ct);
    end;
   writeln(cost);
  end;
 begin
  init1;
  work;
  mincf;
        end.
 {
编译通过...
├ 测试数据 01：答案正确... 0ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 0ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 0ms
├ 测试数据 08：答案正确... 0ms
├ 测试数据 09：答案正确... 0ms
├ 测试数据 10：答案正确... 0ms
-------------------------
Accepted 有效得分：100 有效耗时：0ms

 }