uses math;
var n:int64;
    i,gt:longint;
    ok:boolean;
begin
        read(n);
        if n=1 then writeln('1')
        else begin
        for i:=2 to trunc(sqrt(n)) do
                if (n mod i)=0 then begin
                        ok:=true;
                        gt:=i;
                        break;
                        end;
        if ok then begin
                while (n mod i)=0 do
                        n:=n div i;
                if n=1 then writeln(gt)
                else writeln('1');
                end
        else writeln(n);
        end;
end.

var i,n,m:longint;a:int64;
begin
 read(a);
 if a<4 then write(a) else if not odd(a) then begin
  while a mod 2=0 do a :=a div 2;
  if a=1 then write(2) else write(1)
 end else
 begin
  m:=1;i:=1+trunc(sqrt(A));
  while m <=i do
  begin
  inc(m,2);
   if a mod m=0 then begin
   a:=a div m;
   while a mod m=0 do
   a:=a div m;
   if a=1 then
   write(m) else write(1); halt end
    end;

 write(a); end;
end.

var
  n, d, first_divisor: int64;
  found_second: boolean;

begin
  readln(n);
  first_divisor := 1;
  d := 2;
  while (d * d <= n) and not found_second do begin
    while n mod d = 0 do begin
      n := n div d;
      if first_divisor = 1 then
        first_divisor := d
      else
        if first_divisor <> d then
          found_second := true;
    end;
    d += 1;
    if d > 3 then
      d += 1;
  end;
  if n > 1 then begin
    if first_divisor > 1 then
      found_second := true
    else
      first_divisor := n
  end;
  if found_second then
    writeln(1)
  else
    writeln(first_divisor);
end.

Program A1242;
var n: int64;

Procedure get_colors(n:int64);
var i, j, d: int64;
begin;
  i:=2;
  d:=1;
  while trunc(sqrt(n))>= i do
  begin
    if d>1 then
    begin
      n:=1;
      break
    end;
    while (n mod i = 0) and (trunc(sqrt(n)) >= i) do
    begin;
      d:=i;
      n:=n div i;
    end;
    i+=1
  end;
  if (d<>n) and (d>1) then
    n:=1;
  writeln(n)
end;

begin;
  readln(n);
  get_colors(n)
end.

                                             const eps=1e-12;
                          besk=2002000000000000000; label 4,1,3,2,44,22;
                    type mas=array[-100..1200000+1] of int64;
                    integer=longint;   zap=record p1,p2,p3:int64; end;
                    zap1=^zap;
                    var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                    ss3,ss,ss1,ss2:string;
                    qqq:zap;  pmin,bet,al:extended;
                    ot1,ot2:zap;
                    ver:array[-1..500,-1..5] of extended;
                    sum,ssum:array[0..10000,0..10000] of byte;
                    verugad:array[-2..200,-2..200,-2..200] of extended;
                    leftx,lefty,rightx,righty,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                      z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                     vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                      zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                      ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                      ppole:array[-1000000..3000000] of char;
                      str1,str2,stroka:array[-1000..1000000] of char;
                      dinam:array[-100000..1000000] of extended;
                      t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                      dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                      sp,sss:array[-10..2000000] of string;
                      newpole,pole:array[-1..2100,-1..2700] of char;
                      blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                      poss:int64;
                      ch:char;
                      ff,flagg1:boolean;
                      oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                      dddd:array[-10..5010,-10..5010] of int64;
                     function srav(i,j:longint):boolean; label 44;

                    begin
                       if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                       if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                       if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                     44:
                    end;

                    procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                    begin
                    i:=l;j:=m; flag:=true; step:=0;while flag do begin
                    if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                    inc(step);inc(i);
                    {writeln('step=',step,' i=',i);} end;
                    if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                    inc(step);inc(j);end;
                    if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                    end;
                    if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                    if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                    end;
                    procedure sort(var c:mas);

                    begin

                    k:=1; repeat
                    l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                    for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                    until (k>=n);

                    end;

                    function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                    function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                    function min3(a,b,c:int64):int64;  var ot:int64;
                    begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

          function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
      tt:zap; tt1:zap1;  fl:boolean;
    begin
      fl:=false;
      if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
      x2:=1;x1:=0;y2:=0;y1:=1;
      while b>0 do
        begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
              a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
        end;
        if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
             begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
       evkl:=tt1;
    end;

                    function phi(a,b:double):double; label 222;var p:double;
                    begin
                      if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                      if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                      if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                      if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                      if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                      222: phi:=p;
                    end;

                    function nod(a,b:int64):int64; var p,t:int64;
                    begin
                      a:=abs(a); b:=abs(b);
                      if (a>0)and(b>0) then
                       begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                        p:=a;
                       end else if a=0 then p:=b else p:=a;
                    nod:=p;
                    end;
              function arccos(tt:extended):extended;
      begin
        if abs(tt)>1-1e-13 then
        if tt>0 then  arccos:=0 else arccos:=pi;
        if tt=0 then arccos:=pi/2 else
        if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
        else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

      end;

                    function nok(a,b:int64):int64;
                    begin  nok:=(a*b) div nod(a,b);  end;

                       function degg(a:int64;k:int64):int64; var p:int64;
                    begin
                     if k<=0 then degg:=1 else if odd(k) then degg:=(degg(a,k-1)*a) mod modul  else
                       begin  p:=degg(a,k div 2); degg:=(p*p) mod modul;    end;

                    end;

          {          function zaprmax(left,right:longint):int64;
                begin
                   if left>=right then zaprmax:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                         begin
                          if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                          if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                         end;

                     end;

                end;
           }
              function zaprmin(left,right:longint):int64;
                begin
                   if left>=right then zaprmin:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                         begin
                          if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                          if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                         end;

                     end;

                end;

                    procedure udal(ii:longint);
                    begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                    function nomerr(gr:int64):int64;

                    var ot,aa,bb,cc:int64; fl:boolean;
                    begin
                      aa:=1; bb:=p;  cc:=aa; fl:=false;
                      while abs(aa-bb)>1 do
                        begin
                           cc:=(aa+bb) shr 1;
                           writeln('cc=++ ',cc);
                           if y[cc]<gr then aa:=cc else bb:=cc;

                        end;
                       writeln(' cc= ',cc);
                     {  cc:=max(cc-3,0);
                     }  repeat inc(cc) until y[cc]>=gr;
                       if y[cc]=gr then fl:=true else fl:=false;
                        if fl then nomerr:=a1[cc] else nomerr:=-1000;
                       nomerr:=cc;
                    end;

                    function pprost(pp:longint):boolean;
                    var i,j,t:longint; tt:extended; fl:boolean;
                    begin
                      tt:=pp;
                      tt:=sqrt(tt);
                      fl:=true;
                      for i:=2 to round(tt) do if pp mod i=0 then  fl:=false;

                     pprost:=fl;

                    end;

                    function gl(c:char):boolean;
                    begin
                     if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                    end;

function sovp(p:longint):boolean;
var i,j:longint;  fl:boolean;
begin
   fl:=true;
   for i:=1 to p do if xx[i]<>yy[i] then fl:=false;

   sovp:=fl;
end;

procedure change(ii,jj:longint);
var pp:longint;
begin
  pp:=xx[ii];
  xx[ii]:=yy[jj];
  yy[jj]:=pp;

end;

function prostt(pp:int64):boolean;
var i,j:longint; t:extended; fl:boolean;
begin
 t:=pp;
 t:=sqrt(t);
 for i:=2 to round(t) do if pp mod i=0 then fl:=false;

 prostt:=fl;
end;

     begin
    {    assign (input,'D:\Projects\input.txt');reset(input);
          assign (output,'D:\Projects\output.txt'); rewrite(output);
     }

             read(tt);
           x[0]:=1;

        if prostt(tt) then begin writeln(tt); goto 1;  end;
  al:=tt;
  al:=sqrt(al);
  for i:=1 to round(al) do
    begin
       if (tt mod i=0)and(i>1) then begin inc(p); x[p]:=i;  end;
       if (tt mod i=0) then begin inc(p); x[p]:=tt div i;  end;

    end;

 { writeln('p= ',p);
  for i:=1 to p do write(x[i]:4);
  writeln;
 } qq:=x[1];
  for i:=1 to p do qq:=nod(qq,x[i]);
  writeln(qq);

        goto 1;
 read(qq);
   for stepp:=1 to qq do

    begin
          readln(p); tt:=0;
          readln(ss1); readln(ss2);
          for i:=1 to p do begin xx[i]:=ord(ss1[i])-ord('a'); yy[i]:=ord(ss2[i])-ord('a');        end;
         for i:=0 to 26 do begin   x[i]:=0;     end;
         for i:=1 to p do begin
          t:=ord(ss1[i])-ord('a'); inc(x[t]);  t:=ord(ss2[i])-ord('a'); inc(x[t]);
                      end;
         flag:=true;
         for i:=0 to 25 do if odd(x[i]) then flag:=false;
         if flag then writeln('YES') else begin  writeln('NO'); goto 2;     end;

         q:=0;
         while not sovp(p) and (q<1000000)and(tt<1000000) do
           begin
           {  writeln('q= ',q);
           }  inc(q);  flag1:=false; flag2:=false;
             for i:=1 to p do if xx[i]<>yy[i] then begin pos1:=i; break;  end;
             for i:=1 to p do if (xx[i]=xx[pos1])and(i<>pos1) then begin  flag1:=true; pos2:=i; goto 3;  end;
             for i:=1 to p do if (yy[i]=xx[pos1]) then begin  flag2:=true; pos2:=i; break;  end;
3:         {  writeln(flag1,' ',flag2,' pos1= ',pos1,' pos2= ',pos2);
           }  if flag1 then
               begin
                  inc(tt);
              {    for i:=1 to p do write(xx[i]:3); writeln;
                  for i:=1 to p do write(yy[i]:3); writeln;
               }
                  z[tt]:=pos2; zz[tt]:=pos1;
                  change(z[tt],zz[tt]);
                {  writeln('case 1');
                  for i:=1 to p do write(xx[i]:3); writeln;
                  for i:=1 to p do write(yy[i]:3); writeln;
                writeln('----------------');
                 }
               end;

             if flag2 then
                begin
               {  for i:=1 to p do write(xx[i]:3); writeln;
                 for i:=1 to p do write(yy[i]:3); writeln;
                }
                  inc(tt); z[tt]:=p; zz[tt]:=pos2;
                  change(z[tt],zz[tt]);
                  inc(tt); z[tt]:=p; zz[tt]:=pos1;
                  change(z[tt],zz[tt]);
                {  writeln('case 2');
                  for i:=1 to p do write(xx[i]:3); writeln;
                  for i:=1 to p do write(yy[i]:3); writeln;
             writeln('-----------------');
                 }
                end;

           end;
         writeln(tt);
         for i:=1 to tt do writeln(z[i],' ',zz[i]);

  2:

    end;

  1: close (output);
end.

var i,n,m:longint;a:int64;
begin
 read(a);
 if a<4 then write(a) else if not odd(a) then write(2) else
 begin
  m:=1;
  while m*m<=a do
  begin
  inc(m,2);
   if a mod m=0 then begin write(m); halt end
    end;

 write(a); end;
end.

uses math;
var n:int64;
    i,gt:longint;
    ok:boolean;
begin
        read(n);
        if n=1 then writeln('1');
        for i:=2 to trunc(sqrt(n)) do
                if (n mod i)=0 then begin
                        ok:=true;
                        gt:=i;
                        break;
                        end;
        if ok then begin
                while (n mod i)=0 do
                        n:=n div i;
                if n=1 then writeln(gt)
                else writeln('1');
                end
        else writeln(n);
