Есть ли кто-нибудь, кто хорошо разбирается в Паскале? Сын не может решить одну из задач, заданных ему на курсах информатики. Пишут они в PascalABC.NET. Я сам в этом ни в зуб ногой. Условие здесь - http://informatics.mccme.ru/moodle/mod/ … terid=1664

Вот что он уже написал.

Код:
const
  M = 10003;

type
  TArr = array [0..M] of int64;

var
  n, i, j, l, r, c, h, y, p: int64;
  x, x2, o: TArr;


procedure swap(var a, b: int64);
var
  c: int64;
begin
  c := a;
  a := b;
  b := c;
end;

procedure qsort(l, r: int64);
var
  c, i, j: int64;
begin
  if l >= r then exit;
  i := l - 1;
  c := l + random(r - l + 1);
  swap(x[c], x[r]);
  swap(x2[c], x2[r]);
  for j := l to r - 1 do
    if x[j] < x[r] then 
    begin
      inc(i);
      swap(x[j], x[i]);
      swap(x2[j], x2[i]);
    end;
  swap(x[r], x[i + 1]);
  swap(x2[r], x2[i + 1]);
  qsort(l, i);
  qsort(i + 2, r);
end;

begin

  read(n);
  for i := 1 to n do
  begin
    read(x[i]);
    x2[i] := i;
  end;
  qsort(1, n); 
  for i := 1 to n do
  begin
    h := x2[i];
    for j := 1 to i - 1 do
    begin
      l := j + 1;
      r := i;
      while r - l > 1 do
      begin
        c := (l + r) div 2;
        if x[c] > x[i] - x[j] then
          r := c
        else
          l := c;
      end;
      if x[l] = x[i] - x[j] then
        y := l
      else
        y := -1;
      l := j;
      r := i - 1;
      while r - l > 1 do
      begin
        c := (l + r) div 2;
        if x[c] >= x[i] - x[j] then
          r := c
        else
          l := c;
      end;
      if x[r] = x[i] - x[j] then
        p := l
      else
        p := -1;
      if (y <> -1) and (p <> -1) then
        o[h] := o[h] + y - p;
    end;
  end;
  for i := 1 to n do
    write(o[i], ' ');
end.

Задача успешно проходит 7 тестов, но с 8 по 12 - превышено время работы. Может кто-нибудь сам сможет помочь или сведет со знающими людьми.

Отредактировано semga3 (2014-03-26 12:07:59)