var
  n:string;
  i,s:longint;
begin
  readln(n);
  for i:=1 to length(n)-1 do if n[i]<>n[i+1] then inc(s);
  writeln(s);
end.


Global OOD problem IDs are disjoint from train, validation, and in-distribution test problem IDs.

Score : 300 points

Problem Statement

Two foxes Jiro and Saburo are playing a game called 1D Reversi. This game is played on a board, using black and white stones. On the board, stones are placed in a row, and each player places a new stone to either end of the row. Similarly to the original game of Reversi, when a white stone is placed, all black stones between the new white stone and another white stone, turn into white stones, and vice versa.

In the middle of a game, something came up and Saburo has to leave the game. The state of the board at this point is described by a string S. There are |S| (the length of S) stones on the board, and each character in S represents the color of the i-th (1 ≦ i ≦ |S|) stone from the left. If the i-th character in S is B, it means that the color of the corresponding stone on the board is black. Similarly, if the i-th character in S is W, it means that the color of the corresponding stone is white.

Jiro wants all stones on the board to be of the same color. For this purpose, he will place new stones on the board according to the rules. Find the minimum number of new stones that he needs to place.

Constraints

1 ≦ |S| ≦ 10^5

Each character in S is B or W.

Input

The input is given from Standard Input in the following format:

S

Output

Print the minimum number of new stones that Jiro needs to place for his purpose.

Sample Input 1

BBBWW

Sample Output 1

1

By placing a new black stone to the right end of the row of stones, all white stones will become black. Also, by placing a new white stone to the left end of the row of stones, all black stones will become white.

In either way, Jiro's purpose can be achieved by placing one stone.

Sample Input 2

WWWWWW

Sample Output 2

0

If all stones are already of the same color, no new stone is necessary.

Sample Input 3

WBWBWBWBWB

Sample Output 3

9

Submitted source-code file size, in bytes.

Execution CPU time reported by official Project CodeNet metadata, in milliseconds.

Peak memory usage reported by official Project CodeNet metadata, in kilobytes.


var   ch,ch1:char;
             ans:longint;
begin
    ch:=' ';
     while not eoln do
     begin
         read(ch1);
       if ch1<>ch then inc(ans);
             ch:=ch1;
     end;
       writeln(ans-1);
end.


var   ch,ch1:char;
             ans:longint;
begin
    ch:=' ';
     while not eoln do
     begin
         read(ch1);
       if ch1<>ch then inc(ans);
             ch1:=ch;
     end;
       writeln(ans);
end.


var   ch,ch1:char;
             ans:longint;
begin
    ch:=' ';
     while not eoln do
     begin
         read(ch1);
       if ch1<>ch then inc(ans);
             ch:=ch1;
     end;
       writeln(ans);
end.


var   ch,ch1:char;
             ans:longint;
begin
    ch:=' ';
     while not eof do
     begin
         read(ch1);
       if ch1<>ch then inc(ans);
             ch:=ch1;
     end;
       writeln(ans);
end.


var
i,j,k:longint;
s:string;
begin
    readln(s);
    for i:=2 to length(s) do
    if s[i]<>s[i-1] then inc(k);
    writeln(k);
end.


var
  s:ansistring;
  sum,i:longint;
begin
  readln(s);
  for i:=1 to length(s)-1 do if s[i]<>s[i+1] then inc(sum);
  writeln(sum);
end.


var
  s:ansistring;
  sum,i:longint;
begin
  readln(s);
  for i:=1 to length(s)-1 do if s[i]<>s[i+1] then inc(sum);
  write(sum);
end.


var
  sum,i:longint;
  s:string;
begin
  readln(s);
  for i:=1 to length(s)-1 do
    begin
      if s[i]<>s[i+1] then inc(sum);
    end;
  write(sum);
end.


var
  s:ansistring;
  i,sum:longint;
begin
  readln(s);
  for i:=2 to length(s) do
    if s[i]<>s[i-1] then inc(sum);
  write(sum);