end.

                                             const eps=1e-12;
                          besk=2002000000000000000; label 4,1,3,2,44,22;
                    type mas=array[-100..1200000+1] of int64;
                    integer=longint;   zap=record p1,p2,p3:int64; end;
                    zap1=^zap;
                    var sdvig,start,dl,len,i1,j1,mask,stepp,n2,i,j,k,l,step,k1,mesto,num:longint;
                    ss3,ss,ss1,ss2:string;
                    qqq:zap;  pmin,bet,al:extended;
                    ot1,ot2:zap;
                    ver:array[-1..500,-1..5] of extended;
                    sum,ssum:array[0..10000,0..10000] of byte;
                    verugad:array[-2..200,-2..200,-2..200] of extended;
                    leftx,lefty,rightx,righty,qq,kol,chisl,znam,n,m,ttt,right,left,numpos,vx,vy,ans,up,down,xmin,xmax,ymin,ymax,imax,t3,qq1,qq2,q1,q2,ost,koll,w,pos,dx,dy,finish,time,p3,p4,jj,qqqq,ii,tt,pmax,pmax2,p1,p2,ot,ott,hh,pos0,pos1,pos2,pp,mm,maxot,mnog,tmax,summax,nn,kk,modul,t0,n1,q,t,p:int64; flag1:boolean;
                      z,a2,invx,invy,summ,place,str,b2,z1,sum1,sum0,d0,d1,ccc,c,d,a,b:mas; flag2,flag:boolean;  pl:longint;
                     vel,zapas,razn,oldll,oldrr,ppp,shag,posx,posy,minx,miny,maxx,maxy,kolplus,kolminus,razr,jmax,gr,grr,ener,dob,aa,bb,cc,dist,tt3,tt1,tt2,ugg,aa1,aa2,r,ug:int64;
                      zzan,prost,marked,zan:array[-1000000..1000000] of boolean;
                      ll,rr,zpl,zmi,path,lx,a3,a4,dd1,dd2,predok,a1,b1,strok:array[-10000..1500000] of int64;
                      ppole:array[-1000000..3000000] of char;
                      str1,str2,stroka:array[-1000..1000000] of char;
                      dinam:array[-100000..1000000] of extended;
                      t1,t2,al1,bet1,cosa,sina,cosb,sinb,rx,ry,sdvigx,sdvigy,px,py,h1,h2,h,l1,l2,otmax,v:int64;
                      dd,ssumitog,profil,zzz:array[-10..2100,-10..2100] of int64;
                      sp,sss:array[-10..2000000] of string;
                      newpole,pole:array[-1..2100,-1..2700] of char;
                      blizpr,ddd,ddinv,dnech,poschet,posnechet:array[-10..390000,-1..6] of int64;
                      poss:int64;
                      ch:char;
                      ff,flagg1:boolean;
                      oldx,oldy,zz,numx,numy,xleft,xright,s,znach,nomer,newplace,newstr,next,prev,xx,yy,aold,x,y:array[-10000..400002] of int64;
                      dddd:array[-10..5010,-10..5010] of int64;
                     function srav(i,j:longint):boolean; label 44;

                    begin
                       if (a[i]<a[j]) then begin srav:=true; goto 44;  end;
                       if a[i]>a[j] then begin  srav:=false; goto 44;   end;
                       if a[i]=a[j] then if a1[i]<a1[j] then srav:=true else srav:=false;

                     44:
                    end;

                    procedure sl (k,l,m:integer);  {k- dlina, l,m - nachalo dvuh blokov}
                    begin
                    i:=l;j:=m; flag:=true; step:=0;while flag do begin
                    if (srav(i,j)) then begin begin b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];end;
                    inc(step);inc(i);
                    {writeln('step=',step,' i=',i);} end;
                    if (not srav(i,j)) then begin begin b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];end;
                    inc(step);inc(j);end;
                    if  ((i>=l+k) or (j>=m+k)) then flag:=false;
                    end;
                    if(i>=l+k) then repeat b[l+step]:=a[j];b1[l+step]:=a1[j];b2[l+step]:=a2[j];inc(step);inc(j);until (j>=m+k);
                    if(j>=m+k) then repeat b[l+step]:=a[i];b1[l+step]:=a1[i];b2[l+step]:=a2[i];inc(step);inc(i);until (i>=l+k);
                    end;
                    procedure sort(var c:mas);

                    begin

                    k:=1; repeat
                    l:=1;m:=k+l; repeat sl(k,l,m); l:=l+2*k;m:=m+2*k; until (l>=n); k:=k*2;
                    for i:=1 to n do begin a[i]:=b[i];a1[i]:=b1[i];a2[i]:=b2[i]; end;
                    until (k>=n);

                    end;

                    function min (a,b:int64):int64;begin min:=b;if a<b then min:=a;  end;
                    function max (a,b:int64):int64;begin max:=b;if a>b then max:=a;  end;
                    function min3(a,b,c:int64):int64;  var ot:int64;
                    begin ot:=a; if b<ot then ot:=b; if c<ot then ot:=c;  min3:=ot;  end;

          function evkl(a,b:int64):zap1; var d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
      tt:zap; tt1:zap1;  fl:boolean;
    begin
      fl:=false;
      if a<b then begin r:=a;a:=b;b:=r; fl:=true; end;
      x2:=1;x1:=0;y2:=0;y1:=1;
      while b>0 do
        begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
              a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
        end;
        if not fl then begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end else
             begin d:=a; x:=x2;y:=y2; tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;
       evkl:=tt1;
    end;

                    function phi(a,b:double):double; label 222;var p:double;
                    begin
                      if (a>0)and (b>=0) then begin p:=arctan(b/a);goto 222; end;
                      if (a<0) then begin p:=pi+arctan(b/a);goto 222; end;
                      if (a>0)and (b<0) then begin p:=2*pi+arctan(b/a);goto 222; end;
                      if (a=0)and (b>0) then begin p:=pi/2;goto 222; end;
                      if (a=0)and (b<0) then begin p:=3*pi/2;goto 222; end;
                      222: phi:=p;
                    end;

                    function nod(a,b:int64):int64; var p,t:int64;
                    begin
                      a:=abs(a); b:=abs(b);
                      if (a>0)and(b>0) then
                       begin while (b>0) do begin t:=a mod b;a:=b;b:=t;    end;
                        p:=a;
                       end else if a=0 then p:=b else p:=a;
                    nod:=p;
                    end;
              function arccos(tt:extended):extended;
      begin
        if abs(tt)>1-1e-13 then
        if tt>0 then  arccos:=0 else arccos:=pi;
        if tt=0 then arccos:=pi/2 else
        if abs(tt)<=1-1e-13 then if tt>=0 then arccos:=arctan(sqrt(1-tt*tt)/tt)
        else arccos:=pi+arctan(sqrt(1-tt*tt)/tt);

      end;

                    function nok(a,b:int64):int64;
                    begin  nok:=(a*b) div nod(a,b);  end;

                       function degg(a:int64;k:int64):int64; var p:int64;
                    begin
                     if k<=0 then degg:=1 else if odd(k) then degg:=(degg(a,k-1)*a) mod modul  else
                       begin  p:=degg(a,k div 2); degg:=(p*p) mod modul;    end;

                    end;

          {          function zaprmax(left,right:longint):int64;
                begin
                   if left>=right then zaprmax:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmax:=zaprmax(left shr 1,right shr 1) else
                         begin
                          if odd(left) then zaprmax:=max(zaprmax(left+1,right),y[left]);
                          if not odd(right) then zaprmax:=max(zaprmax(left,right-1),y[right]);

                         end;

                     end;

                end;
           }
              function zaprmin(left,right:longint):int64;
                begin
                   if left>=right then zaprmin:=y[left] else
                     begin
                        if not odd(left) and odd(right) then zaprmin:=zaprmin(left shr 1,right shr 1) else
                         begin
                          if odd(left) then  zaprmin:=min(zaprmin(left+1,right),y[left]);
                          if not odd(right) then zaprmin:=min(zaprmin(left,right-1),y[right]);

                         end;

                     end;

                end;

                    procedure udal(ii:longint);
                    begin  next[prev[ii]]:=next[ii];prev[next[ii]]:=prev[ii];  end;

                    function nomerr(gr:int64):int64;

                    var ot,aa,bb,cc:int64; fl:boolean;
                    begin
                      aa:=1; bb:=p;  cc:=aa; fl:=false;
                      while abs(aa-bb)>1 do
                        begin
                           cc:=(aa+bb) shr 1;
                           writeln('cc=++ ',cc);
                           if y[cc]<gr then aa:=cc else bb:=cc;

                        end;
                       writeln(' cc= ',cc);
                     {  cc:=max(cc-3,0);
                     }  repeat inc(cc) until y[cc]>=gr;
                       if y[cc]=gr then fl:=true else fl:=false;
                        if fl then nomerr:=a1[cc] else nomerr:=-1000;
                       nomerr:=cc;
                    end;

                    function pprost(pp:longint):boolean;
                    var i,j,t:longint; tt:extended; fl:boolean;
                    begin
                      tt:=pp;
                      tt:=sqrt(tt);
                      fl:=true;
                      for i:=2 to round(tt) do if pp mod i=0 then  fl:=false;

                     pprost:=fl;

                    end;

                    function gl(c:char):boolean;
                    begin
                     if (c='a')or (c='o')or(c='e')or(c='i')or(c='u') then gl:=true else gl:=false;

                    end;

function sovp(p:longint):boolean;
var i,j:longint;  fl:boolean;
begin
   fl:=true;
   for i:=1 to p do if xx[i]<>yy[i] then fl:=false;

   sovp:=fl;
end;

procedure change(ii,jj:longint);
var pp:longint;
begin
  pp:=xx[ii];
  xx[ii]:=yy[jj];
  yy[jj]:=pp;

end;

function prostt(pp:int64):boolean;
var i,j:longint; t:extended; fl:boolean;
begin
 t:=pp;
 t:=sqrt(t);
 for i:=2 to round(t) do if pp mod i=0 then fl:=false;

 prostt:=fl;
end;

     begin
       { assign (input,'D:\Projects\input.txt');reset(input);
          assign (output,'D:\Projects\output.txt'); rewrite(output);
        }

             read(tt);
           x[0]:=1;
           for i:=1 to 60 do x[i]:=x[i-1]*2;
        for i:=1 to 60 do if tt=x[i] then begin  writeln(2); goto 1;  end;
        if prostt(tt) then begin writeln(tt); goto 1;  end;
        writeln(1);

        goto 1;
 read(qq);
   for stepp:=1 to qq do

    begin
          readln(p); tt:=0;
          readln(ss1); readln(ss2);
          for i:=1 to p do begin xx[i]:=ord(ss1[i])-ord('a'); yy[i]:=ord(ss2[i])-ord('a');        end;
         for i:=0 to 26 do begin   x[i]:=0;     end;
         for i:=1 to p do begin
          t:=ord(ss1[i])-ord('a'); inc(x[t]);  t:=ord(ss2[i])-ord('a'); inc(x[t]);
                      end;
         flag:=true;
         for i:=0 to 25 do if odd(x[i]) then flag:=false;
         if flag then writeln('YES') else begin  writeln('NO'); goto 2;     end;

         q:=0;
         while not sovp(p) and (q<1000000)and(tt<1000000) do
           begin
           {  writeln('q= ',q);
           }  inc(q);  flag1:=false; flag2:=false;
             for i:=1 to p do if xx[i]<>yy[i] then begin pos1:=i; break;  end;
             for i:=1 to p do if (xx[i]=xx[pos1])and(i<>pos1) then begin  flag1:=true; pos2:=i; goto 3;  end;
             for i:=1 to p do if (yy[i]=xx[pos1]) then begin  flag2:=true; pos2:=i; break;  end;
3:         {  writeln(flag1,' ',flag2,' pos1= ',pos1,' pos2= ',pos2);
           }  if flag1 then
               begin
                  inc(tt);
              {    for i:=1 to p do write(xx[i]:3); writeln;
                  for i:=1 to p do write(yy[i]:3); writeln;
               }
                  z[tt]:=pos2; zz[tt]:=pos1;
                  change(z[tt],zz[tt]);
                {  writeln('case 1');
                  for i:=1 to p do write(xx[i]:3); writeln;
                  for i:=1 to p do write(yy[i]:3); writeln;
                writeln('----------------');
                 }
               end;

             if flag2 then
                begin
               {  for i:=1 to p do write(xx[i]:3); writeln;
                 for i:=1 to p do write(yy[i]:3); writeln;
                }
                  inc(tt); z[tt]:=p; zz[tt]:=pos2;
                  change(z[tt],zz[tt]);
                  inc(tt); z[tt]:=p; zz[tt]:=pos1;
                  change(z[tt],zz[tt]);
                {  writeln('case 2');
                  for i:=1 to p do write(xx[i]:3); writeln;
                  for i:=1 to p do write(yy[i]:3); writeln;
             writeln('-----------------');
                 }
                end;

           end;
         writeln(tt);
         for i:=1 to tt do writeln(z[i],' ',zz[i]);

  2:

    end;

  1: close (output);
end.

Program A1242;
var n: integer;

Procedure get_colors(n:integer);
var i, j, d: integer;
begin;
  i:=2;
  d:=1;
  while trunc(sqrt(n))>= i do
  begin
    if d>1 then
    begin
      n:=1;
      break
    end;
    while (n mod i = 0) and (trunc(sqrt(n)) >= i) do
    begin;
      d:=i;
      n:=n div i;
    end;
    i+=1
  end;
  writeln(n)
