blob: 0609579ef39ef9e8362eb134ca7e5f744f04a46a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
import qualified Data.Set as Set
import Data.List
import System.Environment
import Data.Char
-- Return a list of all rotations of word
rotations :: String -> [String]
rotations word = list' word 0
where list' "" _ = [""]
list' word@(w:ord) num
| num == length word = []
| otherwise = word:list' (ord++[w]) (num+1)
isWord :: String -> (Set.Set String) -> Bool
isWord [] _ = True
isWord word words = word `Set.member` words
wordGroupsOfLength :: [String] -> Int -> [String]
wordGroupsOfLength words 1 = words
wordGroupsOfLength [] _ = []
wordGroupsOfLength words length = [initial++other|initial<-words,other<-wordGroupsOfLength words (length-1)]
-- All word groups, combinations of words
allGroups :: (Set.Set String) -> [String]
allGroups words = concat [wordGroupsOfLength (Set.toList words) x|x<-[1..]]
-- Given a string, return a list of possible junctions, which are lists of ways to break the word
allWords :: String -> Int -> [[String]]
allWords words 1 = [[words]]
allWords words 2 = [[take x words,drop x words]|x<-[0..length words]]
allWords words n = [take x words:remainder|x<-[0..length words],remainder<-allWords (drop x words) (n-1)]
-- Return True if words is composed of english words concatenated together
canMakeWords :: String -> (Set.Set String) -> Bool
canMakeWords words dict = canMakeWords' (allWords words (length words)) dict
where canMakeWords' (x:xs) dict
| allTrue (map (`isWord` dict) x) = True
| otherwise = canMakeWords' xs dict
canMakeWords' [] _ = False
allTrue :: [Bool] -> Bool
allTrue [] = True
allTrue (x:xs)
| x == False = False
| otherwise = allTrue xs
-- Return True if the word is a valid rotatable word
testWord :: String -> (Set.Set String) -> Bool
testWord word dict = allTrue (map (`canMakeWords` dict) (rotations word))
-- Given a dictionary, return all groups that work (infinite list)
returnValids :: (Set.Set String) -> [String]
returnValids words = [validWords | validWords<-allGroups words, testWord validWords words]
main = do dict <- getContents
args <- getArgs
let num = if (args /= [])
then read (args !! 0)
else 5
-- print . take num . Set.toList . Set.fromList . lines $ dict
mapM putStrLn (take num $ returnValids . Set.fromList . lines $ dict)
|
