Отримання знань

   Входные данные

   Выходные данные

   Пример входных данных

   Пример выходных данных

   Анализ условия и обсуждение идеи решения

   Пример решения на Pascal:

var sat      : array ['A'..'P','A'..'P'] of boolean;
    cansit   : array ['A'..'P',1..6] of char;
    bound    : array ['A'..'P'] of boolean;
    mates    : array ['A'..'P',1..3] of integer;
    solution : array [1..5,1..4,1..4] of char;

type string3 = string[3];
procedure InitMat;
var c,r : char;
begin
   for r := 'A' to 'P' do
     for c := 'A' to 'P' do
        sat[r,c] := (r = c);
end;

procedure ReadData;
var
    line,partners : string;
    night,table   : integer;
    i,j,n         : integer;
begin

   for night := 1 to 3 do begin
      Readln(line);
      n := 1;
      for table := 1 to 4 do begin
         while not (line[n] in ['A'..'P']) do inc(n);
         partners := Copy(line,n,4);
         for i := 1 to 3 do begin
            for j := i+1 to 4 do begin
               sat[partners[i],partners[j]] := True;
               sat[partners[j],partners[i]] := True;
            end;
         end;
         for i := 1 to 4 do
            solution[night,table,i] := partners[i];
         n := n + 4;
      end;
   end;

end;

procedure FindAllowedSeating;
var c,r : char;
    i   : integer;
begin
   for r := 'A' to 'P' do begin
     i := 1;
     for c := 'A' to 'P' do begin
        if not sat[r,c] then begin
           cansit[r,i] := c;
           inc(i);
        end;
     end;
   end;
end;

function FindFinalSeating(c : char): string3;
var i : integer;
    s : string;
begin
   s := '';
   for i := 1 to 6 do
      if (i <> mates[c,1]) and (i <> mates[c,2]) and (i <> mates[c,3]) then
         s := s + cansit[c,i];
   FindFinalSeating := s;
end;

