program ksp17-3-5;
const
  MaxN = 100;
  MaxA = 5;
var
  N, A, P, F, NN, NF: Integer;
  Edges: array[0..MaxN - 1, 0..MaxA - 1] of Integer;
  Final, Reach: array[0..MaxN - 1] of Boolean;
  Equiv, Done: array[0..MaxN - 1, 0..MaxN - 1] of Boolean;
  First, Renamed: array[0..MaxN - 1] of Integer;

  procedure MarkReachable(X: Integer);
  var
    I: Integer;
  begin
    if Reach[X] then Exit;

    Reach[X]:= True;
    for I:= 0 to A - 1 do
    MarkReachable(Edges[X, I]);
  end;

  function Equivalent(X, Y: Integer): Boolean;
    function AllEquiv: Boolean;
    var
      I: Integer;
    begin
      AllEquiv:= False;
      for I:= 0 to A - 1 do
      if not Equivalent(Edges[X, I], Edges[Y, I]) then Exit;
      AllEquiv:= True;
    end;
  begin
    if not Done[X, Y] then
    begin
      Done[X, Y]:= True;
      Done[Y, X]:= True;
      Equiv[X, Y]:= True;
      Equiv[Y, X]:= True;
      Equiv[X, Y]:= AllEquiv;
    end;
    Equivalent:= Equiv[X, Y];
    Equiv[Y, X]:= Equiv[X, Y];
  end;

var
  I, J, X: Integer;
begin
  Readln(N, A, P, F);
  Dec(P);
  for I:= 0 to F - 1 do
    Final[I]:= False;
  for I:= 1 to F do
  begin
    Read(X);
    Final[X - 1]:= True;
  end;
  Readln;
  for I:= 0 to N - 1 do
  begin
    for J:= 0 to A - 1 do
    begin
      Read(X);
      Edges[I, J]:= X - 1;
    end;
    Readln;
  end;

  for I:= 0 to N - 1 do
    Reach[I]:= False;

  MarkReachable(P);

  for I:= 0 to N - 1 do
  for J:= 0 to N - 1 do
  if I = J then
  begin
    Equiv[I, I]:= True;
    Done[I, I]:= True;
  end else
  if Final[I] <> Final[J] then
  begin
    Equiv[I, J]:= False;
    Done[I, J]:= True;
  end else
    Done[I, J]:= False;

  for I:= 0 to N - 1 do
  for J:= I + 1 to N - 1 do
    if Reach[I] and Reach[J] and not Done[I, J] then Equivalent(I, J);

  for I:= 0 to N - 1 do
  for J:= 0 to N - 1 do
  if Equiv[I, J] then
  begin
    First[I]:= J;
    Break;
  end;

  NN:= 0;
  NF:= 0;
  for I:= 0 to N - 1 do
  if Reach[I] and (First[I] = I) then
  begin
    Inc(NN);
    Renamed[I]:= NN;
    if Final[I] then Inc(NF);
  end;

  Writeln(NN, ' ', A, ' ', First[P] + 1, ' ', NF);
  for I:= 0 to N - 1 do
  if Reach[I] and (First[I] = I) and Final[I] then Write(Renamed[I], ' ');
  Writeln;
  for I:= 0 to N - 1 do
  if Reach[I] and (First[I] = I) then
  begin
    for J:= 0 to A - 1 do
      Write(Renamed[First[Edges[I, J]]], ' ');
    Writeln;
  end;
end.