Blog Archive

Monday, July 23, 2007

ICFP '07 Post-Mortem: IV

My friend Creighton and I entered the ICFP programming competition this year, we didn't make it very far, but then again we didn't spend as much time on it as last year. That's the way it goes.

I'm posting this in the hopes that someone can point out our bug. Please, help me!

This is our main module to convert DNA to RNA. If you're familiar with this years contest (and Haskell, I suppose) it should be reasonably comprehensible. I hope. If not, please let me know.
====================
Execute.lhs



> {-# OPTIONS -fglasgow-exts #-}

> module Execute where

> import DNA
> import Control.Monad.State
> import Data.List
> import System.IO
> import System.Environment
> import Data.Maybe
> import Maybe


I don't know that I've ever even tested our "main" method, maybe Creighton has. Almost all of our testing was done by loading the Testing module into GHCI.


> main :: IO ()
> main = do
> prefile:dnafile:_ <- getArgs
> prefix <- (openFile prefile ReadMode) >>= hGetContents
> dna <- (openFile dnafile ReadMode) >>= hGetContents
> let (World rna _ ) = execState execute (World [] (prefix++dna))
> print rna
> return ()


Here are our datatypes for the template items and pattern items. Everywhere the spec uses the Template datatype, that translates to [Template] in our implementation (and similarly for Pattern). Otherwise, these are pretty much straight from the spec.


> data Template = TBase Char | NL Int Int | N Int
> deriving Show

> data Pattern = Base Char | Skip Int | Search DNA | GOpen | GClose
> deriving Show


Most of the interesting stuff happens in the state monad, and this is our state!
DNA is of type String, and RNA is of type [DNA].


> data World = World RNA DNA
> deriving (Show, Eq)


These next few function operate on our state, they let us read DNA and write RNA. They'll get used all over the place.


> peekDNA :: (MonadState World m, Integral a) => a -> m [Char]
> peekDNA n = do World _ dna <- get
> return $ genericTake n dna

> popDNA :: (MonadState World m, Integral a) => a -> m [Char]
> popDNA n = do World a dna <- get
> put $ World a (genericDrop n dna)
> return $ genericTake n dna

> pushRNA :: MonadState World m => [Char] -> m ()
> pushRNA rna = do World rnas a <- get
> put $ World (rna:rnas) a


This is the Big Deal DNA to RNA function. The idea is that you give this to execState along with a World containing no RNA and the input DNA, and you'll get back a World containing the output RNA. The "main" function above has an example of this.


> execute :: MonadState World m => m ()
> execute = runMaybeT execute' >> return ()


The function execute' is run under the MaybeT monad transformer so that we can short-circuit the process from any of our functions by calling fail, which acts like finish () in the spec.

The function execute' looks almost exactly like in the spec. The reversals are in hopes that lots of pre-pending plus one big reverse is quicker that a lot of small post-pendings.


> execute' :: MonadState World m => m ()
> execute' = do p <- liftM reverse pattern
> t <- liftM reverse template
> matchreplace p t >> execute'


> pattern :: MonadState World m => m [Pattern]
> pattern = pattern' 0 []


Again, if you're familiar with the function pattern in the contest spec, this shouldn't look at all unfamiliar. Tail recursion is used to keep track of how match pattern is built up so far, and the current level.


> pattern' :: MonadState World m => Int -> [Pattern] -> m [Pattern]
> pattern' x ps = do
> base <- popDNA 1
> case base of
> "C" -> pattern' x ((Base 'I'):ps)
> "F" -> pattern' x ((Base 'C'):ps)
> "P" -> pattern' x ((Base 'F'):ps)
> otherwise -> do
> base' <- popDNA 1
> case (base,base') of
> ("I","C") -> pattern' x ((Base 'P'):ps)
> ("I","P") -> do
> n <- nat
> pattern' x ((Skip n):ps)
> ("I","F") -> do
> popDNA 1
> s <- consts
> pattern' x ((Search s):ps)
> otherwise -> do
> base'' <- popDNA 1
> case (base,base',base'') of
> ("I","I","P") -> pattern' (x+1) ((GOpen):ps)
> ("I","I","C") -> if x==0 then return ps else pattern' (x-1) ((GClose):ps)
> ("I","I","F") -> if x==0 then return ps else pattern' (x-1) ((GClose):ps)
> ("I","I","I") -> (popDNA 7 >>= pushRNA) >> pattern' x ps
> otherwise -> fail ""

> template :: MonadState World m => m [Template]
> template = template' []


Again, this shouldn't look unfamiliar to anyone who's spent time on the contest. And again, tail recurion is used to build up the template. In retrospect I probably didn't need to pass the current list in as a param, but hey, it's done. I guess I've bought into the "tail recursion as a replacement for state" meme. I'll need to break that habit - it isn't very Haskell-ish.


> template' :: MonadState World m => [Template] -> m [Template]
> template' ts = do base <- popDNA 1
> case base of
> "C" -> template' $ (TBase 'I') : ts
> "F" -> template' $ (TBase 'C') : ts
> "P" -> template' $ (TBase 'F') : ts
> "I" -> do base' <- popDNA 1
> case base' of
> "C" -> template' $ (TBase 'P'):ts
> "F" -> do l <- nat
> n <- nat
> template' ((NL n l):ts)
> "P" -> do l <- nat
> n <- nat
> template' ((NL n l):ts)
> "I" -> do base'' <- popDNA 1
> case base'' of
> "C" -> return ts
> "F" -> return ts
> "P" -> do n <- nat
> template' $ (N n):ts
> "I" -> do pushRNA =<< popDNA 7
> template' ts
> _ -> fail ""
> _ -> fail ""
> _ -> fail ""


This is where our error is. Are there any Haskell people who did this years ICFP contest who can tell us where we went wrong? Because I'm mystified, myself, and I really wish I had a working DNA -> RNA converter. In one of the examples, the "popDNA i" in the base case never seems to get called!


> matchreplace p t= matchreplace' p t 0 [] []
> matchreplace' [] t i e c = popDNA i >> (modify $ replace t e)
> matchreplace' (p:ps) t i e c = do
> (World _ dna) <- get
> case p of
> Base b -> if dna !!! i == (Just b)
> then matchreplace' ps t (i+1) e c
> else return ()
> Skip n -> if length dna > (i + n) then return ()
> else matchreplace' ps t (i+n) e c
> Search s -> case searchPost s dna i of
> Just n -> matchreplace' ps t n e c
> Nothing -> return ()
> GOpen -> matchreplace' ps t i e (i:c)
> GClose -> matchreplace' ps t i (e++[(subseq (head c) i dna)]) (subseq' 1 c)

> searchPost :: DNA -> DNA -> Int -> Maybe Int
> searchPost s dna i = let search n [] = Nothing
> search n (s':next) = if s' == s then Just n else search (n+1) next
> in liftM ((i+length s)+) $ search 0 ((map $ take (length s)) . tails $ genericDrop i dna)


> replace t e = replace' t e []

> replace' [] e r = (\(World rna dna) -> World rna (r++dna))
> replace' (t:ts) e r = case t of
> TBase b -> replace' ts e (r++[b])
> NL n l -> replace' ts e (r++(protect l $ fromMaybe [] (e!!!n)))
> N n -> replace' ts e (r++(asnat $ length $ fromMaybe [] (e!!!n)))


The rest of this are the utility functions used by the above. They're pretty simple, and should be familiar to you if you've done this year's ICFP competion


> asnat :: Integral n => n -> DNA
> asnat n | n==0 = "P"
> | n >= 0 && n `mod` 2==0 = 'I':(asnat $ n `div` 2)
> | n >= 0 = 'C' : (asnat $ n `div` 2)

> quote :: DNA -> DNA
> quote ('I':ds) = 'C':(quote ds)
> quote ('C':ds) = 'F':(quote ds)
> quote ('F':ds) = 'P':(quote ds)
> quote ('P':ds) = 'I':'C':(quote ds)
> quote _ = []

> protect :: Integral n => n -> DNA -> DNA
> protect 0 dna = dna
> protect n dna | n > 0 = protect (n-1) (quote dna)
> | otherwise = error "Protect should never receive a negative argument"


> nat :: (MonadState World m, Integral i) => m i
> nat = do dna <- popDNA 1
> case dna of
> "P" -> return 0
> "I" -> liftM (* 2) nat
> "F" -> liftM (* 2) nat
> "C" -> liftM (\x -> 2*x+1) nat
> _ -> fail ""

> consts :: MonadState World m => m DNA
> consts = do n <- popDNA 1
> case n of
> "C" -> liftM ('I':) consts
> "F" -> liftM ('C':) consts
> "P" -> liftM ('F':) consts
> "I" -> do n' <- peekDNA 1
> case n' of
> "C" -> popDNA 2 >> liftM ('P':) consts
> _ -> return ""
> _ -> return ""


And that's it for this file!

ICFP '07 Post-Mortem: III

Welcome to my series of posts on the ICFP competion entry I worked on!

"Testing" is our testing harness. the most exciting thing here is the function "test", which is just like the function "execute" in the Execute module, except it's wrapped around the IO monad and spits out diagnostics. If you're going to try an execute our code, you're going to want this.


===================
Testing.lhs


> module Testing where

> import Control.Monad.State
> import Maybe
> import Execute
> import System.IO
> import DNA


The strings iter1 through iter3 are the DNA sequences provided in the contest docs for testing out code.


> iter1 = "IIPIPICPIICICIIFICCIFPPIICCFPC"
> iter2 = "IIPIPICPIICICIIFICCIFCCCPPIICCFPC"
> iter3 = "IIPIPIICPIICIICCIICFCFC"


This is an all-in-one function to go from DNA to RNA, all while spitting out patterns and templates as debug messages.


> test :: DNA -> IO World
> test dna = flip execStateT (World [] dna) $ runMaybeT $
> let eval = do liftIO $ putStrLn "About to execute pattern"
> p <- liftM reverse pattern
> dna <- peekDNA 51
> liftIO $ do putStrLn $ "p: " ++ (show p)
> putStrLn $ "next dna: " ++ formatDNA dna
> putStrLn $ "About to execute template"
> t <- liftM reverse template
> dna <- peekDNA 51
> liftIO $ do putStrLn $ "t: " ++ (show t)
> putStrLn $ "next dna: " ++ formatDNA dna
> putStrLn $ "About to execute matchreplace"
> matchreplace p t
> dna <- peekDNA 51
> liftIO $ do putStrLn $ "next dna: " ++ formatDNA dna
> putStrLn $ "About to go through again!"
> eval
>
> in do liftIO $ putStrLn $ "Starting DNA: " ++ (formatDNA $ take 51 dna)
> eval

> formatDNA dna =
> if length dna > 50 then (take 50 dna) ++ "..." else dna

ICFP '07 Post-Mortem: II

Next up are some helper datatypes to make our code look more like the spec. If you're familiar with the contest (which is what I'm assuming) nothing here should look strange. For those of you that aren't familiar with the contest, here's the specification (PDF).


============
DNA.lhs


> module DNA where

> import Data.List

> type DNA = String
> type RNA = [DNA]

> subseq' a = genericDrop a

> subseq a b = genericTake (b-a) . genericDrop a

> (!!!) :: [a] -> Int -> Maybe a
> dna !!! x = if x >= length dna then Nothing else Just (dna !! x)

ICFP '07 Post-Mortem: I

This is the first of a few posts outlining Creighton and myself's effort towards this years IFCP programming competition. We didn't get too far, but I've learned a lot (more) about Haskell along the way.

I plan on doing one post per module, and this first post defines the Maybe monad transformer, which isn't in GHC (yet?) but made our code look much neater.


Check it out!

=======================
Maybe.lhs


> {-# OPTIONS -fallow-undecidable-instances -fglasgow-exts #-}

> module Maybe where


Almost all of this is taken from the Haskell Wiki


> import Control.Monad
> import Control.Monad.Trans
> import Control.Monad.State

> newtype MaybeT m a = MaybeT {runMaybeT :: m (Maybe a)}

> instance Functor m => Functor (MaybeT m) where
> fmap f x = MaybeT $ fmap (fmap f) $ runMaybeT x

> instance Monad m => Monad (MaybeT m) where
> return = MaybeT . return . return
> x >>= f = MaybeT $ runMaybeT x >>= maybe (return Nothing) (runMaybeT . f)
> fail _ = MaybeT $ return Nothing

> instance Monad m => MonadPlus (MaybeT m) where
> mzero = MaybeT $ return mzero
> mplus x y = MaybeT $ liftM2 mplus (runMaybeT x) (runMaybeT y)

> instance MonadTrans MaybeT where
> lift = MaybeT . liftM return


Here are my contributions, which I shoudl proabbly give back to the wiki: the MonadIO instance and the MonadState instance. You'd think these would generalize to any instance of MonadTrans, seeing as I only use lift. I haven't tried it yet.


> instance MonadIO m => MonadIO (MaybeT m) where
> liftIO = lift . liftIO


My Haskell-fu isn't good enough to make the instance of MonadState work without -fallow-undecidable-instances. If anyone knows why, let me know.


> instance (MonadState s m) => MonadState s (MaybeT m) where
> get = lift get
> put = lift . put

Tuesday, July 10, 2007

Latex + Blogger help

I've been working on writing up my solutions to the exercises in Pierce's Basic Category Theory for Computer Scientists in this space, but I'm getting to the point where it's useful to include diagrams in my solutions.

Does anyone have any Linux-based workflows they'd like to share that could give a small JPEG if I supply a prelude and a LaTeX statement?

Friday, July 06, 2007

More from Pierce's Category Theory

Continuing the last set of exercises:

1.3.10 Exercises

4 Let f :: A -> B be an isomorphism. Show that it's inverse is unique.
First, I will suppose that the inverse of f is not unique, that is there exists two unique arrows a,b :: B -> A such that:
  • f . b = idA, b . f = idB
  • f . a = idA, a . f = idB

Therefore:
  • f . b = f . a
  • a . (f . b) = a . (f . a)
  • (a . f) . b = (a . f) . b
  • idB . b = idB . a
  • b = a
If f is an isomorphism, it's inverse is unique.

5 Show that if f' is the inverse of f :: A -> B and g' is the inverse of g :: B -> C, then (f' . g') is the inverse of (g . f).

(Notational note: In this exercise I'm using prime (') to denote inversion)

  • (g . f)' . (g . f) = idA
  • ((g . f)' . g) . f = idA
  • (g . f)' . g = f'
  • (g . f)' = f' . g' QED
6 Find a category containing an arrow that is both a monomorphism and an epimorphism, but not an isomorphism.

I don't really understand this question ... Does the category 2 satisfy this? The only non-identity arrow is trivially both epic and monic and has no inverse. So, yeah.

That's it for this bit of questions! Hopefully I can keep this up for at least the next exercise set.

Thursday, July 05, 2007

Basic Catagory Theory for Computer Scientists

I'm not in grad school anymore (which is a story!), so now I have to practice on my own time to keep my academic knife sharp.

To that end I'm working through Pierce's Basic Category Theory for Computer Scientists. So far, category theory isn't hard conceptually - but the concepts are so abstract that I find it difficult to internalize them. But then, it's not like I spent a lot of time in the math dept. back when I was in school (as much as I liked the mathematical tools I used).

Although I shouldn't be going on about how "not hard" it is while I'm still in chapter one.

Onward!

1.3.10 Exercises

2 Show that in any category, if two arrows f and g are both monic then their composition (g . f) is monic. Also, if (g . f) is monic then so is f.

The first part:
  • Let (g . f) . a = (g. f) . b
  • -> g . (f . a) = g . (f . b)
  • Because g is monic -> f . a = f . b
  • Because f is monic -> a = b
Therefore (g . f) is monic

The second part:

Suppose that (g . f) is monic.
Let's further suppose that there exists two arrows a and b such that:

f . a = f . b, a \= b

  • g . (f . a) = g . (f . b), a \=b, via arrow composition
  • (g . f) . a = (g . f) . b, a\=b, via associativity of composition
Which violates my first assumption. Therefore: If (g . f) is monic, for all pairs of arrows a and b such (f . a) = (f . b), a = b. Therefore f is monic.


3 Dualize the previous exercise: state and prove the analogous proposition for epics.

Along the same lines as the previous proof:
  1. Let (g . f) be epic.
  2. Let there exist two arrows a and b such that a . g = b . g and a \= b.
(a . g) . f = (b . g) . f, a \=b via composition of arrows
a . (g . f) = b . (g . f), a \= b via associativity of composition

My assumptions are in contradiction. Therefore, if (g . f) is epic, there exist no two arrows a and b such that a . g = b . g and a \=b - that is, g is epic.

More to come. Let me know if my math is crap.

Wednesday, July 04, 2007

Another quine

This quine is a lot like my first Haskell quine, except shorter.
(This one is technically not a quine, due to linebreaks, but it prints a quine when executed)

import System.IO
main=(putStr.map toEnum)p>>(putStr.show)p>>putStr "\n"
p=[105,109,112,111,114,116,32,83,
121,115,116,101,109,46,73,79,
10,109,97,105,110,61,40,112,
117,116,83,116,114,46,109,97,
112,32,116,111,69,110,117,109,
41,112,62,62,40,112,117,116,
83,116,114,46,115,104,111,119,
41,112,62,62,112,117,116,83,
116,114,32,34,92,110,34,10,
112,61]

Tuesday, July 03, 2007

Another quine, this time using the printf trick

I'm not sure how to make blogger give me a scrollbar to put code in.
You'll just have to remove linebreaks where needed.


import System.IO
import Text.Printf
main = let s = "import System.IO%cimport Text.Printf%cmain = let s = %c%s%c
in printf s (10 :: Int) (10 :: Int) (34 :: Int) s (34 :: Int) (10 :: Int)%c"
in printf s (10 :: Int) (10 :: Int) (34 :: Int) s (34 :: Int) (10 :: Int)

Hurrah for fixed points


import System.IO

-- My first haskell quine, revised

main :: IO ()
main = do (putStr . map toEnum) prog

(putStr . breaker . show) prog

putStr "\n"

breaker :: String -> String
breaker = (unwordsBy ',' . f . wordsBy ',') where
f xs
| length xs > 8 = (take 8 xs) ++ (f . g) (drop 8 xs)
| otherwise = xs

g [] = []
g (x:xs) = ("\n " ++ x):xs

-- Adapted from "lines" in the GHC List module
wordsBy :: Char -> String -> [String]
wordsBy _ "" = []
wordsBy c s = let (l, s') = break (== c) s in
l: case s' of
[] -> []
(_:s'') -> wordsBy c s''

-- Adapted from "unlines" in the GHC List module
unwordsBy :: Char -> [String] -> String
unwordsBy _ [] = ""
unwordsBy c ws = foldr1 (\w s -> w ++ c:s) ws

prog :: [Int]
prog = [105,109,112,111,114,116,32,83,
121,115,116,101,109,46,73,79,
10,10,45,45,32,77,121,32,
102,105,114,115,116,32,104,97,
115,107,101,108,108,32,113,117,
105,110,101,44,32,114,101,118,
105,115,101,100,10,10,109,97,
105,110,32,58,58,32,73,79,
32,40,41,10,109,97,105,110,
32,61,32,100,111,32,40,112,
117,116,83,116,114,32,46,32,
109,97,112,32,116,111,69,110,
117,109,41,32,112,114,111,103,
10,10,32,32,32,32,32,32,
32,32,32,32,40,112,117,116,
83,116,114,32,46,32,98,114,
101,97,107,101,114,32,46,32,
32,115,104,111,119,41,32,112,
114,111,103,10,10,32,32,32,
32,32,32,32,32,32,32,112,
117,116,83,116,114,32,34,92,
110,34,10,10,98,114,101,97,
107,101,114,32,58,58,32,83,
116,114,105,110,103,32,45,62,
32,83,116,114,105,110,103,10,
98,114,101,97,107,101,114,32,
61,32,40,117,110,119,111,114,
100,115,66,121,32,39,44,39,
32,46,32,102,32,46,32,119,
111,114,100,115,66,121,32,39,
44,39,41,32,119,104,101,114,
101,10,32,32,102,32,120,115,
10,32,32,32,32,124,32,108,
101,110,103,116,104,32,120,115,
32,62,32,56,32,61,32,40,
116,97,107,101,32,56,32,120,
115,41,32,43,43,32,40,102,
32,46,32,103,41,32,40,100,
114,111,112,32,56,32,120,115,
41,10,32,32,32,32,124,32,
111,116,104,101,114,119,105,115,
101,32,32,32,32,32,61,32,
120,115,10,10,32,32,103,32,
32,91,93,32,32,32,32,61,
32,91,93,10,32,32,103,32,
40,120,58,120,115,41,32,61,
32,40,34,92,110,32,34,32,
43,43,32,120,41,58,120,115,
32,10,10,45,45,32,65,100,
97,112,116,101,100,32,102,114,
111,109,32,34,108,105,110,101,
115,34,32,105,110,32,116,104,
101,32,71,72,67,32,76,105,
115,116,32,109,111,100,117,108,
101,10,119,111,114,100,115,66,
121,32,58,58,32,67,104,97,
114,32,45,62,32,83,116,114,
105,110,103,32,45,62,32,91,
83,116,114,105,110,103,93,10,
119,111,114,100,115,66,121,32,
95,32,34,34,32,61,32,91,
93,10,119,111,114,100,115,66,
121,32,99,32,115,32,32,61,
32,108,101,116,32,40,108,44,
32,115,39,41,32,61,32,98,
114,101,97,107,32,40,61,61,
32,99,41,32,115,32,105,110,
10,32,32,32,32,32,32,32,
32,32,32,32,32,32,32,32,
108,58,32,99,97,115,101,32,
115,39,32,111,102,10,32,32,
32,32,32,32,32,32,32,32,
32,32,32,32,32,32,32,32,
32,32,91,93,32,32,32,32,
32,32,45,62,32,91,93,10,
32,32,32,32,32,32,32,32,
32,32,32,32,32,32,32,32,
32,32,32,32,40,95,58,115,
39,39,41,32,45,62,32,119,
111,114,100,115,66,121,32,99,
32,115,39,39,10,10,45,45,
32,65,100,97,112,116,101,100,
32,102,114,111,109,32,34,117,
110,108,105,110,101,115,34,32,
105,110,32,116,104,101,32,71,
72,67,32,76,105,115,116,32,
109,111,100,117,108,101,10,117,
110,119,111,114,100,115,66,121,
32,58,58,32,67,104,97,114,
32,45,62,32,91,83,116,114,
105,110,103,93,32,45,62,32,
83,116,114,105,110,103,10,117,
110,119,111,114,100,115,66,121,
32,95,32,91,93,32,61,32,
34,34,10,117,110,119,111,114,
100,115,66,121,32,99,32,119,
115,32,61,32,102,111,108,100,
114,49,32,40,92,119,32,115,
32,45,62,32,119,32,43,43,
32,99,58,115,41,32,119,115,
10,10,112,114,111,103,32,58,
58,32,91,73,110,116,93,10,
112,114,111,103,32,61,32]

Listening:

Watching:

  • House
  • Ride Back