Cod sursa(job #726095)

Utilizator ionutz32Ilie Ionut ionutz32 Data 26 martie 2012 23:55:24
Problema 2SAT Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 5.18 kb
type ref=^nod;
nod=record
    nr:longint;
    adr:ref;
    end;
ref3=^nod3;
nod3=record
     nr1,nr2:longint;
     adr:ref3;
     end;
var graf,comp,graf2:array[0..200005] of ref;
hash:array[0..200005] of ref3;
viz,sol,ex:array[0..200005] of byte;
stiva,ind,nrcomp,inversa,pred:array[0..200005] of longint;
n,m,i,x,y,nrs,numar,temp,nrc,poz,a,b:longint;
temp2:double;
f,g:text;
bufin:array[1..65000] of byte;
u,u2:ref;
u3:ref3;
gasit:boolean;
s:string;
const fi=(sqrt(5)-1)/2;
function non(node:longint):longint;
         begin
         if node<=n then
            non:=node+n
         else
             non:=node-n;
         end;
function tarjan(node:longint):longint;
         var u:ref;
         min:longint;
         begin
         viz[node]:=1;
         inc(nrs);
         stiva[nrs]:=node;
         inc(numar);
         min:=numar;
         ind[node]:=numar;
         u:=graf[node];
         while u<>nil do
               begin
               if viz[u^.nr]=0 then
                  begin
                  temp:=tarjan(u^.nr);
                  if temp<min then
                     min:=temp;
                  end
               else
                   if (viz[u^.nr]=1) and (ind[u^.nr]<min) then
                      min:=ind[u^.nr];
               u:=u^.adr;
               end;
         if min=ind[node] then
            begin
            inc(nrc);
            while stiva[nrs]<>node do
                  begin
                  new(u);
                  u^.nr:=stiva[nrs];
                  u^.adr:=comp[nrc];
                  comp[nrc]:=u;
                  nrcomp[stiva[nrs]]:=nrc;
                  viz[stiva[nrs]]:=2;
                  dec(nrs);
                  end;
            new(u);
            u^.nr:=stiva[nrs];
            u^.adr:=comp[nrc];
            comp[nrc]:=u;
            nrcomp[stiva[nrs]]:=nrc;
            viz[stiva[nrs]]:=2;
            dec(nrs);
            end;
         tarjan:=min;
         end;
procedure citeste(var x,y:longint);
          var c:longint;
          minus:boolean;
          begin
          x:=0;
          y:=0;
          readln(f,s);
          c:=1;
          if s[c]='-' then
             begin
             minus:=true;
             inc(c);
             end
          else
              minus:=false;
          while s[c]<>' ' do
                begin
                x:=x*10+ord(s[c])-48;
                inc(c);
                end;
          if minus then
             x:=-x;
          inc(c);
          if s[c]='-' then
             begin
             minus:=true;
             inc(c);
             end
          else
              minus:=false;
          while c<=length(s) do
                begin
                y:=y*10+ord(s[c])-48;
                inc(c);
                end;
          if minus then
             y:=-y;
          end;
begin
assign(f,'2sat.in');
assign(g,'2sat.out');
reset(f);rewrite(g);
settextbuf(f,bufin);
citeste(n,m);
for i:=1 to m do
    begin
    citeste(x,y);
    if x<0 then
       x:=n-x;
    if y<0 then
       y:=n-y;
    new(u);
    u^.nr:=y;
    u^.adr:=graf[non(x)];
    graf[non(x)]:=u;
    new(u);
    u^.nr:=x;
    u^.adr:=graf[non(y)];
    graf[non(y)]:=u;
    end;
for i:=1 to 2*n do
    if viz[i]=0 then
       tarjan(i);
for i:=1 to 2*n do
    begin
    if nrcomp[non(i)]=nrcomp[i] then
       begin
       writeln(g,-1);
       close(f);close(g);
       halt;
       end;
    inversa[nrcomp[i]]:=nrcomp[non(i)];
    end;
for i:=1 to 2*n do
    begin
    u:=graf[i];
    while u<>nil do
          begin
          a:=nrcomp[u^.nr];
          b:=nrcomp[i];
          if a<>b then
             begin
             poz:=(a div 100)*(b div 100) mod 200000+1;
             gasit:=false;
             u3:=hash[poz];
             while u3<>nil do
                   begin
                   if (u3^.nr1=a) and (u3^.nr2=b) then
                      begin
                      gasit:=true;
                      break;
                      end;
                   u3:=u3^.adr;
                   end;
             if gasit=false then
                begin
                new(u3);
                u3^.nr1:=a;
                u3^.nr2:=b;
                u3^.adr:=hash[poz];
                hash[poz]:=u3;
                new(u2);
                u2^.nr:=a;
                u2^.adr:=graf2[b];
                graf2[b]:=u2;
                inc(pred[a]);
                end;
             end;
          u:=u^.adr;
          end;
    end;
repeat
      gasit:=false;
      for i:=1 to nrc do
          if (pred[i]=0) and (ex[i]=0) then
             begin
             gasit:=true;
             u:=comp[inversa[i]];
             while u<>nil do
                   begin
                   sol[u^.nr]:=1;
                   u:=u^.adr;
                   end;
             u:=graf2[i];
             while u<>nil do
                   begin
                   dec(pred[u^.nr]);
                   u:=u^.adr;
                   end;
             ex[i]:=1;
             ex[inversa[i]]:=1;
             end;
until gasit=false;
for i:=1 to n do
    write(g,sol[i],' ');
close(f);close(g);
end.