Cod sursa(job #455267)

Utilizator sapiensCernov Vladimir sapiens Data 13 mai 2010 12:57:41
Problema Arbori indexati binar Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
Program Aib;
 var f,g:text; i,n,m,x,y:longint;
     a:array[1..100000]of longint;
     key:byte;
 function next (x:longint):longint;
  var y:longint;
  begin
   y:=1;
   while (x mod 2)=0 do begin
     y:=y*2;
     x:=x div 2;
   end;
   exit (y);
  end;
 procedure sum (x,y:longint);
  begin
   while (x<=n) do begin
     a[x]:=a[x]+y;
     x:=x+next (x);
   end;
  end;
 function suma (x:longint):longint;
  var z:longint;
  begin
   if x=1 then exit (a[1]);
   z:=0;
   while x>1do begin
     inc (z,a[x]);
     x:=x-next (x);
   end;
   exit (z);
  end;
 function sum_int (x,y:longint):longint;
  begin
   exit (suma (y)-suma (x-1));
  end;
 procedure cauta (x,y,z:longint);
  begin
   if (x=y) then if suma (x)=z then writeln (g,x) else writeln (g,-1) else begin
     if suma ((x+y) div 2)>z then cauta (x,(x+y) div 2-1,z);
     if suma ((x+y) div 2)<z then cauta ((x+y) div 2+1,y,z);
     if suma ((x+y) div 2)=z then writeln (g,(x+y) div 2);
   end;
  end;
 begin
  assign (f,'aib.in'); reset (f);
  assign (g,'aib.out'); rewrite (g);
  readln (f,n,m);
  for i:=1 to n do begin
    read (f,x);
    sum (i,x);
  end;
  for i:=1 to m do begin
    read (f,key);
    case key of
      0: begin
           readln (f,x,y);
           sum (x,y);
         end;
      1: begin
           readln (f,x,y);
           writeln (g,sum_int (x,y));
         end;
      2: begin
           readln (f,x);
           cauta (1,n,x);
         end;
    end;
  end;
  close (f); close (g);
 end.