UVa12219 Common Subexpression Elimination

2014-10-05

链接：Link 状态：Runtime Error

前言

这题做的可真够久的，整整三个小时。但即便如此，还是只过了一部分的点，另一部分报运行时错误——估计是哈希表设计的不太好。但这确实是一道好题，因此，在睡觉前决定记录一下。

分析

很容易便想到：用一个三元组 $(x,y,z)$ 表示节点，表示内容为 x 的节点下跟着标号为 y 和 z 的左右子树。这样一来，一类相同的子树便可以唯一确定了，而不必每构造一棵子树就把整棵树遍历一遍。对于三元组的储存，刚开始图方便，用了数组。查找也是用了 $O(n)$ 的线性查找。磕磕碰碰写了两个多小时然后兴冲冲地提交，结果 TLE 了…………没办法，只好又花了半个小时写了一个哈希表，然后就是上文说过的情况了：Runtime Error204。可能是哈希数组过大的原因，日后再微调一下，今天实在是没有脑子了。

Code

const
  maxn = 20000;
type
  NodeRec = record
    Value: string;
    l, r, index: longint;
  end;
  Node = record
      left, right: longint;   //Index of left and right child in the `tree` array, -1 for none.
      Rec: NodeRec;
      index: longint;
  end;
  //以下为哈希表的定义
  _PNode = ^_Node;
  _Node = record
    n: Node;
    next: _PNode;
  end;

  HashTable = object
    arr: array [0..maxn] of _PNode;
    function hash(n: NodeRec): longint;
    procedure add(n: Node);
    procedure clear;
    function find(n: NodeRec): longint;
  end;

procedure HashTable.clear;
var
  i: longint;
  p, q: _PNode;
begin
  for i := 0 to maxn do
  begin
    p := arr[i];
    while p<>nil do
    begin
      q := p^.next;
      dispose(p);
      p := q;
    end;
  end;
  fillchar(arr, sizeof(arr),0);
end;

function cmp(r1, r2: NodeRec): Boolean;
begin
  cmp := (r1.l = r2.l) and (r1.r = r2.r) and (r1.Value = r2.Value);
end;

function HashTable.hash(n: NodeRec): longint;
var
  i: longint;
begin
  hash := 0;
  for i := 1 to length(n.Value) do
    hash := (hash*5 + ord(n.Value[i]) - ord('a')) mod maxn;
  hash := (hash + n.l * 10 + n.r * 5) mod maxn;
end;

procedure HashTable.add(n: Node);
var
  h: longint;
  p, q: _PNode;
begin
  h := hash(n.rec);
  new(q);
  fillchar(q^, sizeof(_Node), 0);
  q^.next := arr[h];
  q^.n := n;
  arr[h] := q;
end;

function HashTable.find(n: NodeRec): longint;
var
  p: _PNode;
begin
  find := -1;
  p := arr[hash(n)];
  while (p<>nil) and not cmp(n, p^.n.rec) do p := p^.next;
  if p <> nil then
    find := p^.n.index;
end;
//哈系表定义结束
var
  inputs: Ansistring;
  _: longint;
  tree: array [1..50001] of Node;
  cur: longint;              //The current pointer of the input string.
  num: longint;              //The current number of the `tree` array.
  ls: longint;
  t: longint;
  tot: longint;
  ht: HashTable;

function build: longint; //建树
label lb;
var
  rec: NodeRec;
  i,j,l,r: longint;
begin
  l := 0;
  r := 0;
  fillchar(rec, sizeof(rec), 0);
  inc(tot);
  rec.index := tot;
  while (cur<=ls) and (inputs[cur] in ['a'..'z']) do
  begin
    rec.Value := rec.Value+inputs[cur];
    inc(cur);
  end;
  if cur>ls then goto lb;    //。。。这里被迫跳转控制流，由于实在不想多谢，就用了臭名昭著的label
  if inputs[cur] = '(' then
  begin
    inc(cur);
    l := build();
    rec.l := tree[l].rec.index;
    inc(cur);
    r := build();
    rec.r := tree[r].rec.index;
    inc(cur);
  end;
  j := ht.find(rec);
  if j>0 then
  begin
    dec(tot);
    exit(j);
  end
  else
  begin
