Add the existing filesHEADmain

This is a program that takes a list of words, then finds which phrases
when read in a circle shape contain only english words when split in a
certain way.

1 files changed, 62 insertions, 0 deletions

diff --git a/circleWords.hs b/circleWords.hs
new file mode 100755
index 0000000..0609579
--- /dev/null
+++ b/circleWords.hs
@@ -0,0 +1,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)
+