As my assignment I'm creating a sudoku solver in Erlang using concurrency. My initial idea was to use backtracking algorithm which would spawn new threads whenever it's making a choice.
However, after putting some time and thought into the project I'm starting to think that the way I wanted to solve this is a bit too complicated. Has anyone done something similiar in the past? Would you recommend some different algorithm that would work better with Erlang and concurrency?
BackTracking algorithm is not really adapted to use concurrency. Of course, it is always possible to spawn several processes in parallel that start with different initial conditions (all possible values of the first or 2 first cells to solve). But I don't think this is a true concurent application.
A more suitable algorithm is the propagation of constraints. The idea is to create a process per cell, each cell knowing the 20 "connected cells" processes (8 in the same column, 8 in the same line, and 4 more in the same square). A cell has a state which contain - at least - all the possible values it can take. If a cell has only one single possible value remaining, after initialisation or during the propagation of constraint, it sends a message {remove,Value} to all its connected cells to inform them to remove the value from their list.
It is a true concurrent process, but it has (at least) 2 issues:
- knowing when a solution is found or when the propagation is stuck;
- Only the simplest puzzles will be solved by this algorithm in one shot.
There are some other rules that could be used to solve more complex puzzles. For example look for numbers that have only one remaining possibility, looking for pairs... But these rules are not really easy to implement in parallel, and I don't know the set of rules necessary to solve any puzzle.
Note In the general case the set of rule does not exist since a puzzle may have multiple solutions, although it is not the case for the puzzles we can find in newspapers.
My idea is to complete the constraint propagation algorithm with a search algorithm. A new process, the controller, is in charge to:
- initialize the puzzle
- select the most promissing trial
- ask to make the trial to the cell processes,
- control the end of the propagation process,
- check if it is
- a solution -> print it
- a dead end -> ask to come back to previous state, remove the initial trial number from the list, and select the next most promising trial
- ask to store the current result state and continue to the next trial
So the cells have to complete their state with a stack where they can push and pop their current list of possible value.
The most promising trial can be the selected this way: find the cell with the less remaining possible values, and take the first one.
The next problem is to synchronize everything. The first "simple" solution is to use a timeout. But as always, a timeout is very difficult to define, and at the end very inefficient. I would keep a timeout only for debug purpose, so with a rather big value, because there are some risks that it doesn't work at the first attempt :o).
An alternative to the timeout is to use a counter. Each time the controller sends a message that need synchronization, it increments its counter. Each time a cell has complete the handling of a message that needs synchronization, it returns an {ack_synchro,N} message to the controller, which in turn subtracts N to its counter. Doing this, during the propagation of constraint, when a cell has only one remaining possible value, it can send an {ack_synchro,-20} to the controller before sending the {remove,Value} to its connected cells so the controller "knows" it has to wait for 20 messages more. With this principle, it is possible to synchronize the activity of the cells for the push, pop, {try,Value}, {remove,Value} messages.
I guess it is missing a lot of details, and I am not sure that it will be faster than the imperative backtracking, but it should work at a reasonable coding cost, and it is concurrent.
Edit
I coded this proposal, it is tested with only 2 test cases, one simple puzzle, one complex, and it works fine. Here is the code:
The main module (actually it runs in the shell process) to solve a puzzle use the command: sudo:start(file,Filename) or sudo:start(table,InitialList):
-module (sudo).
-export ([start/2]).
start(file,File) ->
{ok,[Table]} = file:consult(File),
start(table,Table);
start(table,Table) ->
init_cells(),
solve(Table),
print_result(),
stop().
stop() ->
lists:foreach(fun(X) -> cell:stop(X) end ,cells()).
cells() ->
[a1,a2,a3,a4,a5,a6,a7,a8,a9,
b1,b2,b3,b4,b5,b6,b7,b8,b9,
c1,c2,c3,c4,c5,c6,c7,c8,c9,
d1,d2,d3,d4,d5,d6,d7,d8,d9,
e1,e2,e3,e4,e5,e6,e7,e8,e9,
f1,f2,f3,f4,f5,f6,f7,f8,f9,
g1,g2,g3,g4,g5,g6,g7,g8,g9,
h1,h2,h3,h4,h5,h6,h7,h8,h9,
i1,i2,i3,i4,i5,i6,i7,i8,i9].
init_cells() ->
lists:foreach(fun(X) -> cell:start_link(X) end ,cells()),
Zip = lists:zip(cells(),lists:seq(0,80)),
lists:foreach(fun({N,P}) -> cell:init(N,neighbors(P,Zip)) end, Zip),
wait(81).
neighbors(P,Zip) ->
Line = fun(X) -> X div 9 end,
Col = fun(X) -> X rem 9 end,
Square = fun(X) -> {Line(X) div 3, Col(X) div 3} end,
Linked = fun(X) -> (X =/= P) andalso
( (Line(X) == Line(P)) orelse
(Col(X) == Col(P)) orelse
(Square(X) == Square(P))) end,
[Name || {Name,Pos} <- Zip, Linked(Pos)].
solve(Table) ->
Zip = lists:zip(cells(),Table),
test(Zip),
do_solve(is_solved()).
do_solve({true,_,_,_}) ->
done;
do_solve({false,Name,Value,_}) ->
push(),
test(Name,Value),
do_solve(is_solved());
do_solve(error) ->
pop(),
{false,Name,Value,_} = is_solved(),
remove(Name,Value),
do_solve(is_solved()).
print_result() ->
R = get_cells(),
F = fun({_,[I]},Acc) ->
case Acc of
_ when (Acc rem 27) == 0 -> io:format("~n~n ~p",[I]);
_ when (Acc rem 9) == 0 -> io:format("~n ~p",[I]);
_ when (Acc rem 3) == 0 -> io:format(" ~p",[I]);
_ -> io:format(" ~p",[I])
end,
Acc+1
end,
lists:foldl(F,0,R),
io:format("~n").
test(List) ->
F = fun({_,0},Acc) ->
Acc;
({Name,Value},Acc) ->
cell:test(Name,Value),
Acc+1
end,
NbMessages = lists:foldl(F,0,List),
wait(NbMessages).
test(_,0) -> ok;
test(Name,Value) ->
cell:test(Name,Value),
wait(1).
remove(Name,Value) ->
cell:remove(Name,Value),
wait(1).
push() ->
lists:foreach(fun(X) -> cell:push(X) end, cells()),
wait(81).
pop() ->
lists:foreach(fun(X) -> cell:pop(X) end, cells()),
wait(81).
wait(0) ->
done;
wait(NbMessages) ->
receive
{done,N} -> wait(NbMessages-N);
{add,N} -> wait(NbMessages+N)
after 2000 ->
error
end.
get_cells() ->
F = fun(X) -> cell:get_val(X), receive {possible,M} -> M end, {X,M} end,
[F(X) || X <- cells()].
is_solved() ->
State = get_cells(),
F = fun({_,[]},_) -> error;
(_,error) -> error;
({Name,List},Acc = {_,_CurName,_CurVal,Length}) ->
NL = length(List),
case (NL > 1) andalso( NL < Length) of
true -> {false,Name,hd(List),NL};
false -> Acc
end
end,
lists:foldl(F,{true,none,0,10},State).
The Cell server and its interfaces
-module (cell).
-export ([start_link/1,init/2,push/1,pop/1,test/2,remove/2,stop/1,get_val/1]).
% Interfaces
start_link(Name) ->
Pid = spawn_link(fun() -> init() end),
register(Name,Pid).
init(Name,List) ->
Name ! {init,self(),List}.
push(Name) ->
Name ! push.
pop(Name) ->
Name ! pop.
test(Name,Value) ->
Name ! {test,Value}.
remove(Name,Value) ->
Name ! {remove,Value}.
get_val(Name) ->
Name ! get.
stop(Name) ->
Name ! stop.
% private
init() ->
loop(none,[],[],[]).
loop(Report,Possible,Stack,Neighbors) ->
receive
{init,R,List} ->
R ! {done,1},
loop(R,lists:seq(1,9),[],List);
push ->
Report ! {done,1},
loop(Report,Possible,[Possible|Stack],Neighbors);
pop ->
Report ! {done,1},
loop(Report,hd(Stack),tl(Stack),Neighbors);
{test,Value} ->
NewP = test(Report,Possible,Neighbors,Value),
loop(Report,NewP,Stack,Neighbors);
{remove,Value} ->
NewP = remove(Report,Possible,Neighbors,Value),
loop(Report,NewP,Stack,Neighbors);
get ->
Report ! {possible,Possible},
loop(Report,Possible,Stack,Neighbors);
stop ->
ok
end.
test(Report,Possible,Neighbors,Value) ->
true = lists:member(Value,Possible),
Report ! {add,20},
lists:foreach(fun(X) -> remove(X,Value) end, Neighbors),
Report ! {done,1},
[Value].
remove(Report,Possible,Neighbors,Value) ->
case Possible of
[Value,B] ->
remove(Report,B,Neighbors);
[A,Value] ->
remove(Report,A,Neighbors);
_ ->
Report ! {done,1}
end,
lists:delete(Value,Possible).
remove(Report,Value,Neighbors) ->
Report ! {add,20},
lists:foreach(fun(X) -> remove(X,Value) end, Neighbors),
Report ! {done,1}.
a test file:
[
0,0,0,4,0,6,9,0,0,
0,0,0,0,0,0,1,0,0,
0,0,0,3,0,0,0,7,2,
0,0,5,6,4,0,0,0,0,
0,2,3,0,8,0,0,0,1,
0,8,0,0,0,2,4,0,5,
0,7,8,0,0,0,5,0,0,
6,0,1,0,0,7,2,0,0,
0,0,2,0,0,9,0,0,0
].
in action:
1> c(sudo).
{ok,sudo}
2> c(cell).
{ok,cell}
3> timer:tc(sudo,start,[file,"test_hard.txt"]).
1 3 7 4 2 6 9 5 8
2 6 9 7 5 8 1 4 3
8 5 4 3 9 1 6 7 2
7 1 5 6 4 3 8 2 9
4 2 3 9 8 5 7 6 1
9 8 6 1 7 2 4 3 5
3 7 8 2 1 4 5 9 6
6 9 1 5 3 7 2 8 4
5 4 2 8 6 9 3 1 7
{16000,ok}
4>
No comments in the code, but it does exactly what I propose in the first part of the answer.
if you install wx , just run sudoku:go(). https://github.com/erlang/otp/blob/86d1fb0865193cce4e308baa6472885a81033f10/lib/wx/examples/sudoku/sudoku.erl
or see this project:
https://github.com/apauley/sudoku-in-erlang
I am trying to implement the Thistlethwaite's algorithm in Haskell, following the descriptions found here, but encountered difficulties.
So far, I have managed to represent the cube, make it move as one likes, and display it on the terminal (a 2-dimensional representation), but I got problems when trying to reduce a general cube to one which can be obtained from a standard cube by moves in the group (R, L, F, B, U2, D2) (notations as in the link), as there are too many cases to consider: how many colors on the up layer are wrongly-oriented, on the middle layer, etc. This is only the first stage in the description, but I found a mess in my codes already, so I must have missed something.
As I am not sure if my description above is clear, I put up the relevant codes below, which are not correct, but indicate the problem.
--To intersect lists, of which the sizes are not very large, I chose to import the Data.List
import Data.List
--Some type declarations
data Colors = R | B | W | Y | G | O
type R3 = (Int, Int, Int)
type Cube = R3 -> Colors
points :: [R3] --list of coordinates of facelets of a cube; there are 48 of them.
mU :: Cube -> Cube --and other 5 moves.
type Actions = [Cube -> Cube]
turn :: Cube -> Actions -> Cube --chains the actions and turns the cube.
edges :: [R3] --The edges of cubes
criterion :: Colors -> R3 -> Bool -- determine if the edges are mis-placed.
criterion co p#(x, y, z) = case co of --W and Y are up and down faces respectively.
R -> not (or [abs(x) == 3, abs(y) == 3])
B -> not (or [abs(y) == 3, abs(z) == 3])
O -> not (or [abs(x) == 3, abs(y) == 3])
G -> not (or [abs(y) == 3, abs(z) == 3])
_ -> True
stage1 :: Cube -> Cube
stage1 c = turn c opes where
wrongs = do
res <- [[]]
eg <- edges
if criterion (c eg) eg
then res
else res ++ [eg]
ups = filter (\(x, y, z) -> y == 3) points
downs = filter (\(x, y, z) -> y == -3) points
middles = filter (\(x, y, z) -> y == 0) points
opes = do
res <- [[]]
case length (intersect middles wrongs) of
0 -> case [length (intersect ups wrongs) == 0, length (intersect downs wrongs) == 0] of
[True, True] -> res
[True, False] -> [mD] --A quarter turn of the downside of the cube.
[False, True] -> [mU]
_ -> [mD, mU]
1 -> let [(x, y, z)] = intersect middles wrongs in
if x == 3 then case [length (intersect ups wrongs) == 0, length (intersect downs wrongs) == 0] of
[True, True] -> if z > 0 then [mR, mU] else [mR, mD]
[True, False] -> if z > 0 then [mD, mR, mU] else [mD, mR, mD]
[False, True] -> if z > 0 then [mU, mR, mU] else [mU, mR, mD]
_ -> if z > 0 then [mD, mU, mR, mU] else [mD, mU, mR, mD]
else []
Then I realized that the above code is wrong as I cannot simply make a quarter turn U or D which makes the correct edges, if any, become incorrect, and I shall discuss 125 = 5 * 5 * 5 cases according to how many wrong edges are on each of the three layers of the cube, which I think of as not "right."
So my question is how to implement an algorithm that can handle so many cases, in a nice way?
If something about the description is unclear, please tell me so that I can explain what I am doing and what my problem is.
Any ideas and suggestions are greatly appreciated, thanks very much in advance.
P.S. I originally wanted to implement Korf's or Kociemba's algorithms, though it turned out that I cannot even handle the simplest case.
One thing - this code:
wrongs = do
res <- [[]]
eg <- edges
if criterion (c eg) eg
then res
else res ++ [eg]
is better written as filter (\eg -> not (criterion (c eg) eg)) edges.
As practice, I am trying to write a simulation for the casino game "war" in Haskell.
http://en.wikipedia.org/wiki/Casino_war
It is a very simple game with a few rules. It would be an otherwise very simple problem to write in any of the imperative language I know, however I am struggling to write it in Haskell.
The code I have so far:
-- Simulation for the Casino War
import System.Random
import Data.Map
-------------------------------------------------------------------------------
-- stolen from the internet
fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g)
fisherYatesStep (m, gen) (i, x) = ((insert j x . insert i (m ! j)) m, gen')
where
(j, gen') = randomR (0, i) gen
fisherYates :: RandomGen g => g -> [a] -> ([a], g)
fisherYates gen [] = ([], gen)
fisherYates gen l = toElems $ Prelude.foldl
fisherYatesStep (initial (head l) gen) (numerate (tail l))
where
toElems (x, y) = (elems x, y)
numerate = zip [1..]
initial x gen = (singleton 0 x, gen)
-------------------------------------------------------------------------------
data State = Deal | Tie deriving Show
-- state: game state
-- # cards to deal
-- # cards to burn
-- cards on the table
-- indices for tied players
-- # players
-- players winning
-- dealer's winning
type GameState = (State, Int, Int, [Int], [Int], Int, [Int], Int)
gameRound :: GameState -> Int -> GameState
gameRound (Deal, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) card
| toDeal > 0 =
-- not enough card, deal a card
(Deal, toDeal - 1, 0, card:inPlay, tied, numPlayers, pWins, dWins)
| toDeal == 0 =
-- enough cards in play now
-- here should detemine whether or not there is any ties on the table,
-- and go to the tie state
let
dealerCard = head inPlay
p = zipWith (+) pWins $ (tail inPlay) >>=
(\x -> if x < dealerCard then return (-1) else return 1)
d = if dealerCard == (maximum inPlay) then dWins + 1 else dWins - 1
in
(Deal, numPlayers + 1, 0, [], tied, numPlayers, p, d)
gameRound (Tie, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins) card
-- i have no idea how to write the logic for the tie state AKA the "war" state
| otherwise = (Tie, toDeal, toBurn, inPlay, tied, numPlayers, pWins, dWins)
-------------------------------------------------------------------------------
main = do
rand <- newStdGen
-- create the shuffled deck
(deck, _) <- return $ fisherYates rand $ [2 .. 14] >>= (replicate 6)
-- fold the state updating function over the deck
putStrLn $ show $ Prelude.foldl gameRound
(Deal, 7, 0, [], [], 6, [0 ..], 0) deck
-------------------------------------------------------------------------------
I understand why extra work has to go towards creating random numbers, but I am pretty sure I am missing some basic construct or concept. It shouldn't be this awkward to keep a collection of states, and run a branching logic over a list of input. I couldn't even figure out a good way to write the logic for the case where there are ties on the table.
I am not asking for complete solutions. It would be real nice if someone could point out what I am doing wrong, or some good reading materials that are relevant.
Thanks in advance.
A useful design pattern for maintaining application state is the so called state monad. You can find a description and some introductory examples here. Also, you might want to consider using a data type with named fields instead of a tuple for GameState, for example:
data GameState = GameState { state :: State,
toDeal :: Int
-- and so on
}
This will make it easier to access/update individual fields using record syntax.
To make the code more readable, you should break up the structure of the game into meaningful components, and reorganizing your code accordingly. What you've done is to put all the game's state into one data structure. The result is that you have to deal with all the game details all the time.
The game keeps track of scores for each player and the dealer. Sometimes it adds 1 or subtracts 1 from a score. Scores aren't used for anything else. Separate out the score management from the other code:
-- Scores for each player and the dealer
data Score = Score [Int] Int
-- Outcome for each player and the dealer. 'True' means a round was won.
data Outcome = Outcome [Bool] Bool
startingScore :: Int -> Score
startingScore n = Score (replicate n 0) 0
updateScore :: Outcome -> Score -> Score
updateScore (Outcome ps d) (Score pss ds) = Score (zipWith upd pss pos) (update ds d)
where upd s True = s+1
upd s False = s-1
The cards dealt are also associated with players and the dealer. Winning or losing a round is based only on the card values. Separate out the score computation from the other code:
type Card = Int
data Dealt = Dealt [Card] Card
scoreRound :: Dealt -> Outcome
scoreRound (Dealt ps dealerCard) = Outcome (map scorePlayer ps) (dealerCard == maximumCard)
where
maximumCard = maximum (dealerCard : ps)
scorePlayer p = p >= dealerCard
I would say a game round consists of all steps needed to produce a single Outcome. Reorganize the code accordingly:
type Deck = [Card]
deal :: Int -> Deck -> (Dealt, Deck)
deal n d = (Dealt (take n d) (head $ drop n d), drop (n+1) d) -- Should check whether deck has enough cards
-- The 'input-only' parts of GameState
type GameConfig =
GameConfig {nPlayers :: Int}
gameRound :: GameConfig -> Deck -> (Deck, Outcome)
gameRound config deck = let
(dealt, deck') = deal (nPlayers config) deck
outcome = scoreRound dealt
in (deck', outcome)
This covers most of what was in the original code. You can approach the rest in a similar way.
The main idea you should get is that Haskell makes it easy to decompose programs into small pieces that are meaningful on their own. That is what makes code easier to work with.
Instead of putting everything into GameState, I created Score, Outcome, Dealt, and Deck. Some of these data types came from the original GameState. Others were not in the original code at all; they were implicit in the way complicated loops were organized. Instead of putting the entire game into gameRound, I created updateScore, scoreRound, deal, and other functions. Each of these interacts with only a few pieces of data.
It occurred to me that the recommendation 'use StateT' might be a little opaque so I translated a bit into that jargon, hoping you could see how to go from there. It might be best to include the state of the deck in the game state. gameround below just restates your function in StateT lingo. The previous definition, game uses the deck field of the game state, continuously reduced, and contains the whole game. I introduce IO actions, just to show how it's done, and so you can see the succession of states if you call main in ghci. You 'lift' IO actions into the StateT machinery, to put them on a level with the gets and puts. Note that in mose subcases, we put the new state and then call for the action to be repeated, so that the do block contains the complete recursive operation. (Tie and an empty deck end the game immediately.) Then in the last line of main we runStateT on this self-updating game yielding a function GameState -> IO (GameState,()); then we feed this with a certain starting state including the randomly determined deck to get the IO action which is the main business. (I don't follow how the game is supposed to work, but was mechanically moving things around to get the idea across.)
import Control.Monad.Trans.State
import Control.Monad.Trans
import System.Random
import Data.Map
data Stage = Deal | Tie deriving Show
data GameState =
GameState { stage :: Stage
, toDeal :: Int
, toBurn :: Int
, inPlay :: [Int]
, tied :: [Int]
, numPlayers :: Int
, pWins :: [Int]
, dWins :: Int
, deck :: [Int]} deriving Show
-- deck field is added for the `game` example
type GameRound m a = StateT GameState m a
main = do
rand <- newStdGen
let deck = fst $ fisherYates rand $ concatMap (replicate 6) [2 .. 14]
let startState = GameState Deal 7 0 [] [] 6 [0 ..100] 0 deck
runStateT game startState
game :: GameRound IO ()
game = do
st <- get
lift $ putStrLn "Playing: " >> print st
case deck st of
[] -> lift $ print "no cards"
(card:cards) ->
case (toDeal st, stage st) of
(0, Deal) -> do put (first_case_update st card cards)
game -- <-- recursive call with smaller deck
(_, Deal) -> do put (second_case_update st card cards)
game
(_, Tie) -> do lift $ putStrLn "This is a tie"
lift $ print st
where -- state updates:
-- I separate these out hoping this will make the needed sort
-- of 'logic' above clearer.
first_case_update s card cards=
s { numPlayers = numPlayers s + 1
, pWins = [if x < dealerCard then -1 else 1 |
x <- zipWith (+) (pWins s) (tail (inPlay s)) ]
, dWins = if dealerCard == maximum (inPlay s)
then dWins s + 1
else dWins s - 1
, deck = cards }
where dealerCard = head (inPlay s)
second_case_update s card cards =
s { toDeal = toDeal s - 1
, toBurn = 0
, inPlay = card : inPlay s
, deck = cards}
-- a StateTified formulation of your gameRound
gameround :: Monad m => Int -> GameRound m ()
gameround card = do
s <- get
case (toDeal s, stage s) of
(0, Deal) ->
put $ s { toDeal = numPlayers s + 1
, pWins = [if x < dealerCard then -1 else 1 |
x <- zipWith (+) (pWins s) (tail (inPlay s)) ]
, dWins = if dealerCard == maximum (inPlay s)
then dWins s + 1
else dWins s - 1}
where dealerCard = head (inPlay s)
(_, Deal) ->
put $ s { toDeal = toDeal s - 1
, toBurn = 0
, inPlay = card : inPlay s}
(_, Tie) -> return ()
fisherYatesStep :: RandomGen g => (Map Int a, g) -> (Int, a) -> (Map Int a, g)
fisherYatesStep (m, gen) (i, x) = ((insert j x . insert i (m ! j)) m, gen')
where
(j, gen') = randomR (0, i) gen
fisherYates :: RandomGen g => g -> [a] -> ([a], g)
fisherYates gen [] = ([], gen)
fisherYates gen l = toElems $ Prelude.foldl
fisherYatesStep (initial (head l) gen) (numerate (tail l))
where
toElems (x, y) = (elems x, y)
numerate = zip [1..]
initial x gen = (singleton 0 x, gen)
Given a finite dictionary of words and a start-end pair (e.g. "hands" and "feet" in the example below), find the shortest sequence of words such that any word in the sequence can be formed from either of its neighbors by either 1) inserting one character, 2) deleting one character, or 3) changing one character.
hands ->
hand ->
and ->
end ->
fend ->
feed ->
feet
For those who may be wondering - this is not a homework problem that was assigned to me or a question I was asked in an interview; it is simply a problem that interests me.
I am looking for a one- or two- sentence "top down view" of what approach you would take -- and for the daring, a working implementation in any language.
Instead of turning the dictionary into a full graph, use something with a little less structure:
For each word in the dictionary, you get a shortened_word by deleting character number i for each i in len(word). Map the pair (shortened_word, i) to a list of all the words.
This helps looking up all words with one replaced letter (because they must be in the same (shortened_word, i) bin for some i, and words with one more letter (because they must be in some (word, i) bin for some i.
The Python code:
from collections import defaultdict, deque
from itertools import chain
def shortened_words(word):
for i in range(len(word)):
yield word[:i] + word[i + 1:], i
def prepare_graph(d):
g = defaultdict(list)
for word in d:
for short in shortened_words(word):
g[short].append(word)
return g
def walk_graph(g, d, start, end):
todo = deque([start])
seen = {start: None}
while todo:
word = todo.popleft()
if word == end: # end is reachable
break
same_length = chain(*(g[short] for short in shortened_words(word)))
one_longer = chain(*(g[word, i] for i in range(len(word) + 1)))
one_shorter = (w for w, i in shortened_words(word) if w in d)
for next_word in chain(same_length, one_longer, one_shorter):
if next_word not in seen:
seen[next_word] = word
todo.append(next_word)
else: # no break, i.e. not reachable
return None # not reachable
path = [end]
while path[-1] != start:
path.append(seen[path[-1]])
return path[::-1]
And the usage:
dictionary = ispell_dict # list of 47158 words
graph = prepare_graph(dictionary)
print(" -> ".join(walk_graph(graph, dictionary, "hands", "feet")))
print(" -> ".join(walk_graph(graph, dictionary, "brain", "game")))
Output:
hands -> bands -> bends -> bents -> beets -> beet -> feet
brain -> drain -> drawn -> dawn -> damn -> dame -> game
A word about speed: building the 'graph helper' is fast (1 second), but hands -> feet takes 14 seconds, and brain --> game takes 7 seconds.
Edit: If you need more speed, you can try using a graph or network library. Or you actually build the full graph (slow) and then find paths much faster. This mostly consists of moving the look-up of edges from the walking function to the graph-building function:
def prepare_graph(d):
g = defaultdict(list)
for word in d:
for short in shortened_words(word):
g[short].append(word)
next_words = {}
for word in d:
same_length = chain(*(g[short] for short in shortened_words(word)))
one_longer = chain(*(g[word, i] for i in range(len(word) + 1)))
one_shorter = (w for w, i in shortened_words(word) if w in d)
next_words[word] = set(chain(same_length, one_longer, one_shorter))
next_words[word].remove(word)
return next_words
def walk_graph(g, start, end):
todo = deque([start])
seen = {start: None}
while todo:
word = todo.popleft()
if word == end: # end is reachable
break
for next_word in g[word]:
if next_word not in seen:
seen[next_word] = word
todo.append(next_word)
else: # no break, i.e. not reachable
return None # not reachable
path = [end]
while path[-1] != start:
path.append(seen[path[-1]])
return path[::-1]
Usage: Build the graph first (slow, all timings on some i5 laptop, YMMV).
dictionary = ispell_dict # list of 47158 words
graph = prepare_graph(dictionary) # more than 6 minutes!
Now find the paths (much faster than before, times without printing):
print(" -> ".join(walk_graph(graph, "hands", "feet"))) # 10 ms
print(" -> ".join(walk_graph(graph, "brain", "game"))) # 6 ms
print(" -> ".join(walk_graph(graph, "tampering", "crunchier"))) # 25 ms
Output:
hands -> lands -> lends -> lens -> lees -> fees -> feet
brain -> drain -> drawn -> dawn -> damn -> dame -> game
tampering -> tapering -> capering -> catering -> watering -> wavering -> havering -> hovering -> lovering -> levering -> leering -> peering -> peeping -> seeping -> seeing -> sewing -> swing -> swings -> sings -> sines -> pines -> panes -> paces -> peaces -> peaches -> beaches -> benches -> bunches -> brunches -> crunches -> cruncher -> crunchier
A naive approach could be to turn the dictionary into a graph, with the words as nodes and the edges connecting "neighbors" (i.e. words that can be turned into one another via one operation). Then you could use a shortest-path algorithm to find the distance between word A and word B.
The hard part about this approach would be finding a way to efficiently turn the dictionary into a graph.
Quick answer. You can compute for the Levenshtein distance, the "common" edit distance in most dynamic programming texts, and, from the computation table generated, try to build that path.
From the Wikipedia link:
d[i, j] := minimum
(
d[i-1, j] + 1, // a deletion
d[i, j-1] + 1, // an insertion
d[i-1, j-1] + 1 // a substitution
)
You can take note of when these happens in your code (maybe, in some auxiliary table) and, surely, it'd be easy reconstructing a solution path from there.