lb:
    inc(num);
    tree[num].left := l;
    tree[num].right := r;
    tree[num].rec := rec;
    tree[num].index := num;
    ht.add(tree[num]);
    exit(num);
  end;
end;

procedure print(n: longint);
begin
  if tree[n].rec.index > t then
  begin
    write(tree[n].rec.Value);
    t := tree[n].rec.index;
  end
  else
  begin
    write(tree[n].rec.index);
    exit;
  end;
  if tree[n].right = 0 then
    exit;
  write('(');
  print(tree[n].left);
  write(',');
  print(tree[n].right);
  write(')');
end;
begin
  assign(input, 'main.in'); reset(input);
  assign(output, 'main.out'); rewrite(output);
  readln(_);
  fillchar(ht.arr, sizeof(ht.arr),0);
  while _>0 do
  begin
    dec(_);
    readln(inputs);
    fillchar(tree, sizeof(tree), 0);
    ht.clear;
    ls := length(inputs);
    cur := 1;  num := 0; tot := 0;
    build;
    t := 0;
    print(num);
    writeln;
  end;
  close(input); close(output);
end.

UVa536 Recovery

2014-10-05

链接：Link 耗时：0.012s

前言

真是疯玩了几天，脑袋都残了，一道弱智题做了近一个小时。

Code

var
    pre, mid, s: string;
    tree: array [1..50] of record
        l, r: integer;
        ch: char;
    end;
    cur: integer;
function init: integer;
var
    m: integer;
begin
    readln(s);
    m := length(s) >> 1 + 1;
    pre := Copy(s, 1, m-1);
    mid := Copy(s, m+1, length(s));
    init := m-1;
end;
function build(l1, l2, r2: integer): integer;
var
    m,len: integer;
    t: integer;
begin
    if l2 > r2 then exit(0); //该子树不存在。**这个地方坑了我很久**
    inc(cur);
    t := cur;      // 这里也坑了我，当下面构造完左右子树后，cur已经变了，所以要缓存起来
    build := t;
    tree[t].ch := pre[l1];
    if r2-l2 = 0 then //叶节点
        exit;
    m := pos(pre[l1], mid); //在中序遍历中找根节点
    len := m - l2;
    tree[t].l := build(l1+1, l2, m-1); //构造左子树
    tree[t].r := build(l1+len+1, m+1, r2); //构造右子树
end;
procedure print(x: integer);
begin
    if x = 0 then exit;
    print(tree[x].l);
    print(tree[x].r);
    write(tree[x].ch);
end;
begin
    assign(input, 'main.in'); reset(input);
    assign(output, 'main.out'); rewrite(output);
    while not eof do
    begin
        fillchar(tree, sizeof(tree), 0);
        cur := 0;
        build(1, 1, init);
        print(1);
        writeln;
    end;
    close(input);
    close(output);
end.

UVa11582 Colossal Fibonacci Numbers! && 大数操作

2014-10-01

链接：Link 耗时：0.139s

前言

这道题的主要思路就是打表，看看 Fibonacci 数列模 n 几个一循环。但由于这题给的数太大了，从而在细节上耗了很久。在此记录一下：

var
    x: qword;
    y: longint;
begin
    x := 1<<64-1;
    y := 100;
    x := x mod y; //报错201
    x := x mod qword(y); //正确
end.

Code

var
    a,b: qword;
    _, n, i, k, cnt: longint;
    f: array [1..1000000] of longint;

function superMod(a, b: qword; m: longint): longint;
var
    x: qword;
begin
    if b = 0 then
        exit(1);
    x := superMod(a, b shr 1, m);
    superMod := x * x mod m;
    if odd(b) then
        superMod := superMod * a mod m;
end;

