bzoj2251

以前看到这道题想到的是SA，做起来不是很美观

学了SAM之后，这题简直是随便搞

var go:array[0..6010,'0'..'1'] of longint;
    s,sa,mx,w,fa:array[0..6010] of longint;
    i,n,last,t:longint;
    ch:char;

procedure add(c:char);
  var p,np,nq,q:longint;
  begin
    p:=last;
    inc(t); np:=t; last:=t;
    mx[np]:=mx[p]+1;
    w[np]:=1;
    while (p>0) and (go[p,c]=0) do
    begin
      go[p,c]:=np;
      p:=fa[p];
    end;
    if p=0 then fa[np]:=1
    else begin
      q:=go[p,c];
      if mx[q]=mx[p]+1 then fa[np]:=q
      else begin
        inc(t); nq:=t;
        mx[nq]:=mx[p]+1;
        go[nq]:=go[q];
        fa[nq]:=fa[q];
        fa[q]:=nq; fa[np]:=nq;
        while go[p,c]=q do
        begin
          go[p,c]:=nq;
          p:=fa[p];
        end;
      end;
    end;
  end;

procedure pre;
  var i,x:longint;
  begin
    for i:=1 to t do
      inc(s[mx[i]]);
    for i:=1 to n do
      inc(s[i],s[i-1]);
    for i:=t downto 1 do
    begin
      sa[s[mx[i]]]:=i;
      dec(s[mx[i]]);
    end;
    for i:=t downto 1 do
    begin
      x:=sa[i];
      inc(w[fa[x]],w[x]);
    end;
  end;

procedure dfs(x:longint);
  var y:longint;
      c:char;
  begin
    for c:='0' to '1' do
      if go[x,c]>0 then
      begin
        if w[go[x,c]]>1 then writeln(w[go[x,c]]);
        dfs(go[x,c]);
      end;
  end;

begin
  readln(n);
  t:=1; last:=1;
  for i:=1 to n do
  begin
    read(ch);
    add(ch);
  end;
  pre;
  dfs(1);
end.