3
\$\begingroup\$

I've been toying with Haskell again and implementing a simple text replacement program that replaces all consonants c in a text by coc, i.e., inserting an 'o' in between:

> robber_simple "abcdef"
"abobcocdodefof"

This is rather simple to implement:

robber_simple :: [Char] -> [Char]
robber_simple [] = []
robber_simple (x:xs)
  | x `elem` monophthongs = x:(robber_simple xs)
  | otherwise            = x:'o':x:(robber_simple xs)
  where -- vowels represented by one character, or monograph
        monophthongs :: [Char]
        monophthongs = "aeiouy"

However, in many languages, such as German, we have multigraphs which can act as vowels or consonants, such as "uh" ("uhr") or "sch" ("schokolade").

So I implemented a more complicated program which does a basic lookahead to figure out, whether the, say 's', we currently read is actually part of a "sch". I'm not happy with it, though :)

import Data.List

robber :: [Char] -> [Char]
robber xs = robber' xs [] where
  robber' :: [Char] -> [Char] -> [Char]
  -- Read first character into backlog
  robber' (x:xs) [] = robber' xs [x]
  -- Nonempty prefix, new input can either form a multigraph prefix or end one.
  robber' (x:xs) (p:ps)
    -- Current character with existing prefix forms a prefix of a multigraph
    | token `elem` (prefixes multigraph_consonant) = robber' xs token
    | token `elem` (prefixes multigraph_vowel)     = robber' xs token
    -- The current token makes it clear that we aren't reading a multigraph
    | otherwise                                    = (robber' [] (p:ps))    ++ (robber' (x:xs) [])
    where token = (p:ps) ++ [x]
  -- No input, consume characters in backlog.
  robber' [] pref
    -- Either this forms a multigraph...
    | pref `elem` multigraph_consonant                   = pref ++ 'o':pref
    | pref `elem` multigraph_vowel                       = pref
    -- ... or not.
    | otherwise                                          = robber_simple pref

-- consonant phoneme made up of multiple characters
multigraph_consonant :: [[Char]]
multigraph_consonant = ["sch", "ch", "sc"]

-- same for vowels
multigraph_vowel :: [[Char]]
multigraph_vowel = ["ei", "uh"]

prefixes :: [[a]] -> [[a]]
prefixes xs = concat $ map prefix xs

prefix :: [a] -> [[a]]
prefix = inits

The parsing/tokenizing strategy I use, is to read characters and store them into the backlog until a character (or end of input) comes that determines that the current backlog can be treated as one unit. That is, it either is a complete monograph (e.g., "sch") or definitely not a prefix of a monograph ("c").

In that case, I replace the backlog x with either x++'o':x or leave it, depending on whether it is a consonant or a vowel.

Finally, I carry on parsing the rest of the string.

Any suggestions welcome!

\$\endgroup\$
1
\$\begingroup\$

I probably would reach directly for Parsec or another parsing library writing this from scratch, but I think even with a more direct recursive solution you've drastically overcomplicated this!

Separate your problem into constituent pieces which you find easier to handle on their own terms. In this case, I would start by writing a function phoneme :: [Multigraph] -> String -> (Phoneme, String) to consume only a single n-graph off of a given word.

import Data.List (isPrefixOf, stripPrefix)

type Phoneme = String
type Multigraph = Phoneme

phoneme :: [Multigraph] -> String -> Maybe (Phoneme, String)
phoneme multigraphs word@(letter:rest) = -- The use of @ is an example of an 'as-pattern'
    case filter (`isPrefixOf` word) multigraphs of
      (multigraph:_) -> Just (multigraph, fromJust $ stripPrefix multigraph word)
      []             -> Just ([letter], rest)
phoneme _multigraphs [] = Nothing        -- Prefixing an arg with _ says to the compiler
                                         -- that you meant not to use it in the definition
                                         -- i.e. you won't get a warning when compiling
                                         -- with -Wall (specifically --Wunused-matches)

This version achieves multigraph detection by testing the passed multigraphs against the remaining portion of the string, \$O(m)\$ in the number of multigraphs. Your original version tests every multigraph against every prefix of the string, making it \$O(mn)\$.

Now the next obvious step is to use this function in breaking an entire string into its constituent phonemes.

import Data.List (unfoldr)

phonemes :: [Multigraph] -> String -> [Phoneme]
phonemes multigraphs = unfoldr (phoneme multigraphs)

Sometimes you either know about a common Haskell concept or you don't. In this case, if you're unfamiliar, unfoldr :: (b -> Maybe (a, b)) -> b -> [a] repeatedly applies a function that returns a desired output and some state to itself, collecting the output into a list and terminating once the function reaches the “end” and has returned Nothing.

Now before anything else we have to be able to robber an individual phoneme.

robberPhoneme :: [Multigraph] -> [Multigraph] -> Phoneme -> String
robberPhoneme _mconsonants mvowels p
  | p `elem` mvowels = p
  | p `elem` vowels  = p
  | otherwise        = p ++ "o" ++ p
  where vowels = map pure "aeiouy"

You could obviously leave out the consonants argument, but I think it's helpful to remind callers not to just pass all of the multigraphs they have on hand, vowels being treated differently from consonants.

And now we're ready to tie it together.

robber :: [Multigraph] -> [Multigraph] -> String -> String
robber mconsonants mvowels = concatMap (robberPhoneme mconsonants mvowels)
                           . phonemes (mconsonants ++ mvowels)

And there you go! Much less bookkeeping, parsed strictly left to right, and by relying entirely on standard functions for all of the recursion anyone reading my code (including me, later) can quickly understand how control flows through the program without having to mentally grapple with primitive recursion.

This doesn't sit wholly perfectly with me (I'd probably create a datatype to represent all the different kinds of phonemes in a language and pass that around instead, I didn't feel good just throwing the monophthongs in there but it was expedient, couple other nits) but it's enough of a solution that I'd ship it.

\$\endgroup\$
2
  • 1
    \$\begingroup\$ TYVM! I thought about basically tokenizing into phonemes first, then replacing, but I tried to use the splitOn family and failed :) I definitely learned a few things today, especially the phoneme function is wonderful. It took some time and delving into Applicatives in order to understand that map pure on a list is basically mapping (:[]), but this lead me to reading up on Functors etc. which was much fun. People like you make this website so great! \$\endgroup\$
    – ljrk
    Mar 13 '21 at 17:13
  • \$\begingroup\$ You’re more than welcome! \$\endgroup\$
    – bisserlis
    Mar 14 '21 at 17:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.