tree.pas

PASCAL光盘资料PASCAL光盘资料PASCAL光盘资料

{$A+,B-,D-,E-,F-,G+,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X-,Y-}
{$M 65520,0}
program tree(input, output);

const fin = 'tree.in';
      fon = 'tree.out';
      maxnodes = 1296;

type relation = array [0..2, 1..maxnodes] of integer;
     status = array [1..maxnodes] of ^relation;

var r :relation;
    a :status;
    n, p, max :integer;

procedure initialize;
 var i, j, k, id, q :integer;
     tri :array [1..4, 1..18, 1..35] of integer;
     c :array [1..maxnodes] of integer;

 procedure link(x, y :integer);
  begin
    r[c[x], x] := y; inc(c[x]);
    r[c[y], y] := x; inc(c[y])
  end;

 begin
    readln(n); p := 4 * n * n;
    fillchar(c, sizeof(c), 0);
    for i := 1 to p do
      begin
        new(a[i]);
        fillchar(a[i]^, sizeof(a[i]^), 0)
      end;

    for i := 1 to 4 do
      for j := 1 to n do
        for k := 1 to j shl 1 - 1 do
          readln(tri[i, j, k]);

    for i := 1 to 4 do
      for j := 1 to n do
        for k := 2 to j shl 1 - 2 do
          if k and 1 = 0
            then begin
                   link(tri[i, j, k], tri[i, j, k - 1]);
                   link(tri[i, j, k], tri[i, j, k + 1]);
                   link(tri[i, j, k], tri[i, j - 1, k - 1])
                 end;

    j := -1; k := n shl 1 + 1;
    for i := 1 to n do
      begin
        inc(j, 2); dec(k, 2);
        link(tri[1, i, 1], tri[3, i, j]); {a left, c right}
        link(tri[1, i, j], tri[2, i, 1]); {a right, b left}
        link(tri[1, n, k], tri[4, i, 1]); {a bottom, d left}
        link(tri[2, i, j], tri[3, i, 1]); {b right, c left}
        link(tri[2, n, j], tri[4, i, j]); {b bottom, d right}
        link(tri[3, n, j], tri[4, n, k])  {c bottom, d bottom}
      end
 end;

function getsub(id, range, fid :integer) :integer;
 var from, low, high, i, j, temp, lmax, rmax :integer;
 begin
   from := 0; while r[from, id] <> fid do inc(from);
   if a[id]^[from, range] > 0
     then begin
            getsub := a[id]^[from, range];
            exit
          end;

   if range > fid
     then begin
            low := fid + 1;
            high := range
          end
     else begin
            low := range;
            high := fid - 1
          end;

   lmax := 0; rmax := 0;
   for i := 0 to 2 do
     if (i <> from) and (r[i, id] >= low) and (r[i, id] <= high)
       then if r[i, id] < id
              then begin
                     temp := getsub(r[i, id], low, id);
                     if temp > lmax then lmax := temp
                   end
              else begin
                     temp := getsub(r[i, id], high, id);
                     if temp > rmax then rmax := temp
                   end;

   i := lmax + rmax + 1;
   a[id]^[from, range] := i; getsub := i
 end;

procedure solve;
 var i, j, k, temp, lmax, rmax :integer;
 begin
   max := 0;
   for i := 1 to p do
     begin
       lmax := 0; rmax := 0;
       for j := 0 to 2 do
         if r[j, i] < i
           then begin
                  temp := getsub(r[j, i], 1, i);
                  if temp > lmax then lmax := temp;
                end
           else begin
                  temp := getsub(r[j, i], p, i);
                  if temp > rmax then rmax := temp
                end;
       if lmax + rmax > max then max := lmax + rmax
     end;
   inc(max)
 end;

begin
  assign(input, fin); reset(input);
  assign(output, fon); rewrite(output);
  initialize;
  solve;
  writeln(max); close(output); close(input)
end.