Program in Haskell To Count Words In File And Find Anagrams

Instructions

Objective

Write a haskell assignment program to count words in file, and find words that are anagrams.

Requirements and Specifications

Counting Words

In this assignment you will produce a sorted word count from input text. The input will be a text stream as in the rot13 program and you will output a list of words with their associated counts such that the words are sorted (String is in typeclass Ord and so that ordering is acceptable) and all in lower-case. E.g. the text:

A parser for things Is a function from strings To lists of pairs Of things and strings should output:

a 2

and 1

for 1

from 1

function 1

is 1

lists 1

of 2

pairs 1

parser 1

strings 2

things 2

to 1

Implement this as a program with the exact name WordCount.hs such that it can be run as ./WordCount like the rot13 program. It should be in the assignment4 directory of your repository.

A word is defined as a contiguous sequence of letters with the quote character '\'' and the dash character '-'. That means "dog's" and "about-face" are each considered one word. Note that '\'':[] == "'".

Screenshots of output

Count words in file and find words that are anagrams in haskell

Count words in file and find words that are anagrams in haskell 1

Count words in file and find words that are anagrams in haskell 2

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

Count Words In File, And Find Words That Are Anagrams Assignment Solution.

Instructions

Requirements and Specifications