{$apptype console}
{$J+,O+,R+}
{Back tracking algorithm.}
{This program proves that if the word starts with 2 basic words, its either
contains prefix with high density or prefix with density >=883/3215 which ends with
2 basic words.}
uses windows;
const
{we represent letters using integers}
  char_a=0;
  char_b=1;
  char_c=2;
{Maximal number of letters we are dealing with. 
If the program detects overflow, it would exit.}  
  max_len=200000;
{Size of hash table}    
  hashsize=200003;
{length of basic words}  
  basiclen=3215;
{exponent for hash function}   
  hashp=5;
  inthash=6;
{-hashp^m(mod hashsize). It needed for quick hash calculations}  
  hashpm:integer=0;
{default size of the block for hashing}   
  m:integer=14;
  ratiter:integer=1;
{save state every savetime msec.}   
  savetime=30000;{30 seconds}
type
  tbytearr=array[0..100] of byte;
  pbytearr=^tbytearr;
  rational=record
    x,y:integer;
  end;
  {hash information about position}
  node=record
    xhash:integer;{unprecise hash}
    yhash:integer;{precise hash}
    next:integer;{next position with the same precise hash}
  end;
  pinteger=^integer;
var
  {length of the current word}
  len:integer;
  maxlen,minlen:integer;
  {current string in backtrack algorithm}
  deepstring:array[0..max_len] of shortint;
  {hash information for all positions}
  nodestring:array[0..max_len] of node;
  {hash table - hashtable[i] = index of the last position with hash i.}
  hashtable:array[0..hashsize-1] of integer;
  {4 basic words}
  basicwords:array[1..4,0..4000] of integer;
  {maximal allowable density for all lengths. If current word have density more than
   maxdensity[len], we found prefix needed in the theorem.}
  maxdensity:array[1..max_len] of rational;
  density:rational;
  {number of letters "a" in the current word.}
  count_a:integer;
  lasttime:integer;
  count:integer=0;
  time:integer;
  curt:int64;
  {file to read result from words_first_search program.}
  fres:text;
procedure calchash;forward;
function ptime:int64;forward;
function checkword:boolean;forward;
{load (n(w),|w|) pairs and calculate maxdensity array.}
procedure loadfres;
var
  i,j:integer;
  nfres:integer;
  f:text;
  d:rational;
  fres:rational;
begin
  {default maxdensity value - zero.}
  for i:=1 to max_len do
  begin
    maxdensity[i].x:=0;
    maxdensity[i].y:=1;
  end;
  assign(f,'fres.txt');
  reset(f);
  {read number of pairs}
  read(f,nfres);
  for i:=1 to nfres do
  begin
    {read pair}
    read(f,fres.x,fres.y);
    for j:=2*basiclen+1 to max_len do
    begin
      {calculate maximal density of the prefix}
      d.x:=((int64(883)*(j-2*basiclen+fres.y)) div basiclen)-fres.x+1;
      d.y:=j-2*basiclen;
      {increase maxdensity if necessary}
      if int64(d.x)*maxdensity[j].y>int64(d.y)*maxdensity[j].x then
      begin
        maxdensity[j].x:=d.x;
        maxdensity[j].y:=d.y;
      end;
    end;
  end;
  close(f);
end;
{read basic words from basicword<N>.txt files}
procedure loadbasicwords;
var
  i,j:integer;
  c:char;
  s:string;
  f:text;
