[Haskell-cafe] How Albus Dumbledore would sell Haskell

Alexey Rodriguez Yakushev mrchebas at gmail.com
Wed Apr 25 20:23:55 EDT 2007


Since no one mentioned automatic differentiation (AD), I will. I  
think AD is a nice example of using type classes and higher order  
functions to get small and useful code. Maybe this example is not  
ideal for the audience, but anyway, Simon has the last word.

Here is how demo would go:

Define a polynomial with roots at -9, 0 and 9:

 > Main> let poly x = (x + 9) * x * (x - 9)

check type:

 > Main> :t poly
 > poly :: (Num a) => a -> a

then explain type and handwave a bit about the polymorphism 
+overloading and the type.

Check that it works:

 > Main> poly 2
 > -154
 > Main> poly 9
 > 0

Aha, it works.

Let's see a graph then (sorry if the email formatting destroys the  
graph):

 > Main> draw poly
 >        ******       |
 >       *      ***    |
 >     **          *   |
 >    *             ** |                  *
 >                    *|
 > --*-----------------**----------------*-
 > *                  | **             *
 >                     |   *          **
 > *                   |    ***      *
 >                     |       ******

"Oh did I mention that 'draw' is a higher order function?" (handwavy  
explanation of H.O. functions, bla bla)

 > Main> :t draw
 > draw :: (Double -> Double) -> IO ()

Now define, first derivative of "poly":

 > Main> let poly' x = d poly x

(Note that x is required because of monomorphism restriction, but I  
wouldn't mention it).

and test it:

 > Main> draw poly'
 > *                   |
 > *                  |                  *
 >   **                |                **
 >     *               |               *
 >      *              |              *
 >       **            |            **
 >         **          |          **
 > ----------**-----------------**---------
 >             ****    |    ****
 >                 *********

one can do it once again:

 > Main> let poly'' x = d poly' x
 > Main> draw poly''
 >                     |                ***
 >                     |            ****
 >                     |        ****
 >                     |   *****
 > --------------------****----------------
 >                 ****|
 >            *****    |
 >        ****         |
 >    ****             |
 > ***                 |

The nice thing is that the code for "d" is very small (unlike the  
drawing code, for example):

 > data Dual a = Dual a a
 >             deriving (Eq,Show)
 >
 > instance (Num a) => Num (Dual a) where
 >     (Dual x y) + (Dual x' y') = Dual (x+x') (y+y')
 >     (Dual x y) * (Dual x' y') = Dual (x*x') (x*y'+y*x')
 >     negate (Dual x y) = Dual (negate x) (negate y)
 >     fromInteger n = Dual (fromInteger n) 0

(omitting some methods here)

Below, "d is a H.O. function bla bla"

 >
 > type Poli = forall a.(Num a) => a -> a
 >
 > d :: Poli -> Poli
 > d f x
 >     = case f (Dual x 1) of
 >       Dual f_x f'_x -> f'_x

end of pseudo-demo

This code is based on a blog post[1] which is in turn based on some  
nice posts by Dan Piponi. It's nothing new, but it's worthwhile to  
stress how easy it is to do this kind of thing in Haskell.

Cheers,

Alexey

[1] http://insomne.pinguinos.org/2006/06/25/derivacion-automatica- 
utilizando-numeros-duales-y-clases-type-classes/

On Apr 19, 2007, at 10:05, Simon Peyton-Jones wrote:

> | Simon (aka Dumbledore) is speaking to four different Houses:  
> scientists
> | (Ravenclaw), engineers (Hufflepuff), entrepreneurs (Slytherin), and
> | managers (Griffindor).
>
> I wish I could live up to this image!
>
> Lots of interesting ideas on this thread, and Haskell-Cafe threads  
> are *supposed* to wander a bit.  But, just to remind you all: I'm  
> particularly interested in
>
>   concrete examples (pref running code) of programs that are
>        * small
>        * useful
>        * demonstrate Haskell's power
>        * preferably something that might be a bit
>                tricky in another language
>
> I have lots of *general* ideas.  What I'm hoping is that I can  
> steal working code for one or two compelling examples, so that I  
> can spend my time thinking about how to present it, rather than on  
> dreaming up the example and writing the code.
>
> (But don't let me inhibit wider-ranging discussion as well.)
>
> thanks
>
> Simon
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list