/* General alphametic (cryptarithmetic) solver in Picat. This is a more general solver for alphametic problems than http://www.hakank.org/picat/alphametic.pi Model created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ import util. import cp. main => go. go => go1. go1 => L = "SEND + MORE = MONEY", _Solution = runit(L, 10), nl. go2 => problems(Problems), println(problems=Problems), Base = 10, foreach(Problem in Problems) _Res = runit(Problem, Base) end, nl. % % Reading the problem from standard input. % We assume base 10. % go3 => Base = 10, print("Type the problem (e.g. send+more=money): "), Problem= read_line(), printf("The problem is: %w\n", Problem), _Solution = runit(Problem, Base), nl. % % This was inspired by one of the problem from the % Celebration Of Mind (Gathering for Gardner) Google Hangout % 2013-10-21. % % Here are some solutions. % % HOMAGE+HOMAGE=GATHER % MAGIC+MAGIC=GATHER % MAGIC+MAGIC=HOMAGE % MARTIN+HOMAGE=GATHER % MARTIN+MARTIN=GATHER % MARTIN+MARTIN=HOMAGE % go4 => Words = [ "MARTIN", "GARDNER", "HOMAGE", "GATHERING", "GATHER", "MIND", "MAGIC", "MATH", "CELEBRATION" ], Base = 10, % Weed out impossible words, i.e. % those with more than 10 different digits Words := [W : W in Words, W.remove_dups().length <= Base], println(Words), P = [], foreach(W1 in Words, W2 in Words, W3 in Words, W1 @< W2, W2 @< W3) W = W1 ++ "+" ++ W2 ++ "=" ++ W3, ( (_ = runit(W,Base)) -> P := P ++ [W] ; true ) end, foreach(PP in P.sort()) println(PP) end, nl. % % A larger file. % go5 => Words=split(read_file_chars("unixdict.txt"),"\n"), println(len=Words.length), % foreach(Word in Words) % println(Word) % end, Base = 10, Words := [W : W in Words, W.remove_dups().length <= Base, length(W) > 4], P = [], foreach(W1 in Words, W2 in Words, W3 in Words, W1 @< W2, W2 @< W3) W = W1 ++ "+" ++ W2 ++ "=" ++ W3, if _ = runit(W,Base) then P := P ++ [W] end end, foreach(PP in P.sort()) println(PP) end, nl. % % Another word list and with different base ( = Base) % % Base 10 % actors+actors=planner = 10 % actors+actors=solver = 10 % actors+pattern=planner = 10 % easy+easy=logic = 10 % easy+easy=picat = 10 % logic+logic=picat = 10 % logic+logic=puzzle = 10 % patterns+planner=planning = 10 % go6 => Words = [ "picat", "pattern", "patterns", "matching", "intuitive", "imperative", "constraints", "actors", "tabling", "planning", "planner", "puzzle", "logic", "function", "functions", "programming", "constraint", "solver", "minizinc", "solution", "solving", "solutions", "fun", "easy" ], Base = 10, % Weed out impossible words, i.e. % those with more than 10 different digits Words := [W : W in Words, W.remove_dups().length <= Base], println(Words), P = [], foreach(W1 in Words, W2 in Words, W3 in Words, W1 @=< W2, W2 @=< W3) W = W1 ++ "+" ++ W2 ++ "=" ++ W3, ( (_ = runit(W,Base)) -> P := P ++ [W=Base] ; true ) end, foreach(PP in P.sort()) println(PP) end, fail, nl. % % Theres a lot of solutions but only few that are true: % % five+four=nine % one+one=two % % eight+nine+three=twenty % seven+seven+six=twenty % go7 => Map = new_map([ "zero"=0, "one"=1, "two"=2, "three"=3, "four"=4, "five"=5, "six"=6, "seven"=7, "eight"=8, "nine"=9, "ten"=10, "eleven"=11, "twelve"=12, "thirteen"=13, "fourteen"=14, "fifthteen"=15, "sixteen"=16, "seventeen"=17, "eighteen"=18, "nineteen"=19, "twenty"=20 ]), Words = Map.keys, Base = 10, % Weed out impossible words, i.e. % those with more than 10 different digits Words := [W : W in Words, W.remove_dups().length <= Base], println(Words), P = [], % foreach(W1 in Words, W2 in Words, W3 in Words, W1 @=< W2, W2 @=< W3) foreach(W1 in Words, W2 in Words, W1 @=< W2, W3 in Words, W2 @=< W3, W4 in Words, W3 @=< W4) W = W1 ++ "+" ++ W2 ++ "+" ++ W3 ++ "=" ++ W4, ( (_ = runit(W,Base)) -> P := P ++ [W] ; true ) end, foreach(PP in P.sort()) println(pp=PP), % [W1,W2,W3] = split(PP,"+="), % if Map.get(W1) + Map.get(W2) == Map.get(W3) then % println(true=PP) % end [W1,W2,W3,W4] = split(PP,"+="), if Map.get(W1) + Map.get(W2) + Map.get(W3) == Map.get(W4) then println(PP) end end, % fail, nl. % % Parses the problem string, solve it and print the solution. % runit(Problem, Base) = Res => Problem := delete_all(Problem,' '), % remove spaces Split = split(Problem,"+="), println(problem=Problem), Unique=delete_all(Problem,+).delete_all(=).remove_dups(), HashDigits = new_map(), foreach(U in Unique) T :: 0..Base-1, HashDigits.put(U,T) end, List = [[HashDigits.get(T) : T in SS] : SS in Split], alphametic(List, Base, Res), % solve it writeln(res=Res), foreach(I in 1..Unique.length) println(Unique[I]=Res[I]) end, nl, print_res(List), nl. term_variables(L) = Flatten => Flatten1 = [], foreach(LL in L) Flatten1 := Flatten1 ++ LL end, Flatten2 = remove_dups(Flatten1), Flatten = Flatten2. alphametic(L,Base, Vars) => Last = L.last(), Sums = L.reverse().tail(), Vars = L.vars, % term_variables(L), all_different(Vars), Vals #= sum([Val : S in Sums, Val = calc(S,Base)]), Vals = calc(Last,Base), foreach(S in Sums) S[1] #> 0 end, Last[1] #> 0, solve([ff], Vars). calc(X,Base) = Y => Len = length(X), Y #= sum([X[I]*Base**(Len-I) : I in 1..Len]). print_res(L) => MaxLen = max([length(E) : E in L]), Last = L.last(), Sums = L.reverse().tail(), foreach(S in Sums) print_single(S,MaxLen) end, println("="), print_single(Last,MaxLen), nl. % print a single term print_single(L,MaxLen) => S = L, Len = L.length, if Len < MaxLen then foreach(_I in 1..(MaxLen-length(L))) S := " " ++ S end end, foreach(SS in S) print(SS) end, nl. problems(Problems) => Problems = [ "SEND+MORE=MONEY", "SEND+MOST=MONEY", "DONALD+GERALD=ROBERT", "SATURN+URANUS+NEPTUNE+PLUTO=PLANETS", "VINGT+CINQ+CINQ=TRENTE", "EIN+EIN+EIN+EIN=VIER", "WRONG+WRONG=RIGHT", "GATHER+HOMAGE=MARTIN" ].