///////////////////////////////////////////////////////////////////////////////
//
// Alphametics are word arithmetic problems where each letter is replaced
// by a unique digit 0-9.  This means that no two letters are assigned the 
// same values and no two digits are assigned to the same letter. Additionally,
// the initial letter of the word cannot be 0. Sometimes an additional 
// requirement of a single solution is specified.
//
// Some popular alphametics are:
//      send + more = money
//      donald + gerald = robert
//      cross + roads = danger
//      who + is + this = idiot
//      this + isa + great + time = waster
//
// The predicate Alphametic in the code below can find all solutions for any 
// alphametic. The predicate accepts two arguments: 
//
//       list of strings to be added, for example ('send','more',Nil)
//       resulting string ('money')
//
// The strings themselves can be in upper or lower case, deep down in the bowels 
// of the predicate they are all converted to lower case.
//
// Some examples:
//
// all Alphametic(('send','more',Nil),'money')
// all Alphametic(('who','is','this',Nil),'idiot')
// all Alphametic(('Winter', 'is', 'windier', 'summer', 'is',Nil), 'sunnier')
// all Alphametic(('Romans','also','more', 'or', 'less', 'added',Nil), 'letters')
// all Alphametic(('donald','gerald',Nil),'robert')
// all Alphametic(('cross','roads',Nil),'danger')
// all Alphametic(('this','isa','great','time',Nil),'waster')
//
// The code for the predicate Alphametic is quite straightforward. It was created
// as a generalization of a code for a single hardcoded alphametic 
//
//     and + to + all + a + good = night 
//
// The code for the above problem is in the predicate GoodNight and it is 
// also present in this file for reference purposes, possibly clarifying some 
// points of the predicate Alphametic.
//
///////////////////////////////////////////////////////////////////////////////

// Define some local types

local Digit09 = L[0..9]                     // number between 0..9
local WordVars = [0..]->Digit09             // array of numbers between 0..9
local Map = arr:[0..25]->I,lettersused:I    // structure used to count letters

pred Alphametic(strings:<list S,sum:<S) iff

    // Map has 26 values, one for each letter of alphabet. -1 neans letter not used,
    // otherwise it is an index of the letter in the order of appearance.

    map :.Map & map := 
    ([-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1],0) &

    // Having initialized the map, count the number of different letters used 
    // in all strings.

    CountVars(strings,sum,map) &

    // Define an array of variables, one for each letter used.

    v::[0..]->>Digit09 & Len(v,map.lettersused) &

    maxlen = Len(sum) & // the length of the longest string
    wall::[0..]->WordVars & Len(wall,Len(strings)) & 

    // Using the map, convert strings to arrays, assign a variable for each letter and
    // pad the arrays to the same lengths (maxlen)

    ListToVars(strings,wall,v,map,maxlen,0) &
    StringToVars(res,sum,v,map,maxlen) & 

    // Define some additional variables (remainders and carries)

    r1::[0..]->L[0..] & Len(r1,maxlen) & 
    c1::[0..]->L[0..] & Len(c1,maxlen+1) & c1(0) = 0 & c1(maxlen) = 0 &

    // Set up constraints between the variables

    SumAllColumns(wall,res,r1,c1,0) &

    // Print one result

    PrintResult(wall,res,0) 


///////////////////////////////////////////////////////////////////////////////
//
// Helper routines
//
///////////////////////////////////////////////////////////////////////////////

// Sum all columns af all arrays.
local pred SumAllColumns(wall::[0..]->WordVars,res::WordVars,r1::[0..]->L[0..],
    c1::[0..]->L[0..],ix:<I) iff
    if ix < Len(res) then
        SumColumns2(wall,res,r1,c1,ix) & SumAllColumns(wall,res,r1,c1,ix+1)
    end

local pred SumColumns2(wall::[0..]->WordVars,res::WordVars,r1::[0..]->L[0..],
    c1::[0..]->L[0..],column:<I) iff
    SumOneColumn(wall,0,sumout,column,0) & 
    sumout + c1(column) = r1(column) & 
    res(column) = r1(column) mod 10 & c1(column+1) = r1(column) / 10 

