http://acm.pku.edu.cn/JudgeOnline/problem?id=1201

Код:
program PKU1201;
{$i-,s-,q-,r-}

const maxn = 100000;

type integer = longint;

var a, b, c, s: array[1..maxn] of integer;
    h: array[1..maxn] of boolean;
    n, m: integer;

var tmp1: integer;

procedure swap(var i, j: integer);
begin
  tmp1 := i; i := j; j := tmp1;
end;

procedure sort(l, r: integer);
var i, j, mid: integer;
begin
  i := l; j := r; mid := b[(l + r) shr 1];
  while i <= j do begin
    while b[i] < mid do i := i + 1;
    while b[j] > mid do j := j - 1;
    if i <= j then begin
      swap(a[i], a[j]); swap(b[i], b[j]); swap(c[i], c[j]);
      i := i + 1; j := j - 1;
    end;
  end;
  if i < r then sort(i, r);
  if l < j then sort(l, j);
end;

procedure prepare;
var i: integer;
begin
  read(n);
  for i := 1 to n do begin
    read(a[i], b[i], c[i]);
    inc(a[i]); inc(b[i]);
  end;
  sort(1, n);
end;

var sum: integer;

function calc(k: integer): integer;
begin
  sum := 0;
  while k > 0 do begin
    sum := sum + s[k];
    k := k - k and (k xor (k - 1));
  end;
  calc := sum;
end;

procedure add(k: integer);
begin
  while k <= m do begin
    s[k] := s[k] + 1;
    k := k + k and (k xor (k - 1));
  end;
end;

procedure main;
var i, j, now: integer;
begin
  fillchar(s, sizeof(s), 0);
  fillchar(h, sizeof(h), true);
  m := b[n];
  for i := 1 to n do begin
    now := calc(b[i]) - calc(a[i] - 1);
    now := c[i] - now;
    if now > 0 then
    for j := b[i] downto a[i] do if h[j] then begin
      add(j); h[j] := false;
      now := now - 1;
      if now = 0 then break;
    end;
  end;
  writeln(calc(m));
end;

begin
  prepare;
  main;
end.