function FindSolution: boolean;
var c,d   : char;
    ok    : boolean; { whether we have a valid configuration }
    i     : integer;
    s3,d3 : string3; { s3 is c's mates on evening 5, d3 is d's mates on same }
    found : boolean;

   function SetNextCfg(c : char): boolean;
   var ans : boolean;
   begin
      ans := True;
      if mates[c,3] = 6 then begin
         if mates[c,2] = 5 then begin
            if mates[c,1] = 4 then
               ans := False
            else begin
               inc(mates[c,1]);
               mates[c,2] := mates[c,1] + 1;
               mates[c,3] := mates[c,2] + 1;
            end
         end
         else begin
            inc(mates[c,2]);
            mates[c,3] := mates[c,2] + 1;
         end;
      end
      else
         inc(mates[c,3]);
      SetNextCfg := ans;
   end;

   { AssignTableMates updates all necessary data structures when c allocates }
   { three of his allowed mates to sit with him on the fourth evening.       }
   procedure AssignTableMates(c : char);
   var i : integer;
   begin
      { Assign tablemates seats with c }
      bound[cansit[c,mates[c,1]]] := True;
      bound[cansit[c,mates[c,2]]] := True;
      bound[cansit[c,mates[c,3]]] := True;
      { Update the sat array with new seating }
      for i := 1 to 3 do begin
         sat[c,cansit[c,mates[c,i]]] := True;
         sat[cansit[c,mates[c,i]],c] := True;
      end;
      sat[cansit[c,mates[c,1]],cansit[c,mates[c,2]]] := True;
      sat[cansit[c,mates[c,1]],cansit[c,mates[c,3]]] := True;
      sat[cansit[c,mates[c,2]],cansit[c,mates[c,3]]] := True;
      sat[cansit[c,mates[c,2]],cansit[c,mates[c,1]]] := True;
      sat[cansit[c,mates[c,3]],cansit[c,mates[c,1]]] := True;
      sat[cansit[c,mates[c,3]],cansit[c,mates[c,2]]] := True;
   end;

   { DeassignTableMates does the reverse of AssignTableMates. It is used when }
   { we have to backtrack.                                                    }
   procedure DeassignTableMates(c : char);
   var i : integer;
   begin
      { Deassign tablemates seats with c }
      bound[cansit[c,mates[c,1]]] := False;
      bound[cansit[c,mates[c,2]]] := False;
      bound[cansit[c,mates[c,3]]] := False;
      { Update the sat array with new seating }
      for i := 1 to 3 do begin
         sat[c,cansit[c,mates[c,i]]] := False;
         sat[cansit[c,mates[c,i]],c] := False;
      end;
      sat[cansit[c,mates[c,1]],cansit[c,mates[c,2]]] := False;
      sat[cansit[c,mates[c,1]],cansit[c,mates[c,3]]] := False;
      sat[cansit[c,mates[c,2]],cansit[c,mates[c,3]]] := False;
      sat[cansit[c,mates[c,2]],cansit[c,mates[c,1]]] := False;
      sat[cansit[c,mates[c,3]],cansit[c,mates[c,1]]] := False;
      sat[cansit[c,mates[c,3]],cansit[c,mates[c,2]]] := False;
   end;

   procedure Backtrack;
   begin
      while (c >= 'A') and not ok do begin
         repeat
            dec(c);
         until (not bound[c]);
         { Unassign c's mates and find him others }
         DeassignTableMates(c);
         ok := SetNextCfg(c);
      end;
   end;

   procedure MoveToNextMember;
   var i : integer;
   begin
      inc(c);
      if not bound[c] then
         for i := 1 to 3 do mates[c,i] := i; { Initialize tablemate pick for c }
   end;

begin
   for c := 'A' to 'P' do bound[c] := False;      { init who is assigned a seat }
   c := 'A';                                      { begin at first member }
   ok := True;                                    { we are ok at the start }
   for i := 1 to 3 do mates['A',i] := i;          { Initialize tablemate pick for 'A' }
   { main loop }
   while ok and (c < 'Q') and (c >= 'A') do begin { if we find a solution then c will go over 'P' }
                                                  { if no solution then SetNextCfg will return False }
      if not bound[c] then begin
         { Find tablemates for c: }
         { 1. Pick different tablemates while one of c's mates is bound or  }
         {    two of his mates have already sat next to one another.        }
         {    Note: We try to eliminate as many illegal possibilities as we }
         {    can here, to save time; hence the complex condition.          }
         while ok and
               (bound[cansit[c,mates[c,1]]] or
                bound[cansit[c,mates[c,2]]] or
                bound[cansit[c,mates[c,3]]] or
                sat[cansit[c,mates[c,1]],cansit[c,mates[c,2]]] or
                sat[cansit[c,mates[c,1]],cansit[c,mates[c,3]]] or
                sat[cansit[c,mates[c,2]],cansit[c,mates[c,3]]]) do
            ok := SetNextCfg(c);
         { 2. If ok then we have found tablemates for c; }
         {    else c can't sit anywhere, so we have to backtrack }
         if ok then begin
            AssignTableMates(c);
            { Make sure the fifth evening is OK }
            s3 := FindFinalSeating(c);
            ok := not (sat[c,s3[1]] or sat[c,s3[2]] or sat[c,s3[3]]);
            { Move on or backtrack according to whether fifth evening is ok. }
            { Note that if c='A' here we have backtracked as far as we can.  }
            if ok then
               MoveToNextMember
            else if c > 'A' then begin
               Backtrack;
               ok := True;
            end
            else begin
               FindSolution := False;
               ok := False;
               exit;
            end;
         end
         else if c > 'A' then begin
            Backtrack;
            ok := True;
         end
         else begin
            FindSolution := False;
            ok := False;
            exit;
         end;
      end
      else begin
         d := 'A';
         found := False; { I.e. haven't found d }
         while not found and (d < c) do begin
            if not bound[d] then begin
               d3 := FindFinalSeating(d);
               if pos(c,d3) > 0 then found := True; { c sits with d on fifth }
            end;
            inc(d);
         end;
         if found then begin
            dec(d);
            for i := 1 to 3 do
               if (c <> d3[i]) and sat[c,d3[i]] then
                  ok := False;
         end;
         if ok then
            MoveToNextMember
         else begin
            Backtrack;
            ok := True;
         end;
      end;
   end;
   FindSolution := ok;
end;

procedure WriteSolution;
var c     : char;
    table : integer;
    last  : string3;
    i     : integer;
    done  : array ['A'..'P'] of boolean; { Needed to see who's already seated }
                                         { on the fifth evening               }
begin
   table := 1;
   for c := 'A' to 'P' do begin
      if not bound[c] then begin
         solution[4,table,1] := c;
         solution[4,table,2] := cansit[c,mates[c,1]];
         solution[4,table,3] := cansit[c,mates[c,2]];
         solution[4,table,4] := cansit[c,mates[c,3]];
         inc(table);
      end;
   end;
   for c := 'A' to 'P' do done[c] := False;
   table := 1;
   for c := 'A' to 'P' do begin
      if not done[c] then begin
         { Then c isn't assigned a seat on the fifth night - find him one }
         if not bound[c] then
            { Then we can use the FindFinalSeating function }
            last := FindFinalSeating(c)
         else begin
            { Then the mates vector isn't defined for c: Can't use the    }
            { FindFinalSeating function => We have to check whether c has }
            { sat with each member of his cansit vector.                  }
            last := '';
            for i := 1 to 6 do
                if not sat[c,cansit[c,i]] then last := last + cansit[c,i];
         end;
         solution[5,table,1] := c;
         solution[5,table,2] := last[1];
         solution[5,table,3] := last[2];
         solution[5,table,4] := last[3];
         done[last[1]] := True;
         done[last[2]] := True;
         done[last[3]] := True;
         inc(table);
      end;
   end;
end;



procedure SolveIt;
var s : string;
    n,t,i : integer;
begin
   if FindSolution then begin
      WriteSolution;
      for n := 1 to 5 do begin
         s := '';
         for t := 1 to 4 do begin
            for i := 1 to 4 do s := s + solution[n,t,i];
            s := s + ' ';
         end;
         Writeln(s);
      end;
   end
   else
      Writeln('It is not possible to complete this schedule.');
end;

begin
   while not Eof do
   begin
     InitMat;
     ReadData;
     FindAllowedSeating;
     SolveIt;
     if not Eof then Readln;
     writeln;
   end;
end.