RNA Folding based on Free Energy Minimization (Zuker's Algorithm)
This is the historical Zuker algorithm. Since the energy model used in 1981 is outdated we do not provide a true energy minimization algebra. Read the full description in Systematic Dynamic Programming in Bioinformatics.
ADP Source Code Try DP online
Haskell header: showcode
> module Zuker where

> import Array
> import List
> import ADPTriCombinators
The signature: showcode
> data Folding = Str    Folding                                   | 
>                Hl     Char (Int,Int) Char                       | 
>                Bi     Char Folding Folding Char                 | 
>                Sr     Char Folding Char                         | 
>                BulgeL Char (Int,Int) Folding Char               |
>                BulgeR Char           Folding (Int,Int) Char     | 
>                Il     Char (Int,Int) Folding (Int,Int) Char     | 
>                OpenL  Char    Folding                           | 
>                OpenR  Folding Char                              | 
>                Branch Folding Folding 
>                              deriving (Eq, Show)
The yield grammar: showcode
> zuker81 alg inp = axiom struct where
>   (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) = alg
>   
>   struct = str <<< w
> 
>   v = tabulated (
>       (hairpin ||| twoedged ||| bifurcation) `with` basepairing ... h)
>     where
>     hairpin     = hl <<< base -~~ (region `with` minloopsize) ~~- base
>     bifurcation = bi <<< base -~~ w +~+ w ~~- base ... h
>     twoedged    = stack ||| bulgeleft ||| bulgeright ||| interior ... h
>       where
>       stack      = sr     <<< base -~~            v            ~~- base
>       bulgeleft  = bulgeL <<< base -~~ region +~+ v            ~~- base
>       bulgeright = bulgeR <<< base -~~            v +~+ region ~~- base
>       interior   = il     <<< base -~~ region +~+ v +~+ region ~~- base
>  
>   w = tabulated (openleft ||| openright ||| v ||| connected ... h)
>         where
>         openleft  = openL  <<< base -~~ w
>         openright = openR  <<< w    ~~- base
>         connected = branch <<< w    +~+ w    ... h
Bind input: showcode
>   z         = mk (inp)
>   (_,n)     = bounds z

>   base      = achar' z
>   tabulated = table n
>   axiom     = axiom' n

>   minloopsize :: Filter
>   minloopsize (i,j) = i+minloop<j+1
>   minloop = 3

>   basepairing :: Filter
>   basepairing  = match inp
>   match  inp (i,j) = i+1<j && basepair (z!(i+1), z!(j))
>   basepair ('a','u') = True
>   basepair ('u','a') = True
>   basepair ('c','g') = True
>   basepair ('g','c') = True
>   basepair ('g','u') = True
>   basepair ('u','g') = True
>   basepair ( x , y ) = False

>   region (i,j) =  [(i,j) | i < j]
Enumeration algebra: showcode
> enum :: Zucker_Algebra Char (Int,Int) Folding
> enum = (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) where
>    str    = Str
>    hl     = Hl
>    bi     = Bi
>    sr     = Sr
>    bulgeL = BulgeL
>    bulgeR = BulgeR
>    il     = Il
>    openL  = OpenL
>    openR  = OpenR 
>    branch = Branch
>    h      = id
Pretty printing algebra: showcode
> prettyprint :: Zucker_Algebra Char (Int,Int) String
> prettyprint = (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) where
>   str = id
>   hl _ (h1,h2) _           = '(' : dots (h2-h1) ++ ")"
>   bi _ s1 s2 _             = '(' : s1 ++ s2 ++ ")"
>   sr _ s _                 = '(' : s ++ ")"
>   bulgeL _   (l1,l2) s _   = '(' : dots (l2-l1) ++ s ++ ")"
>   bulgeR _ s (r1,r2)   _   = '(' : s ++ dots (r2-r1) ++ ")"
>   il _ (l1,l2) s (r1,r2) _ = '(' : dots (l2-l1) ++ s ++ dots (r2-r1) ++ ")"
>   openL _ s                = '.' : s
>   openR s _                = s ++ "."
>   branch s1 s2             = s1 ++ s2
>   h                        = id

>   dots i = replicate i '.'
Counting Algebra: showcode
> count :: Zucker_Algebra Char (Int,Int) Int
> count = (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) where
>    str    x       = x
>    hl     _ _ _   = 1
>    bi     _ x y _ = x*y
>    sr     _ x _   = x
>    bulgeL _ _ x _ = x
>    bulgeR _ x _ _ = x
>    il   _ _ x _ _ = x
>    openL  _ x     = x
>    openR  x _     = x
>    branch x y     = x*y
>    h xs           = [sum xs]
Base pair algebra: showcode
> pairmax :: Zucker_Algebra Char a Int
> pairmax = (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) where
>    str    x       = x
>    hl     _ _ _   = 1
>    bi     _ x y _ = x + y + 1
>    sr     _ x _   = x + 1
>    bulgeL _ _ x _ = x + 1
>    bulgeR _ x _ _ = x + 1
>    il   _ _ x _ _ = x + 1
>    openL  _ x     = x
>    openR  x _     = x
>    branch x y     = x + y
>    h []           = []
>    h xs           = [maximum xs]
Stacking base pair algebra: showcode
> stackmax :: Zucker_Algebra Char a Int
> stackmax = (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) where
>    str    x       = x
>    hl     _ _ _   = 0
>    bi     _ x y _ = x + y
>    sr     _ x _   = x + 1
>    bulgeL _ _ x _ = x 
>    bulgeR _ x _ _ = x 
>    il   _ _ x _ _ = x 
>    openL  _ x     = x
>    openR  x _     = x
>    branch x y     = x + y
>    h []           = []
>    h xs           = [maximum xs]
Algebra type: showcode
> type Zucker_Algebra alph alph2 answer = (
>   answer -> answer,					  -- str
>   alph -> alph2 -> alph -> answer,			  -- hl
>   alph -> answer -> answer -> alph -> answer,		  -- bi
>   alph -> answer -> alph -> answer,			  -- sr
>   alph -> alph2 -> answer -> alph -> answer,		  -- bulgeL
>   alph -> answer -> alph2 -> alph -> answer,		  -- bulgeR
>   alph -> alph2 -> answer -> alph2 -> alph -> answer,   -- il
>   alph -> answer -> answer,				  -- openL
>   answer -> alph -> answer,				  -- openR
>   answer -> answer -> answer,				  -- branch
>   [answer] -> [answer]            		          -- h
>   )
Algebra cross product: showcode
> infix ***
> alg1 *** alg2 = (str,hl,bi,sr,bulgeL,bulgeR,il,openL,openR,branch,h) where
>    (str1, hl1, bi1, sr1, bulgeL1, bulgeR1, il1, openL1, openR1, branch1, h1) = alg1
>    (str2, hl2, bi2, sr2, bulgeL2, bulgeR2, il2, openL2, openR2, branch2, h2) = alg2
> 
>    str (x1,x2) = (str1 x1, str2 x2)
>    hl b l b' = (hl1 b l b', hl2 b l b')
>    bi b (x1,x2) (y1,y2) b' = (bi1 b x1 y1 b', bi2 b x2 y2 b')
>    sr b (x1,x2) b' = (sr1 b x1 b', sr2 b x2 b')
>    bulgeL b l (x1,x2) b' = (bulgeL1 b l x1 b', bulgeL2 b l x2 b')
>    bulgeR b (x1,x2) r b' = (bulgeR1 b x1 r b', bulgeR2 b x2 r b')
>    il b r (x1,x2) l b' = (il1 b r x1 l b', il2 b r x2 l b')
>    openL u (x1,x2) = (openL1 u x1, openL2 u x2)
>    openR (x1,x2) u = (openR1 x1 u, openR2 x2 u)
>    branch (x1,x2) (y1,y2) = (branch1 x1 y1, branch2 x2 y2)
> 
>    h xs = [(x1,x2)| x1 <- nub $ h1 [ y1 | (y1,y2) <- xs],
>                     x2 <-       h2 [ y2 | (y1,y2) <- xs, y1 == x1]]
For usage on your local machine:
background image
university bielefeld AG PI BiBiServ
ambient picture