// sumout = wall(i,column) + wall(i+1,column) +...wall(Len(wall)-1,column)
local pred SumOneColumn(wall::[0..]->WordVars,sumin::L,sumout::L, column:<I,i:<I) iff
    if i < Len(wall) then
        SumOneColumn(wall,sumin + wall(i,column),sumout,column,i+1)
    else
        sumout = sumin
    end


///////////////////////////////////////////////////////////////////////////////
//
// Routines for a formatted output of results.
//
///////////////////////////////////////////////////////////////////////////////
local proc PrintResult(w:<[0..]->WordVars,res:<WordVars,i:<I) iff
    if i < Len(w) then 
        PrintNumString(w(i)) & PrintResult(w,res,i+1)
    else
        Print('\n -------') &
        PrintNumString(res) &
        Print('\n') 
    end

local proc PrintNumString(w:<WordVars) iff
    Print('\n ') & PrintNumString1(RtlReverse(w),1,0)

local proc PrintNumString1(w:<WordVars,blank:<I,i:<I) iff
    if i < Len(w) then 
        if w(i) = 0 & blank = 1 then
            Print(' ') & PrintNumString1(w,1,i+1) {don't print leading zeros}
        else
            Print(w(i)) & PrintNumString1(w,0,i+1) 
        end 
    end        

///////////////////////////////////////////////////////////////////////////////
// Go thru all strings and count all letters used. Update the letter map
// accordingly.
///////////////////////////////////////////////////////////////////////////////
local pred CountVars(strings:<list S,sum:<S,map:.Map) iff 
    if strings = h,t then
        CountVarsInOneString(RtlToLowerString(h),map,0) & CountVars(t,sum,map)
    end &
    CountVarsInOneString(RtlToLowerString(sum),map,0)

///////////////////////////////////////////////////////////////////////////////
// Given a string and a map of characters, mark all used characters in the map. 
//
///////////////////////////////////////////////////////////////////////////////
local pred CountVarsInOneString(s:<S, map:.Map,i:<I) iff
    if i < Len(s) then
        if map.arr(s(i)-"a") = -1 then {if character not encountered yet}
            map.arr(s(i)-"a") := map.lettersused & map.lettersused := map.lettersused+1
        end & CountVarsInOneString(s,map,i+1)
    end
        

///////////////////////////////////////////////////////////////////////////////
//
// Having a map of used letters and an array of variables, assign a variable
// for each letter (same letters will use the same variable).
// Convert strings to lower case.
// Create arrays of variables based on the string letters.
// Assure the first character of the string is never 0.
// Pad unused array of variable entries with zeros.
//
///////////////////////////////////////////////////////////////////////////////
local pred ListToVars(strings:<list S,wall::[0..]->WordVars,v::[0..]->>Digit09,map:.Map,maxlen:<I,i:<I) iff
    if strings = h,t then
        StringToVars(wall(i),h,v,map,maxlen) & ListToVars(t,wall,v,map,maxlen,i+1)
    end

local pred StringToVars(w::WordVars,s:<S,v::[0..]->>Digit09,map:.Map,maxlen:<I) iff
    Len(w,maxlen) & StringToVars1(w,RtlToLowerString(RtlReverse(s)),v,map,maxlen,0)  

local pred StringToVars1(w::WordVars,s:<S,v::[0..]->>Digit09,map:.Map,maxlen:<I,i:<I) iff
    if i < maxlen then      // for all array elements
        if i < Len(s) then
            w(i) = v(map.arr(s(i)-"a")) &
            if i = Len(s) -1 then w(i) <> 0 end // first string character cannot represent zeros
        else
            w(i) = 0        // pad with zeros if array longer than the string
        end & StringToVars1(w,s,v,map,maxlen,i+1)
    end
        

///////////////////////////////////////////////////////////////////////////////
// The following code solves a hardwired alphametic:
//  
//      AND 
//  +    TO 
//  +   ALL 
//  +     A 
//  +  GOOD 
//    -----
//    NIGHT 
//
// The code is here for illustration purposes, as it is quite easy to follow
// the steps used to solve the problem.
//
// By generalizing the specialized code we would eventually derive all the 
// above code for the predicate Alphametic and all supporting routines.
//
// To execute this code, issue the query
//
//      all GoodNight()
// 
///////////////////////////////////////////////////////////////////////////////

pred GoodNight() iff

    // Nine variables used, corresponding to nine letters used : a,n,d,t,o,l,g,i,h 
    // They must be all different.

    v::[0..]->>Digit09 & Len(v,9) & v = [a,n,d,t,o,l,g,i,h] &
    wall::[0..]->[0..4]->Digit09 & Len(wall,5) & // five strings added

    // Break individual strings into letters. Reverse them and pad them all with zeros
    // up to the length of the longest (i.e.resulting) string, in our case 'night'.
    // Note we don't want any leading zeroes, therefore the letters "a","t","g","n"
    // are explicitely declared as non-zero

    wall(0) = [d,n,a,0,0] & a <> 0 &  
    wall(1) = [o,t,0,0,0] & t <> 0 &  
    wall(2) = [l,l,a,0,0] & a <> 0 &  
    wall(3) = [a,0,0,0,0] & a <> 0 &  
    wall(4) = [d,o,o,g,0] & g <> 0 &  

    // Break down the "result" string into letters, same procedure as for the previous 
    // strings:

    res ::[0..]->Digit09 & res = [t,h,g,i,n] & n <> 0 &

    // The above steps are generalized for a list of strings in the routine
    //  ListToVars(strings,wall,v,map,maxlen,0) &

    r1::[0..]->L[0..] & Len(r1,Len(res)) &  {array of remainders, one for each column}

    // Array of carries, one for each column. The first one is guaranteed to be zero.
    // This way we can treat all columns eaqually

    c1::[0..]->L[0..] & Len(c1,Len(res)+1) & c1(0) = 0 & 

    // Set up the constraints by specifying the relations between individual variables:
    // add the columns just like adding regular multidigit numbers: 
    //
    //     d + o + l + a + d      = t1 & t = t1 mod 10 & c1 = t1 / 10 &
    //     n + t + l     + o + c1 = h1 & h = h1 mod 10 & c2 = h1 / 10 &
    //     a     + a     + o + c2 = g1 & g = g1 mod 10 & c3 = g1 / 10 &
    //                     g + c3 = i1 & i = i1 mod 10 & c4 = i1 / 10 &
    //                         c4 = n  &
       
    // By renaming the variables the above relations can be expressed as follows:

    wall = [w0,w1,w2,w3,w4] &

    w0(0) + w1(0) + w2(0) + w3(0) + w4(0) + c1(0) = r1(0) & res(0) = r1(0) mod 10 & c1(0+1) = r1(0) / 10 &
    w0(1) + w1(1) + w2(1) + w3(1) + w4(1) + c1(1) = r1(1) & res(1) = r1(1) mod 10 & c1(1+1) = r1(1) / 10 &
    w0(2) + w1(2) + w2(2) + w3(2) + w4(2) + c1(2) = r1(2) & res(2) = r1(2) mod 10 & c1(2+1) = r1(2) / 10 &
    w0(3) + w1(3) + w2(3) + w3(3) + w4(3) + c1(3) = r1(3) & res(3) = r1(3) mod 10 & c1(3+1) = r1(3) / 10 &
    w0(4) + w1(4) + w2(4) + w3(4) + w4(4) + c1(4) = r1(4) & res(4) = r1(4) mod 10 & c1(4+1) = r1(4) / 10 &

    // All the above columns adding can be replaced by a single call "SumAllColumns(wall,res,r1,c1,0)",

    // We are done, print the result:

    Print('\n')     &
    Print('   ',  a,n,d, '\n') &
    Print('    ',   t,o, '\n') & 
    Print('   ',  a,l,l, '\n') & 
    Print('     ',    a, '\n') & 
    Print('  ', g,o,o,d, '\n') &
    Print(' -----\n') &
    Print(' ',n,i,g,h,t, '\n') 

This page was created by F1toHTML