Monday, April 26, 2010

Conjugating verbs in Haskell


> {-# LANGUAGE RecordWildCards #-}
> import Data.Maybe
> import Data.Default
> import Control.Monad.Writer hiding (First)

I'll show you an English verb conjugator. Although handling inflections is complex, the structure of the language can be expressed idiomatically, using a monad. You'll see that things like "perfect continuous" are really "perfect" on top of "continuous", in code.

First, some boring code and auxiliary functions.

> data Tense = Past | Present | Future
> type Infinitive = String
> data Person = First | Second | Third
> -- plural in English is the same form as second person

> pastForms inf = fromMaybe (inf++"ed", inf++"ed") $
> lookup inf [("do", ("did", "done")),
> ("have", ("had", "had")),
> ("be", ("was", "been")),
> ("drive", ("drove", "driven")),
> ("build", ("built", "built"))]

> presentParticiple inf | last inf == 'e' && inf /= "be" = init inf ++ "ing"
> | otherwise = inf ++ "ing"

> pastParticiple inf = snd $ pastForms inf

> conjugate1 :: Tense -> Person -> Infinitive -> String
> conjugate1 Future p inf = "will " ++ inf
> conjugate1 t p "be" = case (t, p) of
> (Present, First) -> "am"
> (Present, Second) -> "are"
> (Present, Third) -> "is"
> (Past, Second) -> "were"
> (Past, _) -> "was"

> conjugate1 Past p inf = fst $ pastForms inf
> conjugate1 Present Third "have" = "has"
> conjugate1 Present Third "do" = "does"
> conjugate1 Present Third inf = inf ++ "s"
> conjugate1 Present _ inf = inf

We can conjugate verbs in three tenses, and form participles. For example:

> test1 = conjugate1 Future First "drive"
> test2 = conjugate1 Present Third "phone"
> test3 = presentParticiple "have"

Adding "perfect"
Now the fun begins.

Exercise: Allow forming perfect tenses:

> conjugate2 :: Bool -> Tense -> Person -> Infinitive -> String

(For example, conjugate2 True Present Third "drive" should be "has driven")



Solution:

Perfect is "have" + past participle. You can express this directly:

> conjugate2 False tense person inf = conjugate1 tense person inf
> conjugate2 True tense person inf = conjugate1 tense person "have" ++ " " ++ pastParticiple inf


Adding "continuous"
It will be downhill now.

Exercise: Allow forming continuous tenses:

> conjugate3 :: Bool -> Bool -> Tense -> Person -> Infinitive -> String


where the first parameter will be continuous or not. For example, conjugate3 True False Present Third "drive" should be "is driving".



Solution:

It's be + present participle.

> conjugate3 False perf tense person inf = conjugate2 perf tense person inf
> conjugate3 True perf tense person inf = conjugate2 perf tense person "be" ++ " " ++ presentParticiple inf


This composes nicely:

> test4 = "he " ++ conjugate3 True True Present Third "drive"

Adding passive voice
Exercise: Allow forming passive voice:


> conjugate4 :: Bool -> Bool -> Bool -> Tense -> Person -> Infinitive -> String

> test5 = "the house " ++ conjugate4 True True False Present Third "build"




Solution:

> conjugate4 False cont perf tense person inf = conjugate3 cont perf tense person inf
> conjugate4 True cont perf tense person inf = conjugate3 cont perf tense person "be" ++ " " ++ pastParticiple inf


Merging
conjugate2, conjugate3 and conjugate4 can be joined into a single function.
Remembering all arguments in order and specifying them every time is problematic. This is described in Brent Yorgey's Haskell anti-pattern - incremental ad-hoc parameter abstraction. Also there's a lot of repetition.


> conjugate5 :: Bool -> Bool -> Bool -> Tense -> Person -> Infinitive -> String
> conjugate5 True continuous perfect tense person inf =
> conjugate5 False continuous perfect tense person "be" ++ " " ++ pastParticiple inf
> conjugate5 _ True perfect tense person inf =
> conjugate5 False False perfect tense person "be" ++ " " ++ presentParticiple inf
> conjugate5 _ _ True tense person inf =
> conjugate5 False False False tense person "have" ++ " " ++ pastParticiple inf
> conjugate5 _ _ _ tense person inf = conjugate1 tense person inf


Using records


> data ConjugateOptions = ConjugateOptions { passive :: Bool,
> perfect :: Bool,
> continuous :: Bool,
> person :: Person,
> tense :: Tense }

> instance Default ConjugateOptions where
> def = ConjugateOptions False False False First Present

> conjugate6 :: ConjugateOptions -> Infinitive -> String
> conjugate6 (o@ConjugateOptions{ .. }) inf
> | passive = conjugate6 o { passive = False } "be" ++ " " ++ pastParticiple inf
> | continuous = conjugate6 o { continuous = False } "be" ++ " " ++ presentParticiple inf
> | perfect = conjugate6 o { perfect = False } "have" ++ " " ++ pastParticiple inf
> | otherwise = conjugate1 tense person inf

Much better - we can use it like


> test6 = conjugate6 def { perfect=True } "paint"


Using the Writer monad
conjugate6 is doing recursion on some infinitive and adds "remaining part" to the end. The Writer monad can express this.


> plumb :: Infinitive -> (Infinitive -> String) -> Infinitive -> Writer [String] Infinitive
> plumb aux participle inf = Writer (aux, [participle inf])

> passive' = plumb "be" pastParticiple
> continuous' = plumb "be" presentParticiple
> perfect' = plumb "have" pastParticiple

> conjugate7 :: Tense -> Person -> (Infinitive -> Writer [String] Infinitive) -> Infinitive -> String

> conjugate7 tense person tr inf =
> let (a,b) = runWriter (tr inf)
> in unwords $ (conjugate1 tense person a):(reverse b)


You can join those different "higher order verbs" using >=>.


> test7 = "he " ++ conjugate7 Past Third (continuous' >=> perfect') "paint"


and add new new ones instantly:

> learn = plumb "learn" ("to "++)

> test8 = "I " ++ conjugate7 Present First (learn >=> perfect') "love" ++ " Haskell"

Obviously there is a lot missing - inflections ("he goes", "he panicks"), irregular verbs, modal verbs, negation, "used to", "have something done", interrogative mood... It gets dirty then.

You can write such conjugator in similar languages, like German.

Haskell is a great language - imagine how would you write conjugate1 without pattern matching, or writing the plumbing in conjugate5 again, when Writer can do that for you.

Followers