begin
    assign(input, 'main.in'); reset(input);
    assign(output, 'main.out'); rewrite(output);
    readln(_);
    while _ > 0 do
    begin
        dec(_);
        readln(a, b, n);
        if a = 0 then
        begin
            writeln(0);
            continue;
        end;
        if n = 1 then
        begin
            writeln(0);
            continue;
        end;
        f[1] := 1;
        f[2] := 1;
        cnt := 2;
        while not ((f[cnt-1] = 1) and (f[cnt] = 0)) do
        begin
            inc(cnt);
            f[cnt] := (f[cnt-1] + f[cnt-2]) mod n;
        end;
        //while x > int64(1 <<60) do
        //    x := x - int64((cnt << 59));
        a := a mod qword(cnt);
        k := superMod(a, b, cnt);
        writeln(f[k]);
    end;
    close(output); close(input);
end.

扩展欧几里得算法

2014-10-01

今天开始学习数论方面的算法。这部分在 NOIP 中并不常出现，即使出现了也不会像高联这么难（。。。）。

什么是扩展欧几里得算法

所谓欧几里得算法，实际上就是辗转相除法——求两个数最大公约数的一种高效算法。而扩展欧几里得算法则是来源于于一类方程的解决：

$$ax+by=gcd(a,b)$$

这有点像是裴蜀定理的一般形式。和裴蜀定理类似，这类方程也有无数多个整数解。如何高效率地求得它的一组特解呢？

代码

procedure gcd_ex(a, b: longint; var d: longint; var x, y: longint);
begin
    if b = 0 then
    begin
        d := a;
        x := 1;
        y := 0;
        exit;
    end;
    // hl:begin #1
    gcd_ex(b, a mod b, d, y, x);
    // hl:end
    y := y-(a div b) * x;
end;

详解

乍一看，算法似乎和一般欧几里得算法很是相似：都是递归实现，参数传递过程中都体现了“辗转相除”的思想。那为什么这个算法是正确的呢？这里先解释一下参数：

a：方程中的参数 a
b：方程中的参数 b
d：即 gcd(a,b)。由于和辗转相除法的相似性，在这里最大公约数也可以“顺便”算出。当然，去掉也无大碍
(x,y)：方程的一组特解 (x, y)

下面解释标注了 1 的那行代码。

假设方程 $ax+by=gcd(a,b)$ 有一组特解 $(x_0,y_0)$。则有$$ax_0+by_0=gcd(a,b)$$

由最大公约数原理可知：$$gcd(a,b)=gcd(b, a\ mod\ b)$$

从而有$$ax_0+by_0=gcd(b,a\ mod\ b)$$

又方程 $bx+(a\ mod\ b)y=gcd(b,a\ mod\ b)$ 一定有整数解，设其为 $(x_1,y_1)$。则有

$$ax_0+by_0=gcd(b,a\ mod\ b)=bx_1+(a\ mod\ b)y_1$$即$$ax_0+by_0=bx_1+(a-(a\ div\ b)*b)y_1$$

即 $$a(x_0-y_1)=b(x_1-(a\ div\ b)y_1-y_0)$$

由恒等原理可知：$$x_0=y_1$$$$y_0=x_1-(a\ div\ b)y_1$$

因此，当 $a,b\neq0$ 时，$x,y$ 的值可以递归求得。递归边界为：$b=0$ 时 $x=1,y=0$。

注意到上面的算法用到了一个技巧：在递归传参数的时候将 y, x 调换了。这样做的好处是节省了一个中间变量用来储存 $y_1$，否则在计算 $y_0$ 时 $y_1$ 也被覆盖了。从而使算法更加的精简。

应用

计算几何中求整点的问题
求一元一次同余方程 $a\equiv b\pmod{m}$ 的一组特解。（即方程 $ax+my=b$ 的一组特解）

UVa10285 Cake Slicing

2014-10-01

链接：Link 耗时：1.825s

这道题做的可真够久的：前前后后加起来将近有两个小时，因此当 AC 的那一刻，自己心中还是挺自豪的。

事实上，这是一道复杂一点的区间型动态规划，之所以说“复杂”，是因为它的状态转移是二维的：切蛋糕既可以横切，也可以纵切。由此我想到了分治算法：

