#This package has on primary procedure: Squares, which produces all words that
#are squares, but contain no sub squares.


print(`SQUARES`):
print(`A Maple package by Anne E. Edlin.`):
print(`Version - 17th June 1998.`):
print(`This package is designed to produce all words that are squares,`):
print(`but that contain no squares as sub words.`):
print(`For a list of procedures type   Help();`):
print(`For help using a specific procedure type   Help(procedure name);`):


Help:=proc():
  if args=NULL then 
    print(`Contains the following main procedure:`):
    print(`Squares.`):
  elif nargs=1 and args[1]=Squares then 
    print(`Squares requires two inputs, the maximum length of the Squares`):
    print(`required and the alphabet from which they are to be formed.`):
  else 
    print(`There is no Help available on`, args):
  fi:
end:



#The following procedure produces all the Squares of at most length n on the
#input alphabet.

Squares:=proc(n,alph)
  local i,out,test,j,testlist,testsqr,k,l,check,letter1,sqr1:
  option remember:
   
#check length is an integer  
  if not type(n, integer) then				
    ERROR(`A word can only have integer length.`):
  fi:
  
#checks length is at least 2  							
  if n<2 then	          				
    ERROR(`The length for the output square words must be at least 2.`):
  fi:							
  
#checks alphabet is in list form 
  if not type(alph,list) then				
    ERROR(`The input alphabet must be in the form of a list`):
  fi:
  
#checks list contains no repeats							
  if nops(convert(alph, set))<>nops(alph) then		
    ERROR(`The same character can not appear twice in the input alphabet`):
  fi:
  
#produces initial square list by taking single letters and doubling them							
  out:={}:
  if n=2 then								
    for j from 1 to nops(alph) do			
      letter1:=op(j,alph):
      sqr1:=[letter1,letter1]:
      out:=out union {sqr1}:
    od:
    
#checks n is large enough for back step
  elif n>2 then
  
#finds all squares of length at most n-1 by calling itself						
    out:=Squares(n-1,alph):				 
    if n-1<2*trunc(n/2) then
    
#collects a list of square free words of length at most one half requested 
#length
      testlist:=convert(sqrfr(trunc(n/2),alph),list);	
      for j from 1 to nops(testlist) do
        test:=op(j,testlist):
        
#produces squares of square free words
        testsqr:=[op(test),op(test)]:
        
#initializes check tag		
        check:=0:
        
#tests to see if new word contains any sub-squares and if it does increases the 
#check tag by one  							
        for k from 1 to nops(testsqr)-1 do
          for i from k+1 to nops(testsqr) do
            if member([op(k..i,testsqr)],Squares(n-1,alph))  then
              check:=check+1
            fi:						
          od:			 			
        od:
        
#adds words whose check tag remained 0 to output, they are sub square free
        if check=0 then
          out:=out union {testsqr}:			
        fi:						
      od:
    fi:
  fi:
  out:
end:



#The following procedure generates all square free words of length n on the 
#given alphabet.

sqrfr:=proc(n,alph)
  local out,i,j,step,test:
  option remember:
  
#check length is an integer
  if not type(n, integer) then				
    ERROR(`A word can only have integer length.`):
  fi:
  
#checks length requested is positive							
  if n<1 then	          				
    ERROR(`The length requested for the output words must be at least 1.`):
  fi:
  
#checks alphabet is in list form							
  if not type(alph,list) then				
    ERROR(`The input alphabet must be in the form of a list`):
  fi:
  
#checks list contains no repeats							
  if nops(convert(alph, set))<>nops(alph) then		
    ERROR(`The same character can not appear twice in the input alphabet`):
  fi:
  
#initializes the out put as an empty set							
  out:={}:
  
#produces all words of length 1						
  if n=1 then
    for i from 1 to nops(alph) do
      out:=out union {[op(i,alph)]}:			
    od:							
    
#calls up squarefree words of 1 less length as a list so can be used in order
    else step:=convert(sqrfr(n-1,alph),list);		
      for i from 1 to nops(step) do
        for j from 1 to nops(alph) do
     
#adjoins each letter to the start of previous square free words
          test:=[op(j,alph),op(op(i,step))]:
          
#tests to see if new word is still square free		
          if sqrfr1(test)=1 then
          
#adds new square free words to output			
            out:=out union {test}			
          fi:  
        od:
      od:
    fi:
  out;
end:




#The following procedure tests to see if a word formed by adding one new letter 
#at the start of a square free word is sqaure free.

sqrfr1:=proc(word)
  local i:
  
#looks for squares starting with the first letter of all possible lengths
  for i from 1 to trunc(nops(word)/2) do
    if op(1..i,word)=op(i+1..2*i,word) then
      RETURN(0);
    fi:
  od:							
  1:
end: