Описание
Всем известны правила игры «в города»: первый игрок называет произвольный город, следующий – город, название которого начинается на ту же букву, на которую заканчивается название предыдущего города, и т.д. Аналогичным образом можно играть не в названия городов, а, например, в названия животных. Задан список допустимых для описанной игры слов, слова в нем могут повторяться

Задание
Напишите программу, определяющую, в каком порядке в процессе игры должны быть названы слова из списка, чтобы каждое слово было использовано ровно столько раз, сколько оно в нем встречается


Входные данные
В первой строке входного файла записано целое число N – количество слов в списке (1
N1000), а в последующих N строках – сами слова. Каждое из них является последовательностью не более чем из 10 строчных английских букв

Выходные данные
Выведите в выходной файл слова в искомом порядке, либо сообщение "NO", если такого порядка не существует. Каждое слово должно быть выведено в отдельную строку выходного файла


Например:

PUN.IN
4
b
ab
bc
bb

PUN.OUT
ab
bb
b
bc





Идеи
Эйлеров путь

Комментарии
Составим ориентированный мультиграф (мультиграфом называется граф, в котором пары вершин могут быть соединены более чем одним ребром), вершинами которого будут являться буквы от a до z. Каждому слову из списка сопоставим ребро, соединяющее первую и последнюю буквы этого слова. В полученном мультиграфе требуется найти эйлеров путь (т.е. путь, проходящий по каждому ребру ровно один раз). Алгоритм построения такого пути можно найти, например, в [Липский 88, п.2.7].
 




Решение

{$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V+,X+}
{$M 65520,0,655360}

program
pun;
const
  InFile='pun.in';
  OutFile='pun.out';
  MaxN=1000;
type
  TWord=String[10];
  PWordList=^TWordList;
  TWordList=Record
    Item:TWord;
    Next:PWordList;
  end;
var
  A:Array['a'..'z','a'..'z']Of LongInt;
  NIn,NOut:Array['a'..'z']Of LongInt;
  WLib:Array['a'..'z','a'..'z']Of PWordList;
  Can:Boolean;
  N:Word;
  NInWay:LongInt;
  Way:Array[1..MaxN+1]Of Char;

Procedure
Load;
Var
  I:Word;
  W:TWord;
  PL:PWordList;
Begin
  Assign(Input,InFile);
  ReSet(Input);
  FillChar(A,SizeOf(A),0);
  FillChar(NIn,SizeOf(NIn),0);
  FillChar(NOut,SizeOf(NOut),0);
  FillChar(WLib,SizeOf(WLib),0);
  ReadLn(N);
  For I:=1 To N Do Begin
    ReadLn(W);
    Inc(A[W[1],W[Length(W)]]);
    New(PL);
    PL^.Next:=WLib[W[1],W[Length(W)]];
    PL^.Item:=W;
    WLib[W[1],W[Length(W)]]:=PL;
    Inc(NOut[W[1]]);
    Inc(NIn[W[Length(W)]]);
  End;
  Close(Input);
End;

Procedure
Solve;
Var
  NStart,NFinish,NMiddle,NBad:LongInt;
  I,J:LongInt;
  AStart,AFinish:Char;
  Ch:Char;

Procedure
InsertChar(Before:LongInt; Ch:Char);
Var
  I:LongInt;
Begin
  For I:=NInWay DownTo Before Do Way[I+1]:=Way[I];
  Way[Before]:=Ch;
  Inc(NInWay);
End;

Function
Euler:Boolean;
Var
  Cur,Temp:Char;
  Final:Boolean;
  I:LongInt;
  Ch:Char;
  CWay:LongInt;
Begin
  If AStart=' ' Then Begin
    For Ch:='a' To 'z' Do If NOut[Ch]>0 Then AStart:=Ch;
  End;
  If AFinish=' ' Then AFinish:=AStart;
  NInWay:=1;
  Way[1]:=AStart;
  Repeat
    Final:=True;
    For I:=1 To NInWay Do If NOut[Way[I]]>0 Then Begin
      Final:=False;
      Temp:=Way[I];
      Cur:=Temp;
      CWay:=I+1;
      Repeat
        For Ch:='a' to 'z' Do If A[Cur,Ch]>0 Then Begin
          Dec(A[Cur,Ch]);
          Dec(NOut[Cur]);
          Dec(NIn[Ch]);
          InsertChar(CWay,Ch);
          Cur:=Ch;
          Inc(CWay);
          Break;
        End;
      Until NOut[Cur]=0;
    End;
  Until Final;
  Euler:=NInWay=(N+1);
End;
Begin
  NStart:=0;
  NFinish:=0;
  NMiddle:=0;
  NBad:=0;
  AStart:=' ';
  AFinish:=' ';
  For Ch:='a' To 'z' Do Case NOut[Ch]-NIn[Ch] Of
    1:Begin Inc(NStart); AStart:=Ch; End;
    0:Inc(NMiddle);
    -1:Begin Inc(NFinish); AFinish:=Ch; End;
    Else Inc(NBad);
  End;
  If (NBad>0) Or (NStart>1) Or (NFinish>1) Then Begin Can:=False; Exit; End;
  NInWay:=0;
  Can:=Euler;
End;

Procedure
Save;
Var
  I:LongInt;
Begin
  Assign(Output,OutFile);
  ReWrite(Output);
  If Can Then Begin
    For I:=1 To NInWay-1 Do Begin
      WriteLn(WLib[Way[I],Way[I+1]]^.Item);
      WLib[Way[I],Way[I+1]]:=WLib[Way[I],Way[I+1]]^.Next;
    End;
  End Else WriteLn('NO');
  Release(HeapOrg);
  Close(Output);
End;

Begin

  Load;
  Solve;
  Save;
End.

 


© Особенности национальных задач по информатике