假设一个矩形它所需要切的刀数是 f，则 f 可以由组成该矩形的小矩形的 f 值决定。

因此，这个问题具有最优子结构。由于每个状态为一个矩形，因此需要 4 个维度来记录状态（及左上、右下两个顶点）。下面是横切时的状态转移方程，纵切时同理可得：

$$ \begin{aligned} f(up, down, left, right) = &\ min\{f(up, i, left, right) \\ & + f(i, down, left, right) + right - left\},i = up + 1 .. down -1 \end{aligned} $$

{$R-}
const INF = maxint div 5; //正无穷
var
    f: array [0..20, 0..20, 0..20, 0..20] of integer;
    cherries: array [1..500, 1..2] of integer;
    map: array [0..20, 0..20] of boolean;
    n, m, i, k: integer;

function min(x, y: integer): integer; inline;
begin
    if x<y then exit(x) else exit(y);
end;

function cherryin(u, d, l, r: integer): integer; inline; //判断矩形内有没有樱桃
var
    i, j: integer;
begin
    cherryin := 0;
    for i := u+1 to d do
        for j := l+1 to r do
            if map[i, j] then
            begin
                inc(cherryin);
                if cherryin = 2 then exit;
            end;
end;

function dp(u, d, l, r: integer): integer;
var
    b: integer;
    i: integer;
begin
    if f[u, d, l, r] <> -1 then
        exit(f[u,d , l, r]);
    b := cherryin(u, d, l, r);
    if b = 1 then
    begin
        f[u, d, l, r] := 0;
        exit(0);
    end;
    if b = 0 then
    begin
        f[u, d, l, r] := INF;
        exit(INF);
    end;
    dp := INF;
    for i := u+1 to d-1 do
        dp := min(dp, dp(u, i, l, r)+dp(i, d, l, r)+r-l);
    for i := l+1 to r-1 do
        dp := min(dp, dp(u, d, l, i)+dp(u, d, i, r)+d-u);
    f[u, d, l, r] := dp;
end;

var
    _: integer;

begin
    assign(input, 'main.in');reset(input);
    assign(output, 'main.out');rewrite(output);
    _ := 0;
    readln(n, m, k);
    while n>0 do
    begin
        inc(_);
        fillchar(map, sizeof(map), 0);
        fillchar(f, sizeof(f), -1);
        for i := 1 to k do
        begin
            readln(cherries[i, 1], cherries[i, 2]);
            map[cherries[i, 1], cherries[i, 2]] := true;
        end;
        writeln('Case ',_,': ', dp(0,n,0,m));
        readln(n, m, k);
    end;
    close(input);close(output);
end.

UVa10285 Longest Run on a Snowboard

2014-09-29

链接：Link 耗时：0.028s

一道简单的动态规划，主要思路就是：用 $f[i,j]$ 表示到达 $(i,j)$ 的最长路径的长度。找到每个最高点，从其开始向四周的低处搜索。如果该点已搜过并且 f 值大于当前长度则退出回溯。直到达到某个最低点为止。

不多说了，直接上代码：

const
    delta :array [1..4, 1..2] of integer = ((-1, 0), (1, 0), (0, 1), (0, -1)); //四个方向向量
var
    _: Integer;
    name: string;
    n, m, i, j, x: Integer;
    ans: longint;
    map: array [0..101, 0..101] of integer;
    f: array [1..100, 1..100] of longint;

function max(x, y: longint): longint; inline;
begin
    if x>y then exit(x) else exit(y);
end;

function can(x, y: integer): Boolean; inline; //判断是否是最高点
var
    i: Integer;
    tx, ty: integer;
begin
    can := true;
    for i := 1 to 4 do
    begin
        tx := x + delta[i, 1];
        ty := y + delta[i, 2];
        can := can and (map[x, y] >= map[tx, ty]);
        if not can then break;
    end;
end;

procedure dp(x, y: integer; len: longint); //回溯进行动态规划
var
    i: Integer;
    tx, ty: integer;
