More Samples
///////////////////////////////////////////////////////////////////////////////
//
// Anagram is a word or phrase formed by rearranging the letters of another 
// word or phrase. For example, 'ringo' is an anagram of 'groin'. 
//
// The following code generates one word, two words or three words ASCII anagrams
// by calling one of the three queries FindAnagram1, FindAnagram1, FindAnagram3.
// For example, to find anagrams of the word 'estimate' run one of the
// following queries:
//  
//      FindAnagram1('estimate')  // find one word anagrams of 'estimate'
//      FindAnagram2('estimate')  // find two word anagrams of 'estimate'
//      FindAnagram3('estimate')  // find three word anagrams of 'estimate'
//
// Of course in order to generate the anagrams, we must have a database of
// admissible words. In our case, we use the words as contained in the
// module 'AllAnagramWords'. This is a list of english words. To generate
// anagrams in different languages, simple replace the module 'AllAnagramWords'. 
//
// The algorithm for finding anagrams is fairly simple:
//
// Assign a code number to each string. Each alphabet letter is assigned a 
// different prime number and all the individual prime numbers corresponding 
// to the individual letters of the string are multiplied together, generating
// the code number. 
// The value of the prime number is not really important, what is important 
// is that all the prime numbers are different.
// This way all strings with the same letters (in any order) will be
// assigned the same code number, for example
//
//      estimate
//      meatiest
//
// will both have assigned the code number 77075891882. Searching for an anagram
// of a word will be then reduced to searching for a word with the same
// code number.
// Also note that all non-alphabet characters will be assigned number 1,
// which will in effect ignore those characters. This will come in handy
// when dealing with words that contain spaces, apostrophes etc. 
//
// For one word anagrams simply look for exact code number matches, for
// multiple word anagrams take advantage of the fact that if code number A 
// divides another code number B, then the corresponding word
// 'A' can be formed from the word 'B'. Take the remainder of the division 
// and repeat the search. 
//
// The code below implements the described algorithm. In addition, there
// is a code that can be used to generate the code for the module 
// 'AllAnagramWords'. You may need this code if you need to generate non-english 
// anagrams. 
//
///////////////////////////////////////////////////////////////////////////////

use 'AllAnagramWords'

///////////////////////////////////////////////////////////////////////////////
// Find a single word anagram
///////////////////////////////////////////////////////////////////////////////

proc FindAnagram1(s:<S) iff
    out:.L & out:= 1 & AssignLetters(s,0,out) &
    FindPrimeWord1(out,0)
    
local proc FindPrimeWord1(num:<L,ix:<I) iff
    if ix < Len(AllAnagramWords) then
        if AllAnagramWords(ix).n = num then Print('\n',AllAnagramWords(ix).s) end
        & FindPrimeWord1(num,ix+1)
    end


///////////////////////////////////////////////////////////////////////////////
// Find a two word anagram
///////////////////////////////////////////////////////////////////////////////

proc FindAnagram2(s:<S) iff
    out:.L & out:= 1 & AssignLetters(s,0,out) &
    FindPrimeWord21(out,0)
    

local proc FindPrimeWord21(num:<L,ix:<I) iff
    if ix < Len(AllAnagramWords) then
        if num mod AllAnagramWords(ix).n = 0 then 
            num1 = num / AllAnagramWords(ix).n & 
            FindPrimeWord22(ix,num1,0)
        end
        & FindPrimeWord21(num,ix+1)
    end

local proc FindPrimeWord22(ix1:<I,num:<L,ix:<I) iff
    if ix < Len(AllAnagramWords) then
        if AllAnagramWords(ix).n = num then 
            Print('\n',AllAnagramWords(ix1).s,' ',AllAnagramWords(ix).s) end
        & FindPrimeWord22(ix1,num,ix+1)
    end


///////////////////////////////////////////////////////////////////////////////
// Find a three word anagram
///////////////////////////////////////////////////////////////////////////////

proc FindAnagram3(s:<S) iff
    out:.L & out:= 1 & AssignLetters(s,0,out) &
    FindPrimeWord31(out,0)
    
local proc FindPrimeWord31(num:<L,ix:<I) iff
    if ix < Len(AllAnagramWords) then
        if num mod AllAnagramWords(ix).n = 0 then 
            num1 = num / AllAnagramWords(ix).n & 
            FindPrimeWord32(ix,num1,0)
        end
        & FindPrimeWord31(num,ix+1)
    end

local proc FindPrimeWord32(ix1:<I,num:<L,ix:<I) iff
    if ix < Len(AllAnagramWords) then
        if num mod AllAnagramWords(ix).n = 0 then 
            num1 = num / AllAnagramWords(ix).n & 
            FindPrimeWord33(ix1,ix,num1,0)
        end
        & FindPrimeWord32(ix1,num,ix+1)
    end

