Cod sursa(job #132)

Utilizator wefgefAndrei Grigorean wefgef Data 5 decembrie 2006 14:17:52
Problema Pedefe Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.27 kb
program pedefe;

const filein = 'pedefe.in';
      fileout = 'pedefe.out';
      Nmax = 511;
      Pmax = 127;
      Range = 511;
      modulo = 666013;

var N, M, P, maxr : longint;
    s1, s2 : array[0..Nmax] of longint;
    s3 : array[0..Pmax] of longint;
    c1, c2 : array[0..Nmax,0..Nmax] of longint;
    aib1, aib2 : array[0..Nmax,0..Range] of longint;
    nrz : array[1..Nmax] of longint;
    put : array[0..9] of longint;

procedure readdata;
var i : longint;
begin
assign(input, filein); reset(input);
read(N, M, P);
for i := 1 to N do
  begin
    read(s1[i]);
    if s1[i] > maxr then maxr := s1[i];
  end;
for i := 1 to M do
  begin
    read(s2[i]);
    if s2[i] > maxr then maxr := s2[i];
  end;
for i := 1 to P do
  begin
    read(s3[i]);
    if s3[i] > maxr then maxr := s3[i];
  end;
close(input);
end;

function interog1(i, j : longint) : longint;
var sum, ii, jj : longint;
begin
ii := i;
sum := 0;
while ii > 0 do
  begin
    jj := j;
    while jj > 0 do
      begin
        sum := sum + aib1[ii,jj];
        while sum >= modulo do dec(sum, modulo);
        jj := jj-put[nrz[jj]];
      end;
    ii := ii-put[nrz[ii]];
  end;
interog1 := sum;
end;

procedure update1(i, j, val : longint);
var ii, jj : longint;
begin
ii := i;
while ii <= M do
  begin
    jj := j;
    while jj <= maxr do
      begin
        aib1[ii,jj] := aib1[ii,jj] + val;
        while aib1[ii,jj] >= modulo do dec(aib1[ii,jj], modulo);
        jj := jj+put[nrz[jj]];
      end;
    ii := ii+put[nrz[ii]];
  end;
end;

function interog2(i, j : longint) : longint;
var sum, ii, jj : longint;
begin
ii := i;
sum := 0;
while ii > 0 do
  begin
    jj := j;
    while jj > 0 do
      begin
        sum := sum + aib2[ii,jj];
        while sum >= modulo do dec(sum, modulo);
        jj := jj-put[nrz[jj]];
      end;
    ii := ii-put[nrz[ii]];
  end;
interog2 := sum;
end;

procedure update2(i, j, val : longint);
var ii, jj : longint;
begin
ii := i;
while ii <= M do
  begin
    jj := j;
    while jj <= maxr do
      begin
        aib2[ii,jj] := aib2[ii,jj] + val;
        while aib2[ii,jj] >= modulo do dec(aib2[ii,jj], modulo);
        jj := jj+put[nrz[jj]];
      end;
    ii := ii+put[nrz[ii]];
  end;
end;

procedure solve;
var i, j, k, rez : longint;
begin
put[0] := 1;
for i := 1 to 9 do
  put[i] := put[i-1] shl 1;

for i := 1 to Nmax shr 1 do
  begin
    nrz[i*2] := nrz[i] + 1;
    nrz[i*2+1] := 0;
  end;

for i := 1 to N do
  begin
    for j := 1 to M do
      if s1[i] = s2[j] then
        begin
          rez := interog1(j-1, s1[i]); inc(rez);
          while rez >= modulo do dec(rez, modulo);
          c1[i,j] := rez;
        end;
    for j := 1 to M do
      if c1[i,j] > 0 then
        update1(j, s1[i], c1[i,j]);
  end;

fillchar(aib1, sizeof(aib1), 0);

for i := 1 to N do
  begin
    for j := 1 to M do
      if s1[i] = s2[j] then
        if s1[i] = s3[1] then
          begin
            rez := interog1(j-1, s1[i]); inc(rez);
            while rez > modulo do dec(rez, modulo);
            c2[i,j] := rez;
          end
        else
          begin
            rez := interog2(j-1, s1[i]);
            c2[i,j] := rez;
          end;
    for j := 1 to M do
      begin
        if c2[i,j] >0 then update2(j, s1[i], c2[i,j]);
        if c1[i,j] >0 then update1(j, s1[i], c1[i,j]);
      end;
  end;

for k := 2 to P do
  begin
    c1 := c2;
    fillchar(aib1, sizeof(aib1), 0);
    fillchar(aib2, sizeof(aib2), 0);

    for i := 1 to N do
      begin
        for j := 1 to M do
          if s1[i] = s2[j] then
            if s1[i] = s3[k] then
              c2[i,j] := interog1(j-1, s1[i])
            else
              c2[i,j] := interog2(j-1, s1[i]);

        for j := 1 to M do
          begin
            if c1[i,j] > 0 then update1(j, s1[i], c1[i,j]);
            if c2[i,j] > 0 then update2(j, s1[i], c2[i,j]);
          end;
      end;
end;
end;

procedure writedata;
var i, j, rez : longint;
begin
assign(output, fileout); rewrite(output);
rez := 0;
for i := 1 to N do
  for j := 1 to M do
    begin
      rez := rez + c2[i,j];
      while rez >= modulo do dec(rez, modulo);
    end;
writeln(rez);
close(output);
end;

begin
readdata;
solve;
writedata;
end.