Program Chain;
Uses Meter;
Const
  MaxN=10000;                    {max. # atoms}
Var
  N:Integer;                     {# atoms }
  S:Array[0..MaxN] of Integer;   {solution}
  i:Integer;

Procedure Compute;
{Global: N, S }
Var
  Pos:Array[0..MaxN] Of -MaxN..MaxN;{atom positions relative to atom 1}
  a,b,c,x,y:Integer;             {atom labels}
  Dab,Dxy,Dax,Dbx,Dby:Integer;   {distances}
  i,k,min,z:Integer;

Begin{Compute};
  a:=1; b:=2; c:=3;  {chose three atoms}
  Dab:=Span(a,b); Dax:=Span(a,c); Dbx:=Span(b,c);
  Pos[1]:=0; Pos[2]:=Dab;
  If (Dax=Dab+Dbx) Or (Dab=Dax+Dbx) Then {compute the position of c relative to a->b}
    Pos[c]:=Pos[a]+Dax
  Else If (Dbx=Dax+Dab) Then
    Pos[c]:=Pos[a]-Dax;

  i:=3;
  While i+2<=N Do Begin
  {a,b and c accessed only two times, their relative positions are known}
    x:=i+1; y:=i+2;        {next two atoms:x, y}
    Inc(i,2);
    Dxy:=Span(x,y);        {query the distance of x and y}
    {Select two atoms from [a,b,c] such that their distance
     is different from Dxy.}
    If Dxy<>Abs(Pos[b]-Pos[c]) Then Begin         {b--c<>x--y}
      z:=a; a:=c; c:=z;
    End Else If Dxy<>Abs(Pos[a]-Pos[c]) Then Begin{a--c<>x--y}
      z:=b; b:=c; c:=z;
    End;  {Else a--b<>x--y }
    Dab:=Abs(Pos[a]-Pos[b]);
    If Pos[b]<Pos[a] Then Begin{ensure that Pos[a]<Pos[b]}
      z:=a; a:=b; b:=z;
    End;
    {Pos[a]<Pos[b], Dab<>Dxy}
    Dax:=Span(a,x);
    Dby:=Span(b,y);
    {determine the relative position of x and y}
    If (Dax=Dab+Dby+Dxy) Or                 {a--b--y--x}
       (Dax+Dxy=Dab+Dby) Then Begin         {a--b--x--y}
      Pos[x]:=Pos[a]+Dax;                   {a--x--b--y}
      Pos[y]:=Pos[b]+Dby;
    End Else If (Dab=Dax+Dxy+Dby) Or        {a--x--y--b}
       (Dab+Dxy=Dax+Dby) Then Begin         {a--y--b--x}
      Pos[x]:=Pos[a]+Dax;                   {a--y--x--b}
      Pos[y]:=Pos[b]-Dby;                   {y--a--b--x}
                                            {y--a--x--b}
    End Else If (Dxy=Dab+Dax+Dby) Then Begin{x--a--b--y}
      Pos[x]:=Pos[a]-Dax;
      Pos[y]:=Pos[b]+Dby;
    End Else If (Dby=Dxy+Dax+Dab) Or        {y--x--a--b}
                (Dax+Dab=Dby+Dxy) Then Begin{x--y--a--b}
      Pos[x]:=Pos[a]-Dax;                   {x--a--y--b}
      Pos[y]:=Pos[b]-Dby;
    End{If};
    a:=x; b:=y;      {replace a and b by x and y, resp.}
  End{while};

  If Not Odd(N) Then Begin{process the last item if N is even}
    If Pos[b]<Pos[a] Then Begin
      z:=a; a:=b; b:=z;
    End;
    Dab:=Abs(Pos[a]-Pos[b]);
    Dax:=Span(a,N);
    Dbx:=Span(b,N);;
    If Dax=Dab+Dbx Then
      Pos[N]:=Pos[b]+Dbx
    Else If Dab=Dax+Dbx Then
      Pos[N]:=Pos[a]+Dax
    Else
      Pos[N]:=Pos[a]-Dax
  End;
  min:=Pos[1];
  For i:=2 To N Do
  If Pos[i]<min Then min:=Pos[i];
  min:=-min+1;
  For i:=1 To N Do     {shift positions to the range 1..N}
    S[Pos[i]+min-1]:=i;
End{Compute};

Begin{program}
  N:=Size;
  Compute;
  For i:=0 To N-1 Do
    Answer(i+1,S[i]);
End.


\\\\\\\\\\\\\\\\\\\\\\\\\\

Program Circuit;
Const
  MaxN=101;
  Visited=16;
Type
  Node=Record x,y:Byte End;
  Table=Record HEnd,VEnd:Word; T:Array[1..MaxN*MaxN] of Node End;
Var
  N,M,MN:Word;
  G:Array[0..MaxN,0..MaxN] Of Byte;
  Disp:Table;
  Cost,OC:Word;
  OList:Array[1..MaxN*MaxN] of Record x,y,c:Byte End;

Procedure ReadIn;
Var
  InFile:Text;
  x,y,z:Byte;
Begin{ReadIn}
  Assign(InFile, 'circuit.in'); Reset(InFile);
  ReadLn(InFile, N,M);
  For x:=1 To N Do Begin
    For y:=1 To M Do Begin
      Read(InFile, z);
      G[x,y]:=z;
    End;
    ReadLn(InFile);
  End{for x};
  Close(InFile);

  For x:=0 To N+1 Do Begin
    G[x,0]:=Visited;
    G[x,M+1]:=Visited;
  End;
  For y:=0 To M+1 Do Begin
    G[0,y]:=Visited;
    G[N+1,y]:=Visited;
  End;
End{ReadIn};

Procedure WriteOut;
Var i:Integer;
  OutF:Text;
Begin{WriteOut}
  Assign(OutF, 'circuit.out'); Rewrite(OutF);
  WriteLn(OutF, OC,' ',Cost);
  For i:=1 To OC Do
    WriteLn(OutF, OList[i].x,' ',OList[i].y,' ',OList[i].c);
  Close(OutF);
End{WriteOut};

Function NotEmptyVert:Boolean;
Begin
  NotEmptyVert:=Disp.VEnd>0
End;
Function NotEmptyHoriz:Boolean;
Begin
  NotEmptyHoriz:=Disp.HEnd<=MN
End;

Procedure TakeVert(Var P:Node);
Begin{TakeVert}
  P:=Disp.T[Disp.VEnd];
  Dec(Disp.VEnd);
End{TakeVert};
Procedure TakeHoriz(Var P:Node);
Begin{TakeHoriz}
  P:=Disp.T[Disp.HEnd];
  Inc(Disp.HEnd);
End{TakeHoriz};

Procedure PutVert(Const P:Node);
Begin
  Inc(Disp.VEnd);
  Disp.T[Disp.VEnd]:=P;
End{PutVert};
Procedure PutHoriz(Const P:Node);
Begin
  Dec(Disp.HEnd);
  Disp.T[Disp.HEnd]:=P;
End{PutHoriz};

Procedure DFS(P:Node);
Var
  Q1,Q2,Q3,Q4:Node;{must be global in DOS!}
Begin{DFS}
  G[P.x,P.y]:=G[P.x,P.y]+Visited;
  Q1.x:=P.x; Q1.y:=P.y-1;
  If (G[Q1.x,Q1.y]<Visited) And (G[Q1.x,Q1.y]>1) Then
    DFS(Q1);
  Q2.x:=P.x+1; Q2.y:=P.y;
  If (G[Q2.x,Q2.y]<Visited) And Odd(G[P.x,P.y]-Visited) Then
    DFS(Q2);
  Q3.x:=P.x; Q3.y:=P.y+1;
  If (G[Q3.x,Q3.y]<Visited) And (G[P.x,P.y]-Visited>1) Then
    DFS(Q3);
  Q4.x:=P.x-1; Q4.y:=P.y;
  If (G[Q4.x,Q4.y]<Visited) And Odd(G[Q4.x,Q4.y]) Then
    DFS(Q4);

  If G[Q1.x,Q1.y]<Visited Then Begin
    PutHoriz(Q1);
  End;
  If G[Q2.x,Q2.y]<Visited Then Begin
    Q2.x:=Q2.x+N;
    PutVert(Q2);
  End;
  If G[Q3.x,Q3.y]<Visited Then Begin
    Q3.y:=Q3.y+M;
    PutHoriz(Q3);
  End;
  If G[Q4.x,Q4.y]<Visited Then Begin
    PutVert(Q4);
  End;

End{DFS};

Procedure PutOut(P:Node; c:Byte);
Begin
  Inc(Cost,c);
  Inc(OC);
  OList[OC].x:=P.x; OList[OC].y:=P.y; OList[OC].c:=c;
End;

Procedure Compute;
Var
  P,Q:Node;
Begin{Compute}
  MN:=M*N;
  Disp.VEnd:=0; Disp.HEnd:=MN+1;
  Cost:=0; OC:=0;
  P.x:=1; P.y:=1;
  DFS(P);
  While True Do Begin
    If NotEmptyVert Then Begin
      TakeVert(P);
      If P.x>N Then Begin
        P.x:=P.x-N;
        Q.x:=P.x-1;
      End Else
        Q.x:=P.x;
      If G[P.x,P.y]>=Visited Then Continue;
      Q.y:=P.y;
      PutOut(Q,1);
      DFS(P);
    End Else If NotEmptyHoriz Then Begin
      TakeHoriz(P);
      If P.y>M Then Begin
        P.y:=P.y-M;
        Q.y:=P.y-1;
      End Else
        Q.y:=P.y;
      If G[P.x,P.y]>=Visited Then Continue;
      Q.x:=P.x;
      PutOut(Q,2);
      DFS(P);
    End Else
      Break;
  End{while};
End{Compute};

Begin{program}
  ReadIn;
  Compute;
  WriteOut;
End.


\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Program Trip;
Const
  MaxN=1000;
Type
  Point=1..MaxN;
  List=^Cell;
  Cell=Record P:Point; link:List End;
  Graph=Array[1..MaxN] Of List;
  Path=Array[1..MaxN] Of 0..MaxN;
Var
  G:Graph;      {input graph}
  N:Word;       {# junctions}
  A,B:Word;     {source and destination}
  CommE:Word;   {min. # common edges}
  P1,P2:Path;   {the two paths between A and B}
  P1n,P2n:Word; {number of nodes in paths }

Procedure ReadIn;
Var InF:Text;
  u,v:Point;
  E,i:Word;
  Guv:List;
Begin
  Assign(InF, 'trip.in'); Reset(InF);
  ReadLn(InF, A, B);
  ReadLn(InF, N, E);

  For u:=1 To N Do Begin       {Init}
    G[u]:=Nil;
  End;
  For i:=1 To E Do Begin       {Read input}
    ReadLn(InF, u,v);
    New(Guv);
    Guv^.p:=v; Guv^.link:=G[u];
    G[u]:=Guv;
    New(Guv);
    Guv^.p:=u; Guv^.link:=G[v];
    G[v]:=Guv;
  End{for i};

 Close(InF);
End{ReadIn};

Procedure WriteOut;
Var OutF:Text;
  i:Word;
Begin
  Assign(OutF, 'trip.out'); Rewrite(OutF);
  If P1n=0 Then
    WriteLn(OutF,-1)
  Else Begin
    WriteLn(OutF,CommE:1);
    For i:=P1n DownTo 2 Do
      Write(OutF, P1[i]:1,' ');
    WriteLn(OutF, P1[1]:1);

    For i:=1 To P2n-1 Do
      Write(OutF, P2[i]:1,' ');
    WriteLn(OutF,P2[P2n]:1);
  End;
  Close(OutF);
End{WriteOut};

Procedure Compute;
Var
  D,T,L,R:Array[Point] of 0..MaxN;
  (*T[u]->u are the tree edges in the DFS tree *)
  (* L[u]= v: path exists in DFS tree u~>w, w->v is back edge, and D[v] min *)
  (* u->R[u]~>w->L[u] *)
  Time:Word;
  u:Point;

  Procedure DFS(u:Point);
  {Global: Time, D,T,L,R}
  Var
    El:List;
    v,w,bw:Point;
  Begin
    D[u]:=Time;
    Inc(Time);
    w:=u; bw:=u;
    El:=G[u];
    While El<>Nil Do Begin{processing u->v edges}
      v:=El^.p;
      If T[v]=0 Then Begin{u->v is a tree edge}
        T[v]:=u;
        DFS(v);
        If D[L[v]]<D[w] Then Begin
          w:=L[v]; bw:=v;
        End;
      End Else Begin      {u->v is a back edge}
        If (v<>T[u])And(D[v]<D[w]) Then Begin
          w:=v; bw:=u;
        End;
      End;
      El:=El^.link;
    End{while u->v};
    L[u]:=w; R[u]:=bw;
  End{DFS};

  Procedure Traverse1(u:Point; Var P:Path; Var Pn:Word);
  Var Lu:Integer;
  Begin{Traverse}
    Repeat
      If L[u]=u Then Begin {u-T[u] is a bridge}
        Inc(CommE);
        Inc(Pn); P[Pn]:=u;
        u:=T[u];
      End Else Begin
        While u<>R[u] Do Begin
          Inc(Pn); P[Pn]:=u;
          u:=R[u];
        End;
        Inc(Pn); P[Pn]:=u;
        u:=L[u];
        If u=L[u] Then Continue;
        Lu:=L[L[u]];
        If L[u]=Lu Then
          Repeat
            Inc(Pn); P[Pn]:=u;
            u:=T[u];
          Until (u=Lu)
        Else
          Repeat
            Inc(Pn); P[Pn]:=u;
            u:=T[u];
          Until L[u]=Lu;
      End;
    Until u=A;
    Inc(Pn); P[Pn]:=A;
  End{Traverse1};

  Procedure Traverse2(u:Point; Var P:Path; Var Pn:Word);
  Var Lu:Integer;
  Begin{Traverse}
    Repeat
      If L[u]=u Then Begin {u-T[u] is a bridge}
        Inc(Pn); P[Pn]:=u;
        u:=T[u];
      End Else Begin
        Lu:=L[L[u]];
        If L[u]=Lu Then Begin
          Repeat
            Inc(Pn); P[Pn]:=u;
            u:=T[u];
          Until u=Lu;
        End Else Begin
          Repeat
            Inc(Pn); P[Pn]:=u;
            u:=T[u];
          Until L[u]=Lu;
          While u<>R[u] Do Begin
            Inc(Pn); P[Pn]:=u;
            u:=R[u];
          End;
          Inc(Pn); P[Pn]:=u;
          u:=L[u];
        End;
      End;
    Until u=A;
    Inc(Pn); P[Pn]:=A;
  End{Traverse2};

Begin{Compute}
  For u:=1 To N Do T[u]:=0; {init}
  T[A]:=A; Time:=0;
  P1n:=0; P2n:=0;
  CommE:=0;

  DFS(A);                   {build DFS tree, compute T,L,R}

  If T[B]=0 Then            {no route to B}
    Exit;
  Traverse1(B, P1, P1n);    {forward route to B}

  Traverse2(B, P2, P2n);    {return rote to A  }

End{Compute};

Begin{Prog}
  ReadIn;
  Compute;
  WriteOut;
End.


\\\\\\\\\\\\\\\\\\\\\\\\\\\


Program Bitmap;
{tree + double linked list of chirdren, with path compression}
Const
  MaxN=10000;
  MaxM=1000;
Type
  STree=Array[0..MaxM] of Record
                            Rep,        {father}
                            l1,l2,      {double link}
                            Fch:Longint;{first child}
                            comp:Boolean
                          End;
Var
  InFile:Text;
  N,M:Longint;
  NComp,CComp:Longint;
  T:STree;

Procedure Init;
Var
  i:Word;
Begin{ReadIn}
  Assign(InFile, 'bitmap.in'); Reset(InFile);
  ReadLn(InFile, N,M);
  For i:=1 To M Do Begin
    T[i].Rep:=0;
    T[i].l1:=i; T[i].l2:=i;
    T[i].Fch:=0;
    T[i].comp:=True;
  End;
End{Init};

Procedure WriteOut;
Var i:Integer;
  OutF:Text;
Begin{WriteOut}
  Close(InFile);
  Assign(OutF, 'bitmap.out'); Rewrite(OutF);
  WriteLn(OutF, NComp);
  WriteLn(OutF, CComp);
  Close(OutF);
End{WriteOut};

Function SFind(x:Longint):Longint;
Var Nx,x1,x2,y1,y2,xRep:Longint;
Begin{SFind}
  If T[x].Rep=0 Then
    Nx:=0
  Else Begin
    Nx:=x;
    While T[Nx].Rep>0 Do Nx:=T[Nx].Rep;
                                       {path compression}
(*
    If (x<>Nx) And (T[x].Rep<>Nx) Then Begin
      x1:=T[Nx].Fch; x2:=T[x1].l2;
      xRep:=T[x].Rep;
      While xRep<>Nx Do Begin
        y1:=T[x].l1; y2:=T[x].l2;
        If x=T[xRep].Fch Then Begin
          If T[x].l1=x Then
            T[xRep].Fch:=0
          Else
            T[xRep].Fch:=y1;
        End;
        T[y2].l1:=y1; T[y1].l2:=y2;
        T[x2].l1:=x; T[x].l2:=x2;
        x2:=x;
        T[x].Rep:=Nx;
        x:=xRep; xRep:=T[x].Rep;
      End{while};
      T[x1].l2:=x2; T[x2].l1:=x1;
    End;
*)
  End;

  SFind:=Nx;
End{SFind};

Procedure SUnion(Var Nx:Longint; Ny:Longint);
  Var x,x1,x2,y1,y2:Longint;
Begin{SUnion}
  If Nx=Ny Then Exit;
  If T[Ny].Rep=0 Then T[Ny].Rep:=-1;
  If Nx=0 Then Begin Nx:=Ny; Exit End;

  If T[Nx].Rep>T[Ny].Rep Then Begin
    X:=Nx; Nx:=Ny; Ny:=X;
  End;
  T[Nx].Rep:=T[Nx].Rep+T[Ny].Rep;
  T[Nx].comp:=T[Nx].comp And T[Ny].comp;
  T[Ny].Rep:=Nx; T[Ny].comp:=True;
  x1:=T[Nx].Fch;
  If x1=0 Then Begin
    T[Nx].Fch:=Ny
  End Else Begin
    x2:=T[x1].l2;
    T[Ny].l1:=x1; T[x1].l2:=Ny;
    T[x2].l1:=Ny; T[Ny].l2:=x2;
  End;
End{SUnion};

Procedure SDelete(Var Nx:Longint; X:Longint);
Var xRep,Root,S:Longint;
  x1,x2,y1,y2:Longint;
  Ocomp:Boolean;
Begin{SDelete}
  S:=T[Nx].Rep;
  If S=0 Then Begin Nx:=0; Exit End;
  Ocomp:=T[Nx].comp;
  Inc(S);
  If S=0 Then Begin   {deleting last node in a component tree}
    Inc(NComp);
    If T[Nx].comp Then{compact component}
      Inc(CComp);
    T[x].Rep:=0;
    T[x].comp:=True;
    Nx:=0;
    Exit;
  End;

  If x=Nx Then Begin{x is the root}
    Root:=T[x].Fch;
    x1:=T[Root].l1;
    If x1<>Root Then Begin
      x2:=x1; T[x2].Rep:=Root;
      While T[x2].l1<>Root Do Begin
        x2:=T[x2].l1;
        T[x2].Rep:=Root;
      End;
      T[Root].l1:=Root; T[Root].l2:=Root;
      y1:=T[Root].Fch;
      If y1=0 Then Begin
        T[Root].Fch:=x1;
        T[x1].l2:=x2; T[x2].l1:=x1;
      End Else Begin
        y2:=T[y1].l2;
        T[y2].l1:=x1; T[x1].l2:=y2;
        T[y1].l2:=x2; T[x2].l1:=y1;
      End;
    End;
  End Else Begin{x is not the root}
    Root:=Nx;
    xRep:=T[x].Rep;
    x1:=T[x].l1; x2:=T[x].l2;
    y1:=T[x].Fch;
    If y1=0 Then Begin
      T[x1].l2:=x2; T[x2].l1:=x1;
      If x=x1 Then
        T[xRep].Fch:=0
      Else
        T[xRep].Fch:=x1;
    End Else Begin{y1<>0}
      y2:=y1; T[y2].Rep:=xRep;
      While T[y2].l1<>y1 Do Begin
        y2:=T[y2].l1;
        T[y2].Rep:=xRep;
      End;
      If T[x].l1<>x Then Begin
        T[x2].l1:=y1; T[y1].l2:=x2;
        T[x1].l2:=y2; T[y2].l1:=x1;
      End;
      T[xRep].Fch:=y1;
    End;
  End;
  T[Root].Rep:=S;
  T[Root].comp:=Ocomp;
  T[x].Rep:=0; T[x].l1:=x;  T[x].l2:=x; T[x].Fch:=0;
  T[x].comp:=True;
  Nx:=Root;
End{SDelete};

Procedure Process;
Var
  i,x:Longint;
  C10,C1,C2:Longint;
  Pix:Array[0..MaxM] of Boolean;

Procedure ReadRow;
Var i,ii,w,b:longint;
Begin{ReadRow}
  i:=1;
  While True Do Begin
    Read(InFile, w);
    If w=-1 Then Exit;
    For ii:=i To i+w-1 Do Pix[ii]:=False;
    Inc(i,w);
    Read(InFile, b);
    For ii:=i To i+b-1 Do Pix[ii]:=True;
    Inc(i,b);
  End;
  ReadLn(InFile);
End{ReadRow};

Begin{Process}
  For x:=1 To N Do Begin
    ReadRow;              {read the next row into Row}
    C10:=0; C2:=0;
    For i:=1 To M Do Begin
      C1:=SFind(i);
      If Pix[i] Then Begin
	If C1=0 Then Begin{0}
	  SUnion(C2, i);  {1}
	  C10:=0;
	End Else Begin
	  If (C2=C1) And (C10=0) Then{01}
            T[C1].comp:=False;       {11}
	  If C2<>C1 Then Begin
	    SUnion(C2, C1);
	    C10:=C2;
	  End Else
            C10:=C1;
	End;{C1<>0}
      End Else Begin      {0}
        If C1<>0 Then SDelete(C1, i);
	C10:=C1;
	C2 :=0;
      End;
    End{for i};
  End{for x};

  For i:=1 To M Do
    If (T[i].Rep<0)  Then Begin
    Inc(NComp);
    If T[i].comp Then Inc(CComp);
  End;
End{Process};

Begin{Program}
  Init;
  NComp:=0; CComp:=0;
  Process;
  WriteOut;
End.





\\\\\\\\\\\\\\\\\\\\\\\





Program Pattern;
Const
  MaxL=20;
Var
  A,AA,B,BB:String[MaxL];
  SA,SB:Array[0..MaxL] Of Boolean;
  LA,LB:Integer;
  CC:Integer;
  P:Array[1..2*MaxL] of Char;
  T:Array[0..MaxL, 0..MaxL] of Boolean;
  OList:Array[1..1000] of String[2*MaxL];
  OLc,i,j:Integer;

Procedure ReadIn;
Var
  InFile:Text;
Begin{ReadIn}
  Assign(InFile, 'pattern.in'); Reset(InFile);
  ReadLn(InFile, A);
  ReadLn(InFile, B);
  Close(InFile);
End{ReadIn};

Procedure WriteOut;
Var i:Integer;
  OutF:Text;
Begin{WriteOut}
  Assign(OutF, 'pattern.out'); Rewrite(OutF);
  WriteLn(OutF, OLc);
  For i:=1 To OLc Do
    WriteLn(OutF, OList[i]);

  Close(OutF);
End{WriteOut};

Function Match(Const P,Q:String):Boolean;
{<=>h(P)=Q}
Var
  T:Array[0..2*MaxL, 0..2*MaxL] Of Boolean;
  LP,LQ,i,j:Integer;
Begin{Match}
  LP:=Length(P); LQ:=Length(Q);
  T[0,0]:=True;
  For i:=1 To LP Do
    T[i,0]:=(P[i]='*') And T[i-1,0];
  For j:=1 To LQ Do T[0,j]:=False;

  For i:=1 To LP Do
    For j:=1 To LQ Do
      T[i,j]:=(P[i]='*') And (T[i-1,j-1] Or T[i-1,j] Or T[i,j-1])Or
              (P[i]=Q[j]) And T[i-1,j-1];
    {for j};
  {for i};
  Match:=T[LP,LQ];
End{Match};

Procedure PutPattern;
Var i,k:Integer;
  S:String;
Begin{PutPattern}
  S:='';
  For k:=CC Downto 1 Do
    S:=S+P[k];
  If OLc=0 Then Begin
    OLc:=1; OList[1]:=S;
    Exit;
  End;
  i:=1;
  While i<=OLc Do Begin
    If Match(S, OList[i]) Then Begin
      OList[i]:=OList[OLc];
      Dec(OLc);
    End Else If Match(OList[i], S) Then Begin
      Break;
    End Else
      Inc(i);
  End{while};

  If i>OLc Then Begin
    Inc(OLc);
    OList[OLc]:=S;
  End;
End{PutPattern};

Procedure Traverse(i,j:Byte);
Begin{Traverse}
  If SA[i] And SB[j] Then Begin
    Inc(CC); P[CC]:='*';
  End;
  If (i=0)And(j=0) Then Begin
    PutPattern
  End Else Begin
    If (i>0) And SB[j] And T[i-1,j] Then Begin
      Inc(CC); P[CC]:=AA[i];
      Traverse(i-1,j);
      Dec(CC);
    End;
    If (j>0) And SA[i] And T[i,j-1] Then Begin
      Inc(CC); P[CC]:=BB[j];
      Traverse(i,j-1);
      Dec(CC);
    End;
    If (i>0) And (j>0) And T[i-1,j-1] And (AA[i]=BB[j]) Then Begin
      Inc(CC); P[CC]:=AA[i];
      Traverse(i-1,j-1);
      Dec(CC);
    End;
  End;
  If SA[i] And SB[j] Then Dec(CC);
End{Traverse};

Begin{Program}
  ReadIn;

  CC:=0; OLc:=0;

  LA:=0; SA[0]:=False;
  For i:=1 To Length(A) Do
    If A[i]='*' Then
      SA[LA]:=True
     Else Begin
       Inc(LA);
       AA[LA]:=A[i];
       SA[LA]:=False;
     End;
  LB:=0; SB[0]:=False;
  For j:=1 To Length(B) Do
    If B[j]='*' Then
      SB[LB]:=True
     Else Begin
       Inc(LB);
       BB[LB]:=B[j];
       SB[LB]:=False;
     End;

  T[0,0]:=True;
  For i:=1 To LA Do T[i,0]:=SB[0];
  For j:=1 To LB Do T[0,j]:=SA[0];
  For i:=1 To LA Do
    For j:=1 To LB Do
      T[i,j]:=T[i-1,j] And SB[j] Or
              T[i,j-1] And SA[i] Or
              T[i-1,j-1] And (AA[i]=BB[j]);

  If T[LA,LB] Then Traverse(LA, LB);

  WriteOut;
End.



\\\\\\\\\\\\\\\\\\\\


Program Select;
Uses Query;
Const
  MaxN=30000;                    {max. size}
  MaxK=20;                       {MaxN<=2^MaxK}
Var
  N:1..MaxN;                     {# of all elements}
  M:0..MaxN;                     {the actual # number of elements}
  Half:Longint;                  {the actual # of elements of the majority group}
  B:Array[0..MaxK] Of Boolean;   {having a subgroup with 2^k elements}
  R:Array[0..MaxK] Of 0..MaxN;   {representatives of the subgroups}
  Pow2:Array[0..MaxK] Of Longint;{Pow2[k]=2^k}
  L:Word;                        {the largest subgroup has 2^L elements}
  i,k:Integer;
Begin
  Pow2[0]:=1;
  For k:=1 To MaxK Do Pow2[k]:=Pow2[k-1] Shl 1;
  N:=Size;
  If Odd(N) Then M:=N Else M:=N-1;
  Half:=M div 2 +1;
  L:=0;  i:=0;
  While i<N Do Begin              {search for majority member of M elements}
    k:=0; B[0]:=True;
    Inc(i); R[0]:=i;
    Inc(i);                       {take the next two elements i and i+1}
    If i>N Then Break;
    While B[k] Do Begin           {there are two subgroups with 2^k elements}
      If Member(R[k],i)=1 Then Begin{join the two subgroups of 2^k elements}
        B[k]:=False;
        Inc(k);
        If k>L Then L:=k;         {new largest subgroup}
      End Else Begin              {different subgroups}
        Dec(M, Pow2[k+1]);        {M:=M-2^(k+1)}
        Dec(Half, Pow2[k]);       {Half:=Half-2^k}
        B[k]:=False;              {discard the subgroup}
        If k=L Then               {update L}
          While (L>0)And Not B[L] Do Dec(L);
        k:=-1;
        Break;
      End;
    End{while B[k]};

    If k>=0 Then Begin
      B[k]:=True;                 {form a new subgroup having 2^k elements}
      R[k]:=i;                    {i is the representativ of the new subgroup}
    End;

    If (L>0)And(Pow2[L]>=Half) Then{the largest subgroup is the majority}
      Break;
  End{while i<N};

  Answer(R[L]);                   {the largest subgroup is the majority}
End.