begin
    inc(len);
    if f[x, y] > len then exit;
    f[x, y] := len;
    ans := max(ans, len);
    for i := 1 to 4 do
    begin
        tx := delta[i, 1] + x;
        ty := delta[i, 2] + y;
        if (tx = 0) or (tx > n) or (ty = 0) or (ty > m) then continue;
        if map[x, y] <= map[tx, ty] then continue;
        dp(tx, ty, len);
    end;
end;

procedure ReadAndProcessName; //处理那行该死的名字！！
var
    s: string;
    i: integer;
begin
    readln(s);
    i := 1;
    name := '';
    n := 0;
    m := 0;
    while s[i] <> ' ' do
    begin
        name := name + s[i];
        inc(i);
    end;
    inc(i);
    while s[i] <> ' ' do
    begin
        n := n * 10 + ord(s[i]) - ord('0');
        inc(i);
    end;
    inc(i);
    while i <= length(s) do
    begin
        m := m * 10 + ord(s[i]) - ord('0');
        inc(i);
    end;
end;

begin
    assign(input, 'main.in');reset(input);
    assign(output, 'main.out');rewrite(output);
    readln(_);
    while _>0 do
    begin
        dec(_);
        fillchar(map, sizeof(map), 0);
        ReadAndProcessName;

        for i := 1 to n do
            for j := 1 to m do
            begin
                read(x);
                map[i, j] := x+1;
            end;
        readln;

        fillchar(f, sizeof(f), 0);
        ans := 0;
        for i := 1 to n do
            for j := 1 to m do
                if can(i, j) then
                    dp(i, j, 0);
        writeln(name, ': ', ans);
    end;
    close(input);close(output);
end.

关于 Ubuntu 突然无法连接 Wifi 的解决方案

2014-09-27

事实上我也不知道发生了什么，大概是几天前插了“小度 Wifi”的缘故。没有任何征兆地，Wifi 就用不了了。其实我也不知道原理，大概是某个驱动被刷掉了。下面是从网上找来的答案：

sudo apt-get install wicd-daemon

做个记录。

UVa12186 Another Crisis && [Dynamic Arrays in Pascal]

2014-09-27

链接：Link 耗时：0.586s

昨晚做的太急了，没时间写总结，正好下午有空，补上。

这是一道典型的树形动态规划，不是很难，但十分坑语言。思路大致如下：

对于第 $i$ 个节点，用 $d(i)$ 表示其上诉所需的最小工人数。若 $i$ 为叶节点，则 $d(i)=1$；否则，遍历求出 $i$ 的子节点所对应的 $d$ 值，并由小到大排序，取出最小的几个相加，即为 $d(i)$。

很容易想到用递归来实现。但对于“子节点的 d 值的排序”实现起来却十分困难：因为事先不知道有多少个数。当然啦，如果是 C++ 组，用 vector 可以轻松搞定，可至于 P 党，实现起来却难上加难。思来想去，决定试试 Pascal 的动态数组。磕磕碰碰调了近 1 个小时，终于 AC 了。

//Accepted
var
    tree: array [0..100000] of array of int64;
    T: Integer;
    f: array [0..100000] of int64;
    i,l,n,x:longint;

function min(x,y: int64): int64;
begin
    if x<y then exit(x) else exit(y);
end;

procedure sort(var arr: array of int64;l,r:longint); overload;
var
  i,j:longint;
  m,t: int64;
begin
  i := l;
  j := r;
  m := arr[(l+r) >> 1];
  repeat
    while arr[i]<m do inc(i);
    while arr[j]>m do dec(j);
    if i<=j then
    begin
      t := arr[i];
      arr[i] := arr[j];
      arr[j] := t;
      inc(i);
      dec(j);
    end;
  until i>j;
  if i<r then sort(arr, i, r);
  if l<j then sort(arr, l, j);
end;

procedure sort(var arr: array of int64); overload;
begin
  sort(arr, low(arr), high(arr));
end;
function dp(x: longint): int64;
var
  arr: array of int64;
  l,i, num: longint;
