program slovaeil;
const
 bukvi=26;
 Nmax=20;
  type
  stroka=string[25];
   slovo=record
     s,e:byte;
     word:stroka;
    end;
   zapis=record
     p:integer;
     word:stroka;
     end;
  tmas=array[1..Nmax]of slovo;
  tmassiv=array[1..bukvi,1..bukvi]of zapis;
  Tme=array[1..3*3]of integer;
  rec=record
   en:integer;
   out:integer;
  end;
  Tmv=array[1..26] of rec;

  procedure add_e(var me:tme;v:integer;var mp:tme;var nv1:integer;nv2:integer);
  var
   i,j,k:integer; mpr:tme;
  begin
   j:=1;
   k:=1;
   while me[j]<>v do
    begin
     mpr[k]:=me[j];
     inc(j);
     inc(k);
    end;
   for i:=1 to nv2 do
    begin
     mpr[k]:=mp[i];
     inc(k);
    end;
   for i:=k to nv1+nv2 do
    begin
     mpr[i]:=me[j];
     inc(j);
    end;
   nv1:=i;
   me:=mpr;
  end;
  function find_e(var ms:tmv;var me:tme;var v:integer;var nv1:integer):boolean;
  var
   i:integer;
  begin
   i:=1;
   while (i<=nv1) and(ms[me[i]].en=0)and( ms[me[i]].out=0) do
    inc(i);
   if i<=nv1 then
    begin
     v:=me[i];
     find_e:=true;
    end
   else
    find_e:=false;
  end;
  procedure cicle_e(vs,ve:integer;var r:tmassiv;var ms:tmv;var mc:tme;var nv:integer);
  var
   i,j:integer;flend:boolean;
   begin
   mc[1]:=vs;
   flend:=false;
   nv:=1 ;
   repeat
    i:=1;
    while (i<=26) and(r[mc[nv],i].p=0) do
     inc(i);
    if (i<=26) then
     begin
      dec(r[mc[nv],i].p);
      dec(ms[mc[nv]].out);
      dec(ms[i].en);
      if i<>ve then
       begin
        inc(nv);
        mc[nv]:=i;
       end
      else
       begin
        if vs<>ve then
         begin
          inc(nv);
          mc[nv]:=i;
          dec(r[i,vs].p);
          dec(ms[i].out);
          dec(ms[vs].en);
         end;
        flend:=true;
       end;
     end
   until flend;
  end;
 function eiler(var r:tmassiv;var ms:tmv;var vs,ve:integer):boolean;
 var
  k,i:integer;prov,rebro:boolean;
  begin
   prov:=true;
   i:=1;
   vs:=0;
   ve:=0;
   k:=0;
   while prov and(i<=26) do
    begin
     if (ms[i].en=ms[i].out) then
      prov:=true
     else
      begin
       k:=k+1;
       if ((ms[i].en=ms[i].out+1)or (ms[i].out=ms[i].en+1))and(k<=2) then
        begin
         if ms[i].en=ms[i].out+1 then
          begin
           ms[i].out:=ms[i].out+1;
           ve:=i
          end
         else
          begin
           ms[i].en:=ms[i].en+1;
           vs:=i;
          end;
         if (ve<>0)and (vs<>0) then
          begin
           r[ve,vs].p:=r[ve,vs].p+1;
           prov:=true
          end
        end
      else
       prov:=false
    end;
    inc(i);
   end;
  eiler:=prov;
  end;
 procedure findeiler(var massiv:tmassiv;var me:tme;var nv1:integer;var ok:boolean);
  var
   ms:tmv;
   r:tmassiv;
   mp:tme;
   i,j,v,vs,v2:integer;
   ve,nv2:integer;
  begin
   r:=massiv;
   for i:=1 to 26 do
    begin
     ms[i].en:=0;
     ms[i].out:=0;
     for j:=1 to 26 do
      begin
       inc(ms[i].out,r[i,j].p);
       inc(ms[i].en,r[j,i].p);
      end;
    end;
   if eiler(massiv,ms,vs,ve) then
    begin
     ok:=true;
     i:=1;
     if (vs=0)and(ve=0) then
      begin
       while (ms[i].en=0)and(ms[i].out=0) do
        inc(i);
        vs:=i;
        ve:=i;
      end;
     cicle_e(vs,ve,massiv,ms,me,nv1);
     while find_e(ms,me,v,nv1)do
      begin
       cicle_e(v,v,massiv,ms,mp,nv2);
       add_e(me,v,mp,nv1,nv2);
      end;
    end
   else
    ok:=false;
  end;
  var
   i,j,N:integer;
   massiv:tmassiv;
   st:stroka;
   K:char;ok:boolean;nv1:integer;
   mas:tmas;
   me:tme;
 begin
  writeln('Vvedite kolichestvo slov');
  readln(N);
   for i:=1 to bukvi do
    for j:=1 to bukvi do
     massiv[i,j].p:=0;
     for i:=1 to N do
     begin
      writeln('Vvedite slova,pod nomerami ',i,':');
      readln(st);
      k:=st[1];
      mas[i].s:=ord(k)-96;
      k:=st[length(st)];
      mas[i].e:=ord(k)-96;
      mas[i].word:=st;
      massiv[mas[i].s,mas[i].e].p:=1;
      massiv[mas[i].s,mas[i].e].word:=mas[i].word;
     end;
     findeiler(massiv,me,nv1,ok);
     if ok then
      begin
       writeln ('Slova raspolojeni v sleduyushem poryadke:');
       for i:=1 to nv1-1 do
        begin
          for j:=1 to n do
           begin
            if (mas[j].s=me[i]) and (mas[j].e=me[i+1])then
             writeln(mas[j].word);
           end;
        end;
      end
     else
      writeln('Resheniye ne naideno')
 end.