Ujan has been lazy lately, but now has decided to bring his yard to good shape. First, he decided to paint the path from his house to the gate.The path consists of $$$n$$$ consecutive tiles, numbered from $$$1$$$ to $$$n$$$. Ujan will paint each tile in some color. He will consider the path aesthetic if for any two different tiles with numbers $$$i$$$ and $$$j$$$, such that $$$|j - i|$$$ is a divisor of $$$n$$$ greater than $$$1$$$, they have the same color. Formally, the colors of two tiles with numbers $$$i$$$ and $$$j$$$ should be the same if $$$|i-j| > 1$$$ and $$$n \bmod |i-j| = 0$$$ (where $$$x \bmod y$$$ is the remainder when dividing $$$x$$$ by $$$y$$$).Ujan wants to brighten up space. What is the maximum number of different colors that Ujan can use, so that the path is aesthetic?

The first line of input contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^{12}$$$), the length of the path.

Output a single integer, the maximum possible number of colors that the path can be painted in.

NoteIn the first sample, two colors is the maximum number. Tiles $$$1$$$ and $$$3$$$ should have the same color since $$$4 \bmod |3-1| = 0$$$. Also, tiles $$$2$$$ and $$$4$$$ should have the same color since $$$4 \bmod |4-2| = 0$$$.In the second sample, all five colors can be used.

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.

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.

                                             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.

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.

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.

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.


Recently Adaltik discovered japanese crosswords. Japanese crossword is a picture, represented as a table sized a × b squares, and each square is colored white or black. There are integers to the left of the rows and to the top of the columns, encrypting the corresponding row or column. The number of integers represents how many groups of black squares there are in corresponding row or column, and the integers themselves represents the number of consecutive black squares in corresponding group (you can find more detailed explanation in Wikipedia https://en.wikipedia.org/wiki/Japanese_crossword).Adaltik decided that the general case of japanese crossword is too complicated and drew a row consisting of n squares (e.g. japanese crossword sized 1 × n), which he wants to encrypt in the same way as in japanese crossword.    The example of encrypting of a single row of japanese crossword. Help Adaltik find the numbers encrypting the row he drew.

The first line of the input contains a single integer n (1 ≤ n ≤ 100) — the length of the row. The second line of the input contains a single string consisting of n characters 'B' or 'W', ('B' corresponds to black square, 'W' — to white square in the row that Adaltik drew).

The first line should contain a single integer k — the number of integers encrypting the row, e.g. the number of groups of black squares in the row. The second line should contain k integers, encrypting the row, e.g. corresponding to sizes of groups of consecutive black squares in the order from left to right.

NoteThe last sample case correspond to the picture in the statement.

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.

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.

{$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 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 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.

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.

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 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.

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.

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.

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.

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
        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.

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.

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
  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..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
  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
 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.

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.

 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 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.

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.

{$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 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.

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
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.

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,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.

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.

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,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,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.

{$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.

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,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.

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.

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,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 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.

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.

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,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 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
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.

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,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 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.

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 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 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.

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 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.

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.

{$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.

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[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.

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.

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 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.

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.

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.

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: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.

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.

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.

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.

{$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, 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, 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.

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
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 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 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.

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
  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.

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.

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 .