end.


var
  k,i:longint;
  s:ansistring;
begin
  read(s);
  for i:=1 to length(s)-1 do
  begin
    if s[i]<>s[i+1] then k:=k+1;
  end;
  writeln(k);
end.


var
 s:ansistring;
 i,ss:longint;
begin
 readln(s);
 for i:=2 to length(s) do
  if s[i]<>s[i-1] then inc(ss);
 writeln(ss);
end.


var
  s:ansistring;
  i,ans:longint;
begin
  readln(s);
  for i:=2 to length(s) do
   if s[i]<>s[i-1] then ans:=ans+1;
  writeln(ans);
end.


var
a:string;
i,s:longint;
begin
read(a);
for i:=1 to length(a)-1 do
if a[i]<>a[i+1] then inc(s);
writeln(s);
end.


var
s,s1,s2,s3:string;
i,j,c,d,e,zz:longint;
begin
read(s);
for i:=1 to length(s)-1 do
if s[i]<>s[i+1] then inc(c);
writeln(c);
end.


var
 s:ansistring;
 i,j:longint;
begin
 readln(s);
 for i:=1 to length(s)-1 do
  if s[i]<>s[i+1] then inc(j);
  writeln(j);
end.


var
 s:longint;
 ch1,ch2:char;
begin
 while not eoln do
 begin
  read(ch1);
  if ch1<>ch2 then inc(s);
  ch2:=ch1;
 end;
 writeln(s);
end.


program retaskF;
var s:string;
    sum,i,len:longint;
begin
readln(s);
len:=Length(s);
for i:=1 to len-1 do
begin
  if s[i]<>s[i+1] then
  sum:=sum+1;
end;
writeln(sum);
end.


program taskF;
var o:array[1..100000]of integer;
    i,j,len,sum:longint;
    s:string;
    ok:boolean;
begin
readln(s);
len:=Length(s);
for i:=1 to len do
begin
  if s[i]='B' then
  o[i]:=1
  else
  o[i]:=2;
end;
while ok=false do
begin
  ok:=true;
  for i:=1 to len do
  begin
    for j:=1 to len do
    begin
      if o[i]<>o[j] then
      ok:=false;
    end;
  end;
  if ok=true then
  break;
  if o[len]=2 then
  begin
    o[len+1]:=1;
    len:=len+1;
    j:=len-1;
    while o[j]=2 do
    begin
      o[j]:=1;
      j:=j-1;
    end;
  end
  else
  begin
    o[len+1]:=2;
    len:=len+1;
    j:=len-1;
    while o[j]=1 do
    begin
      o[j]:=2;
      j:=j-1;
    end;
  end;
  sum:=sum+1;
end;
writeln(sum);
end.


var
m,n,i,j,k,x,y,z:longint;
s,t,r:ansistring;
begin
    readln(s);
    t:=s;
    for i:=2 to length(s) do
    begin
        if s[i]=t[i-1] then
        s[i]:='Q';
    end;
    x:=0;
    for i:=1 to length(s) do
    if s[i]='Q' then
    inc(x);
    writeln(length(s)-1-x);
end.


var cc: ansistring ;
   sum, a,b,c,d,e,f : longint ;
     g : char;
begin
 readln(cc);
 a:=length(cc);
 for b:=a downto 1 do
  if b=a then
   g:=cc[b]
  else if cc[b]<>g then
   begin
    sum:=sum+1;
    g:=cc[b];
   end;
  writeln(sum);
end.


var a:ansistring;
l,p,x,y,ans,i:longint;
c:char;
begin
    readln(a);
    l:=length(a);
    c:=a[1];
    for i:=1 to l do
    begin
        if a[i]<>c then
        begin
            ans:=ans+1;
            c:=a[i];
        end;
    end;
    writeln(ans);
end.


