How do you keep track of multiple properties of a string without traversing it multiple times?

Question

I recently did a practice problem for validating a string.

Use the Maybe type to write a function that counts the number of vowels in a string and the number of consonants. If the number of vowels exceeds the number of consonants, the function returns Nothing.

I ended up two functions for each counting vowels and counting consonants:

isVowel :: Char -> Bool
isVowel c = c `elem` "aeiou"

countVowels :: String -> Integer
countVowels []     = 0
countVowels (x:xs) =
  if isVowel x
  then countVowels xs + 1
  else countVowels xs

countConsonants :: String -> Integer
countConsonants []     = 0
countConsonants (x:xs) =
  if not $ isVowel x
  then countConsonants xs + 1
  else countConsonants xs

And then just comparing the values of the two to get my answer.

makeWord :: String -> Maybe String
makeWord [] = Nothing
makeWord s  =
  if countVowels s < countConsonants s
  then Nothing
  else Just s

My problem with this is that it traverses the string twice, once to get the number of vowels and another time to get the number of consonants.

I thought perhaps I could fix this by subtracting the number of vowels from the length of the string to begin with, but that also takes two traversals.

So I tried making a function that tracks both vowels and consonants at once, storing the results in a tuple, but since I didn't know adding tuples is actually pretty hard, the result was even more complex.

countVowelsAndConsonants :: String -> [(Integer, Integer)]
countVowelsAndConsonants []     = []
countVowelsAndConsonants (x:xs) =
  if isVowel x
    then (1, 0) : countVowelsAndConsonants xs
    else (0, 1) : countVowelsAndConsonants xs

makeWord :: String -> Maybe String
makeWord [] = Nothing
makeWord s  =
  if countVowels s < countConsonants s
    then Nothing
    else Just s
  where counts = let unzipped = unzip (countVowelsAndConsonants s)
                 in (sum $ fst unzipped, sum $ snd unzipped)

and, to be honest, I think this is even worse than what I started off with.

Also, what if I also had to keep track of uppercase and lowercase letters? Then I don't think the tuple approach would scale.

In an imperative language, for example javascript, which I'm more used to, it would be as simple as this to traverse it just once.

const word        = "somestring"
let numVowels     = 0
let numConsonants = 0

for (var s of word) isVowel(s) ? numVowels++ : numConsonants++

I'm sure Haskell has a way that's just as simple, but unfortunately I'm unfamiliar.

What's the idiomatic way of keeping tabs of multiple properties of a String without having to keep traversing it multiple times?

Answer 1

I'd start by defining the traditional "indicator function"

indicate :: Num a => Bool -> a
indicate b = if b then 1 else 0

so that

indicate . isVowel :: Char -> Integer

Next, I'd get hold of two key pieces of kit from Control.Arrow

(&&&) :: (x -> y) -> (x -> z) -> x -> (y, z)
(***) :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)

so (remembering that some characters are neither vowels nor consonants)

(indicate . isVowel) &&& (indicate . isConsonant)
  :: Char -> (Integer, Integer)

And then I'd grab hold of Sum from Data.Monoid.

(Sum . indicate . isVowel) &&& (Sum . indicate . isConsonant)
  :: Char -> (Sum Integer, Sum Integer)
getSum *** getSum :: (Sum Integer, Sum Integer) -> (Integer, Integer)

Now I deploy foldMap, because we're doing some sort of monoidal "crush".

(getSum *** getSum) .
foldMap ((Sum . indicate . isVowel) &&& (Sum . indicate . isConsonant))
  :: String -> (Integer, Integer)

Then I remember that I wrote some code which got turned into Control.Newtype and I discover the following is missing but should be there.

instance (Newtype n o, Newtype n' o') => Newtype (n, n') (o, o') where
  pack = pack *** pack
  unpack = unpack *** unpack

And now I need only write

ala' (Sum *** Sum) foldMap ((indicate . isVowel) &&& (indicate . isConsonant))
  :: String -> (Integer, Integer)

The key gadget is

ala' :: (Newtype n o, Newtype n' o') =>
 (o -> n) -> ((a -> n) -> b -> n') -> (a -> o) -> b -> o'
-- ^-packer    ^-higher-order operator  ^-action-on-elements

where the packer's job is to select the newtype with the correct behavioral instance and also determine the unpacker. It's exactly designed to support working locally at a more specific type that signals the intended structure.