Planet Haskell

Image a = R² → (Color, a) · Call for Papers: Haskell Symposium 2010

> {-# LANGUAGE ScopedTypeVariables, UndecidableInstances #-}
> {-# OPTIONS -fglasgow-exts #-}

Bool
Maybe ()
A
B
Either A B
A
B
Either
(,)
Void

> data Void
> instance Show Void where
>     show _ = undefined

undefined
show
Void
Maybe
A
Maybe A

> type One   = Maybe Void
> type Two   = Maybe One
> type Three = Maybe Two
> type Four  = Maybe Three
> type Five  = Maybe Four
> type Six   = Maybe Five

> zero  = Nothing
> one   = Just zero
> two   = Just one
> three = Just two
> four  = Just three
> five  = Just four

A
B
Either A B
Plus A B
plus
plus'

> class Plussable a b where
>    type Plus a b
>    plus  :: Either a b -> Plus a b
>    plus' :: Plus a b -> Either a b

> instance Plussable Void b where
>    type Plus Void b = b

>    plus (Right b) = b
>    plus'       b  = Right b

plus
plus

> instance Plussable a b => Plussable (Maybe a) b where
>    type Plus (Maybe a) b = Maybe (Plus a b)
>    plus (Left Nothing)  = Nothing
>    plus (Left (Just a)) = Just ((plus :: Either a b -> Plus a b) (Left a))
>    plus (Right b)       = Just ((plus :: Either a b -> Plus a b) (Right b))

>    plus' Nothing = Left Nothing
>    plus' (Just x) =
>        let i' = plus' :: Plus a b -> Either a b
>        in  case i' x of
>            Left  a -> Left (Just a)
>            Right b -> Right b

> class Timesable a b where
>    type Times a b
>    times  :: (a, b) -> Times a b
>    times' :: Times a b -> (a, b)

> instance Timesable Void b where
>    type Times Void b = Void
>    times  _ = undefined
>    times' _ = undefined

> instance (Timesable a b, Plussable b (Times a b)) => Timesable (Maybe a) b where
>     type Times (Maybe a) b = Plus b (Times a b)

>     times (Nothing, b) =
>         let i = plus :: Either b (Times a b) -> Plus b (Times a b)
>         in  i (Left b)

>     times (Just a, b) =
>         let i = plus :: Either b (Times a b) -> Plus b (Times a b)
>         in  i (Right (times ((a, b))))

>     times' b = 
>         let i' = plus' :: Plus b (Times a b) -> Either b (Times a b)
>         in case i' b of
>             Left  b  -> (Nothing, b)
>             Right ab -> let (a, b) = times' ab in (Just a, b)

times :: (Two, Three) -> Six

canonical

> class Canonicable a where
>     type Canonical a

>     canonical  :: a -> Canonical a
>     canonical' :: Canonical a -> a

Void

> instance Canonicable Void where
>     type Canonical Void = Void

>     canonical  = id
>     canonical' = id

Maybe A
A
Maybe A

> instance Canonicable a => Canonicable (Maybe a) where
>     type Canonical (Maybe a) = Maybe (Canonical a)

>     canonical  Nothing  = Nothing
>     canonical  (Just n) = Just (canonical n)
>     canonical' Nothing  = Nothing
>     canonical' (Just n) = Just (canonical' n)

Either A B
A
B
plus

> instance (Canonicable m, Canonicable n, Plussable (Canonical m) (Canonical n)) => Canonicable (Either m n) where
>     type Canonical (Either m n) = Plus (Canonical m) (Canonical n)
>     canonical (Left m) =
>         let i = plus :: Either (Canonical m) (Canonical n) -> Plus (Canonical m) (Canonical n)
>         in  i (Left (canonical m))
>     canonical (Right n) =
>         let i = plus :: Either (Canonical m) (Canonical n) -> Plus (Canonical m) (Canonical n)
>         in  i (Right (canonical n))
>     canonical' x =
>         let i' = plus' :: Plus (Canonical m) (Canonical n) -> Either (Canonical m) (Canonical n)
>         in case i' x of
>             Left  m -> Left  (canonical' m)
>             Right n -> Right (canonical' n)

> instance (Canonicable m, Canonicable n, Timesable (Canonical m) (Canonical n)) => Canonicable (m, n) where
>     type Canonical (m, n) = Times (Canonical m) (Canonical n)
>     canonical (m, n) =
>         let i = times :: (Canonical m, Canonical n) -> Times (Canonical m) (Canonical n)
>         in  i (canonical m, canonical n)
>     canonical' x =
>         let i' = times' :: Times (Canonical m) (Canonical n) -> (Canonical m, Canonical n)
>             (m, n) = times' x
>         in (canonical' m, canonical' n)

> iso :: (Canonical m ~ Canonical n, Canonicable m, Canonicable n) => m -> n
> iso m = canonical' (canonical m)

> test = iso :: Either (Two, Two) Five -> (Three, Three)

> go1 = Left (zero, one)
> go2 = Left (one, zero)
> go3 = Right four

Three
iso
 mempty = Color 0 0 0 0
 mappend c@(Color _ _ _ a) c' = a*c + (1-a)*c'

mempty `mappend` x = x
f(g(c)) = [fa;fx]([ga;gx](c))
        = fa fx + (1 - fa) ([ga;gx](c))
        = fa fx + (1 - fa) (ga gx + (1 - ga) c)
        = fa fx + (1 - fa) ga gx + (1 - fa) (1 - ga) c
        = fa fx + (1 - fa) ga gx + (1 - fa - ga + fa ga) c
        = (fa fx + (1 - fa) ga gx) + (1 - (fa + ga - fa ga)) c

        = a' (fa fx + (1 - fa) ga gx) / a' + (1 - a') c

[fa;fx] . [ga;gx] = [a' ; (fa fx + (1 - fa) ga gx) / a']
   where a' = fa + ga - fa ga

a x + (1 - a) c = c

runAll = defaultMain . bgroup "" . map (uncurry bench . second runCHP_)
main = runAll [("SimpleChannel", simpleChannel)
              ,("SimpleChoice 2", choice 2)
              ,("SimpleChoice 5", choice 5)
              ,("SimpleChoice 10", choice 10)
              ]

CHP ()
IO ()
cabal update && cabal install progression
cabal install criterion -f-Chart
cabal install progression
darcs get http://patch-tag.com/r/twistedsquare/progression
           data word  bit
sent       0 1 1      0
corrupted  1 0 1      0
           data word  bit
sent       1 0 1      0
corrupted  1 1 1      1
push 5; push 42; pop;

type Program instr    = [instr]
type StackProgram     = Program StackInstruction
data StackInstruction = Push Int | Pop

example = Push 5 : Push 42 : Pop : []

exampleTwice = example ++ example
    = Push 5 : Push 42 : Pop : Push 5 : Push 42 : Pop : []

empty = []

 empty ++ is      =  is                  -- left unit
    is ++ empty   =  is                  -- right unit
(is ++ js) ++ ks  =  is ++ (js ++ ks)    -- associativity

replace a = Pop : Push a : []

push :: Int -> StackProgram
pop  :: StackProgram

empty :: StackProgram
(++)  :: StackProgram -> StackProgram -> StackProgram 

type Stack a = [a]

interpret :: StackProgram -> (Stack Int -> Stack Int)

interpret (Push a : is) stack = interpret is (a : stack)
interpret (Pop    : is) stack = interpret is (tail stack)
interpret []            stack = stack

a <- pop;
b <- pop;
push (a+b);

a <- pop; b <- pop; push (a+b);

Pop :: StackInstruction

Pop :: StackInstruction Int

Push 42 :: StackInstruction ()
Push    :: Int -> StackInstruction ()

data StackInstruction a where
    Pop  :: StackInstruction Int
    Push :: Int -> StackInstruction ()

data Program instr a where ...

type StackProgram a = Program StackInstruction a

Pop `Then` \a -> rest 

let a = foo in bar   <=>   (\a -> bar) foo

example2 = Pop `Then` (\a -> Pop `Then`
                        (\b -> Push (a+b) `Then` Return))

example2 = Pop `Then` \a ->
           Pop `Then` \b ->
           Push (a+b) `Then`
           Return

Then :: instr a -> (a -> Program instr b) -> Program instr b

Return :: a -> Program instr a

example3 = Pop `Then` \a -> Pop `Then` \b -> Return (a*b)

data Program instr a where
    Then   :: instr a -> (a -> Program instr b) -> Program instr b
    Return :: a -> Program instr a

type StackProgram a = Program StackInstruction a

interpret :: StackProgram a -> (Stack Int -> a)
interpret (Push a `Then` is) stack     = interpret (is ()) (a:stack)
interpret (Pop    `Then` is) (b:stack) = interpret (is b ) stack
interpret (Return c)         stack     = c

GHCi> interpret example3 [7,11]
77

singleton :: instr a -> Program instr a
singleton i = i `Then` Return

pop  :: StackProgram Int
push :: Int -> StackProgram ()

pop  = singleton Pop
push = singleton . Push

(>>=) :: Program i a -> (a -> Program i b) -> Program i b
(Return a)    >>= js  = js a
(i `Then` is) >>= js  = i `Then` (\a -> is a >>= js)

return = Return

return a >>= is     = is a                        -- left unit
is >>= return       = is                          -- right unit
(is >>= js) >>= ks  = is >>= (\a -> js a >>= ks)  -- associativity

instance Monad (Program instr) where
    (>>=)  = ...
    return = ...

State (Stack Int)

evalState :: State s -> (s -> a)

type Random a = StdGen -> (a,StdGen)

type Probability = Double
type Random a    = [(a,Probability)]

type Random a = Program RandomInstruction a

data RandomInstruction a where
    Uniform :: [a] -> RandomInstruction a

uniform :: [a] -> Random a
uniform = singleton . Uniform

die :: Random Int
die = uniform [1..6]

sum2Dies = die >>= \a -> die >>= \b -> return (a+b)

sample :: Random a -> StdGen -> (a,StdGen)
sample (Return a)             gen = (a,gen)
sample (Uniform xs `Then` is) gen = sample (is $ xs !! k) gen'
    where (k,gen') = System.Random.randomR (0,length xs-1) gen

distribution :: Random a -> [(a,Probability)]
distribution (Return a)             = [(a,1)]
distribution (Uniform xs `Then` is) =
    [(a,p/n) | x <- xs, (a,p) <- distribution (is x)]
    where n = fromIntegral (length xs)

symbol :: Parser Char
mzero  :: Parser a
mplus  :: Parser a -> Parser a -> Parser a

interpret :: Parser a -> (String -> [a])

satisfies p = symbol >>= \c -> if p c then return c else mzero 
many  p     = return [] `mplus` many1 p
many1 p     = liftM2 (:) p (many p) 
digit       = satisfies isDigit >>= \c -> return (ord c - ord '0')
number      = many1 digit >>= return . foldl (\x d -> 10*x + d) 0

data ParserInstruction a where
    Symbol :: ParserInstruction Char
    MZero  :: ParserInstruction a
    MPlus  :: Parser a -> Parser a -> ParserInstruction a

type Parser a = Program ParserInstruction a

interpret :: Parser a -> String -> [a]
interpret (Return a)            s = if null s then [a] else []
interpret (Symbol    `Then` is) s = case s of
    c:cs -> interpret (is c) cs
    []   -> []
interpret (MZero     `Then` is) s = []
interpret (MPlus p q `Then` is) s =
    interpret (p >>= is) s ++ interpret (q >>= is) s

interpret mzero       = \s -> []
interpret (mplus p q) = \s -> interpret p s ++ interpret q s

interpret (Mplus p q `Then` is) = ...

    mzero >>= m = mzero
mplus p q >>= m = mplus (p >>= m) (q >>= m)

  interpret (Mplus p q `Then` is)
=   { definition of concatenation and mplus }
  interpret (mplus p q >>= is)
=   { MonadPlus law }
  interpret (mplus (p >>= is) (q >>= is))
=   { intended meaning }
  \s -> interpret (p >>= is) s ++ interpret (q >>= is) s

interpret (mplus p q >>= is) = ...

interpret (MPlus p q `Then` is) s =
    interpret (p >>= is) s ++ interpret (q >>= is) s

  (symbol >>= is) `mplus` (symbol >>= js)
=  symbol >>= (\c -> is c `mplus` js c)

  (symbol >>= is) `mplus` (symbol >>= js) `mplus` (symbol >>= ks)
=  symbol >>= (\c -> is c `mplus` js c `mplus` ks c)

expand :: Parser a -> [Parser a]
expand (MPlus p q `Then` is) = expand (p >>= is) ++
                               expand (q >>= is)
expand (MZero     `Then` is) = []
expand x                     = [x]

foldr mplus mzero . expand = id

interpret :: Parser a -> String -> [a]
interpret p = interpret' (expand p)
    where
    interpret' :: [Parser a] -> String -> [a]
    interpret' ps []     = [a | Return a <- ps]
    interpret' ps (c:cs) = interpret'
        [p | (Symbol `Then` is) <- ps, p <- expand (is c)] cs

data Cont m a = Cont { runCont :: forall b. (a -> m b) -> m b }

\k -> interpret (Instruction `Then` k)

evalState (sequence . repeat . State $ \s -> (s,s+1)) 0

take a binding	`a <- pop; rest`
turn the arrow to the right	`pop -> a; rest`
and use a lambda expression to move it past the semicolon	`pop; \a -> rest`

Term	Mathematical operation
`return`	1
`(>>=)`	× multiplication
`mzero`	0
`mplus`	+ addition
`symbol`	x indeterminate

Planet Haskell

Neil Brown: Progression version 0.2 released

Haskell Weekly News: Haskell Weekly News: Issue 149 - February , 2010

Announcements

Discussion

Blog noise

Quotes of the Week

About the Haskell Weekly News

Epilogue for Epigram: Quotients

Tom Schrijvers: Haskell @ AOSD 2010

Joachim Breitner: If I were a caricaturist

Dan Piponi (sigfpe): The Categorification of the Naturals

Roman Cheplyaka: hledger

Luke Palmer: Associative Alpha Blending

John Goerzen (CosmicRay): The Big-Publisher Ebook Scam

Bryn Keller: How to Measure Anything

Neil Brown: Progression: Supporting Optimisation in Haskell

Progression

Using Progression

Installing Progression

Sharing Progression

Issues with the 0.1 release

Pipe Dream

Kevin Reid (kpreid)

Joachim Breitner: FontForge-Article in the German Linux-Magazin

Kevin Reid (kpreid): “Not an exit”

Lee Pike: “Schrodinger’s Probability” for Error-Checking Codes

Background

Simulations

Calculations

Combining the Results

Conclusions

Bryn Keller: Tech Note: Finding All the Assemblies Available to Your Application

Lee Pike: 10 to the -9

Holumbus: Hayoo! Webservice API

apfelmus: The Operational Monad Tutorial

Mikael Vejdemo Johansson (Syzygy-): Testing out the wplatex package

Gareth Smith (gds): Random 11pm thought: Privacy through insecurity.