label sk;
const maxn=5000; {20000}
      maxm=10000;
Type  MType=record
                  S                     : String;
                  A                     : Array[1..maxn] of Byte;
            end;
var     i,j,k,l,m,n                     : LongInt;
        A                               : Array[1..maxn] of String;
        B                               : Array[1..maxn] of LongInt;
        W                               : Array[1..maxm] of MType;
        s2,s                            : String;
        p1,p2                           : LongInt;
        f                               : Boolean;
        x,y                             : LongInt;
        kk                              : Boolean;

procedure upstr(var S: String);
var i     : LongInt;
Begin
 for i:=1 to length(s) do
  s[i]:=upcase(s[i]);
End;

function get(S: String): LongInt;
var i: LongInt;
Begin
 for i:=1 to L do
  if w[i].s=s then
  begin
   get:=i;
   exit;
  end;
 l:=l+1;
 get:=l;
End;

procedure sort(l,r: integer);
var
  i,j: integer;
  x      : String;
  y: MType;
begin
  i:=l; j:=r; x:=w[(l+r) DIV 2].s;
  repeat
    while w[i].s<x do i:=i+1;
    while x<w[j].s do j:=j-1;
    if i<=j then
    begin
      y:=w[i]; w[i]:=w[j]; w[j]:=y;
      i:=i+1; j:=j-1;
    end;
  until i>j;
  if l<j then sort(l,j);
  if i<r then sort(i,r);
end;

procedure print(var p1,p2: LongInt);
begin
      if p2-p1+1>=3 then
       write(p1,'-',p2) else
       if p1<>p2 then write(p1,',',p2) else
       write(p1);
       p1:=0;
       p2:=0;
end;

function numlines(x: IntegeR): integer;
var i,S: Integer;
Begin
 s:=0;
  i:=x;
  while (length(a[i])>0)and(i>0) do
  begin
   inc(s);
   dec(i);
  end;
  i:=x+1;
  while (length(a[i])>0) do
  begin
   inc(s);
   inc(i);
  end;
 numlines:=s;
End;

BEGIN
 Assign(Input,'document.in');
 Assign(Output,'document.out');
 Rewrite(Output);
 ReseT(INput);
  ReadLn(N); m:=0;
  while not eof do
  begin
   inc(m);
   readln(a[m]);
   upstr(a[m]);
  end; l:=0;

  k:=0; x:=1; f:=true; i:=1;
  while I<=M do
  begin
   if (k=0)and(length(a[i])>0) then
   begin
    k:=1;
    b[i]:=x;
    goto sk;
   end;
   if length(a[i])=0 then
   begin
    f:=true;
    inc(K);
    goto sk;
   end;
   inc(K); b[i]:=x;
   If K=N then
   begin
    if length(a[i+1])=0 then
    begin
     inc(i);
     f:=true;
     goto sk;
    end;
    if (f)and(length(a[i+1])>0) then
    begin
     inc(x);
     b[i]:=x; k:=1;
     goto sk;
    end;
    if (length(a[i+1])>0)and(length(a[i+2])=0) then
    begin
     y:=numlines(i);
     if y>3 then
     begin
      inc(x);
      b[i]:=x; k:=1;
      f:=false;
      goto sk;
     end;
     if (y=2)or(y=3) then
     begin
      inc(x);
      b[i]:=x;
      if length(a[i-1])>0 then
      begin
       b[i-1]:=x;
       if length(a[i-2])>0 then b[i-2]:=x;
      end;
      if length(a[i+1])>0 then
      begin
       b[i+1]:=x;
       if length(a[i+2])>0 then b[i+2]:=x;
      end;
      k:=y;
     end;
    end;
   end else
   b[i]:=x;
   f:=false;
   sk:
   inc(I);
   if K>N then
   begin
    inc(x);
    k:=1;
   end;
  end;

  for i:=1 to M+1 do
  begin
   s2:='';
   if length(a[i])=0 then continue;
   a[i]:=a[i]+' ';
   for j:=1 to Length(A[i]) do
    if (a[i][j] in ['A'..'Z']) then
     s2:=s2+a[i][j] else
     begin
      if length(s2)>0 then
      begin
       k:=get(s2);
       w[k].s:=s2;
       w[k].a[b[i]]:=1;
      end;
      s2:='';
     end;
  end;

  sort(1,L);

  for i:=1 to L do
  begin
   write(w[i].s,' '); k:=0; p1:=0; p2:=0;kk:=false;
   for j:=1 to N do
    with w[i] do
     if a[j]=0 then
     begin
      if p1=0 then continue;
      p2:=j-1;
      if kk then write(',');
      print(p1,p2);
      kk:=true;
     end else
     begin
      if p1=0 then p1:=j;
     end;
   writeln;
  end;

 Close(INput);
 Close(Output);
END.