寒假时没事写了这几个代码，算是我几个月后重操键盘了。这是几道经典题目，可能有人需要，再加上昨天搞JavaScript改过去改过来把PJBlog改得面目全非终于实现了代码高亮忍不住想Show一下，于是把这些代码（连同题目）发了上来。

标准的网络流题目代码

Problem : goods
货物运输

问题描述
    你第一天接手一个大型商业公司就发生了一件倒霉的事情：公司不小心发送了一批次品。很不幸，你发现这件事的时候，这些次品已经进入了送货网。这个送货网很大，而且关系复杂。你知道这批次品要发给哪个零售商，但是要把这批次品送到他手中有许多种途径。送货网由一些仓库和运输卡车组成，每辆卡车都在各自固定的两个仓库之间单向运输货物。在追查这些次品的时候，有必要保证它不被送到零售商手里，所以必须使某些运输卡车停止运输，但是停止每辆卡车都会有一定的经济损失。你的任务是，在保证次品无法送到零售商的前提下，制定出停止卡车运输的方案，使损失最小。

输入格式
    第一行：两个用空格分开的整数N(0<=N<=200)和M(2<=M<=200)。N为运输卡车的数目，M为仓库的数目。1号仓库是公司发货的出口，仓库M属于零售商。
    第二行到第N+1行：每行有三个整数，Si、Ei和Ci。Si和Ei(1<=Si,Ei<=M)分别表示这辆卡车的出发仓库和目的仓库，Ci(0<=Ci<=10,000,000)是让这辆卡车停止运输的损失。

输出格式
    输出一个整数，即最小的损失数。

样例输入
5 4
1 2 40
1 4 20
2 4 20
2 3 30
3 4 10

样例输出
50

样例说明
         40
      1——>2
      |      /|
      |     / |
    20|    /  |30
      |  20   |
      |  /    |
      | /     |
      /_     V
      4<——3
          10

    如图，停止1->4、2->4、3->4三条卡车运输线路可以阻止货物从仓库1运输到仓库4，代价为20+20+10=50。

数据规模
    对于50%的数据，N,M<=25
    对于100%的数据，N,M<=200

program goods;

   assign(output,'goods.out');
   rewrite(output);
   writep;
   close(output);
end.

统计逆序对 Treap版

Problem : inverse
逆序对

问题描述
    在一个排列中，前面出现的某个数比它后面的某个数大，即当Ai>Aj且i<j时，则我们称Ai和Aj为一个逆序对。给出一个1到N的排列，编程求出逆序对的个数。

输入格式
    第一行输入一个正整数N；
    第二行有N个用空格隔开的正整数，这是一个1到N的排列。

输出格式
    输出输入数据中逆序对的个数。

样例输入
4
3 1 4 2

样例输出
3

样例说明
    在输入数据中，(3,1)、(3,2)和(4,2)是仅有的三个逆序对。

数据规模
    对于30%的数据，N<=1000；
    对于100%的数据，N<=100 000。
program inverse;

const
   MaxH=Maxlongint;
  
type
   p=^rec;
   rec=record
          v,s,h:longint;
          left,right:p;
       end;

var
   header:p=nil;
   ans:int64=0;

procedure CalcuS(var w:p);
begin
   w^.s:=1;
   if w^.right<>nil then inc(w^.s,w^.right^.s);
   if w^.left<>nil then inc(w^.s,w^.left^.s);
end;

function RotateLeft(w:p):p;
var
   tmp:p;
begin
   tmp:=w^.left;
   w^.left:=tmp^.right;
   tmp^.right:=w;
   exit(tmp);
end;

function RotateRight(w:p):p;
var
   tmp:p;
begin
   tmp:=w^.right;
   w^.right:=tmp^.left;
   tmp^.left:=w;
   exit(tmp);
end;

function Insert(a:longint;w:p):p;
begin
  if w=nil then
  begin
     new(w);
     w^.v:=a;
     w^.h:=random(MaxH);
     w^.s:=1;
     w^.left:=nil;
     w^.right:=nil;
  end

  else if a<w^.v then
  begin
     ans:=ans+1;
     if w^.right<>nil then ans:=ans+w^.right^.s;
     w^.left:=Insert(a,w^.left);
     if w^.left^.h<w^.h then
     begin
        w:=RotateLeft(w);
        CalcuS(w^.right);
     end else
        CalcuS(w^.left);
  end

  else if a>w^.v then
  begin
     w^.right:=Insert(a,w^.right);
     if w^.right^.h<w^.h then
     begin
        w:=RotateRight(w);
        CalcuS(w^.left);
     end else
        CalcuS(w^.right);
  end;

  exit(w);
end;

{====main====}
var
   n,i,t:longint;
begin
   randseed:=2910238;
  
   assign(input,'inverse.in');
   reset(input);
   readln(n);
   for i:=1 to n do
   begin
      read(t);
      header:=Insert(t,header);
   end;
   close(input);

   assign(output,'inverse.out');
   rewrite(output);
   writeln(ans);
   close(output);
end.

USACO经典题目：矩形颜色（离散化+扫描）

Problem : rect
矩形颜色

问题描述
　　N个不同颜色的不透明长方形(1<=N<=1000)被放置在一张宽为A长为B的白纸上。这些长方形被放置时，保证了它们的边与白纸的边缘平行。所有的长方形都放置在白纸内，所以我们会看到不同形状的各种颜色。坐标系统的原点(0,0)设在这张白纸的左下角，而坐标轴则平行于边缘。

输入数据
    每行输入的是放置长方形的方法。第一行输入的是那个放在最底下的长方形（即白纸）。
    第一行：A、B和N，由空格分开(1<=A,B<=10,000)
    第二到N+1行：每行为五个整数llx,lly,urx,ury,color。这是一个长方形的左下角坐标，右上角坐标和颜色。颜色1和底部白纸的颜色相同。

