{$apptype console} {$J+,O+,R-} {Back tracking algorithm.} {This program proves, that there is either to basic words in row or prefix with density more than 883/3215} 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=100000; {Size of hash table} hashsize=100003; {length of basic words} basiclen=3215; {exponent for hash function} hashp=5; {-hashp^m(mod hashsize). It needed for quick hash calculations} hashpm:integer=0; {default size of the block for hashing} m:integer=14; {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; {current density} density:rational; {number of letters a in the current word} count_a:integer; {some variables to measure some times} lasttime:integer; count:integer=0; time:integer; curt:int64; {file to store $(n|w|,w)$ pairs.} fres:text; procedure calchash;forward; function ptime:int64;forward; {read basic words from basicword.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=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); {show some info} writeln(maxlen,' ',minlen); maxlen:=len;minlen:=len; {remember the time of the last save.} lasttime:=gettickcount; end; {load state from save.txt file} procedure open; var f:text; c:char; i:integer; llen:integer; begin assign(f,'save.txt'); reset(f); {read the word's length} readln(f,llen); {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 llen 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; end; end; end; read(f,time); close(f); len:=llen; 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 save.txt file and start calculations} procedure start; var i:integer; begin density.x:=883; density.y:=3215; loadbasicwords; hashpm:=1; {We use m=45} m:=trunc(sqrp(10000/0.7,2.5)); {calculate hashpm=-hashp^m(mod hashsize)} for i:=1 to m do hashpm:=int64(hashpm)*int64(hashp) mod int64(hashsize); hashpm:=hashsize-hashpm; open; if len=2 then {if we started from the beginning, we must create first_res.txt file} begin assign(fres,'first_res.txt'); rewrite(fres); close(fres); end; assign(fres,'first_res.txt'); append(fres); time:=integer(gettickcount)-time; curt:=ptime; maxlen:=len;minlen:=len; 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; 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 eqint1:=nodestring[end1+m-size].yhash=nodestring[end2+m-size].yhash; 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} function checkbasicword:boolean; var i,j:integer; flag:boolean; rlen:integer; flag1:boolean; begin checkbasicword:=false; {length must be at least 2*basiclen} if len<2*basiclen then exit; if deepstring[len]=-1 then rlen:=len-1 else rlen:=len; {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.} 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 checkbasicword:=true; {write stats of found string to the result file.} writeln(fres,count_a,'/',rlen); flush(fres); exit; end; end; end; {enumerate square-free strings with density <=833/3215} procedure calculate; var i:integer; flag:boolean; begin 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 lendeepstring[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(density.y)>=len*int64(density.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=0; {we have enumerated all posibilities} end; {$O+} {for time measuring} function ptime:int64;assembler; asm rdtsc; end; begin start; end.