local proc FindPrimeWord33(ix1:<I,ix2:<I,num:<L,ix:<I) iff
    if ix < Len(AllAnagramWords) then
        if AllAnagramWords(ix).n = num then 
            Print('\n',AllAnagramWords(ix1).s,' ',AllAnagramWords(ix2).s,' ',AllAnagramWords(ix).s) end
        & FindPrimeWord33(ix1,ix2,num,ix+1)
    end

///////////////////////////////////////////////////////////////////////////////
// Assign a code number to each string. Each alphabet letter is assigned a 
// different prime number and all individual prime numbers corresponding 
// to the individual letters of the string are multiplied together, generating
// the code number. 
// The value of the prime number is not really important, what is important 
// is that all prime numbers are different.
// This way all strings with the same letters (in any order) will be
// assigned the same code number, for example
//
//      estimate
//      meatiest
//
// will both have assigned the code number 77075891882. Searching for an anagram
// of a word will be then reduced to searching for a word with the same
// code number.
// Also note that all non-alphabet characters will be assigned number 1,
// which will in effect ignore those characters. This will come in handy
// when dealing with words that contain spaces, aphostrophes etc.
//
///////////////////////////////////////////////////////////////////////////////

local proc AssignLetters(as:<S,ix:<I, out:.L) iff
    if ix < Len(as) then
        case as(ix) of
           "A"|"a" => out := out*2;
           "B"|"b" => out := out*3;
           "C"|"c" => out := out*5;
           "D"|"d" => out := out*7;
           "E"|"e" => out := out*11;
           "F"|"f" => out := out*13;
           "G"|"g" => out := out*17;
           "H"|"h" => out := out*19;
           "I"|"i" => out := out*23;
           "J"|"j" => out := out*29;
           "K"|"k" => out := out*31;
           "L"|"l" => out := out*37;
           "M"|"m" => out := out*41;
           "N"|"n" => out := out*43;
           "O"|"o" => out := out*47;
           "P"|"p" => out := out*53;
           "Q"|"q" => out := out*59;
           "R"|"r" => out := out*61;
           "S"|"s" => out := out*67;
           "T"|"t" => out := out*71;
           "U"|"u" => out := out*73;
           "V"|"v" => out := out*79;
           "W"|"w" => out := out*83;
           "X"|"x" => out := out*89;
           "Y"|"y" => out := out*97;
           "Z"|"z" => out := out*101;
        else 
            out := out*1
        end & AssignLetters(as,ix+1,out)
    end

///////////////////////////////////////////////////////////////////////////////
//
// Should you decide to generate your own list of words, use the folowing code.
// The original list of words was created by calling the query
//
// CreateAnagramWordsF1('ukacdasc.txt','AllAnagramWords.f1') 
//
// NOTE: The assumption is the input text file is an ASCII file containing 
// one word per line.
//
///////////////////////////////////////////////////////////////////////////////


subr CreateAllAnagramWordsF1(fin:.Ascii,fout:.Bin) iff 
    DbRewind(fout) & DbTruncate(fout) &
    DbWriteString(fout,'AllAnagramWords:<[0..]->(s:S,n:L) = [ \n    ') &
    comma :.I & comma:= 0 & ReadInPrimeFile(fin,fout,comma) &
    DbWriteString(fout,']\n')

local subr ReadInPrimeFile(fin:.Ascii, fout:.Bin, comma:.I) iff
    if DbAccess(fin,str) then 
        if ~'*\'*' in str then
            if comma = 1 then
                DbWriteString(fout,',\n    ') & comma := 1 
            end &
            DbWriteString(fout,'(\'') & 
            DbWriteString(fout,str) & 
            DbWriteString(fout,'\',') & 
            out:.L & out := 1 & AssignLetters(str,0,out) &
            DbWriteString(fout,RtlLtoS(out)) & 
            DbWriteString(fout,')') & 
            comma := 1 
        end &
        DbSkip(fin,1) & ReadInPrimeFile(fin,fout,comma)
    end
 
local proc DbWriteString(f:.Bin,s:<S) iff
    DbWriteString1(f,0,Len(s),s)

local proc DbWriteString1(f:.Bin,i:<I,len:<I,s:<S) iff
    if i < len then 
        DbPut(f,s(i)) & DbWriteString1(f,i+1,len,s) 
    end








This page was created by F1toHTML

/span> ~'*\'*' in str then if comma = 1 then DbWriteString(fout,',\n ') & comma := 1 end & DbWriteString(fout,'(\'') & DbWriteString(fout,str) & DbWriteString(fout,'\',') & out:.L & out := 1 & AssignLetters(str,0,out) & DbWriteString(fout,RtlLtoS(out)) & DbWriteString(fout,')') & comma := 1 end & DbSkip(fin,1) & ReadInPrimeFile(fin,fout,comma) end local proc DbWriteString(f:.Bin,s:<S) iff DbWriteString1(f,0,Len(s),s) local proc DbWriteString1(f:.Bin,i:<I,len:<I,s:<S) iff if i < len then DbPut(f,s(i)) & DbWriteString1(f,i+1,len,s) end

This page was created by F1toHTML