Monday, November 20, 2006

Cryptogram solver

Newspaper puzzles beware. I have been working on soving newspaper cryptograms for the past few days in my free time. It is a bit more interesting of a problem to solve than sudoku I think. The algorithm I've implementing is nothing alltogether impressive and it relies on a good dictionary file to get solutions.

The algorithm works like so:
First you need an index which is a map of abstract words to lists of words.
An abstract word is taking a word and turning it into a pattern, for instance, 'cat' has the pattern '123', as does 'hat', and 'fat'. 'mom' has the pattern '121'.

Then it takes the sentence you have given it, splits it on spaces.
Popping the first word off the list, finds the list in the index of possible words it could be, iterates over it generating a map of letters to letters and recurses on the rest of the sentence, once it has reached the end of the sentence it puts the map it has generated into a list of possible solutions. If a generated map for a word conflicts with teh current map it is not a valid solution and moves onto the next possible solution.
The solve function returns a list of solution maps that can eb applied to any sentence to get the result.

Little things that make it helpful include being able to give an intial map, if you are sure some letters map to other letters you can give that as a hint. It can also remove any words whos pattern does not appear in the map.

Todo:
Solve only those subsets of words that, if solved, will result in the entire alphabet being solved. It should do this for all possible combinations of words in teh sentence that will result in this. This is not an optimizations, it should probably make it take longer to solve actually, however it allows it to solve sentences with words that might not exist in the dictionary but could come about as a result of solving the other words. I have a few ideas of how to do this but havn't had time to implement it yet.

The current code can be downloaded here.

Tuesday, November 14, 2006

Sudoku

I've got sudoku fever! Actually, no, I don't, I don't really like sudoku at all but I decided to write a solver in erlang. It was pretty trivial. The basic algorithm is as follows:
1) Create a list of every blank square and the possible values that can go into that square
2) Find the square with the least number of possible values
3) Iterate over the list of possible numbers that can be in that square, create a new board with that value in it and recurse on the new board
4) Continue until there are no more possible values (in which case it failed) or the puzzle is solved.

The code is not the prettiest stuff in the world but it appears to solve the problem (specifically the remove_* functions).

Usage looks like:

Eshell V5.5.1 (abort with ^G)
1> {solved, Res} = sudoku:solve([
1> [9, 5, b, b, b, 6, 4, 7, b],
1> [4, b, 8, 7, b, 2, b, b, b],
1> [6, 2, b, 4, b, b, b, 5, b],
1> [5, b, 2, b, 6, b, 3, b, b],
1> [b, b, b, 2, b, 7, b, b, b],
1> [b, b, 4, b, 1, b, 2, b, 8],
1> [b, 7, b, b, b, 9, b, 3, 4],
1> [b, b, b, 1, b, 3, 7, b, 5],
1> [b, 4, 3, 5, b, b, b, 2, 9]]).
...
2> sudoku:print(Res).
9 5 1 8 3 6 4 7 2
4 3 8 7 5 2 9 6 1
6 2 7 4 9 1 8 5 3
5 8 2 9 6 4 3 1 7
3 1 9 2 8 7 5 4 6
7 6 4 3 1 5 2 9 8
8 7 5 6 2 9 1 3 4
2 9 6 1 4 3 7 8 5
1 4 3 5 7 8 6 2 9
ok


Code (can be downloaded here):

-module(sudoku).

-export([solve/1, print/1]).

solve(Puzzle) when is_list(Puzzle) ->
solve_puzzle(dict_from_list(Puzzle)).

print(Puzzle) ->
lists:foreach(fun(X) ->
lists:foreach(fun(Y) ->
io:format("~w ", [dict:fetch({X, Y}, Puzzle)])
end, lists:seq(0, 8)),
io:format("~n", [])
end, lists:seq(0, 8)).

dict_from_list(List) ->
element(2, lists:foldl(fun(Elm, {X, Dict}) ->
{_, DDict} = lists:foldl(fun(Elem, {Y, NDict}) ->
{Y + 1, dict:store({X, Y}, Elem, NDict)}
end, {0, Dict}, Elm),
{X + 1, DDict}
end, {0, dict:new()}, List)).

solve_puzzle(Puzzle) ->
case generate_open_spots(Puzzle) of
[{{X, Y}, Set} | _] ->
try_value({X, Y}, Set, Puzzle);
[] ->
{solved, Puzzle}
end.

try_value(_, [], Puzzle) ->
print(Puzzle),
io:format("~n", []),
failed;
try_value({X, Y}, [H | R], Puzzle) ->
case solve_puzzle(dict:store({X, Y}, H, Puzzle)) of
{solved, RPuzzle} ->
{solved, RPuzzle};
failed ->
try_value({X, Y}, R, Puzzle)
end.

generate_open_spots(Puzzle) ->
OpenSquareList = dict:fold(fun(Key, b, Acc) ->
[Key | Acc];
(_Key, _Value, Acc) ->
Acc
end, [], Puzzle),
lists:sort(fun({{_X1, _Y1}, E1}, {{_X2, _Y2}, E2}) when length(E1) < length(E2) ->
true;
(_E1, _E2) ->
false
end, generate_open_values(OpenSquareList, Puzzle)).

generate_open_values(List, Puzzle) ->
generate_open_values(List, [], Puzzle).

generate_open_values([], Acc, _Puzzle) ->
Acc;
generate_open_values([{X, Y} | R], Acc, Puzzle) ->
generate_open_values(R, [{{X, Y}, remove_region_vals({X, Y},
remove_x_vals(Y,
remove_y_vals(X, lists:seq(1, 9),
Puzzle),
Puzzle),
Puzzle)} | Acc],
Puzzle).

remove_x_vals(Y, List, Puzzle) ->
lists:foldl(fun(Idx, Acc) ->
case dict:fetch({Idx, Y}, Puzzle) of
b ->
Acc;
E ->
lists:delete(E, Acc)
end
end,
List, lists:seq(0, 8)).

remove_y_vals(X, List, Puzzle) ->
lists:foldl(fun(Idx, Acc) ->
case dict:fetch({X, Idx}, Puzzle) of
b ->
Acc;
E ->
lists:delete(E, Acc)
end
end,
List, lists:seq(0, 8)).

remove_region_vals({X, Y}, List, Puzzle) ->
{RX, RY} = find_region(X, Y),
lists:foldl(fun(IX, AccX) ->
lists:foldl(fun(IY, AccY) ->
case dict:fetch({IX, IY}, Puzzle) of
b ->
AccY;
E ->
lists:delete(E, AccY)
end
end, AccX, lists:seq(RY, RY + 2))
end, List, lists:seq(RX, RX + 2)).

find_region(X, Y) ->
{find_region(X), find_region(Y)}.

find_region(V) when V >= 0, V < 3 ->
0;
find_region(V) when V >= 3, V < 6 ->
3;
find_region(V) when V >= 6, V < 9 ->
6.