end;

begin;
  readln(n);
  get_colors(n)
end.

var
  n, d, first_divisor: int64;
  found_second: boolean;

begin
  readln(n);
  d := 2;
  while (d * d <= n) and not found_second do begin
    while n mod d = 0 do begin
      n := n div d;
      if first_divisor = 0 then
        first_divisor := d
      else
        if first_divisor <> d then
          found_second := true;
    end;
    d += 1;
    if d > 3 then
      d += 1;
  end;
  if n > 1 then begin
    if first_divisor > 0 then
      found_second := true
    else
      first_divisor := n
  end;
  if found_second then
    writeln(1)
  else
    writeln(first_divisor);
end.


 var
  a,b,i,n,j,k:longint;
  x:array[1..111111]of longint;
  ch:array[0..111111]of char;
begin
  readln(n);
  for i:=1 to n do
  read(ch[i]);

  ch[0]:='a';
  k:=0;
  a:=0;
  for i:=1 to n do
  begin
    if ch[i]='B' then k:=k+1;
    if ((ch[i]='W') and (ch[i-1]='B')) or  ((i=n)and (k>0)) then begin a:=a+1;x[a]:=k;k:=0;end;
  end;
  writeln(a);

  for i:=1 to a do
  write(x[i],' ');
end.

var a:array[1..100] of longint;
    n,i,k,q,j:longint;
    c:char;
begin
 readln(n);
 j:=1;
 q:=0;
 k:=0;
 for i:=1 to n do
  begin
   read(c);
   if c='B'
    then inc(q)
    else if q>0
          then begin
                a[j]:=q;
                inc(j);
                inc(k);
                q:=0;
               end;
  end;
 if q>0
  then begin
        a[j]:=q;
        inc(j);
        inc(k);
        q:=0;
       end;
 writeln(k);
 for i:=1 to k do
  write(a[i],' ');
end.

program mirovanie;
var q:char; w:array[1..10000] of integer; z,x:integer;
begin
 x:=1;
 readln(x); x:=1;
 while not eoln do
  begin
   read(q);
   if q='W' then x:=1;
   if q='B' then
    begin
     if x=0 then w[z]:=w[z]+1 else begin z:=z+1;w[z]:=1;x:=0; end;
    end;
  end;
  writeln(z);
  for x:=1 to z do write(w[x],' ');
end.

var i,n,dem,j:longint;
    s:ansistring;
    a:Array[1..100] of integer;
begin
    readln(n);
    readln(S);
    i:=1;
    dem:=0;
    a[0]:=0;
    while (i<=n) do
    begin
        while (i<=n) and (s[i]<>'B') do inc(i);
        if i>n then break;
        inc(dem);
        j:=i;
        while (j<=n) and (s[j]='B') do inc(j);
        a[dem]:=j-i;
        i:=j;
    end;
    writeln(dem);
    for i:=1 to dem do
        write(a[i],' ');
end.

var
a:array[1..1000] of integer;
s:string;
j,g,h,i:longint;
begin
readln(h);
read(s);
j:=1;
while i<length(s)do begin
inc(i);
if s[i]='B' then  begin
while (s[i]<>'W')and(i<=h) do begin
inc(a[j]);
inc(i);
end;
inc(j);
end;
end;
writeln(j-1);
for i:=1 to j-1 do
if a[i]<>0 then write(a[i],' ');
end.

var s:ansistring;
n,i,top,sum:longint;
a:array[0..10000]of longint;
begin
readln(n);
readln(s);
for i:=1 to length(s) do
 begin
  if s[i]='B' then
    inc(a[top])
  else inc(top);
 end;
for i:=0 to top do
 if a[i]>0 then inc(sum);
 writeln(sum);
 for i:=0 to top do
 if a[i]>0 then write(a[i],' ');
end.

const fi = '';
      fo = '';
var s: string;
    n, ans, so, i: longint;
    f: array[1..200] of longint;
begin
  assign(input,fi); reset(input);
  assign(output,fo); rewrite(output);

  readln(n);
  readln(s);
  s:=s+'W';
  i:=1; ans:=0; so:=0;
  for i:=1 to length(s) do
    begin
      if s[i] = 'B' then
        if so = 0 then
          begin
            inc(ans);
            inc(so);
          end
        else inc(so);
      if s[i] = 'W' then
        if so > 0 then
          begin
            f[ans]:=so;
            so:=0;
          end;
    end;
  writeln(ans);
  for i:=1 to ans do write(f[i],' ');

  close(input); close(output);
end.

Const Finp='';
      Fout='';
Var n,m:longint;
    s:string;
    a:array[1..100] of longint;

Procedure Nhap;
Var f:Text;
Begin
    assign(f,finp); reset(f);
    readln(f,n);
    read(f,s);
    close(f);
End;
Procedure Solve;
Var i,j,dem:longint;
Begin
    i:=1; s:=s+'W'; m:=0;
    while i<=n do
        if s[i]='B' then
            begin
                dem:=0;
                for j:=i to n do
                    if s[j]='B' then
                        begin
                            inc(dem);
                            if s[j+1]='W' then
                                break;
                        end;
                inc(m); a[m]:=dem;
                i:=j+1;
            end
        else
            i:=i+1;
End;
Procedure Xuat;
Var f:Text;
    i:longint;
Begin
    assign(f,fout); rewrite(f);
    writeln(f,m);
    for i:=1 to m do
        write(f,a[i],' ');
    close(f);
End;

Begin
    Nhap;
    Solve;
    Xuat;
End.

program zzz;
  var
    a:boolean;
    n,x,i,kol:integer;
    s:string;
    k:array[1..100]of integer;
begin
  a:=true;
  readln(n);
  readln(s);
  x:=0;
  for i:=1 to n do
  begin
    if (a=true)and (s[i]='B') then begin
                                     inc(kol);
                                     a:=false;
                                     inc(x);
                                   end;
    if (a=false)and (s[i]='B') then inc(k[x]);
    if (a=false)and (s[i]='W') then a:=true;
  end;
  writeln(kol);
  for i:=1 to x do
    write(k[i],' ');
end.

const a='B';
      b='W';
var n,i,p,k: integer;
    str: string;
    D:array[1..100] of integer;
begin

readln(n);
readln(str);
k:=0;
p:=0;
for i:=1 to n do
begin
  if (str[i]=a) then
  k:=k+1
  else
   if k>0 then
   begin
   inc(p);
   D[p]:=k;
   k:=0;
   end;
end;
if (k>0) then
begin
inc(p);
D[p]:=k;
end;
writeln(p);
for i:=1 to p do
 write(D[i],' ');

end.

var
 a:array[0..1000]of longint;
 s:ansistring;
 n,m,i,k,j,f,t,c,x,y,z,q,w:longint;
begin
 readln(n);
 readln(s);
 s:=s+'W';
 for i:=1 to n+1 do
 begin
  if((s[i]='B')and(i=1))or((s[i]='B')and(s[i-1]='W'))then f:=i;
  if((s[i]='W')and(i=n+1)and(f<>0))or((s[i]='W')and(s[i-1]='B'))then
  begin
   inc(k);
   a[k]:=i-f;
   f:=0;
  end;
 end;
 writeln(k);
 if k>=1 then write(a[1]);
 for i:=2 to k do write(' ',a[i]);
 if k>=1 then writeln;
end.

var s:string;
i,a,n,d,q:longint;
begin
readln(n);
readln(s);
if s[n]='B' then
s:=s+'W';
for i:=1 to length(s) do
begin
if s[i]='B' then begin inc(a); q:=1 end else if (i>1) and (s[i-1]<>s[i]) then begin a:=0; inc(d); end;
end;
if q = 0 then writeln(0)
else
begin
writeln(d);
a:=0;
for i:=1 to length(s) do
begin
if s[i]='B' then inc(a) else if (i>1) and (s[i-1]<>s[i]) then begin write(a,' '); a:=0;end;
end;
end;
end.

program yan;
  var ar:array[1..100]of longint; s:string;
      i,j,x,y,a,b,n,m:longint;
begin
  readln(n);
  readln(s);
  a:=1;
  for i:=1 to n do
    if s[i]='B' then inc(ar[a]) else inc(a);
  b:=a;
  for i:=1 to b do if ar[i]=0 then dec(a);
  writeln(a);
  for i:=1 to b do
    if ar[i]>0 then write(ar[i],' ');
end.

Var
s:string;
a:array[1..100] of byte;
i,j,k,n:byte;
Begin
Readln(n);
Readln(s);
k:=0;
j:=1;

For i:=1 to n do
  begin
    if s[i]='B' then inc(k);
    if (s[i]='W') and (k<>0) then begin a[j]:=k; inc(j); k:=0; end;
  end;

if s[i]='B' then begin a[j]:=k; end else dec(j);

if a[1]=0 then write('0')
else begin

Writeln(j);
For i:=1 to j do write(a[i],' '); end;
End.

var
 n,i,s,x:longint;
 ch:char;
 a:array[0..1000001] of longint;
begin
 readln(n);
 for i:=1 to n do
  begin
   read(ch);
   if ch='B' then inc(x)
    else if x<>0 then
     begin
      inc(s);
      a[s]:=x;
      x:=0;
     end;
  end;
 if x<>0 then
  begin
   inc(s); a[s]:=x;
  end;
 writeln(s);
 for i:=1 to s do
  write(a[i],' ');
end.

Program p1;
var i, n, k, f:byte;
    a:array [1..100] of char;
    b:array [1..50] of byte;
begin
  readln (n);
  for i:=1 to n do
    read (a[i]);
  f:=0;
  k:=0;
  for i:=1 to n do
    begin
      if a[i]='B' then
        if f=0 then
          begin
            f:=1;
            inc (k);
            b[k]:=1;
          end
        else inc (b[k])
      else f:=0;
    end;
  writeln (k);
  if k<>0 then
    begin
      for i:=1 to k-1 do
        write (b[i],' ');
      write (b[k]);
    end;
end.

var
  a:array [1..200] of integer;
  s:string;
  i,n,k,j:integer;
BEGIN
  readln(n);
  read(s);
  i:=1;j:=1;
  while i<=n do
  begin
    k:=0;
    while (s[i]='B') and (i<=n) do
      begin
        inc(k);
        inc(i);
      end;
    if i<=n
      then
      while (s[i]<>'B') and (i<=n) do
        inc(i);
    if (k<>0)
      then begin
           a[j]:=k;
           inc(j);
           end;
  end;
  writeln(j-1);
  for i:=1 to j-1 do
    write(a[i],' ');

END.

Var s:string;
    n,i,k:longint;
    a:array[1..1000] of longint;
    begin
     readln(s);
     readln(s);
     for i:=1 to length(s) do
      begin
       if s[i]='B' then k:=k+1
        else
         begin
          if k>0 then begin n:=n+1; a[n]:=k; end;
          k:=0;
         end;
      end;
     if k>0 then begin n:=n+1; a[n]:=k; end;
     writeln(n);
     for i:=1 to n do
      write(a[i],' ');
     End.

var n,i,k,b:integer; s,nn,ans:string;
begin
readln(n);
readln(s);
s:=s+'s';
b:=0;
while i < n do begin
i:=i+1;
 if s[i] = 'B' then begin
  k:=k+1;
  while s[i] = 'B' do begin  b:=b+1; i:=i+1; end;
  str(b,nn);
  ans:= ans + nn+' ';
  b:=0;
 end;

end;
writeln(k);
writeln(ans);

end.

{$MODE OBJFPC}

Program cf374A;

Const
  Input= '';
  Output= '';

Var
  Fi, fo: text;
  n, i, res, c: integer;
  a: array[1..100] of integer;
  s: ansistring;

Procedure Enter;
  Begin
    Readln(fi, n);
    readln(fi, s);
  End;

Procedure Solve;
  Begin
    res:= 0; c:= 0;
    For i:= 1 to n do
      if s[i]= 'W' then
       begin
         if c<> 0 then
           begin
             inc(res);
             a[res]:= c;
           end;
         c:= 0;
       end
      else inc(c);
    if c<> 0 then
      begin
        inc(res);
        a[res]:= c;
      end;
  End;

Procedure Finish;
  Begin
    writeln(Fo, res);
    for i:= 1 to res do write(fo, a[i],' ');
  End;