begin
  for i:=1 to 4 do
  begin
    {convert from number to string}
    str(i,s);
    {calculate the file's name}
    s:='basicword'+s+'.txt';
    {open the file}
    assign(f,s);
    reset(f);
    {read word from the file}
    for j:=1 to basiclen do
    begin
      read(f,c);
      if c in ['a','b','c'] then
        basicwords[i,j]:=ord(c)-ord('a')
      else
      begin
        writeln('basicword error');
        sleep(INFINITE);
      end;
    end;
    close(f);
  end;
end;
{Save our state, if needed}
procedure save;
var
  f:text;
  stime:integer;
  i:integer;
begin
  {calculate time from the last save.}
  stime:=integer(gettickcount)-lasttime;
  {check if we should save state.}
  if stime<savetime then exit;
  assign(f,'save1.txt');
  rewrite(f);
  writeln(f,len);
  for i:=1 to len do
    if deepstring[i]>=0 then
      write(f,char(deepstring[i]+ord('a')))
    else
      write(f,'.'); {point mean, that the program haven't enumerated possibilities of the next letter}
  writeln(f);
  writeln(f,integer(gettickcount)-time);
  close(f);
  {remember the time of the last save.}
  lasttime:=gettickcount;
  {show some info}
  writeln(maxlen,' ',minlen);
  minlen:=len;maxlen:=len;
end;
{load state from save1.txt file}
procedure open;
var
  f:text;
  c:char;
  i:integer;
  copy_len:integer;
begin
  assign(f,'save1.txt');
  reset(f);
  {read the word's length}
  readln(f,copy_len);
  {initialize count_a - number of 'a' in the word}
  count_a:=0;
  {clear hash table}
  fillchar(hashtable,sizeof(hashtable),0);
  {read symbols from the file}
  for i:=1 to copy_len do
  begin
    read(f,c);
    if c='.' then
      deepstring[i]:=-1
    else if c in ['a','b','c'] then
    begin
      if c='a' then inc(count_a);{update count_a}
      deepstring[i]:=ord(c)-ord('a');
    end
    else
    begin
      writeln('open error');
      sleep(INFINITE);
    end;
    {calculate hash for this position}
    if i=1 then
    begin
      nodestring[1].xhash:=deepstring[1];
      nodestring[1].yhash:=deepstring[1];
      nodestring[1].next:=0;
    end
    else
    begin
      if deepstring[i]>=0 then
      begin
        {set len for calchash procedure}
        len:=i;
        calchash;
        if (not checkword) and (i<copy_len) then
        begin
          writeln('error - square found');
          sleep(INFINITE);
        end;
      end;
    end;
  end;
  read(f,time);
  close(f);
  len:=copy_len;
  lasttime:=gettickcount;
end;
procedure calculate;forward;
{Calculate x^1/root.}
function sqrp(x:extended;root:extended):extended;
begin
  sqrp:=exp(ln(x)/root);
end;
{Read save1.txt file and start calculations}
procedure start;
var
  i:integer;
begin
  density.x:=883;
  density.y:=3215;
  loadbasicwords;
  loadfres;
  if len=2 then
  begin
    assign(fres,'first_res.txt');
    rewrite(fres);
    close(fres);
  end;
  assign(fres,'first_res.txt');
  append(fres);
  {we use m=60}
  m:=trunc(sqrp(20000/0.7,2.5));
  {calculate hashpm=-hashp^m(mod hashsize)}
  hashpm:=1;
  for i:=1 to m do
    hashpm:=int64(hashpm)*int64(hashp) mod int64(hashsize);
  hashpm:=hashsize-hashpm;
  open;
  time:=integer(gettickcount)-time;
  curt:=ptime;
  calculate;
  close(fres);
end;
{compare [end1-size+1;end1] and [end2-size+1;end2] using hash if size>m}
function eqint1(end1,end2,size:integer):boolean;
var
  i:integer;
  flag:boolean;
begin
  eqint1:=true;
  if size<=m then
  begin
    {basic algorithm}
    for i:=0 to size-1 do
      if deepstring[end1-i]<>deepstring[end2-i] then
      begin
        eqint1:=false;
        exit;
      end;
    exit;
  end;
  {advanced algorithm - using precise hash}
  while size>m do
  begin
    if nodestring[end1].yhash<>nodestring[end2].yhash then
    begin
      eqint1:=false;
      exit;
    end;
    dec(end1,m);dec(end2,m);dec(size,m);
  end;
  {compare the last part of the words}
  if size>0 then
  begin
    flag:=nodestring[end1+m-size].yhash=nodestring[end2+m-size].yhash;
    eqint1:=flag;
  end;
end;
{check if current word doesn't end with 2 equal words}
function checkword:boolean;
var
  i:integer;
begin
  checkword:=true;
  if len<2*m then
  begin
    {small current word}
    for i:=1 to len div 2 do
    begin
      if eqint1(len,len-i,i) then
      begin
        checkword:=false;
        exit;
      end;
    end;
    exit;
  end;
  {check for small suffixes}
  for i:=1 to m do
    if eqint1(len,len-i,i) then
    begin
      checkword:=false;
      exit;
    end;
  {check for >=m suffixes}
  {enumerate list of positions with the same exact hash.}
  i:=nodestring[len].next;
  while i>=((len+1) div 2) do
  begin
    if i<=len-m then
      if eqint1(len,i,len-i) then
      begin
        checkword:=false;
        exit;
      end;
    i:=nodestring[i].next;
  end;
end;
{calculate hash for position len.}
procedure calchash;
var
  i:integer;
begin
  if len<=m then
  begin
    {first positions, all suffixes are different.}
    {calculate inexact hash}
    nodestring[len].xhash:=(nodestring[len-1].xhash*hashp
      +deepstring[len]) mod int64(hashsize);
    {calculate exact hash}
    i:=nodestring[len].xhash;
    while hashtable[i]<>0 do i:=(i+1) mod hashsize;
    nodestring[len].yhash:=i;
    {update lists in hash table}
    hashtable[i]:=len;
    nodestring[len].next:=0;
  end
  else
  begin
    {general case}
    {calculate inexact hash}
    nodestring[len].xhash:=(nodestring[len-1].xhash*hashp+
      deepstring[len-m]*int64(hashpm)+deepstring[len]) mod int64(hashsize);
    {calculate exact hash}
    i:=nodestring[len].xhash;
    while true do
    begin
      {check for empty cell in the table}
      if hashtable[i]=0 then break;
      {check if we found our suffix in the table}
      if hashtable[i]>=m then
        if eqint1(len,hashtable[i],m) then break;
      {go to the next cell}
      i:=(i+1) mod hashsize;
    end;
    nodestring[len].yhash:=i;
    {update lists in hash table}
    nodestring[len].next:=hashtable[i];
    hashtable[i]:=len;
  end;
end;
{remove last position from the hash table}
procedure dechash;
begin
  hashtable[nodestring[len].yhash]:=nodestring[len].next;
end;
{check if current word ends with 2 basic words and have density >=883/3215}
function checkbasicword:boolean;
var
  i,j:integer;
  flag:boolean;
  flag1:boolean;
  rlen:integer;
begin
  checkbasicword:=false;
  {length must be at least 2*basiclen}
  if deepstring[len]=-1 then rlen:=len-1 else rlen:=len;
  if rlen<=2*basiclen then exit;
  {density must be >=883/3215}
  if count_a*3215<883*(rlen-2*basiclen) then exit;
  {check last basiclen symbols}
  flag1:=false;
  for i:=1 to 4 do
  begin
    flag:=true;
    for j:=basiclen downto 1 do
      if deepstring[rlen+j-basiclen]<>basicwords[i,j] then
      begin
        flag:=false;
        break;
      end;
    if flag then
    begin
      flag1:=true;
      break;
    end;
  end;
  if not flag1 then exit;
  {current word ends with basic word, check next basiclen symbols from the end.}
  flag1:=false;
  for i:=1 to 4 do
  begin
    flag:=true;
    for j:=basiclen downto 1 do
      if deepstring[rlen+j-2*basiclen]<>basicwords[i,j] then
      begin
        flag:=false;
        break;
      end;
    if flag then
    begin
      flag1:=true;
      break;
    end;
  end;
  checkbasicword:=flag1;
end;
{enumerate square-free strings which doesn't contain prefixes 
satisfied conditions in the theorem}
procedure calculate;
var
  i:integer;
  flag:boolean;
begin
  {we don't count first 2*basiclen symbols when calculating density}
  dec(count_a,883*2);
  maxlen:=len;minlen:=len;
  repeat
    {overflow check}
    if len>max_len-1000 then
    begin
      writeln('error');
      sleep(INFINITE);
    end;
    {update some stats}
    if len>maxlen then maxlen:=len;
    if len<minlen then minlen:=len;
    {check if we need to save current state}
    inc(count);
    if count=1000 then
    begin
      save;
      count:=0;
    end;
    
    if deepstring[len]=-1 then
    begin
      {we should enumerate all possibilities for the last symbol}
      if checkbasicword then
      begin
        {if current word ends with 2 basic words and have big density, we can step backwards}
        dec(len);
        continue;
      end;
      flag:=false;
      for i:=0 to 2 do {i - new letter}
      if i<>deepstring[len-1] then {quick check for 2 equal symbols in the row.}
      begin
        deepstring[len]:=i;
        if i=0 then inc(count_a);{update count_a}
        {check density}
        if count_a*int64(maxdensity[len].y)>=(len-2*basiclen)*int64(maxdensity[len].x) then
        begin
          if i=0 then
            dec(count_a);
          continue;
        end;
        {calculate hash for the new position}
        calchash;
        {check if current word is square-free}
        if checkword then
        begin
          {we should enumerate all posibilities for next position}
          inc(len);
          deepstring[len]:=-1;
          flag:=true;
          break;
        end;
        dechash;
        if i=0 then dec(count_a);
      end;
      if flag then continue;
      {there isn't good letter for the position, we must backtrack}
      dec(len);
    end;
    {we should enumerate remaining variants for the last symbol}
    if deepstring[len]=2 then
    begin
      {we enumerated all variants for this position, we must backtrack}
      dechash;
      dec(len);
      continue;
    end;
    {increment last position and recalcute hash}
    dechash;
    inc(deepstring[len]);
    calchash;
    {update count_a}
    if deepstring[len]=1 then dec(count_a);
    {check for square-free}
    if checkword then
    begin
      {we must enumerate all posibilities for the next position}
      inc(len);
      deepstring[len]:=-1;
    end;
  until len<=2*basiclen;
  {we have enumerated all posibilities}
end;
{$O+}
{for time measuring}
function ptime:int64;assembler;
asm
  rdtsc;
end;
begin
  start;
end.