begin
    if f[x] <> 0 then
    begin
        dp := f[x];
        exit;
    end;
    if length(tree[x]) = 0 then
    begin
      dp := 1;
      f[x] := 1;
      exit;
    end;
    l := length(tree[x]);
    SetLength(arr, l);
    for i := Low(tree[x]) to High(Tree[x]) do
      arr[i] := dp(tree[x][i]);
    Sort(arr);
    num := (l*T-1) div 100+1;
    for i := Low(arr) to num-1 do
      f[x] := f[x] + arr[i];
    dp := f[x];
end;

begin
    assign(input, 'main.in');reset(input);
    assign(output,'main.out');rewrite(output);
    readln(n, T);
    while n>0 do
    begin
        fillchar(f, sizeof(f), 0);
        fillchar(tree, sizeof(tree), 0);
        for i := 1 to n do
        begin
            read(x);
            SetLength(tree[x], length(tree[x])+1);
            tree[x][high(tree[x])] := i;
        end;
        readln;
        dp(0);
        writeln(f[0]);
        readln(n, T);
    end;
    close(input); close(output);
end.

Dynamic Arrays

这里，再总结一下动态数组的用法。

定义：a: array of [type];
设置长度： SetLength(a, 10);
长度加一： SetLength(a, Length(a)+1);
取得最大、最小下标： High(a), Low(a)

事实上，从 1.1 版本开始 FPC 就支持 Dynamic Arrays 了。所以在 NOIP 竞赛中我们大可放心使用。

UVa11584 Partitioning by Palindromes

2014-09-24

这是一道区间型 DP，转移方程很简单，但在实现的过程中却遇见了很多坑，在此记录一下。链接：Link 耗时：0.368s

容易想到，前 $i$ 个数的划分情况可以由 $1,2,3,\ldots,i-1$ 的划分情况来决定。因此很容易得到状态转移方程：

$$d[i] = min(d[i], d[j]+1)$$

其中 $j = 0, 1, 2,\ldots,n-1$ 并且 $s[j+1, i]$ 为回文串，初始条件：$d[i] = i$。$d[i]$ 表示前 i 项的最小划分。这样一来状态转移的复杂度就为 $O(n^2)$。

但状态转移的判断呢？“回文串”是一个复杂的条件，判断一个串是否为回文串需要将该串至少遍历一遍。这样一来时间复杂度就上升为 $O(n^3)$ 了。而事实上在这种算法中有许多无谓的计算，因此我们可以先对字符串进行预处理：用 huiwen[i,j] 表示 $s[i,j]$ 是否为回文串（奇怪的名字。。。）。如此一来，时间复杂度就降为 $O(n^2)$ 了。

var
    s: AnsiString;
    n, _, i, j, l: integer;
    huiwen: array [1..1000, 1..1000] of boolean; //s[i,j]是否为回文串
    dp: array [0..1000] of integer; //一定从0开始，否则当整串为回文串时就考虑不到了。

function min(x,y: integer): integer;
begin
    if x<y then exit(x) else exit(y);
end;

procedure process(i,j: integer); //对回文串进行预处理
var
    mid: Integer;
    x,y: integer;
begin
    if j = i then
    begin
        huiwen[i,j] := true;
        exit;
    end;
    mid := i + (j-i+1) shr 1;
    x := i;
    y := j;
    while (x <= mid) and (s[x] = s[y]) do
    begin
        inc(x);
        dec(y);
    end;
    huiwen[i, j] := x > mid;
end;

begin
    //assign(input, 'main.in'); reset(input);
    //assign(output, 'main.out'); rewrite(output);
    readln(n);
    for _ := 1 to n do
    begin
        readln(s);
        l := length(s);
        //Pre-process
        fillchar(huiwen, sizeof(huiwen), 0);
        for i := 1 to l do
            for j := i to l do //一定是从i开始，这个错卡了我很久。
                process(i, j);
        //DP
        for i := 1 to l do
        begin
            dp[i] := i;
            for j := 0 to i-1 do
                if huiwen[j+1, i] then
                    dp[i] := min(dp[i], dp[j]+1);
        end;
        write(dp[l]);
        {if _ <>n then }writeln; //吐槽一下：一开始我还谨慎地加上这句以避免行末回车，没想到UVa居然报错了。。看来UVa的比较算法还有待改进啊。
    end;

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

