Cod sursa(job #134339)

Utilizator cezar305Mr. Noname cezar305 Data 11 februarie 2008 14:39:36
Problema Numere 2 Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.02 kb
type vector=array[0..150]of longword;
var exp,i:longword;
    ok,mm:boolean;
    v,x,lim,ind,rez:vector;
    s:string;

function mai_mic(x,v:vector):boolean;
var i,j:longint;
begin
  mai_mic:=false;
  i:=x[0];j:=v[0];
  if x[0]<v[0] then mai_mic:=true
  else begin
    while (x[i]=v[j])and(i>0)and(j>0) do begin
      dec(i);dec(j);
    end;
    if x[i]<v[j] then mai_mic:=true;
  end;
end;

function egal(v,x:vector):boolean;
var i:longint;
begin
  egal:=true;
  if v[0]<>x[0] then egal:=false
  else begin
    for i:=1 to v[0] do
      if v[i]<>x[i] then begin egal:=false;break;end;
  end;
end;

procedure inmultire(a,b:vector;var c:vector);
var i,j,t:longint;
begin
  c[0]:=a[0]+b[0]-1;
  for i:=1 to a[0] do
    for j:=1 to b[0] do
      inc(c[i+j-1],a[i]*b[j]);
  for i:=1 to c[0] do begin
    inc(c[i+1],c[i] div 10);
    c[i]:=c[i] mod 10;
  end;
  if c[c[0]+1]<>0 then inc(c[0]);
  t:=c[c[0]] div 10;c[c[0]]:=c[c[0]] mod 10;
  while t>0 do begin
    inc(c[0]);
    c[c[0]]:=t mod 10;
    t:=t div 10;
  end;
end;

procedure aduna(var v:vector);
var i:longint;
begin
  i:=1;
  while v[i]=9 do begin v[i]:=0;inc(i);end;
  inc(v[i]);
  if v[v[0]+1]<>0 then inc(v[0]);
end;

procedure afis(v:vector);
var i:longint;
begin
  for i:=v[0] downto 1 do write(v[i]);
  writeln;
end;

begin
  assign(input,'numere2.in');reset(input);
  assign(output,'numere2.out');rewrite(output);
  readln(s); v[0]:=length(s);
  for i:=1 to v[0] do v[i]:=ord(s[v[0]-i+1])-48;
  lim[0]:=v[0] div 2+v[0] mod 2;
  for i:=1 to lim[0] do lim[i]:=9;
  ind[0]:=1;
  ind[1]:=2;
  while ind[0]<=lim[0] do begin
    x:=ind;
    exp:=1;
    mm:=mai_mic(x,v);
    while mm do begin
      inmultire(x,ind,rez);
      inc(exp);
      x:=rez;
      for i:=1 to rez[0] do rez[i]:=0;
      rez[0]:=0;
      mm:=mai_mic(x,v);
    end;
    if egal(x,v) then begin afis(ind);writeln(exp);ok:=true;break;end;
    aduna(ind);
  end;
  if not ok then begin afis(v);writeln(1);end;
  close(input);close(output);
end.