Begin
  Assign(Fi, Input); Reset(Fi);
  Assign(Fo, Output); Rewrite(Fo);
  Enter;
  Solve;
  Finish;
  Close(Fi); Close(Fo);
End.

 var
  a,b,i,n,j,k:longint;
  x:array[1..111111]of longint;
  ch:array[0..111111]of char;
begin
  readln(n);
  for i:=1 to n do
  read(ch[i]);

  ch[0]:='a';
  k:=0;
  a:=0;
  for i:=1 to n do
  begin
    if ch[i]='B' then k:=k+1;
    if ((ch[i]='W') and (ch[i-1]='B')) or (((i=n)and (a<>0) and (k>0)) or ((i=n)and (k>0))) then begin a:=a+1;x[a]:=k;k:=0;end;
  end;
  writeln(a);

  for i:=1 to a do
  write(x[i],' ');
end.

var s:string;
n,i,x,y,j:longint;
a:array[1..100] of longint;
BEGIN
readln(n);
read(s);
j:=0;
for i:=1 to n do begin
if (s[i]='B')and(i=1) then begin if j=0 then inc(j);
inc(a[j]);
end;
if (s[i]='B')and(s[i-1]='W') then begin inc(j);
inc(a[j]);
end;
if (s[i]='B')and(s[i-1]='B') then inc(a[j]);
end;
writeln(j);
for i:=1 to j do
write(a[i],' ');
END.

var s:string;
i,j,n,k,i1:longint;
a:array[1..10000]of longint;
begin
   readln(n);
    readln(s);
i:=1;
      while i<=n do
     if s[i]='B' then begin
      i1:=i;
      while (i<=n) and(s[i]='B') do
      i:=i+1;
      k:=k+1;
      a[k]:=i-i1;
      end
      else i:=i+1;
  writeln(k);
    for i:=1 to k do
    write(a[i],' ');end.

program ideone;
var
	s:string;
	k,d,i:longint;
	a:array[0..100] of longint;
begin
	readln(s);
	readln(s);
	k:=0;d:=0;
	s:=s+' ';
	for i:=1 to length(s) do
	begin
		if s[i]<>'B' then d:=0;
		if s[i]='B' then d:=d+1;
		if (s[i]='B') and (s[i+1]<>'B') then
		begin
			k:=k+1;
			a[k]:=d;
			d:=0;
		end;
	end;
	writeln(k);
	for i:=1 to k do write(a[i],' ');
end.

var st:string;
d,k,j,n,i:byte;
begin
 readln(n);
 readln(st);
 i:=1;
 k:=0;
 if st[1]='B' then
 k:=k+1;
 for i:=2 to length(st) do
  if (st[i]='B') and (st[i-1]='W') then
  k:=k+1;
  writeln(k);
  j:=1;
  i:=1;
  while i<= k do
  begin
  while st[j]='B' do
  begin
  d:=d+1;
  if j<length(st) then
  j:=j+1
  else break;
  end;
   while st[j]='W' do
  begin
  if j<length(st) then
  j:=j+1
  else break;
  end;
  if d<>0 then
  begin
  write(d,' ');
  i:=i+1;
  end;
  d:=0;
  end;
 end.

var
  n,uk,t,i:integer;st:string;a:array[1..1000] of integer;
begin
  readln(n);
  read(st);uk:=0;t:=0;st:=st+'W';
  for i:=1 to length(st) do
    if (st[i]='B') then inc(uk) else if (uk>0) then begin
                                                     inc(t);a[t]:=uk;uk:=0;
                                     end;
    writeln(t);
  for i:=1 to t do
    write(a[i],' ');
end.

Var a:array[1..1000]of longint;
    n,i,j,k:longint;
    t:string;
Begin
     readln(n);
     readln(t);
     k:=0;
     j:=0;
     n:=n+1;
     t:=t+'W';
     For i:=1 to n do
     if t[i]='B' then k:=k+1
     else if k<>0 then begin
                       j:=j+1;
                       a[j]:=k;
                       k:=0;
                       end;
     writeln(j);
     For i:=1 to j do
     writeln(a[i]);
end.

var
otv:array[1..100000]of longint;

ans,n,j,i:longint;
s:string;
begin
readln(n);
readln(s);
while i<=length(s) do begin
inc(i);
    if s[i]='B' then begin
        j:=i;
        while s[j]='B' do inc(j);
        inc(ans);
        otv[ans]:=j-i;
        i:=j;
    end;

end;
writeln(ans);
for i:=1 to ans do write(otv[i],' ');
end.

{$mode objfpc}

const
 inputfile='';
 outputfile='';
 maxn=150;

var
 fi,fo:text;
 n:longint;
 s:ansistring;
 top,x:longint;
 a:array[0..maxn] of longint;
 i:longint;

procedure openf;
begin
 assign(fi,inputfile);
 reset(fi);
 assign(fo,outputfile);
 rewrite(fo);
end;

procedure input;
begin
 readln(fi,n);
 read(fi,s);
end;

procedure process;
begin
 fillchar(a,sizeof(a),0);
 top:=1;
 i:=1;
 while (s[i]='W') and (length(s)>1) do delete(s,1,1);
 if (length(s)=1) and (s[1]='W') then exit;
 for i:=1 to length(s) do
  begin
   if s[i]='B' then inc(a[top]);
   if (s[i]='W') and (s[i-1]='B') then inc(top);
  end;
end;

procedure output;
begin
 if (length(s)=1) and (s[1]='W') then
  begin
   write(fo,0);
   exit;
  end;
 if s[length(s)]='W' then x:=top-1 else x:=top;
 writeln(fo,x);
 for i:=1 to x do write(fo,a[i],' ');
end;

procedure closef;
begin
 close(fi);
 close(fo);
end;

begin
 openf;
 input;
 process;
 output;
 closef;
end.

var
        st:string;
        n:longint;
        sg:array[1..12345] of longint;
        numg:longint;
procedure input;
        var i,j,k:longint;
        begin
                readln(n);
                readln(st);
                if (pos('B',st)=0) then
                 begin
                        write(0);
                        exit;
                 end;
                while (st[1]='W') do delete(st,1,1);
                while (st[length(st)]='W') do delete(st,length(st),1);
                while (pos('WW',st)>0) do delete(st,pos('WW',st),1);
                if (st='') then
                 begin
                  write(0);
                  exit;
                 end;
                j:=0;
                k:=0;
                st[length(st)+1]:='W';
                for i:=1 to length(st)+1 do
                        if (st[i]='B') then inc(j)
                         else
                          begin
                                inc(k);
                                sg[k]:=j;
                                j:=0;
                          end;
                writeln(k);
                for i:=1 to k do
                        write(sg[i],' ');
        end;
begin
        input;
end.

type mas = array [1..51] of longint;

procedure encryption(n:longint; s:string; var k:longint; var nums:mas);
var i,j:longint;
begin
    i:=1;
    k:=0;
    while i <= n do begin
        if s[i] = 'B' then begin
            j:=i;
            while (j <= n) and (s[j] = 'B') do
                inc(j);
            inc(k);
            nums[k]:=j-i;
            i:=j+1;
        end else
            inc(i);
    end;
end;

procedure write_mas(k:longint; const nums:mas);
var i:longint;
begin
    for i:=1 to k do
        write(nums[i],' ')
end;

var
    n,k:longint;
    s:string;
    nums:mas;
begin
    readln(n);
    readln(s);
    encryption(n,s,k,nums);
    writeln(k);
    write_mas(k,nums);
end.

program A721;
var j,z,i,n,k: longint;
    a: array [1..100] of char;
    b: array [1..100] of byte;
begin
z:=0;
j:=1;
readln (n);
for i:=1 to n do read (a[i]);
for i:=1 to n do
    begin
    if a[i]='B' then z:=z+1;
    if ((a[i]='W') and (a[i-1]='B')) or ((a[i]='B') and (i=n)) then
       begin
       b[j]:=z;
       z:=0;
       j:=j+1;
       end;
    end;
writeln (j-1);
for i:=1 to j-1 do write (b[i], ' ');
end.

Var
i,n,c,d:integer;
s:string;
Begin
  readln(n);
  readln(s);
  c:=0;d:=0;
  for i:=1 to n do
  begin
    if s[i]='B' then c:=c+1
    else if c<>0 then
         begin
          c:=0;
          d:=d+1;
         end;
  end;
  if c<>0 then d:=d+1;
  Writeln(d);
  c:=0;

  for i:=1 to n do
  begin
    if s[i]='B' then c:=c+1
    else if c<>0 then
         begin
          write(c,' ');
          c:=0;
          d:=d+1;
         end;
  end;
  if c<>0 then begin d:=d+1; write(c,' '); end;
End.

var s:string;
    n,i,j,d:longint;
    a:array[0..300] of longint;
begin
        readln(n);
        read(s);
        d:=0;
        j:=1;
        s:='W'+s;
        s:=s+'W';
        for i:= 2 to n+1 do
           begin
              if (s[i]='B') and (s[i+1]='W') then
                    d:=d+1;
              if s[i]='B' then a[j]:=a[j]+1;
              if (s[i]='B') and (s[i+1]='W') then j:=j+1;
           end;
       if d<>0 then
          begin
             writeln(d);
             for i:= 1 to j-1 do
                 write(a[i],' ');
          end
             else write(0);
end.

var
an : array[1..100] of integer;
g : array[1..100] of char;
I,h,j,o,count : integer;
 begin
 readln(o);
for I:=1 to o do
  read(g[I]);
I:=0;
 repeat
   I:=I+1;
   if g[I]='B' then
       begin
         count:=count+1;
       repeat
         an[count]:=an[count]+1;
         I:=I+1;
         until (g[I]='W') or (I>o)
         end;
   until I>o ;
   writeln(count);
   for I:=1 to count do
         write(an[I],' ')
   end.

program O_O;
 var
  i,j,k,n:longint;
  a:array[0..102] of longint;
  s:string;
begin
  readln(n);
  readln(s);
  s:=s+'.';
  for i:=1 to length(S) do
   if s[i]='B' then inc(k) else
    if k>0 then
     begin
      inc(j);
      a[j]:=k;
      k:=0;
     end;
  writeln(j);
  for i:=1 to j do write(a[i],' ');
end.

var n,t,i:longint;
    s:ansistring;
    a:array[1..1000]of longint;
begin
  readln(n);
  readln(s);
  for i:=1 to n do
    if (s[i]='B')and((i=1)or(s[i-1]<>'B')) then
    begin
      inc(t);
      a[t]:=1;
    end
    else
    if (s[i]='B')and(i<>1)and(s[i-1]='B') then
      inc(a[t]);
  writeln(t);
  for i:=1 to t do
    write(a[i],' ');
end.

var n, i  : byte;
    s     : string;
    groups: array[1..50] of byte;

BEGIN
   readln(n);
   readln(s);

   i:= 0;
   s:= s + '0';
   fillchar(groups, sizeof(groups), 0);
   repeat
      while s[1] = 'W' do delete(s, 1, 1);

      if s[1] = 'B' then
         begin
            inc(i);
            repeat
               inc(groups[i]);
               delete(s, 1, 1);
            until s[1] <> 'B';
         end;
   until s = '0';

   writeln(i);
   if i > 0 then
      for n:= 1 to i do write(groups[n], ' ');

   readln;
END.

var
 a:ansistring;
 n,i,k,stn:longint;
 st:array[1..1000000]of longint;
begin
 readln(n);
 readln(a);
 a:=a+'#';
 for i:=1 to n+1 do if a[i]='B' then inc(k) else if k>0 then
 begin
  inc(stn);
  st[stn]:=k;
  k:=0;
 end;
 writeln(stn);
 for i:=1 to stn-1 do write(st[i],' ');
 if stn>0 then writeln(st[stn]);

end.

{$H+}
var s: string;
	n, i, k: integer;
	a: array [1..1000] of integer;
BEGIN
	readln(n);
	readln(s);
	fillchar(a, sizeof(a), 0);
	k := 0;
	if (s[1] = 'B') then
		begin
			inc(k);
			inc(a[k]);
		end;
	for i := 2 to n do
		begin
			if (s[i] = 'B') then
				begin
					if (s[i - 1] <> 'B') then
						begin
							inc(k);
							inc(a[k]);
						end
						else inc(a[k]);
				end;
		end;
	writeln(k);
	for i := 1 to k do
		write(a[i], ' ');
END.

var
n,i,k,h,m,j:integer;
a:array[1..100] of integer;
s:string;
begin
readln(n);
readln(s);
s:='W'+s+'W';
i:=1;
h:=1;
n:=n+2;
while i<=n do
if (s[i]='B') and (s[i-1]='W')
then begin
     m:=0;
     for j:=i to n do
     if s[j]='B'
        then inc(m)
        else break;
     i:=j;
     inc(k);
     a[h]:=m;
     inc(h);
     end
