ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1129. Door Painting

I don't know whether my algorithm is wrong or my program has error . Please, hepl me.
Posted by raxtinhac 27 Feb 2002 08:08
Here is my program :

const      max  = 100;

var        a          :array[1..max,1..max] of byte;
           color      :array[1..max,1..max] of byte;

           ke         :array[1..max] of byte;
           g,r        :array[1..max] of byte;

           n          :byte;

procedure nhap;
var    i,j      :byte;
begin
  read( n);
  for i := 1 to n do
  begin  read( ke[i]);
         for j := 1 to ke[i] do read( a[i,j]);
  end;
end;


procedure solve;
var     i,j,u,v    :byte;
begin
  fillchar( color, sizeof( color ), 0);
  fillchar(g, sizeof(g), 0);
  fillchar(r, sizeof(r), 0);


  repeat
    for i := 1 to n do
      for j := 1 to ke[i] do
        if color[i,j] = 0 then break;

    if color[i,j] > 0 then break;

    repeat
      for j := 1 to ke[i] do if color[i,j] = 0 then break;
      if  color[i,j] > 0 then break;

      u := a[i,j];
      for v := 1 to ke[u] do if a[u,v] = i then break;

      if g[i] > r[i] then
      begin  inc( r[i] ); inc( g[u] );
             color[i,j] := 1;
             color[u,v] := 2;
      end else
      begin  inc( g[i] ); inc( r[u] );
             color[i,j] := 2;
             color[u,v] := 1;
      end;

      i := u;
    until false;

  until false;
end;


procedure out;
var     i,j   :byte;
begin
  for i := 1 to n do
  begin
    for j := 1 to ke[i] do
      case color[i,j] of
       1 : write('Y ');
       2 : write('G ');
      end;
    writeln;
  end;
end;


begin
  nhap;
  solve;
  out;
end.