输出数据
    输出文件应该包含一个所有能被看到的颜色连同该颜色的总面积的清单（即使颜色的区域不是连续的），按color的增序顺序。
    不要打印出最后不能看到的颜色。

样例输入
20 20 3
2 2 18 18 2
0 8 19 19 3
8 0 10 19 4

样例输出
1 91
2 84
3 187
4 38

数据规模
    对于50%的数据，A,B<=300，N<=60；
    对于100%的数据，A,B<=10000，N<=1000。

program rect;

const
   MaxN=1000;       { Rect number in the Worst Case }
   MaxCol=1000;     { Color number in the Worst Case }
   Infinity=Maxint; { Set to be Heap[0] }

type
   RecSeg=record
            y,x1,x2,order:integer;
          end;
var
   xar,heap:array[0..MaxN*2+2]of integer; { Array of All X-Value and Heap, respectively }
   color:array[1..MaxN+1]of integer;      { Index of Color corresponding to order}
   ans:array[1..MaxCol]of longint;        { Answers to be print }
   seg:array[0..MaxN*2+2]of RecSeg;       { Horizontal Segments }
   hash:array[1..MaxN*2+2]of boolean;     { Determine if a Segment has been scanned }
   n,HeapSize:integer;

procedure SwapInt(var a,b:integer);
var
   tmp:integer;
begin
   tmp:=a;
   a:=b;
   b:=tmp;
end;

procedure SwapRec(var a,b:RecSeg);
var
   tmp:RecSeg;
begin
   tmp:=a;
   a:=b;
   b:=tmp;
end;

procedure DataInsert(start,x1,y1,x2,y2,col,order:integer);
var
   tmp:RecSeg;
begin
   xar[start]:=x1;
   xar[start+1]:=x2;
   color[start div 2+1]:=col;

   tmp.order:=order;
   tmp.y:=y1;
   tmp.x1:=x1;
   tmp.x2:=x2;
   seg[start]:=tmp;

   tmp.y:=y2;
   seg[start+1]:=tmp;
end;

procedure Readp;
var
   a,b,x1,x2,y1,y2,col,i:integer;
begin
   readln(a,b,n);
   n:=n+1;
   DataInsert(1,0,0,a,b,1,1);
   for i:=2 to n do
   begin
      readln(x1,y1,x2,y2,col);
      DataInsert(2*i-1,x1,y1,x2,y2,col,i);
   end;
end;

procedure SortXar;
var
   i,j:integer;
begin
   for i:=1 to 2*n do
   for j:=1 to 2*n-1 do
      if xar[j]>xar[j+1] then SwapInt(xar[j],xar[j+1]);
end;

procedure SortSeg;
var
   i,j:integer;
begin
   for i:=1 to 2*n do
   for j:=1 to 2*n-1 do
      if seg[j].y>seg[j+1].y then SwapRec(seg[j],seg[j+1]);
end;

procedure HeapInsert(x:integer);
var
   w:integer;
begin
   inc(HeapSize);
   w:=HeapSize;
   while Heap[w shr 1]<x do
   begin
      Heap[w]:=Heap[w shr 1];
      w:=w shr 1;
   end;
   Heap[w]:=x;
end;

procedure HeapDelete;
var
&n
bsp;  x:integer;
   w:integer=1;
begin
   x:=Heap[HeapSize];
   dec(HeapSize);
   while w shl 1<=HeapSize do
   begin
      w:=w shl 1;
      if (w<>HeapSize) and (Heap[w+1]>Heap[w]) then inc(w);
      if Heap[w]>x then Heap[w shr 1]:=Heap[w]
      else begin
         w:=w shr 1;
         break;
      end;
   end;
   Heap[w]:=x;
end;

procedure Scan(x1,x2:integer);
var
   i:integer;
   j:integer=0;
begin
   for i:=1 to 2*n do if (seg[i].x1<=x1) and (seg[i].x2>=x2) then
   begin
      inc(ans[Color[Heap[1]]],(x2-x1)*(seg[i].y-seg[j].y));
      hash[seg[i].order]:=not hash[seg[i].order];
      if hash[seg[i].order] then HeapInsert(seg[i].order)
         else while (HeapSize>0) and not hash[Heap[1]] do HeapDelete;
      j:=i;
   end;
end;

procedure Solve;
var
   i:integer;
begin
   for i:=1 to 2*n-1 do if xar[i]<xar[i+1] then
   begin
      fillchar(Heap,Sizeof(Heap),0);
      fillchar(hash,Sizeof(hash),0);
      HeapSize:=0;
      Heap[0]:=Infinity;
      Scan(xar[i],xar[i+1]);
   end;
end;

procedure Writep;
var
   i:integer;
begin
   for i:=1 to MaxCol do
      if ans[i]>0 then writeln(i,' ',ans[i]);
end;

{====main====}
begin
   assign(input,'rect.in');
   reset(input);
   assign(output,'rect.out');
   rewrite(output);

   Readp;
   SortXar;
   SortSeg;
   Solve;
   Writep;

   close(input);
   close(output);
end.

    这几天大家发现我改PJBlog改错了什么东西导致Bug的话麻烦帮忙报告一下。事实上很有可能有人发现有Bug但是不能报告，因为我很有可能把验证码系统也搞坏了。
    如果这几天大家没有发现问题的话，我把这几天我的PJBlog个性修改方法和心得写出来分享一下（越来越喜欢搞Web Design了）。

做人要厚道
转贴请注明出处
（这篇日志没什么技术含量，感觉写上这两句很别扭）