else inc(i);
writeln(k);
for i:=1 to h-1 do
write(a[i]:5);
end.

var
n,i,kol,ans:longint;
a:array[1..100000]of longint;
s:ansiString;
begin
readln(n);
readln(s);
for i:=1 to length(s) do begin
    if s[i]='B' then begin
        inc(kol);
    end
    else begin
        if kol>0 then begin
            inc(ans);
            a[ans]:=kol;
            kol:=0;
        end;
    end;
end;
if kol>0 then begin
    inc(Ans);
    a[ans]:=kol;
end;
writeln(ans);
for i:=1 to ans do write(a[i],' ');
end.

program zxc;
var n,i,k,z,l:integer;
a:array[1..50] of integer;
s:string;
begin
readln(n);
readln(s);
k:=0;
z:=0;
l:=1;
s:='W'+s;
s:=s+'W';
for i:=2 to n+2 do begin
if (s[i]='B') and (s[i-1]='W') then begin
k:=k+1; z:=z+1; end;
if s[i]='W' then begin
if z>0 then begin; a[l]:=z; l:=l+1; end;
z:=0; end;
if (s[i]='B') and (s[i-1]='B') then z:=z+1;
end;
writeln(k);
for i:=1 to l-1 do
write(a[i],' ');
end.

var b:array[0..1000] of longint;
st:string;
n,i,q,q2,s,kl,kol:longint;
begin
  readln(n);
  readln(st);

  for i:=1 to n do
    if st[i]='B' then begin
                        kl:=1;
                        break;
                      end;
  if kl=0 then begin
                 writeln(0);
                 halt;
               end;
  while true do
    BEGIN
      q:=q+1;
      if st[q]='B' then begin
                          s:=0;
                          for i:=q to n do
                            if st[i]='B' then s:=s+1
                                         else break;
                          kol:=kol+1;
                          q2:=q2+1;
                          b[q2]:=s;
                          q:=i;
                        end;
      if q=n then break;
    END;
  writeln(q2);
  for i:=1 to q2 do
    write(b[i],' ');
end.

var n,part,count,i:byte;
    s:string;
begin
        readln(n);
        read(s);
        for i:=1 to length(s) do
        begin
                if (s[i]<>s[i-1]) and (s[i]='B') then part:=part+1;
        end;
        writeln(part);
        for i:=1 to length(s)+1 do
        begin
            if s[i]='B' then inc(count);
            if (s[i]<>'B') and (s[i-1]='B') then
            begin
                write(count,' ');
                count:=0;
            end;
        end;
        readln;
end.

var n,m,i,j,ans:longint;
    a:array[0..1000]of longint;
    s:string;
begin
readln(n);
readln(s);s:=s+'W';
for i:=1 to n+1 do begin
  if s[i]='W' then begin
    if j>0 then BEGIN inc(ans);a[ans]:=j;END;j:=0;
  end else inc(j);
end;
writeln(ans);
for i:=1 to ans do write(a[i],' ');
end.

const    fi = '721a.inp';
         fo = '721a.out';
         maxn = 1005;
var
   n:longint;
   s:string;
   a:array[1..maxn]of longint;

procedure enter;
var   i:longint;
begin
   readln(n);
   readln(s);
end;

procedure solve;
var   i,j,r:longint;
begin
   i:=1;r:=0;
   while(i<=n)do
   begin
      while(i<=n)and(s[i]='W')do inc(i);
      if i>n then break;
      j:=i;
      while(j<=n)and(s[j]='B')do inc(j);
      inc(r); a[r]:=j-i;
      i:=j;
   end;
   writeln(r);
   for i:=1 to r do write(a[i],' ');
end;

BEGIN
 //  assign(input,fi); reset(input);
  // assign(output,fo); rewrite(output);
   enter;
   solve;
   close(input); close(output);
END.

var s:string;
i,n:integer;
k:array[1..100]of integer;
begin
     readln(n);
     readln(s);
     i:=1;
     n:=0;
     while i <= length(s) do
     begin
          if s[i]='B'then
          begin
             n:=n+1;
             while s[i]='B' do
             begin
                   k[n]:=k[n]+1;
                   i:=i+1;
             end;
          end;
          i:=i+1;
     end;
     writeln(n);
     for i:=1 to n do
         write(k[i],' ');
end.

var n,k,i,z:integer; s: string;
begin
readln(n);
readln(s) ;
k:=0; z:=0;

for i:=1 to n+1 do
if s[i]='B' then k:=k+1 else if k>0 then begin z:=z+1; k:=0; end;

writeln(z);

for i:=1 to n+1 do
 if s[i]='B' then k:=k+1 else if k>0 then begin write(k,' ');k:=0; end;

end.

{$mode objfpc}

var
  i,n:integer;
  s:array[0..200] of char;
  kq:integer;
  a:array[0..200] of integer;

begin
//gsdfnhgsdfnobn
//aidgjbdoasjbnonas
//kibhfornsb
//aipdfbn oiadnionbn
  readln(n);
  //fibohaeuofnbion
  for i:=1 to n do read(s[i]);
  //sifbhjidfnbn
  s[0]:='W';
  for i:=1 to n do
    begin
      if (s[i-1] = 'W') and (s[i] = 'B') then inc(kq);
      if s[i] = 'B' then inc(a[kq]);
    end;
  writeln(kq);
  for i:=1 to kq do write(a[i],' ');
end.

var n, i, k:byte; s:array [0..100] of char; a:array [1..100] of byte;
begin
 readln(n);
 for i:=1 to n do
  read(s[i]);
 k:=0;
 for i:=1 to n do
  if s[i]='B' then begin
   if s[i-1]<>'B' then k:=k+1;
   a[k]:=a[k]+1;
  end;
 writeln(k);
 for i:=1 to k do
  write(a[i],' ');
 end.

var s:array[0..100] of char;
    ans:array[0..10000] of longint;
    i,j,sum,n:longint;
begin
  readln(n);
  for i:=1 to n do read(s[i]);
  for i:=1 to n do
  if s[i]='B' then
  begin
    j:=i;
    inc(sum);
    while s[j]='B' do
    begin
      inc(ans[sum]);
      s[j]:='W';
      inc(j);
    end;
  end;
  writeln(sum);
  if sum>0 then
  begin
    for i:=1 to sum do write(ans[i],' ');
    writeln;
  end;
end.

var i,n,m,c:byte;a:array[1..100] of byte;
s:string;
begin
   readln(n);
   read(s);
   c:=0;
   m:=0;
   inc(n);
   s:=s+'e';
   for i:=1 to n do
    begin
        if s[i]='B' then inc(c)
        else
        begin
        	if c>0 then
            begin
            inc(m);
            a[m]:=c;
            end;
            c:=0;
        end;
    end;
   writeln(m);
    for i:=1 to m do write(a[i],' ');
end.

var n,i,k,j:integer;
s:string;
a:array [1..100] of byte;
begin
readln(n);
read(s);
j:=0;
for i:=1 to n do
  if s[i]='B' then
  if (i=1) or (s[i-1]='W') then begin inc(k);inc(j);a[j]:=1;end else
  inc(a[j]);
writeln(k);
j:=1;
while(a[j]>0) do begin
 write(a[j],' ');
 inc(j);
 end;
 end.

var q:string; i,j:integer; w:array[0..100]of integer;
begin
readln(i);
readln(q);
w[0]:=1;
for i:=1 to length(q )do
if q[i]='B' then
inc(j) else
begin
if j<>0 then
begin
w[w[0]]:=j;
inc(w[0]);
end;
j:=0;
end;
if j<>0 then
begin
w[w[0]]:=j;
inc(w[0]);
end;
writeln(w[0]-1);
For i:=1   To  w[0]-1 Do Write(w[i],' ');
end.

var n,i,k,j,k1:longint;
    s:string;
    a:array[1..100] of longint;
BEGIN
readln(n);
readln(s);
k:=0;j:=1;k1:=0;
for i:=1 to n do
 begin
 if s[i]='B' then
  begin
  inc(k);
  inc(k1);
  end
             else
  begin
  a[j]:=k;
  inc(j);
  k:=0;
  end;
 if i=n then a[j]:=k;
 end;

k1:=0;
for i:=1 to n do
 if a[i]>0 then inc(k1);
 writeln(k1);
for i:=1 to n do
 if a[i]>0 then write(a[i],' ');
END.

var n,i,k,j:integer;
    s:string;
    a:array [1..100] of byte;
begin
     readln(n);
     read(s);
     j:=0;
     for i:=1 to n do
      if s[i]='B' then
       if (i=1) or (s[i-1]='W') then
       begin
            inc(k);inc(j);
            a[j]:=1;
       end
      else inc(a[j]);
     writeln(k);
     j:=1;
     while(a[j]>0) do
     begin
          write(a[j],' ');
          inc(j);
     end;
end.

var
  i, j, n, m: integer;
  c, s: string;
begin
     readln(n);
     read(s); c := s + ' ';
     for i := 1 to n do
          if upcase(c[i]) = upcase(c[i + 1]) then c[i] := 'W';
     for i := 1 to n do
          if upcase(c[i]) = 'B' then inc(m);
     writeln(m); m := 0; s += 'W';
     for i := 1 to n + 1 do
          begin
          if (j = 1) and (upcase(s[i]) <> 'B') then begin write(m, ' '); m := 0; j := 0; end;
          if upcase(s[i]) = 'B' then begin j := 1; inc(m); end;
          end;
end.

 label 1;
 var  s:string;n,i,kn,sc:integer;a:array[1..55]of integer;c:char;
begin
 readln(n);
 readln(s);
 For i:=1 to n do
  begin
   c:=s[i];
   if(c='B')and(kn=0)
    then begin
          sc:=sc+1;
          a[sc]:=1;
          kn:=1;
          goto 1;
         end;
   if(c='B')and(kn=1)
    then a[sc]:=a[sc]+1;
   if(c='W')and(kn=1)
   then kn:=0;
  1:end;
 writeln(sc);
 for i:=1 to sc do
  write(a[i],' ');
end.

var
  i, a, ok, v, j, n, b, x, c: integer;
  s: string;

begin
  readln(n);
  readln(s);

  s:=s+'W';

  for i := 1 to n+1 do
    if s[i] = 'B' then b := b + 1
    else
      if b>0 then
      begin
        x:=x+1;
        b:=0;
      end;

  writeln(x);

  for i := 1 to n+1 do
    if s[i] = 'B' then b := b + 1
    else
      if b>0 then
      begin
        write(b,' ');
        b:=0;
      end;

end.

var kolvoch, i, n, k, l : Integer;
              s : String;
            a : array of Integer;
begin
  readln(n);
  readln(s);
  s := s + 'W';
  Inc(n);
  For i := 2 to n do If (s[i] <> s[i - 1]) and (s[i - 1] = 'B') then inc(kolvoch);
  If kolvoch = 0 then begin
                        writeln(0);
                        exit;
                      end;
  //writeln(kolvoch);
  Setlength(a,kolvoch + 1);
  k := 0;
  l := 1;
  For i := 1 to n do
    begin
      If s[i] = 'B' then inc(k)
                    else if k > 0 then begin
                                        //writeln(l);
                                        a[l] := k;
                                        k := 0;
                                        inc(l);
                                      end;
    end;
  writeln(kolvoch);
  write(a[1]);
  For i := 2 to kolvoch do write(' ',a[i]);
end.

Var
    n, Ans: Int64;
    S: String;
    a: Array [0..99] of Int64;

Begin
    Readln(n);
    Readln(S);
    For Var i := 1 to n do
        If S[i] = 'B' then
            a[Ans] += 1
        Else
            Ans += 1;
    Ans := 0;
    For Var i := 0 to 99 do
        If a[i] <> 0 then
            Ans += 1;
    Writeln(Ans);
    For Var i := 0 to 99 do
        If a[i] <> 0 then
            Write(a[i], ' ');
End.

var
i,n,j:integer;
s:string;
f:boolean;
a:array [1..50] of integer;
begin
readln(n);
f:=false;
read(s);
j:=1;
for i:=1 to n do
if s[i]='B' then begin f:=true; inc(a[j]); end else if a[j]<>0 then
inc(j);
if s[n]='W' then dec(j);
writeln(j);
for i:=1 to j do
write(a[i],' ');

end.

