Cod sursa(job #28502)

Utilizator maria_pparcalabescu maria daniela maria_p Data 7 martie 2007 21:46:19
Problema Aprindere Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.43 kb
type vector=array[0..1010]of longint;
var f,g:text;
    b:array[0..1010,0..1010]of longint;
    a,t,c,x:array[0..1010]of longint;
    i,nr,j,aux,timp,m,n:longint;
    ok:boolean;

procedure interclasare(st,mij,dr:longint);
var i,j,k,q:longint;
    x:vector;
begin
for i:=st to dr do
    x[i]:=c[i];
i:=st;
k:=st-1;
j:=mij+1;
while (i<=mij)and(j<=dr) do
      if t[x[i]]<t[x[j]]then
                        begin
                        inc(k);
                        c[k]:=x[i];
                        inc(i);
                        end
      else if(t[x[i]]=t[x[j]])and(b[x[i],0]>b[x[j],0]) then
                        begin
                        inc(k);
                        c[k]:=x[i];
                        inc(i);
                        end
      else if(t[x[i]]=t[x[j]])and(b[x[i],0]=b[x[j],0])and(b[x[i],n+1]>b[x[j],n+1])then
                        begin
                        inc(k);
                        c[k]:=x[i];
                        inc(i);
                        end
                   else begin
                        inc(k);
                        c[k]:=x[j];
                        inc(j);
                        end;
for q:=i to mij do
    begin
    inc(k);
    c[k]:=x[q];
    end;
for q:=j to dr do
    begin
    inc(k);
    c[k]:=x[q];
    end;
end;

procedure sort(st,dr:longint);
var mij:longint;
begin
if st<>dr then begin
               mij:=(st+dr)div 2;
               sort(st,mij);
               sort(mij+1,dr);
               interclasare(st,mij,dr);
               end;
end;

begin
assign(f,'aprindere.in');reset(f);
assign(g,'aprindere.out');rewrite(g);
readln(f,n,m);
dec(n);dec(m);
for i:=0 to n do
    read(f,x[i]);
readln(f);
for i:=0 to m do
    begin
    read(f,a[i],t[i],b[i,0]);
    for j:=1 to b[i,0] do
        begin
        read(f,b[i,j]);
        if x[b[i,j]]=0 then inc(b[i,n+1]);
        end;
    readln(f);
    end;
for i:=0 to m do
    c[i]:=i;
sort(1,m);
timp:=0;
for i:=0 to n do
    if x[i]=1 then inc(nr);
i:=0;
while nr<n do
    begin
    for j:=1 to b[c[i],0] do
        if x[b[c[i],j]]=0 then begin
                               x[b[c[i],j]]:=1;
                               inc(nr);
                               end
        else begin
             x[b[c[i],j]]:=0;
             dec(nr);
             end;
    timp:=timp+t[c[i]];
    inc(i);
    end;
writeln(g,timp);
close(f);
close(g);
end.