Instructions
Requirements and Specifications



Source Code
Word count
module Main where
import Data.Char
import Data.List
import qualified Data.Map.Strict as Map
-- Get a map with all the words found and the counts for each one
getWordCounts :: String -> Map.Map String Int
getWordCounts xs = getFreqs (map toLower xs) []
where
getFreqs [] [] = Map.empty
getFreqs [] ys = Map.singleton ys 1
getFreqs (x:xs) ys =
if (not (isAlpha x)) && x /= '\'' && x /= '-' then
if null ys then
getFreqs xs []
else
Map.unionsWith (+) [Map.singleton ys 1, getFreqs xs []]
else
getFreqs xs (ys ++ [x])
-- Gets an input string and returns the text showing the word counts
getWordCountsStr :: String -> String
getWordCountsStr xs = (intercalate "\n" (map entryToStr (Map.toAscList (getWordCounts xs)))) ++ "\n"
where
--converts a map entry to a string "k v"
entryToStr (xs,n) = xs ++ " " ++ (show n)
main :: IO ()
main = interact getWordCountsStr
Collector permutation
module Main where
import Data.Char
import Data.List
import qualified Data.Map.Strict as Map
import Control.Category
-- Get a map with all the words found and the counts for each one
getWordCounts :: String -> Map.Map String Int
getWordCounts xs = getFreqs (map toLower xs) []
where
getFreqs [] [] = Map.empty
getFreqs [] ys = Map.singleton ys 1
getFreqs (x:xs) ys =
if (not (isAlpha x)) && x /= '\'' && x /= '-' then
if null ys then
getFreqs xs []
else
Map.unionsWith (+) [Map.singleton ys 1, getFreqs xs []]
else
getFreqs xs (ys ++ [x])
-- Determines is a pair of strings are permutations of each other
isPermutation :: String -> String -> Bool
isPermutation [] [] = True
isPermutation _ [] = False
isPermutation [] _ = False
isPermutation (x:xs) ys = case span (/= x) ys of
(hs, []) -> False
(hs, ts) -> isPermutation xs (hs ++ (tail ts))
-- Makes groups of permutations for a given list of words with same lengths
groupPermutations :: [String] -> [[String]]
groupPermutations [] = []
groupPermutations [_] = [] -- ignore single permutations
groupPermutations (x:xs) =
case partition (isPermutation x) (x:xs) of -- get all permutations
([_],zs) -> groupPermutations zs -- no permutations of x
(ys, zs) -> ys : (groupPermutations zs)
collectPermutations :: String -> String
collectPermutations xs =
getWordCounts >>> Map.keys >>> -- get the list of words
filter lenGT1 >>> -- remove single letter words
sortOn length >>> -- sort by length
(groupBy eqLen) >>> -- group by same lengths
(filter lenGT1) >>> -- remove lists that have only one word
(foldr (\x y -> (groupPermutations x) ++ y) []) >>> -- group by permutations and flatten list
(map listToStr) >>> -- Convert each sublist to a string line
sort >>> -- sort line strings
intercalate "\n" >>> -- separate lines by newlines
(++ "\n") $ xs -- append ending newline
where
eqLen xs ys = length xs == length ys
lenGT1 xs = length xs > 1
listToStr xs = intercalate ", " xs
main :: IO ()
main = interact collectPermutations