mirror of
https://codeberg.org/JasterV/word-ladder.hs.git
synced 2026-04-26 18:10:06 +00:00
implement ladder graph creation
This commit is contained in:
parent
b56388a670
commit
375bdba185
2 changed files with 35 additions and 0 deletions
|
|
@ -27,6 +27,7 @@ library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Data.AssocMap
|
Data.AssocMap
|
||||||
Graph
|
Graph
|
||||||
|
Ladder
|
||||||
Lib
|
Lib
|
||||||
PermutationMap
|
PermutationMap
|
||||||
other-modules:
|
other-modules:
|
||||||
|
|
|
||||||
34
src/Ladder.hs
Normal file
34
src/Ladder.hs
Normal file
|
|
@ -0,0 +1,34 @@
|
||||||
|
module Ladder (readDictionary, mkLadderGraph) where
|
||||||
|
|
||||||
|
import Data.Char (isLower)
|
||||||
|
import qualified Data.List as L
|
||||||
|
import qualified Graph as G
|
||||||
|
import qualified PermutationMap as PM
|
||||||
|
import Prelude hiding (lines, words)
|
||||||
|
|
||||||
|
type Dictionary = [String]
|
||||||
|
|
||||||
|
readDictionary :: String -> IO Dictionary
|
||||||
|
readDictionary filename = do
|
||||||
|
text <- readFile filename
|
||||||
|
let lines = L.lines text
|
||||||
|
let lowercaseWords = map (filter isLower) lines
|
||||||
|
return (L.nub lowercaseWords)
|
||||||
|
|
||||||
|
mkLadderGraph :: Dictionary -> G.DiGraph String
|
||||||
|
mkLadderGraph dict = G.buildDiGraph [(word, computeCandidates permMap word) | word <- dict]
|
||||||
|
where
|
||||||
|
permMap = PM.createPermutationMap dict
|
||||||
|
|
||||||
|
computeCandidates :: PM.PermutationMap -> String -> [String]
|
||||||
|
computeCandidates permMap word =
|
||||||
|
-- Delete the original word from the permutations list
|
||||||
|
L.delete word permutations
|
||||||
|
where
|
||||||
|
removed = [L.delete c word | c <- word]
|
||||||
|
added = [c : word | c <- ['a' .. 'z']]
|
||||||
|
modified = [x : L.delete y word | x <- ['a' .. 'z'], y <- word, x /= y]
|
||||||
|
-- Sort and deduplicate all the candidates
|
||||||
|
candidates = L.nub $ map L.sort (added ++ removed ++ modified ++ [word])
|
||||||
|
-- For each candidate, lookup all its permutations
|
||||||
|
permutations = L.concatMap (\w -> PM.findWithDefault [] w permMap) candidates
|
||||||
Loading…
Reference in a new issue