var
  i, a, ok, v, j, n, b, x, c: integer;
  s: string;

begin
  readln(n);
  readln(s);
  s := s + 'W';
  for i := 1 to n + 1 do
    if s[i] = 'B' then b := b + 1
    else
    if b > 0 then
    begin
      x := x + 1;
      b := 0;
    end;
  writeln(x);
  for i := 1 to n + 1 do
    if s[i] = 'B' then b := b + 1
    else
    if b > 0 then
    begin
      write(b, ' ');
      b := 0;
    end;
end.

uses strutils;

      const  eps=1e-11;  besk=8000000000000000000;
    modul=1000000007;
   label 1,2,3,4,11;
    type

    mas=array [-10000..1000000] of int64;   point=record x,y,z:real;end;
    zap=record p1,p2,p3 :int64;end; zap1=^zap;
    mass=array[-10000..10000000] of int64;mass1=^mass;
    var aa,bb,olda1,olda2,ot,q1,aa2,bb2,aa1,bb1,t,t0,t1,p,kol,i1,j1,newdl,dl,kk,t2,m1,n1,pp,px,py,ll,cc,n2,dist,pos,dloch,x0,tt,v1,v2,p3,p4,t4,t5,t6,t3,xx,yy,ost,rr,q,h,n,qq,p1,p2,y0,s1,s2,m,imax,smin,besk1:int64;
     ii,jj,step,k,i,j:longint;
     c1,c2:array[-1000..100000] of int64;
     x,y:array[-10..65000] of int64;
     h1,h2:extended;
    dd,dd1,dd2,newoch,sum,ugol,s,place,xnew,z,och,fact,d, a1,bl,br,c,a,b:array[-10000001..3000000] of int64;
    stoim:array[-10..1200,-10..1200] of int64;
    ss,ss1,ss2 :string;
    grr:array[-100..5000,-100..5000] of boolean;
    ssot:array[-100..10000] of char;
    ch: char;
    ppp:zap;
    de,de1,gr,pole,pole1:array[-10..1400,-10..1400] of int64;
  prost, zan,marked:array[-1000001..1100000] of boolean;
    sss1,name1,name2,sp,sss,maxpr:array[0..1000000] of string;
  w,mm,nn,mm1,nn1,hh,ttt, l, aanew,v0,s0:extended;

    prvin,prlost,prob,x1,y1, xxx,yyy:array[-1..1000000] of extended;
   tt1, xxnew,per,pp2, ee,yot:double;
       flagg,flag2,flag,flag1:boolean;
    function al(x,y:real):real; var t0,t1,p,s0,s1:real;
 begin
     if (x>0)and(y>=0) then p:=arctan(y/x);
     if x<0 then p:=pi+arctan(y/x);
     if(x>0)and(y<0) then p:=2*pi+arctan(y/x);
     if x=0 then if (y>=0) then p:=pi/2 else p:=3*pi/2;
     al:=p;
 end;
  function min(x,y:int64):int64;begin min:=x;if y<x then min:=y; end;
  function max(x,y:int64):int64;begin max:=x;if y>x then max:=y; end;

  function nod(x,y:int64):int64; var z:int64;
begin   repeat  z:=x mod y;x:=y;y:=z;   until  z=0 ;  nod:=x;end;

  function evkl(a,b:int64):zap1; var aa,bb,qq,d,x,y,r,q,i,j,k,x1,x2,y1,y2:int64;
  tt:zap; tt1:zap1;
begin
  aa:=a;bb:=b;
  if a<b then begin r:=a;a:=b;b:=r; end;
  x2:=1;x1:=0;y2:=0;y1:=1; qq:=0;
  while b>0 do
    begin q:=a div b; r:=a mod b; x:=x2-q*x1;y:=y2-q*y1;
          a:=b;b:=r;x2:=x1;x1:=x;y2:=y1;y1:=y;
    end;
    d:=a; x:=x2;y:=y2;
  flag:=x*aa+y*bb=d;
    if flag then begin tt.p1:=d;tt.p2:=x;tt.p3:=y; tt1:=@tt; end;
  flag:=x*bb+y*aa=d;
    if flag then begin tt.p1:=d;tt.p2:=y;tt.p3:=x; tt1:=@tt; end;

   evkl:=tt1;
end;

function degg(modul,a:int64;k:int64):int64; var p:int64;
begin
 if k<=0 then degg:=1 else if odd(k) then degg:=(degg(modul,a,k-1)*a) mod modul  else
   begin  p:=degg(modul,a,k div 2); degg:=(p*p) mod modul;    end;

end;

begin
 { assign (input,'input.txt');reset(input);
   assign (output,'output.txt'); rewrite(output);
  }
  readln(n);
  read(ss);
  for i:=1 to n do
    begin
       if (ss[i]='B')and(ss[i]<>ss[i-1]) then
         begin  inc(t); a[t]:=1;     end;

       if (ss[i]='B')and(ss[i]=ss[i-1]) then
         begin   a[t]:=1+a[t];     end;

    end;

    writeln(t);
    for i:=1 to t do write(a[i],' ');

  1:               close(output);

end.

{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q-,R+,S+,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE CONSOLE}

const filename='qc';
      oo=maxlongint div 2;
      eps=1e-6;
      eee=1e-21;

var qq,cc,a,aa:array[0..1000000]of longint;
    qc,he:array[0..2014,0..2014]of longint;
    ss,sss:array[0..10000]of string;
    s,s0,s1,s2,s3:string;
    x,y,z,xx,yy,zz,x0,y0,z0,x1,x2,x3,y1,y2,y3,z1,z2,z3:extended;
    res64,n64,nn64:int64;
    w,nt,ii,jj,n,m,q,c,q0,c0,q1,c1,q2,c2,q3,c3:longint;
    nn,mm,kk,u,v,res,cur,max,min:longint;
    test,ll,t,tt:longint;
    b,bb,bbb,b0,b1,b2,b3:boolean;
    ccc:char;

function mx(q,c:longint):longint;
  begin
  if q>c then mx:=q else mx:=c;
  end;

function mn(q,c:longint):longint;
  begin
  if q<c then mn:=q else mn:=c;
  end;

procedure init;
  begin
  assign(input,filename+'.in');
  assign(output,filename+'.out');
  reset(input);
  rewrite(output);
  end;

procedure fin;
  begin
  close(input);
  close(output);
  end;

procedure clear;
var i,j,k:longint;
  begin
  fillchar(qc,sizeof(qc),0);
  end;

procedure load;
var i,j,k:longint;
  begin
  end;

procedure save;
var i,j,k:longint;
  begin
  end;

procedure swap(var q,c:longint);
var i:longint;
    begin
    i:=q; q:=c; c:=i;
    end;

procedure qcsort(q,c:longint);
var h,e,d,x:longint;
    ass:boolean;
    begin
    if q>=c then exit;
    x:=q+random(c-q+1);
    swap(qc[q,0],qc[x,0]);
    swap(qc[q,1],qc[x,1]);
    h:=q; e:=c; d:=1;
    while h+d<=e do
      begin
      if qc[h,0]=qc[h+d,0] then inc(d) else
      if qc[h,0]<qc[h+d,0] then
        begin swap(qc[h+d,0],qc[e,0]); swap(qc[h+d,1],qc[e,1]); dec(e); end
      else begin swap(qc[h,0],qc[h+d,0]); swap(qc[h,1],qc[h+d,1]); inc(h); end
      end;
    qcsort(q,h-1);
    qcsort(h+d,c);
    end;

procedure qqcsort(q,c:longint);
var h,e,d,x:longint;
    ass:boolean;
    begin
    if q>=c then exit;
    x:=q+random(c-q+1);
    swap(qq[q],qq[x]);
    h:=q; e:=c; d:=1;
    while h+d<=e do
      begin
      if qq[h]=qq[h+d] then inc(d) else
      if qq[h]<qq[h+d] then
        begin swap(qq[h+d],qq[e]); dec(e); end
      else begin swap(qq[h],qq[h+d]); inc(h); end
      end;
    qqcsort(q,h-1);
    qqcsort(h+d,c);
    end;

procedure run;
var i,j,k:longint;
  begin
  //init;
  readln(n);
  readln(s);
  s:='W'+s+'WWWWWWWWWWWWWWWW';
  res:=0; i:=1;
  while (i<12+n)and(s[i]='W') do inc(i);
  while i<10+n do
    begin
    k:=0;
    while s[i]='B' do begin inc(k); inc(i); end;
    inc(res);
    qq[res]:=k;
    while (i<12+n)and(s[i]='W') do inc(i);
    end;
  writeln(res);
  for i:=1 to res do write(qq[i],' ');
  //fin;
  end;

begin
nt:=1;
//readln(nt);
for test:=1 to nt do
  begin
  clear;
  load;
  run;
  save;
  end;
end.

var n, i  : byte;
    s     : string;
    groups: array[1..50] of byte;

BEGIN
   readln(n);
   readln(s);

   i:= 0;
   s:= s + '0';
   fillchar(groups, sizeof(groups), 0);
   repeat
      while s[1] = 'W' do delete(s, 1, 1);

      if s[1] = 'B' then
         begin
            inc(i);
            repeat
               inc(groups[i]);
               delete(s, 1, 1);
            until s[1] <> 'B';
         end;
   until s = '0';

   writeln(i);
   if i = 0 then writeln(0)
   else
      for n:= 1 to i do write(groups[n], ' ');

   readln;
END.

var
 a:ansistring;
 n,i,k,stn:longint;
 st:array[1..1000000]of longint;
begin
 readln(n);
 readln(a);
 a:=a+'#';
 for i:=1 to n+1 do if a[i]='B' then inc(k) else if k>0 then
 begin
  inc(stn);
  st[stn]:=k;
  k:=0;
 end;
 writeln(stn);
 for i:=1 to stn-1 do write(st[i],' ');
 writeln(st[stn]);

end.

var s:string;
    n,j,i,min,max:longint;
    t:array ['a'..'z'] of longint
    = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26);
begin
  readln(s);
  n:=0;
  j:=t['a'];
  for i:=1 to length(s) do
    begin
      if j < t[s[i]] then begin min:=j; max:=t[s[i]]; end
        else begin min:=t[s[i]]; max:=j; end;

      if max-min < 26-max+min then n:=n+max-min
        else n:=n+26-max+min;
      j:=t[s[i]];    // writeln(j,' ',n);
    end;

  writeln(n);
end.

{$H+}
var s: string;
	n, i, k: integer;
	a: array [1..1000] of integer;
BEGIN
	readln(n);
	readln(s);
	k := 0;
	if (s[1] = 'B') then
		begin
			inc(k);
			inc(a[k]);
		end;
	for i := 2 to n do
		begin
			if (s[i] = 'B') then
				begin
					if (s[i - 1] <> 'B') then
						begin
							inc(k);
							inc(a[k]);
						end
						else inc(a[k]);
				end;
		end;
	writeln(k);
	for i := 1 to k do
		write(a[k], ' ');
END.

var
n,i,k,h,m,j:integer;
a:array[1..100] of integer;
s:string;
begin
readln(n);
readln(s);
s:='W'+s+'W';
i:=1;
h:=1;
n:=n+2;
while i<=n do
if (s[i]='B') and (s[i-1]='W')
then begin
     m:=0;
     for j:=i to n do
     if s[j]='B'
        then inc(m)
        else break;
     i:=j;
     inc(k);
     a[h]:=m;
     inc(h);
     end
else inc(i);
writeln(k);
for i:=1 to h-1 do
write(a[i]:2);
end.

var a:char;
    i,n,count:longint;
    flag:boolean;

begin
 readln(n);
 count:=0;
 flag:=true;
 for i:=1 to n do begin
   read(a);
   if a='B' then
    inc(count)
   else
    if (a='W') and (count>0) then begin
      write(count,' ');
      count:=0;
      flag:=false;
    end;
 end;
 if (count>0) or (flag=true) then
   writeln(count);
end.

var a:char;
    i,n,count:longint;
    arr:array[1..100] of integer;
//    flag:boolean;

begin
 readln(n);
 count:=1;
 //flag:=true;
 for i:=1 to n do begin
   read(a);
   if a='B' then
    inc(arr[count])
   else
    if (a='W') and (arr[count]>0) then begin
     // write(arr[count],' ');
      count:=count+1;
      //flag:=false;
    end;
 end;
 if (arr[count]=0) then
  dec(count);
  writeln(count);
 for i:=1 to count do
  write(arr[count],' ');
end.

