Viewing:
module Chapter11Phone where
import Data.Char
import Data.List
import qualified Data.Map as Map
-- 1. Create the data structure
data Key
= One
| Two
| Three
| Four
| Five
| Six
| Seven
| Eight
| Nine
| Zero
| Star
| Pound
deriving (Eq, Show)
data KeyChars =
KeyChars Key
String
keyCharsOne = KeyChars One "1"
keyCharsTwo = KeyChars Two "abc2"
keyCharsThree = KeyChars Three "def3"
keyCharsFour = KeyChars Four "ghi4"
keyCharsFive = KeyChars Five "jkl5"
keyCharsSix = KeyChars Six "mno6"
keyCharsSeven = KeyChars Seven "pqrs7"
keyCharsEight = KeyChars Eight "tuv8"
keyCharsNine = KeyChars Nine "wxyz9"
keyCharsZero = KeyChars Zero "+ _0"
keyCharsPound = KeyChars Pound ".,#"
keyCharsStar = KeyChars Star ""
allKeyChars =
[ keyCharsOne
, keyCharsTwo
, keyCharsThree
, keyCharsFour
, keyCharsFive
, keyCharsSix
, keyCharsSeven
, keyCharsEight
, keyCharsNine
, keyCharsZero
, keyCharsPound
, keyCharsStar
]
alphabet = foldr (\(KeyChars _ chars) acc -> chars ++ acc) "" allKeyChars
type Presses = Int
type Keypress = (Key, Presses)
getMatchingChars :: Key -> String
getMatchingChars key =
let (KeyChars _ chars) =
case key of
One -> keyCharsOne
Two -> keyCharsTwo
Three -> keyCharsThree
Four -> keyCharsFour
Five -> keyCharsFive
Six -> keyCharsSix
Seven -> keyCharsSeven
Eight -> keyCharsEight
Nine -> keyCharsNine
Zero -> keyCharsZero
Pound -> keyCharsPound
Star -> keyCharsStar
in chars
-- 2. Convert conversations into keypresses.
mFindIndex :: (Eq a) => [a] -> a -> Maybe Int
mFindIndex [] _ = Nothing
mFindIndex xs toFind = go 0 xs
where
go index [] = Nothing
go index (x:xs)
| x == toFind = Just index
| otherwise = go (index + 1) xs
mIndex :: [a] -> Int -> Maybe a
mIndex [] _ = Nothing
mIndex (x:xs) index
| index < 0 = Nothing
| index == 0 = Just x
| otherwise = mIndex xs (index - 1)
keypressToString :: Keypress -> String
keypressToString (Star, presses) = ""
keypressToString (key, presses) =
let matchingChars = getMatchingChars key
numChars = length matchingChars
(_, position) = divMod presses numChars
indexToAccess =
(if position == 0
then numChars
else position) -
1
in case mIndex matchingChars indexToAccess of
Just char -> char : ""
Nothing -> ""
upperFirst :: String -> String
upperFirst "" = ""
upperFirst (x:xs) = toUpper x : xs
charToKey :: Char -> Maybe Key
charToKey '1' = Just One
charToKey '2' = Just Two
charToKey '3' = Just Three
charToKey '4' = Just Four
charToKey '5' = Just Five
charToKey '6' = Just Six
charToKey '7' = Just Seven
charToKey '8' = Just Eight
charToKey '9' = Just Nine
charToKey '0' = Just Zero
charToKey '*' = Just Star
charToKey '#' = Just Pound
charToKey _ = Nothing
parseButtonPress :: Char -> [Keypress] -> [Keypress]
parseButtonPress char [] =
case charToKey char of
Just parsedKey -> [(parsedKey, 1)]
Nothing -> []
parseButtonPress char (tap@(key, presses):taps) =
case charToKey char of
Just parsedKey ->
if key == parsedKey
then (key, presses + 1) : taps
else (parsedKey, 1) : tap : taps
Nothing -> tap : taps
parseInput :: String -> [Keypress]
parseInput = foldr parseButtonPress []
charToTaps :: Char -> [Keypress] -> [Keypress]
charToTaps char acc =
let charIsUpper = isUpper char
effectiveChar = toLower char
in case find
(\(KeyChars key chars) -> effectiveChar `elem` chars)
allKeyChars of
Just (KeyChars matchedKey matchedChars) ->
case mFindIndex matchedChars effectiveChar of
Just index ->
if charIsUpper
then (Star, 1) : (matchedKey, index + 1) : acc
else (matchedKey, index + 1) : acc
Nothing -> acc
Nothing -> acc
tapsToString :: [Keypress] -> String
tapsToString = go False
where
go _ [] = ""
go pendingShift ((Star, presses):taps) = go (mod presses 2 == 1) taps
go pendingShift (keypress:taps) =
(if pendingShift
then upperFirst
else id)
(keypressToString keypress) ++
go False taps
stringToTaps :: String -> [Keypress]
stringToTaps = foldr charToTaps []
convo :: [String]
convo =
[ "Wanna play 20 questions"
, "Ya"
, "U 1st haha"
, "Lol ok. Have u ever tasted alcohol"
, "Lol ya"
, "Wow ur cool haha. Ur turn"
, "Ok. Do u think I am pretty Lol"
, "Lol ya"
, "Just making sure rofl ur turn"
]
-- 3. how many times do digits need to be pressed for each message?
countTaps :: [Keypress] -> Presses
countTaps = foldr (\(_, presses) acc -> acc + presses) 0
totalTaps = map (countTaps . stringToTaps) convo
-- 4. What was the most popular letter. What was its cost?
sumValues :: a -> Int -> Int -> Int
sumValues _ b c = b + c
getLetterCounts char = Map.insertWithKey sumValues char 1
getMostPopularLetters :: Char -> Presses -> (String, Int) -> (String, Int)
getMostPopularLetters char count acc@(candidates, candidateCount)
| count == candidateCount = (char : candidates, candidateCount)
| count > candidateCount = (char : "", count)
| count < candidateCount = acc
mostPopularLettersByCount :: String -> (String, Int)
mostPopularLettersByCount "" = ("", 0)
mostPopularLettersByCount xs =
let charCounts =
foldr
getLetterCounts
Map.empty
(filter (`elem` alphabet ++ ['A' .. 'Z']) xs)
mostPopularWithCount =
Map.foldrWithKey getMostPopularLetters ("", 0) charCounts
in mostPopularWithCount
characterCost :: Char -> (Char, Presses)
characterCost char =
let charIsUpper = isUpper char
effectiveChar = toLower char
in case find
(\(KeyChars key chars) -> effectiveChar `elem` chars)
allKeyChars of
Just (KeyChars matchedKey matchedChars) ->
case mFindIndex matchedChars effectiveChar of
Just index ->
if charIsUpper
then (char, index + 1 + 1)
else (char, index + 1)
Nothing -> (char, 0)
Nothing -> (char, 0)
mostPopular = map (fst . mostPopularLettersByCount) convo
mostPopularWithCost = map (map characterCost) mostPopular
-- 5. What was most popular letter over all?
getCoolestLtrs :: [String] -> String
getCoolestLtrs str =
let mostPopularByCount =
(map
(mostPopularLettersByCount . (filter (\x -> isUpper x || isLower x)))
str)
theAnswer =
foldr
(\(mostPopular, occurrences) acc ->
(foldr
(\char -> Map.insertWithKey sumValues char occurrences)
acc
mostPopular))
Map.empty
mostPopularByCount
in fst $ Map.foldrWithKey getMostPopularLetters ("", 0) theAnswer
coolestLtrs = getCoolestLtrs convo
-- What was most popular word?
convoWords =
map (filter (`elem` ['a' .. 'z'] ++ ['0' .. '9'])) .
map (map toLower) . concatMap (words) $
convo
tallyList :: (Ord a) => [a] -> Map.Map a Int
tallyList = foldr (\wurd -> Map.insertWithKey sumValues wurd 1) Map.empty
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:xs) = Just x
getHighestFold :: a -> Int -> ([a], Int) -> ([a], Int)
getHighestFold key count acc@(candidates, candidateCount)
| count == candidateCount = (key : candidates, candidateCount)
| count > candidateCount = (key : [], count)
| count < candidateCount = acc
getMostPopularInTally :: (Ord a) => Map.Map a Int -> [a]
getMostPopularInTally tally =
fst $ Map.foldrWithKey getHighestFold ([], 0) tally
mostPopularInList :: (Ord a) => [a] -> [a]
mostPopularInList = getMostPopularInTally . tallyList
coolestWord = mostPopularInList convoWords