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

Обсуждение задачи 1153. Суперкомпьютер

I don't know why I got WA?
Послано qwt 29 апр 2002 19:29
type
  num=array[0..10000] of longint;
function max(a,b:longint):longint;
begin
  if a>b then max:=a else max:=b;
end;

procedure chen(x:num;y:longint;var ans:num);
var
  i,j,k:longint;
begin
  fillchar(ans,sizeof(ans),0);ans[0]:=1;
  if y=0 then exit;
  for i:=1 to x[0] do begin
    inc(ans[i],x[i]*y);
    if ans[i]>=100 then begin
      ans[i+1]:=ans[i] div 100;
      ans[i]:=ans[i] mod 100;
    end;
  end;
  if ans[i+1]>0 then ans[0]:=i+1 else ans[0]:=i;
end;
procedure plus(x,y:num;var ans:num);
var
  i:longint;
begin
  fillchar(ans,sizeof(ans),0);
  for i:=1 to max(x[0],y[0]) do begin
    inc(ans[i],x[i]+y[i]);
    if ans[i]>=100 then begin
      ans[i+1]:=ans[i] div 100;
      ans[i]:=ans[i] mod 100;
    end;
  end;
  if ans[i+1]>0 then ans[0]:=i+1 else ans[0]:=i;
end;
function bigger(x,y:num):longint;
var
  i:longint;
begin
  bigger:=0;
  if x[0]>y[0] then begin bigger:=1;exit;end else if x[0]<y[0] then
begin bigger:=-1;exit;end;
  for i:=x[0] downto 1 do
    if x[i]>y[i] then begin bigger:=1;exit;end else if x[i]<y[i] then
begin bigger:=-1;exit;end;
end;
procedure minus(x,y:num;var ans:num);
var
  i,j,k:longint;
begin
  fillchar(ans,sizeof(ans),0);
  for i:=1 to x[0] do begin
    inc(ans[i],x[i]-y[i]);
    if ans[i]<0 then begin inc(ans[i],100);dec(ans[i+1]);end;
  end;
  ans[0]:=i;
  while (ans[0]>1)and(ans[ans[0]]=0) do dec(ans[0]);
end;
procedure work(x:num);
var
  i,j,k,y:longint;
  a,b,c,d:num;
begin
  fillchar(a,sizeof(a),0);a[0]:=1;b:=a;c:=a;
  a[1]:=2*trunc(sqrt(x[x[0]]));
  c[2]:=x[x[0]]-sqr(a[1] div 2);c[1]:=x[x[0]-1];
  write(a[1] div 2);
  if c[2]=0 then c[0]:=1 else c[0]:=2;
  for i:=x[0]-1 downto 1 do begin
    chen(a,10,a);
    for y:=9 downto 0 do begin
      fillchar(b,sizeof(b),0);b[0]:=1;
      b[1]:=y;
      plus(a,b,b);
      chen(b,y,b);
      if bigger(c,b)>=0 then break;
    end;
    write(y);
    minus(c,b,c);
    fillchar(d,sizeof(d),0);d[0]:=1;d[1]:=y*2;
    plus(a,d,a);
    for j:=c[0] downto 1 do c[j+1]:=c[j];inc(c[0]);
    c[1]:=x[i-1];
    while (c[0]>1)and(c[c[0]]=0) do dec(c[0]);
  end;
  writeln;
end;
var
  a:num;
  i,j,k:longint;
  z:char;
  l:array[0..5000] of longint;
begin
  k:=0;
  while not(eoln) do begin
    read(z);
    inc(k);
    l[k]:=ord(z)-ord('0');
  end;
  a[0]:=0;
  for i:=1 to (k+1) div 2 do a[i]:=l[k-i*2+2]+10*l[k-i*2+1];
  a[0]:=(k+1) div 2;
  chen(a,2,a);
  work(a);
end.