program abc;
var a:array[1..100]of integer;
c:string;
i,n,b,z:integer;
begin
  readln(n);
  b:=1;
  readln(c);
  for i:=1 to n do begin
    if (c[i]='W')and(a[b]>0) then begin
      b:=b+1;
      z:=z+1; end else
    if c[i]='B' then
      a[b]:=a[b]+1;
  end;
if c[i]='B' then z:=z+1;
writeln(z);
write(a[1]);
i:=2;
while a[i]<>0 do begin
write(' ',a[i]);
i:=i+1;
end;
end.

var n,k,i,z:integer; a:array [1..101] of string;
begin
readln(n);
k:=0; z:=0;

for i:=1 to n do begin
 read(a[i]);
end;
 a[n+1]:='W';
for i:=1 to n+1 do
if a[i]='B' then k:=k+1 else if k>0 then begin z:=z+1; k:=0; end;

writeln(z);

for i:=1 to n+1 do
 if a[i]='B' then k:=k+1 else if k>0 then begin write(k,' ');k:=0; end;

end.

var
	n,cnt : longint;
	s : string;
begin
	readln(n);
	readln(s);
	if pos('B',s) = 0 then begin
		writeln(0);
		exit;
	end;
	cnt := 0;
	while length(s) <> 0 do begin
		cnt := 0;
		while s[1] = 'B' do begin
			delete(s,1,1);
			inc(cnt);
			if length(s) = 0 then break;
		end;
		if (cnt <> 0) and (pos('B',s) <> 0) then write(cnt,' ')
		else if (cnt <> 0) then write(cnt);
		if length(s) = 0 then break;
		while s[1] = 'W' do begin
			delete(s,1,1);
			if length(s) = 0 then break;
		end;
		if length(s) = 0 then break;
	end;
	writeln;
end.

uses math;
var f,g:text; s:string; i,j,n,d1,d2,t:longint; A:array[1..100] of longint;
begin
    assign(f,''); reset(f);
    assign(g,''); rewrite(g);
    readln(f,n); read(f,s); t:=1;
    for i:=1 to n do
    begin
        if (s[i]='B') and ((s[i-1]='W') or (i=1)) then
        begin
            inc(d1);
            inc(d2);
        end
        else if (s[i]='B') and (s[i-1]='B') then inc(d2)
        else if (s[i]='W') and (s[i-1]='B') then
        begin
            A[t]:=d2;
            inc(t);
            d2:=0;
        end;
    end;
    if d1=0 then write(g,0)
    else
    begin
        writeln(g,d1);
        for i:=1 to t-1 do write(g,A[i],' ');
    end; close(f); close(g);
end.

uses math;
var f,g:text; s:string; i,j,n,d1,d2,t:longint; A:array[1..100] of longint;
begin
    assign(f,''); reset(f);
    assign(g,''); rewrite(g);
    readln(f,n); read(f,s); t:=1;
    for i:=1 to n do
    begin
        if (s[i]='B') and (s[i-1]='W') then
        begin
            inc(d1);
            inc(d2);
        end
        else if (s[i]='B') and (s[i-1]='B') then inc(d2)
        else if (s[i]='W') and (s[i-1]='B') then
        begin
            A[t]:=d2;
            inc(t);
            d2:=0;
        end;
    end;
    if d1=0 then write(g,0)
    else
    begin
        writeln(g,d1);
        for i:=1 to t do write(g,A[i],' ');
    end; close(f); close(g);
end.

uses math;
var f,g:text; s:string; i,j,n,d1,d2,t:longint; A:array[1..100] of longint;
begin
    assign(f,''); reset(f);
    assign(g,''); rewrite(g);
    readln(f,n); read(f,s); t:=1;
    for i:=1 to n do
    begin
        if (s[i]='B') and ((s[i-1]='W') or (i=1)) then
        begin
            inc(d1);
            inc(d2);
        end
        else if (s[i]='B') and (s[i-1]='B') then inc(d2)
        else if (s[i]='W') and (s[i-1]='B') then
        begin
            A[t]:=d2;
            inc(t);
            d2:=0;
        end;
    end;
    if d1=0 then write(g,0)
    else
    begin
        writeln(g,d1);
        for i:=1 to t do write(g,A[i],' ');
    end; close(f); close(g);
end.

uses math;
var f,g:text; s:string; i,j,n,d1,d2,t:longint; A:array[1..100] of longint;
begin
    assign(f,''); reset(f);
    assign(g,''); rewrite(g);
    readln(f,n); read(f,s); t:=1;
    for i:=1 to n do
    begin
        if (s[i]='B') and ((s[i-1]='W') or (s[i-1]=' ')) then
        begin
            inc(d1);
            inc(d2);
        end
        else if (s[i]='B') and (s[i-1]='B') then inc(d2)
        else if (s[i]='W') and (s[i-1]='B') then
        begin
            A[t]:=d2;
            inc(t);
            d2:=0;
        end;
    end;
    if d1=0 then write(g,0)
    else
    begin
        writeln(g,d1);
        for i:=1 to t do write(g,A[i],' ');
    end; close(f); close(g);
end.

uses math;
var f,g:text; s:string; i,j,n,d1,d2,t:longint; A:array[1..100] of longint;
begin
    assign(f,''); reset(f);
    assign(g,''); rewrite(g);
    readln(f,n); read(f,s); t:=1;
    for i:=1 to n do
    begin
        if (s[i]='B') and ((s[i-1]='W') or (s[i-1]='')) then
        begin
            inc(d1);
            inc(d2);
        end
        else if (s[i]='B') and (s[i-1]='B') then inc(d2)
        else if (s[i]='W') and (s[i-1]='B') then
        begin
            A[t]:=d2;
            inc(t);
            d2:=0;
        end;
    end;
    if d1=0 then write(g,0)
    else
    begin
        writeln(g,d1);
        for i:=1 to t do write(g,A[i],' ');
    end; close(f); close(g);
end.

var n, i, k:byte; s:array [0..100] of char; a:array [1..100] of byte;
begin
 readln(n);
 for i:=1 to n do
  read(s[i]);
 k:=0;
 for i:=1 to n do
  if s[i]='B' then begin
   if s[i-1]<>'B' then k:=k+1;
   a[k]:=a[k]+1;
  end;
 writeln(k);
 for i:=1 to k do
  write(a[k],' ');
 end.

var n,i,k,t:integer;
    a:array[1..100] of integer;
    s:string;

begin
readln(n);
readln(s);
k:=0; t:=0;
for i:=1 to n do
begin
if s[i]='B' then k:=k+1;
if s[i]='W' then
            begin
            if k>0 then t:=t+1;
            if k>0 then a[t]:=k;
            k:=0;
            end;
end;
writeln(t);
for i:=1 to t do write(a[i],' ');
end.

var s:string;
    x:char;
    n,block,len,i:byte;
    a:array [1..100] of byte;
begin
  readln(n);
  s:='';
  block:=0;
  for i:=1 to n do
    begin
      read(x);
      s:=s+x;
      if (x='B') then
        if (i=1) or ((i>1) and (s[i]<>s[i-1])) then
          begin
            inc(block);
            a[block]:=1;
          end
        else inc(a[block]);
    end;
  if block = 0 then write(0) else
    for i:=1 to block do write(a[i],' ');
  readln;
end.

var i,j,m,n,ans,tot:longint;
    num:array[0..105]of longint;
    s:ansistring;
begin
    readln(n);
    readln(s);
    s:='W'+s;
    for i:=2 to length(s) do begin
        if (s[i]='B') and (s[i-1]='W') then begin
            inc(ans);
            tot:=1;
        end else if s[i]='B' then inc(tot) else if (s[i]='W') and (s[i-1]='B') then num[ans]:=tot;

    end;
    writeln(ans);
    for i:=1 to ans-1 do write(num[i],' ');
    if ans>0 then writeln(num[ans]);
end.

var i,j,m,n,ans,tot:longint;
    num:array[0..105]of longint;
    s:ansistring;
begin
    readln(n);
    readln(s);
    s:='W'+s;
    for i:=2 to length(s) do begin
        if (s[i]='B') and (s[i-1]='W') then begin
            inc(ans);
            tot:=1;
        end else if s[i]='B' then inc(tot) else if (s[i]='W') and (s[i-1]='B') then num[ans]:=tot;

    end;
    writeln(ans);
    for i:=1 to ans-1 do write(num[i],' ');
    writeln(num[ans]);
end.

var i,n,m,c:byte;a:array[1..100] of byte;
s:string;
begin
   readln(n);
   read(s);
   c:=0;
   m:=0;
   inc(n);
   s:=s+'e';
   for i:=1 to n do
    begin
        if s[i]='B' then inc(c)
        else
        begin
        	if c>0 then
            begin
            inc(m);
            a[m]:=c;
            end;
            c:=0;
        end;
    end;
    if m>0 then begin writeln(m);
    for i:=1 to m do write(a[i],' '); end else begin writeln(1);write(0) end;
end.

Var s:string;
    i,n,dem,tam :Integer;
    A:array[1..1000]of Longint;

Begin
Readln(n);
Readln(S);dem:=0;tam:=0;
For i:=1 to n do
If (S[i]='W') and (dem<>0) then
    Begin
    Inc(tam);
    A[tam]:=dem;
    End
else Inc(dem);
Writeln(tam);
For i:=1 to tam do
Write(A[i],' ');
End.

Var s:string;
    i,n,dem,tam :Integer;
    A:array[1..1000]of Longint;

Begin
Readln(n);
Readln(S);dem:=0;tam:=0;Insert('W',s,n+1);
For i:=1 to n+1 do
If (S[i]='W') and (dem<>0) then
    Begin
    Inc(tam);
    A[tam]:=dem;
    dem:=0;
    End
else Inc(dem);
Writeln(tam);
For i:=1 to tam do
Write(A[i],' ');
End.

var q:string; i,j:integer;
begin
readln(i);
readln(q);
for i:=1 to length(q )do
if q[i]='B' then
inc(j) else
begin
if j<>0 then write(j);
j:=0;
end;
if j<>0 then write(j);
end.

var
  i, n, v, b, e: integer;
  m, s, s1: string;

begin
  readln(n);
  readln(s);
  s1 := '';

  for i := 1 to n do
    if s[i] = 'B' then
    begin
      val(m, b, e);
      if e = 0 then
        b := b + 1;
      str(b, m);
    end
    else
    if m <> '' then
    begin
      s1 := s1 + m + ' ';
      m := '';
    end;

  if s[n] = 'B' then
    s1 := s1 + m + ' ';
  v := 0;

  for i := 1 to length(s1) do
    if s1[i] = ' ' then
      v := v + 1;

  writeln(v);
  writeln(s1);
end.

var
  i, n, v, b, e: integer;
  m, s, s1: string;

begin
  readln(n);
  readln(s);
  s1 := '';
  m := '0';
  for i := 1 to n do
    if s[i] = 'B' then
    begin
      val(m, b, e);
      if e = 0 then
        b := b + 1;
      str(b, m);
    end
    else
    if m <> '' then
    begin
      s1 := s1 + m + ' ';
      m := '';
    end;
  v := 0;
  for i := 1 to length(s1) do
    if s1[i] = ' ' then
      v := v + 1;
  writeln(v);
  writeln(s1);
end.

{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q-,R+,S+,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE CONSOLE}

const filename='qc';
      oo=maxlongint div 2;
      eps=1e-6;
      eee=1e-21;

var qq,cc,a,aa:array[0..1000000]of longint;
    qc,he:array[0..2014,0..2014]of longint;
    ss,sss:array[0..10000]of string;
    s,s0,s1,s2,s3:string;
    x,y,z,xx,yy,zz,x0,y0,z0,x1,x2,x3,y1,y2,y3,z1,z2,z3:extended;
    res64,n64,nn64:int64;
    w,nt,ii,jj,n,m,q,c,q0,c0,q1,c1,q2,c2,q3,c3:longint;
    nn,mm,kk,u,v,res,cur,max,min:longint;
    test,ll,t,tt:longint;
    b,bb,bbb,b0,b1,b2,b3:boolean;
    ccc:char;

function mx(q,c:longint):longint;
  begin
  if q>c then mx:=q else mx:=c;
  end;

function mn(q,c:longint):longint;
  begin
  if q<c then mn:=q else mn:=c;
  end;

procedure init;
  begin
  assign(input,filename+'.in');
  assign(output,filename+'.out');
  reset(input);
  rewrite(output);
  end;

procedure fin;
  begin
  close(input);
  close(output);
  end;

procedure clear;
var i,j,k:longint;
  begin
  fillchar(qc,sizeof(qc),0);
  end;

