ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1165. Subnumber

Why WA?
Послано Evgeny 10 янв 2003 04:16
label Metka;
const maxn = 220;
var
  p,i,j,k,n,m,pos,num,d: integer;
  s: string;
  a,res,b: array[1..2*maxn] of integer;
  max,buf,bufer: array[1..2*maxn] of byte;
  fl: boolean;
procedure calc;
var i,j,k,n,m: integer;
begin
  for i := maxn-20 downto 1 do begin
    if max[i] <> 0 then break;
  end;
  for j := 1 to i-1 do begin
    res[j] := 9*j;
  end;
  for j := 1 to i+10 do begin
    res[j+1] := res[j+1] + res[j] div 10;
    res[j] := res[j] mod 10;
  end;
  dec(max[i]);
  fillchar(a,sizeof(a),0);
  for j := 1 to i do begin
    a[j] := max[j]*i;
  end;
  for j := 1 to i+10 do begin
    a[j+1] := a[j+1] + a[j] div 10;
    a[j] := a[j] mod 10;
  end;
  for j := 1 to i+10 do begin
    b[j+1] := b[j+1] + (a[j] + res[j]) div 10;
    b[j] := b[j] + (a[j] + res[j]) mod 10;
  end;
  res := b;
  res[1] := res[1] +2- pos;
  j := 1;
  while res[j] >= 10 do begin
    res[j+1] := res[j+1] + res[j] div 10;
    res[j] := res[j] mod 10;
    inc(j);
  end;
end;

function srav: boolean;
var i:integer;
begin
  srav := false;
  for i := maxn downto 1 do begin
    if max[i] > bufer[i] then begin
      srav := true;
      exit;
    end;
    if max[i] < bufer[i] then break;
  end;
end;

function test(st,fin: integer): boolean;
var i: integer;
begin
  if st >= 1 then begin
    if buf[fin-st+1] = 0 then begin
      test := false;
      exit;
    end;
  end;
  test := true;
  for i := st to fin do begin
    if (i<1) or (i>n) then continue;
    if buf[fin-i+1] <> a[i] then begin
      test := false;
      exit;
    end;
  end;
end;

procedure incr;
var p : integer;
begin
  p := 1;
  inc(buf[p]);
  while buf[p]>=10 do begin
    buf[p] := buf[p] mod 10;
    buf[p+1] := buf[p+1] +1;
    inc(p);
  end;
  if p > j-i+1 then inc(d);
end;

procedure decr;
var p,i : integer;
begin
  p := 1;
  while buf[p]=0 do begin
    inc(p)
  end;
  dec(buf[p]);
  for i := p-1 downto 1 do buf[i] := 9;
end;

begin
  readln(s);
  fl := true;
  fillchar(max,sizeof(max),9);
  for i := 1 to length(s) do begin
    val(s[i],a[i],k);
    if a[i] <> 0 then fl := false;
  end;
  if fl then begin
    fillchar(max,sizeof(max),0);
    max[length(s)+1] := 1;
    goto Metka;
  end;
  n := length(s);
  for i := 1 to n do begin
    for j := i to n do begin
      if a[i] = 0 then break;
      d := 0;
      fillchar(buf,sizeof(buf),0);
      fillchar(bufer,sizeof(bufer),0);
      for k := j downto i do begin
        buf[j-k+1] := a[k];
        bufer[j-k+1] := a[k];
      end;
      p := i;
      fl := true;
      repeat
        p := p-j+i-1+d;
        decr;
        if not test(p,p+j-i+d) then begin
          fl := false;
          break;
        end;
      until p < 1;
      if fl then begin
        repeat
          p := p+j-i+1+d;
          incr;
          if not test(p,p+j-i+d) then begin
            fl := false;
            break;
          end;
        until p > n;
      end;
      if fl then begin
        if srav then begin
          max := bufer;
          pos := i;
        end;
      end;
    end;
  end;
  for i := 2 to n do begin
    for j := i-1 downto 1 do begin
      if a[i]=0 then break;
      d := 0;
      fillchar(buf,sizeof(buf),0);
      fillchar(bufer,sizeof(bufer),0);
      for k := i-1 downto j do begin
        buf[i-k] := a[k];
        bufer[i-k] := a[k];
      end;
      for k := n downto i do begin
        bufer[i-j+1+n-k] := a[k];
        buf[i-j+1+n-k] := a[k];
      end;
      p := i;
      fl := true;
      num := n-j+1;
      repeat
        p := p-num;
        if not test(p,p+num-1) then begin
          fl := false;
          break;
        end;
        decr;
      until p < 1;
      if fl then begin
        repeat
          p := p+num;
          incr;
          if not t
Re: Why WA?
Послано misha 10 янв 2003 09:35
nu i nakatal!!!