UVa437 The Tower of Babylon

2014-09-23

链接：The Tower of Babylon 耗时：0.015s

这是刘汝佳的紫书中”DAG 中的动态规划”中的习题，我拿它用来熟悉 DAG 中的动态规划。

我们不妨进行逆向考虑：现堆上面的方块，然后考虑在下面进行叠加。这样子一来，影响决策的就只是最下面方块的尺寸了。

对于这种出现了”大套小”这样的二元关系的题，我们可以将其视为一个有向无环图：其中每个节点为一个状态，状态的转移是有固定的方向的（在此题中，状态转移为从小的方块到大的方块）。

但是这道题又不同于平常的 DAG 动态规划：若将边长视为状态的话，则要开一个巨大的数组，这是不可以接受的。因此，我们要换一种思维方式：只记录方块的序号和摆放的方式（如现将边长从小到大进行排序，然后用一个标志 k 表示当前是以第 k 小的边长作为高）。

至此，思路已经清晰了。用 $dp(i, k)$ 表示 “第 i 个方块以第 k 条边为高进行摆放” ，以下给出状态转移方程：

$$dp(i, k) = max\{dp(i, k), dp(j, k_2)\}$$

其中 $j，k_2$ 遍历所有顶面矩形比 $dp(i, k)$ 小的状态。

代码实现首次尝试了 Pascal 中的 object 类型，使其更加工整，但不可避免地损耗了一些性能。

type
    Cube = object
        a: array [1..3] of longint;
        procedure init(x,y,z: longint);
        function height(k: integer): longint;
        function low(k: integer): longint;
        function high(k: integer): longint;
    end;

function max(x,y: longint): longint;
begin
    if x>y then max := x else max := y;
end;

procedure swap(var x,y: longint);
var
    t: longint;
begin
    t := x;
    x := y;
    y := t;
end;

function Cube.height(k: integer): longint;
begin
    height := self.a[k];
end;

function Cube.high(k: integer): longint;
begin
    case k of
        1: high := a[3];
        2: high := a[3];
        3: high := a[2];
    end;
end;

function Cube.low(k: integer): longint;
begin
    case k of
        1: low := a[2];
        2,3: low := a[1];
    end;
end;

procedure Cube.init(x, y, z: longint);
begin
   if x>y then swap(x,y);
   if y>z then swap(y,z);
   if x>y then swap(x,y);
   a[1] := x;
   a[2] := y;
   a[3] := z;
end;

var
    f: array [1..30, 1..3] of longint;
    i,j,m,n,x,y,z: longint;
    cnt: longint;
    cubes: array [1..30] of Cube;

function dp(id, k: integer): longint;
var
    l, h, hi: longint;
    i, j: integer;
begin
    if f[id, k] > 0 then
        exit(f[id, k]);
    l := cubes[id].low(k);
    hi := cubes[id].height(k);
    h := cubes[id].high(k);

    f[id, k] := hi;

    for i := 1 to n do
    begin
        //if i = id then continue;  //此处在一开始时忘记考虑了立方体有无穷多个这一条件。
        for j := 1 to 3 do
        begin
            if not ((cubes[i].low(j) < l) and (cubes[i].high(j) < h)) then
                continue;
            f[id, k] := max(f[id, k], dp(i, j)+hi);
        end;
    end;

    dp := f[id, k];
end;

begin
    assign(input, 'main.in');reset(input);
    assign(output, 'main.out');rewrite(output);
    read(n);
    cnt := 0;
    while n > 0 do
    begin
        inc(cnt);
        for i := 1 to n do
        begin
            read(x,y,z);
            cubes[i].init(x,y,z);
        end;
        fillchar(f, sizeof(f), 0);

        m := 0;
        for i := 1 to n do
            for j := 1 to 3 do
                m := max(m, dp(i, j));

        writeln('Case ', cnt, ': maximum height = ', m);

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