procedure load;
var i,j,k:longint;
  begin
  end;

procedure save;
var i,j,k:longint;
  begin
  end;

procedure swap(var q,c:longint);
var i:longint;
    begin
    i:=q; q:=c; c:=i;
    end;

procedure qcsort(q,c:longint);
var h,e,d,x:longint;
    ass:boolean;
    begin
    if q>=c then exit;
    x:=q+random(c-q+1);
    swap(qc[q,0],qc[x,0]);
    swap(qc[q,1],qc[x,1]);
    h:=q; e:=c; d:=1;
    while h+d<=e do
      begin
      if qc[h,0]=qc[h+d,0] then inc(d) else
      if qc[h,0]<qc[h+d,0] then
        begin swap(qc[h+d,0],qc[e,0]); swap(qc[h+d,1],qc[e,1]); dec(e); end
      else begin swap(qc[h,0],qc[h+d,0]); swap(qc[h,1],qc[h+d,1]); inc(h); end
      end;
    qcsort(q,h-1);
    qcsort(h+d,c);
    end;

procedure qqcsort(q,c:longint);
var h,e,d,x:longint;
    ass:boolean;
    begin
    if q>=c then exit;
    x:=q+random(c-q+1);
    swap(qq[q],qq[x]);
    h:=q; e:=c; d:=1;
    while h+d<=e do
      begin
      if qq[h]=qq[h+d] then inc(d) else
      if qq[h]<qq[h+d] then
        begin swap(qq[h+d],qq[e]); dec(e); end
      else begin swap(qq[h],qq[h+d]); inc(h); end
      end;
    qqcsort(q,h-1);
    qqcsort(h+d,c);
    end;

procedure run;
var i,j,k:longint;
  begin
  //init;
  readln(nn);
  readln(s);
  s:='W'+s+'WWWWWWWWWWWWWWWW';
  res:=0; i:=1;
  while (i<12+n)and(s[i]='W') do inc(i);
  while i<10+n do
    begin
    k:=0;
    while s[i]='B' do begin inc(k); inc(i); end;
    inc(res);
    qq[res]:=k;
    while (i<12+n)and(s[i]='W') do inc(i);
    end;
  writeln(res);
  for i:=1 to res do write(qq[i],' ');
  //fin;
  end;

begin
nt:=1;
//readln(nt);
for test:=1 to nt do
  begin
  clear;
  load;
  run;
  save;
  end;
end.

program mirovanie;
var q:char; w:array[1..10000] of integer; z,x:integer;
begin
 x:=1;
 readln(x); x:=1;
 while not eoln do
  begin
   read(q);
   if q='W' then x:=1;
   if q='B' then
    begin
     if x=0 then w[z]:=w[z]+1 else begin z:=z+1;w[z]:=1;x:=1; end;
    end;
  end;
  writeln(z);
  for x:=1 to z do write(w[x],' ');
end.

program mirovanie;
var q:char; w:array[1..10000] of integer; z,x:integer;
begin
 x:=1;
 readln(x); x:=1;
 while not eoln do
  begin
   read(q);
   if q='W' then x:=1;
   if q='B' then
    begin
     if x=0 then w[z]:=w[z]+1 else begin z:=z+1;w[z]:=1; end;
    end;
  end;
  writeln(z);
  for x:=1 to z do write(w[x],' ');
end.

var
a:array[1..1000] of integer;
s:string;
j,g,h,i:longint;
begin
readln(h);
readln(s);
readln(s);
j:=1;
while i<length(s)do begin
inc(i);
if s[i]='B' then  begin
while (s[i]<>'W')and(i<=h) do begin
inc(a[j]);
inc(i);
end;
inc(j);
end;
end;
writeln(j-1);
for i:=1 to j-1 do
if a[i]<>0 then write(a[i],' ');
end.

const a='B';
      b='W';
var n,i,p,k: integer;
    str: string;
    D:array[1..100] of integer;
begin

readln(n);
readln(str);
k:=0;
p:=0;
for i:=1 to n do
begin
  if (str[i]=a) then
  k:=k+1
  else
   if k>0 then
   begin
   D[i]:=k;
   k:=0;
   end;
end;

for i:=1 to n do
begin
 if (d[i]>0) then
 inc(p);
end;
writeln(p);
for i:=1 to n do
begin
 if (d[i]>0) then
 write(D[i],' ');
end;

end.

var a:array[1..100] of longint;
    s:string;
    l,i,n,j,k:longint;
begin
readln(n);
readln(s);
for i:=1 to n do
if s[i]='B' then break else begin Writeln(0); halt; end;
j:=1;
for i:=1 to n do
begin

if s[i]='B' then a[j]:=a[j]+1;
if (s[i]='W') and (i<>n) then j:=j+1;
end;
writeln(j);
for i:=1 to j do write(a[i],' ');
end.

var s:string;
i,a,n,d:longint;
begin
readln(n);
readln(s);
if s[n]='B' then
s:=s+'W';
for i:=1 to length(s) do
begin
if s[i]='B' then inc(a) else begin a:=0; inc(d); end;
end;
writeln(d);
for i:=1 to length(s) do
begin
if s[i]='B' then inc(a) else begin write(a,' '); a:=0;end;
end;
end.

var s:string;
i,a,n,d,q:longint;
begin
readln(n);
readln(s);
if s[n]='B' then
s:=s+'W';
for i:=1 to length(s) do
begin
if s[i]='B' then begin inc(a); q:=1 end else begin a:=0; inc(d); end;
end;
if q = 0 then writeln(0)
else
begin
writeln(d);
a:=0;
for i:=1 to length(s) do
begin
if s[i]='B' then inc(a) else begin write(a,' '); a:=0;end;
end;
end;
end.

{One cross}
var n,i,amount,black: integer;
    str: string;
    D: array[1..100] of integer;
begin
readln(n);
readln(str);
for i:=1 to n do
begin
 if (str[i]='B') then
 black:=black+1
 else
 if black>0 then
  begin
  inc(amount);
  D[amount]:=black;
  black:=0;
  end;
end;
if str[n]='B' then
inc(amount);
D[amount]:=black;
writeln(amount);
for i:=1 to amount do
write(D[i],' ');
readln;
end.

Program p1;
var i, n, k, f:byte;
    a:array [1..100] of char;
    b:array [1..50] of byte;
begin
  readln (n);
  for i:=1 to n do
    read (a[i]);
  f:=0;
  k:=0;
  for i:=1 to n do
    begin
      if a[i]='B' then
        if f=0 then
          begin
            f:=1;
            inc (k);
            b[k]:=1;
          end
        else inc (b[k])
      else f:=0;
    end;
  writeln (k);
  for i:=1 to k-1 do
    write (b[i],' ');
  write (b[k]);
end.

var a:string;
i,n,m,j,i1,hg:integer;
v:array[1..99999]of integer;
begin
hg:=0;
M:=0;
readln(n);
readln(a);
j:=0;
hg:=0;

if a[length(a)]='B' then
 for i:=1 to 9999 do
  if v[i]=0 then
  begin
   v[i]:=1;
   hg:=hg+1;
   break;
  end;

for i:=1 to 9999 do
 begin
  if a[i]='B' then
   hg:=hg+1;

  if a[i]='W' then
   begin
    if hg>0 then
     begin
      j:=j+1;
      v[j]:=hg;
      hg:=0;
     end;
   end;
 end;
 j:=0;
for i:=1 to 9999 do
 if v[i]<>0 then
  j:=j+1;
write(j);
j:=0;
writeln;

for i:=1 to 9999 do
if v[i]<>0 then
begin
 write(v[i]);
 write(' ');
end;
end.

var a:string;
i,n,m,j,i1,hg:integer;
v:array[1..99999]of integer;
begin
hg:=0;
M:=0;
readln(n);
readln(a);
j:=0;
hg:=0;

for i:=1 to 9999 do
 begin
  if a[i]='B' then
   hg:=hg+1;

  if a[i]='W' then
   begin
    if hg>0 then
     begin
      j:=j+1;
      v[j]:=hg;
      hg:=0;
     end;
   end;
 end;
 j:=0;
for i:=1 to 9999 do
 if v[i]<>0 then
  j:=j+1;
write(j);
j:=0;
writeln;
for i:=1 to 9999 do
if v[i]<>0 then
begin
 write(v[i]);
 write(' ');
end;
end.

var
  a,b,i,n,j,k:longint;
  x:array[1..111]of longint;
  ch:array[0..111]of char;
begin
  readln(n);
  for i:=1 to n do
  read(ch[i]);

  ch[0]:='a';
  k:=0;
  a:=0;
  for i:=1 to n do
  begin
    if ch[i]='B' then k:=k+1;
    if ((ch[i]='W') and (ch[i-1]='B')) or (i=n) then begin a:=a+1;x[a]:=k;k:=0;end;
  end;
  writeln(a);
  for i:=1 to a do
  write(x[i],' ');
end.

var
  a,b,i,n,j,k:longint;
  x:array[1..111111]of longint;
  ch:array[0..111111]of char;
begin
  readln(n);
  for i:=1 to n do
  read(ch[i]);

  ch[0]:='a';
  k:=0;
  a:=0;
  for i:=1 to n do
  begin
    if ch[i]='B' then k:=k+1 else
    if ((ch[i]='W') and (ch[i-1]='B'))  or ((i=n)and (k>0)) then begin a:=a+1;x[a]:=k;k:=0;end;
  end;
  writeln(a);

  for i:=1 to a do
  write(x[i],' ');
end.

var
  a,b,i,n,j,k:longint;
  x:array[1..111111]of longint;
  ch:array[0..111111]of char;
begin
  readln(n);
  for i:=1 to n do
  read(ch[i]);

  ch[0]:='a';
  k:=0;
  a:=0;
  for i:=1 to n do
  begin
    if ch[i]='B' then k:=k+1;
    if ((ch[i]='W') and (ch[i-1]='B')) or (((i=n)and (a<>0)) or ((i=n)and (k>0))) then begin a:=a+1;x[a]:=k;k:=0;end;
  end;
  writeln(a);
  for i:=1 to a do
  write(x[i],' ');
end.

program ideone;
var
	s:string;
	k,d,i:longint;
	a:array[0..100] of longint;
begin
	readln(s);
	readln(s);
	k:=0;d:=0;
	for i:=1 to length(s) do
	begin
		{if kt and (s[i]<>'B') then
		begin
			k:=k+1;
			a[k]:=d;
			d:=0;
			kt:=false;
		end;}

		if s[i]='B' then
			if s[i+1]='B' then d:=d+1
			else
			begin
				k:=k+1;
				a[k]:=d+1;
				d:=0;
			end;
	end;
	writeln(k);
	for i:=1 to k do write(a[k],' ');
end.

var st:string;
d,k,j,n,i:byte;
begin
 readln(n);
 readln(st);
 i:=1;
 k:=0;
 if st[1]='B' then
 k:=k+1;
 for i:=2 to length(st) do
  if (st[i]='B') and (st[i-1]='W') then
  k:=k+1;
  writeln(k);
  j:=1;
  for i:=1 to k do
  begin
  while st[j]='B' do
  begin
  d:=d+1;
  if j<length(st) then
  j:=j+1
  else break;
  end;
   while st[j]='W' do
  begin
  if j<length(st) then
  j:=j+1
  else break;
  end;
  if d<>0 then
  write(d,' ');
  d:=0;
  end;
 end.

Var t:string;
    n,i,k1,k2:longint;
Begin
     readln(n);
     readln(t);
     k1:=0;
     k2:=0;
     For i:=1 to n do
     if t[i]='B' then k1:=k1+1
     else k2:=k2+1;
     writeln(k2);
     writeln(k1);
End.

var
  dem, d, i, n : longint ;
  ch : char ;
  ok : boolean ;
  p : array[0..100] of longint ;

begin
  readln(n) ;
  d := 0 ;
  dem := 0 ;
  ok := false ;
  for i :=1  to n do
    begin
      read(ch) ;
      if (ok = false) and (ch = 'B') then
        begin
          d :=  1 ;
          ok := true ;
            continue ;
        end ;
      if ok then
        begin
          if ch = 'B' then inc(d)
          else
            begin
              ok := false ;
              if d <> 0 then  begin
                inc(dem) ;
                p[dem] := d ;
                d := 0 ;
              end ;
            end ;
        end ;
    end ;
  if d > 0 then
    begin
      inc(dem) ;
      p[dem] := d ;
    end ;

  writeln(dem) ;
  for i := 1 to dem do write(p[dem], ' ') ;
end .