Cod sursa(job #37094)

Utilizator cheery_g1rlHaller Emanuela cheery_g1rl Data 24 martie 2007 16:49:25
Problema Sum Scor 75
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.68 kb
type rez=0..5000050000;
    vector=array[1..100] of 0..1;
var f,g:text;
    s,a:rez;
    n,w,y,i,b,lv,j:longint;
    x:vector;
    v:array[1..100] of 1..200000;
procedure adauga(var x:vector);
          begin
            if x[lv]=0 then x[lv]:=1
                 else
                    begin
                      x[lv]:=0;
                      j:=lv-1;
                      while x[j]=1 do
                          begin
                            x[j]:=0;
                            dec(j);
                          end;
                       x[j]:=1;
                    end;
          end;

function ver(c:longint):longint;
     var w,q,pp:longint;
        ok:boolean;
    begin
      w:=c;
      fillchar(x,lv,0);
      ok:=true;
      while ok do
         begin
           adauga(x);
           q:=0;
           pp:=1;
           for j:=1 to lv do if x[j]=1 then begin inc(q); pp:=pp*v[j]; end;
           if q mod 2=0 then w:=w+c div pp
                       else w:=w-c div pp;
            if q=lv then ok:=false;
         end;
         ver:=w;
    end;

begin
assign(f,'sum.in');
reset(f);
readln(f,n);
assign(g,'sum.out');
rewrite(g);
for i:=1 to n do
  begin
    readln(f,w);
    b:=w;
    lv:=0;
    if w mod 2=0 then
       begin
        inc(lv);
        v[lv]:=2;
        while w mod 2=0 do w:=w div 2;
       end;
    y:=3;
    while w<>1 do
      begin
         if w mod y=0 then
           begin
             inc(lv);
             v[lv]:=y;
             while w mod y=0 do w:=w div y;
           end;
        inc(y,2);
      end;
    a:=ver(b);
    s:=2*a*b;
    writeln(g,s);
  end;

close(f);
close(g);
end.