program d;

{$APPTYPE CONSOLE}

{$DEFINE DEBUGfdfd}

uses
  SysUtils;

const
  TaskName = 'document';

type
  PTree = ^TTree;
  TTree = record
    s:string;
    P:array of integer;
    L,R:PTree;
  end;

var
  n, NN : Integer;
  Lines:array[0..20000]of record
    s:string;
    NLine:integer;
  end;
  Root:PTree;

procedure Display(P:PTree);
var
  i:integer;
begin
  if P.L <> nil then
    Display(P.L);
  Write(P.s,' ');
  for i:=0 to length(P.P)-1 do
    begin
      if i>0 then
        Write(',');
      Write(P.P[i]);
    end;
  WriteLn;
  if P.R <> nil then
    Display(P.R);
end;

procedure Add(s:string; Pg:integer);
var
  P:PTree;
begin
  P:=Root;
  if P<>nil then
    repeat
      if s<P.s then
        if P.L=Nil then
          begin
            New(P.L);
            P:=P.L;
            P.L:=Nil;
            P.R:=Nil;
            P.s:=s;
            SetLength(P.P,1);
            P.P[0]:=Pg;
            break;
          end
        else
          P:=P.L
      else if s>P.s then
        if P.R=Nil then
          begin
            New(P.R);
            P:=P.R;
            P.L:=Nil;
            P.R:=Nil;
            P.s:=s;
            SetLength(P.P,1);
            P.P[0]:=Pg;
            break;
          end
        else
          P:=P.R
      else
        begin
          SetLength(P.P,length(P.P)+1);
          P.P[length(P.P)-1]:=Pg;
          break;
        end
    until false
  else
    begin
      New(P);
      Root:=P;
      P.L:=Nil;
      P.R:=Nil;
      P.s:=s;
      SetLength(P.P,1);
      P.P[0]:=Pg;
    end;
end;

procedure Solve();
  var
    i, j, k: Integer;
    ss:string;
  begin
    Lines[1].NLine:=1;
    for i:=1 to NN do
      begin
        if (Lines[i].s='')and(Lines[i].NLine mod N = 1) then
          Lines[i+1].NLine:=Lines[i].NLine
        else if (Lines[i].s<>'')and(Lines[i-1].s='') then
          begin
            if (Lines[i].NLine mod N = 0)and(Lines[i+1].s<>'') then
              begin
                inc(Lines[i].NLine);
              end
            else if (Lines[i].NLine mod N = N-1)and((Lines[i+2].s='')or(Lines[i+3].s='')) then
              begin
                inc(Lines[i].NLine,2);
              end;
            Lines[i+1].NLine:=Lines[i].NLine+1;
          end
        else if (Lines[i].s<>'')and(Lines[i].NLine mod N = 0)and(Lines[i+2].s='') then
          begin
            inc(Lines[i].NLine);
            Lines[i+1].NLine:=Lines[i].NLine+1;
          end
        else
          Lines[i+1].NLine:=Lines[i].NLine+1;
      end;
    for i:=1 to NN do
      begin
        k:=1;
        ss:='';
        for j:=1 to length(Lines[i].s) do
          begin
            if not (Lines[i].s[j] in ['a'..'z','A'..'Z']) then
              begin
                if k<j then
                  begin
                    Add(ss,Lines[i].NLine div N + 1);
                    ss:='';
                  end;
                k:=j+1;
              end
            else
              ss:=ss+UpperCase(Lines[i].s[j]);
          end;
        if ss<>'' then
          Add(ss,Lines[i].NLine div N + 1);
      end;
  end;

begin
{$IFNDEF DEBUG}
  Assign( input, TaskName + '.in' );
  Assign( output, TaskName + '.out' );
  Reset(input);
  Rewrite(output);
{$ENDIF}
  ReadLn(N);
  NN:=0;
  Lines[0].s:='';
  while not eof(input) do
    begin
      inc(NN);
      ReadLn(Lines[NN].s);
    end;
  Root:=nil;
  Solve();
  Display(Root);
{$IFNDEF DEBUG}
  Close(input);
  Close(output);
{$ELSE}
  ReadLn;
{$ENDIF}
end.