var
s:ansistring;
i,o:longint;
begin
readln(s);
for i := 1 to length(s)-1 do
begin
if s[i]<>s[i+1] then o:=o+1;
end;
writeln(o);
end.


var n,i,j:longint;
    a:array[0..100]of string;
    t:string;
begin
  readln(n);
  for i:=1 to n do
    readln(a[i]);
  for i:=1 to n do
    for j:=i+1 to n do
      if a[i]>a[j] then
      begin
        t:=a[i];a[i]:=a[j];a[j]:=t;
      end;
  for i:=1 to n do
    write(a[i]);
end.

Score : 200 points

Problem Statement

Iroha has a sequence of N strings S_1, S_2, ..., S_N. The length of each string is L.

She will concatenate all of the strings in some order, to produce a long string.

Among all strings that she can produce in this way, find the lexicographically smallest one.

Here, a string s=s_1s_2s_3...s_n is lexicographically smaller than another string t=t_1t_2t_3...t_m if and only if one of the following holds:

There exists an index i(1≦i≦min(n,m)), such that s_j = t_j for all indices j(1≦j<i), and s_i<t_i.

s_i = t_i for all integers i(1≦i≦min(n,m)), and n<m.

Constraints

1 ≦ N, L ≦ 100

For each i, the length of S_i equals L.

For each i, S_i consists of lowercase letters.

Input

The input is given from Standard Input in the following format:

N L
S_1
S_2
:
S_N

Output

Print the lexicographically smallest string that Iroha can produce.

Sample Input 1

3 3
dxx
axx
cxx

Sample Output 1

axxcxxdxx

The following order should be used: axx, cxx, dxx.


var
 n,x,i,j:longint;
 a:array[0..100] of string;
begin
 readln(n,x);
 for i:=1 to n do readln(a[i]);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if a[i]<a[j] then
    begin
     a[0]:=a[i];a[i]:=a[j];a[j]:=a[0];
    end;
 for i:=1 to n do write(a[i]);
end.


var
  a:array[1..100] of ansistring;
  t:ansistring;
  i,j,n,m:longint;
 function pd(n,m:ansistring;k:longint):boolean;
  begin
    if ord(n[k])>ord(m[k]) then exit(true)
      else if ord(n[k])<ord(m[k]) then exit(false)
             else exit(pd(n,m,k+1));
  end;
