+1 (315) 557-6473 

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


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