Cod sursa(job #42021)

Utilizator vladcyb1Vlad Berteanu vladcyb1 Data 28 martie 2007 20:00:56
Problema Distincte Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.03 kb

  const
      FIN = 'distincte.in';
      FOUT = 'distincte.out';
      NMAX = 100013;
      PRIM = 666013;


  type ref = ^cell;
       cell = record inf : longint; urm : ref; end;
       int = array[ 0..NMAX ] of longint;
       int_ref = array[ 0..NMAX ] of ref;

  var
     f, g : text;
     N, M, K : longint;
     Left, Right, A, cnt, ind, AIB, ANS : int;
     list : int_Ref;

 procedure read_data;
  var i : longint;
  begin
   assign( f, FIN ); reset( f ); readln( f, N, K, M );
   for i := 1 to N do readln( f, A[i] );
   for i := 1 to M do readln( f, Left[i], Right[i] );
   close( f );
  end;

  procedure compute;
   var i : longint;
       q : ref;
   begin
    // fac lista de puncte
   for i := 1 to N do cnt[i] := N + 1;
   for i := N downto 1 do
      begin
        // urm(i) = Cnt[A[i]] -- inseram in lista lui urm(i) punctul i
        new( q ); q^.inf := i; q^.urm := list[ CNT[A[i]] ]; list[CNT[A[i]]] := q;
        CNT[ A[i] ] := i;
      end;
   // sortam intervalele dupa capatul din dreapta O(N) - count-sort
     fillchar( cnt, sizeof(cnt), 0 );
     for i := 1 to M do inc( CNT[ right[i] ] );
     for i := 1 to N do inc( CNT[i], CNT[i-1] );
     for i := 1 to M do begin ind[ CNT[ right[i] ] ] := i; dec( CNT[ right[i] ] ); end;
   end;

 procedure update( p : longint; value : longint );
  var i : longint;
  begin
   i := p;
     while ( i <= N ) do
       begin
        inc( AIB[i], value );
        if AIB[i] >= PRIM then dec( AIB[i], PRIM );
        i := (( i - 1 ) and ( i ) ) xor ( i ) + i;
       end;
  end;

 function suma( p : longint ) : longint;
  var i, sum : longint;
   begin
    i := p; sum := 0;
     while ( i > 0 ) do
       begin
        sum := sum + AIB[i];
        if sum >= PRIM then dec( sum, PRIM );
        i := i - ((i-1)and(i)) xor ( i );
       end;
    suma := sum;
  end;

 procedure solve;
  var i, last, j : longint;
      tmp : ref;
  begin
    ind[ M + 1 ] := M + 1;
    RIGHT[ M + 1 ] := N + 1;
    last := N + 1;
    while list[last] <> nil do
         begin update( list[last]^.inf, A[ list[last]^.inf] );
               list[last] := list[last]^.urm;
         end;
    for i := M downto 1 do
      begin
         if right[ind[i]] <> right[ ind[i+1] ] then
                     begin
                       for j := right[ ind[i] ] + 1 to right[ ind[i+1]] do
                        begin
                        tmp := List[ j ];
                        while tmp <> nil do
                          begin
                            update( tmp^.inf, A[ tmp^.inf] );
                            tmp := tmp^.urm;
                            end;
                        end;
                     end;

         ANS[ ind[i] ] := suma( right[ind[i]] ) - suma( left[ind[i]] - 1 );
            end;
 end;

 procedure save;
  var i : longint;
  begin
   assign( g, FOUT ); rewrite( g );
   for i := 1 to M do writeln( g, ANS[i] );
   close( g );
  end;

  begin
   read_data;
   compute;
   solve;
   save;
  end.