begin
  readln(n,m);
  for i:=1 to n do readln(a[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if pd(a[i],a[j],1) then
        begin
          t:=a[i]; a[i]:=a[j]; a[j]:=t;
        end;
  for i:=1 to n do write(a[i]);
end.


var
a:array[0..105] of string;
n,i,j:integer;
begin
readln(n);
for i:=1 to n do readln(a[i]);
for i:=1 to n-1 do
  for j:=i+1 to n do
    if a[i]+a[j]>a[j]+a[i] then
      begin
        a[0]:=a[i];
        a[i]:=a[j];
        a[j]:=a[0];
      end;
for i:=1 to n do write(a[i]);
end.


var
 i,n:longint;
 a:array[0..202] of string;
 procedure sort(l,r: longint);
      var
         i,j: longint;
         x,y:string;
      begin
         i:=l;
         j:=r;
         x:=a[(l+r) div 2];
         repeat
           while a[i]<x do
            inc(i);
           while x<a[j] do
            dec(j);
           if not(i>j) then
             begin
                y:=a[i];
                a[i]:=a[j];
                a[j]:=y;
                inc(i);
                j:=j-1;
             end;
         until i>j;
         if l<j then
           sort(l,j);
         if i<r then
           sort(i,r);
      end;
begin
 readln(n);
  for i:=1 to n do
     readln(a[i]);
      sort(1,n);
  for i:=1 to n do write(a[i]);
end.


var
 i,n,len:longint;
 s:string;
 heap:array[0..202] of string;
procedure put(x:string);
var son:longint;
   t:string;
begin
    len:=len+1;
    heap[len]:=x;
    son:=len;
    while(son<>1)and(heap[son div 2]>heap[son])do
        begin
            t:=heap[son div 2];
            heap[son div 2]:=heap[son];
            heap[son]:=t;
            son:=son div 2;
        end;
end;
function get:string;
var fa,son:longint;
    s:boolean;
    t:string;
begin
    get:=heap[1];
    heap[1]:=heap[len];
    len:=len-1;
    fa:=1;
    s:=false;
    while((fa*2<=len)or(fa*2+1<=len))and(not s)do
        begin
            if(fa*2+1>len)or(heap[fa*2]<heap[fa*2+1])
                then son:=fa*2 else son:=fa*2+1;
            if heap[fa]>heap[son]then
                begin
                    t:=heap[fa];
                    heap[fa]:=heap[son];
                    heap[son]:=t;
                    fa:=son;
                end
            else s:=true;
        end;
end;
begin
 readln(n);
  for i:=1 to n do
    begin
     readln(s);
     put(s);
    end;
  for i:=1 to n do write(get);
end.


var
  a:array[0..101]of string;
  n,l,i,j:longint;
  s:string;
begin
  readln(n,l);
  for i:=1 to n do readln(a[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[i]>a[j] then
       begin
         s:=a[i];
         a[i]:=a[j];
         a[j]:=s;
       end;
  for i:=1 to n do write(a[i]);
end.


var
  n,l,i,j:longint;
  t:string;
  a:array[0..101] of string;
procedure kp(l,r:longint);
  var
    tl,tr:longint;
    m,t:string;
  begin
    if l>=r then exit;
    tl:=l; tr:=r;
    m:=a[(tl+tr) div 2];
    while tl<tr do
      begin
        while a[tl]<m do inc(tl);
        while a[tr]>m do dec(tr);
        if tl<=tr then
          begin
            t:=a[tl]; a[tl]:=a[tr]; a[tr]:=t;
            inc(tl); dec(tr);
          end;
      end;
    kp(l,tr);
    kp(tl,r);
  end;
begin
  readln(n,l);
  for i:=1 to n do readln(a[i]);
  kp(1,n);
  for i:=1 to n do write(a[i]);
end.


var
  n,l,i,j:longint;
  t:string;
  a:array[0..101] of string;
begin
  readln(n,l);
  for i:=1 to n do readln(a[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if a[i]>a[j] then
        begin
          t:=a[i]; a[i]:=a[j]; a[j]:=t;
        end;
  for i:=1 to n do write(a[i]);
end.


var
  i,j,n:longint;
  a:array[0..100] of string;
  t:string;
procedure kp(l,r:longint);
var
  i,j:longint;
  m,t:string;
begin
  i:=l;j:=r;m:=a[(l+r) div 2];
  while i<j do
  begin
    while a[i]<m do inc(i);
    while a[j]>m do dec(j);
    if i<=j then
    begin
      t:=a[i];a[i]:=a[j];a[j]:=t;
      inc(i);dec(j);
    end;
  end;
  if l<j then kp(l,j);
  if i<r then kp(i,r);
end;
begin
  readln(n);
  for i:=1 to n do readln(a[i]);
  kp(1,n);
  for i:=1 to n do write(a[i]);
  writeln;
end.


var
  i,j,n:longint;
  s:array[0..10000] of string;
  t:string;
begin
  readln(n);
  for i:=1 to n do readln(s[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
    if s[i]>s[j] then begin t:=s[i];s[i]:=s[j];s[j]:=t;end;
  for i:=1 to n do write(s[i]);
  writeln;
end.


var
  s:array[0..100] of string;
  n,l,i,j:longint;
begin
  readln(n,l);
  for i:=1 to n do readln(s[i]);
  for i:=1 to n-1 do
   for j:=i+1 to n do
    if s[i]>s[j] then begin s[0]:=s[i];s[i]:=s[j];s[j]:=s[0]; end;
  for i:=1 to n do write(s[i]);
end.


var n,l,i,j:integer;s:array[0..100]of string;
begin
 readln(n,l);
 for i:=1 to n do
  readln(s[i]);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if s[i]>s[j] then
    begin
     s[0]:=s[i];
     s[i]:=s[j];
     s[j]:=s[0];
    end;
 for i:=1 to n-1 do
  write(s[i]);
 writeln(s[n]);
end.


var
 i,j,n,l:longint;
 a:array[1..100] of string;
 t:string;
begin
 readln(n,l);
 for i:=1 to n do readln(a[i]);
 for i:=1 to n-1 do
 for j:=i+1 to n do
 if a[i]>a[j] then
  begin
   t:=a[i];
   a[i]:=a[j];
   a[j]:=t;
  end;
  for i:=1 to n do write(a[i]);
  end.


Uses sysutils;
var
	n,l,i,j:Longint;
	s:array[1..100]of String[100];
	t:String[100];
begin
	readln(n,l);
	for i:=1 to n do begin
		readln(s[i]);
	end;
	for i:=1 to n do begin
		for j:=i+1 to n do begin
			if AnsiCompareStr(s[i],s[j])>0 then begin
				t:=s[i];
				s[i]:=s[j];
				s[j]:=t;
			end;
		end;
	end;
	for i:=1 to n do write(s[i]);
end.


var n,m,i,j:longint;s:string;a:array[0..100]of string;
begin
  readln(n,m);
  for i:=1 to n do
    readln(a[i]);
  for i:=1 to n-1 do
    for j:=i+1 to n do
    if a[i]>a[j]then
    begin
      s:=a[i];a[i]:=a[j];a[j]:=s;
    end;
  for i:=1 to m do write(a[i]);
  writeln;
end.


var
 n,m,i,j:longint;
 s1:string;
 s:array[0..10001] of string;
begin
 readln(n,m);
 for i:=1 to n do
  readln(s[i]);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if s[i]>s[j] then
    begin
     s1:=s[i]; s[i]:=s[j]; s[j]:=s1;
    end;
 for i:=1 to n do
  write(s[i]);
 writeln;
end.


var
 n,m,i,j:longint;
 a:array[0..100] of ansistring;
begin
 readln(n,m);
 for i:=1 to n do readln(a[i]);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if a[i]>a[j] then
   begin
    a[0]:=a[i];a[i]:=a[j];a[j]:=a[0];
   end;
   for i:=1 to n do write(a[i]);
   writeln;
end.


var
 n,m,i,j:longint;
 a:array[0..100] of ansistring;
begin
 readln(n,m);
 for i:=1 to n do readln(a[i]);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if a[i]<a[j] then
   begin
    a[0]:=a[i];a[i]:=a[j];a[j]:=a[0];
   end;
   for i:=1 to n do write(a[i]);
   writeln;
end.


var
i,j,c,d,e,b,n:longint;
s1,s2,s3,s4:string;
s:array[1..100000] of string;
begin
readln(n,c);
for i:=1 to n do
readln(s[i]);
for i:=1 to n-1 do
for j:=i+1 to n do
if s[i]>s[j] then begin s1:=s[i];s[i]:=s[j];s[j]:=s1;end;
for i:=1 to n do
write(s[i]);
end.


var
 a:array[0..1000] of ansistring;
 n,m,i,j:longint;
 t:ansistring;
begin
 readln(n,m);
 for i:=1 to n do
  readln(a[i]);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if a[i]>a[j] then begin
    t:=a[i]; a[i]:=a[j]; a[j]:=t; end;
 for i:=1 to n do
  write(a[i]);
end.


var
    n,l,i,j,k: Integer;
    S:array[1..100] of String;
    t:String;
    flag:Boolean;
begin
    readln(n,l);
    readln(S[1]);
    for i := 2 to n do
    begin
        readln(t);
        flag:=false;
        for j := 1 to i-1 do
        begin
            if t<S[j] then
            begin
                for k := i-1 downto j do
                begin
                    S[k+1]:=S[k];
                end;
                S[j]:=t;
                flag:=true;
                break;
            end;
        end;
        if not flag then
        begin
            S[i]:=t;
        end;
    end;
    for i := 1 to n do
    begin
        write(S[i]);
    end;
    writeln;
    readln;
end.


var
    n,l,i,j,k: Integer;
    S:array[1..100] of String;
    t:String;
    flag:Boolean;
begin
    readln(n,l);
    readln(S[1]);
    for i := 2 to l do
    begin
        readln(t);
        flag:=false;
        for j := 1 to i-1 do
        begin
            if t<S[j] then
            begin
                for k := i-1 downto j do
                begin
                    S[k+1]:=S[k];
                end;
                S[j]:=t;
                flag:=true;
                break;
            end;
        end;
        if not flag then
        begin
            S[i]:=t;
        end;
    end;
    for i := 1 to l do
    begin
        write(S[i]);
    end;
    writeln;
    readln;
end.


var
    n,l,i,j,k: Integer;
    S:array[1..100] of String;
    t:String;
    flag:Boolean;
begin
    readln(n,l);
    readln(S[1]);
    for i := 2 to l do
    begin
        readln(t);
        flag:=false;
        for j := 1 to i-1 do
        begin
            if t<S[j] then
            begin
                for k := i-1 downto j do
                begin
                    S[k+1]:=S[k];
                end;
                S[j]:=t;
                flag:=true;
                break;
            end;
        end;
        if not flag then
        begin
            S[i]:=t;
        end;
    end;
    for i := 1 to l do
    begin
        writeln(S[i]);
    end;
    readln;
end.


program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,Classes;

procedure Sort0000(var AText: string);
var
  sw:char;
  i,j,min:Integer;
begin
  for i := 0 to Length(AText) do begin
    min := i;
    for j := i+1 to Length(AText) do begin
      if AText[j] < AText[min] then
      min := j;
    end;
    sw:=AText[i];
    AText[i]:=AText[min];
    AText[min]:=sw;
  end;
end;

var
  n,l,i,j,min:Integer;
  sw,nyu:string;
  s:TStringList;
begin
  try
    { TODO -oUser -cConsole Main : ここにコードを記述してください }
    s := TStringList.Create;
    Readln(n);
    Readln(nyu);
    s.CommaText := nyu;

    for i := 0 to n - 1 do begin
      nyu:=s[i];
      Sort0000(nyu);
      s[i]:=nyu;
    end;

    for i := 0 to n-1 do begin
      min := i;
      for j := i+1 to n-1 do begin
        if s[j] < s[min] then
        min := j;
      end;
      sw:=s[i];
      s[i]:=s[min];
      s[min]:=sw;
    end;

    for i := 0 to n - 1 do
      Write(s[i]);

    Writeln;
    Readln;
    s.Free;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

procedure Sort0000(var AText: string);
var
  sw:char;
  i,j,min:Integer;
begin
  for i := 0 to Length(AText) do begin
    min := i;
    for j := i+1 to Length(AText) do begin
      if AText[j] < AText[min] then
      min := j;
    end;
    sw:=AText[i];
    AText[i]:=AText[min];
    AText[min]:=sw;
  end;
end;

var
  n,l,i,j,min:Integer;
  s:array of string;
  sw:string;
begin
  try
    { TODO -oUser -cConsole Main : ここにコードを記述してください }
    Read(n);
    Readln(l);
    SetLength(s,n);
    for i := 0 to n - 1 do begin
      Readln(s[i]);
      Sort0000(s[i]);
    end;

    for i := 0 to n-1 do begin
      min := i;
      for j := i+1 to n-1 do begin
        if s[j] < s[min] then
        min := j;
      end;
      sw:=s[i];
      s[i]:=s[min];
      s[min]:=sw;
    end;

    for i := 0 to n - 1 do
      Write(s[i]);

    Writeln;
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.