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.
```> module Zuker where

> import Array
> import List
```
The signature:
```> 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:
```> 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:
```>   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:
```> 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:
```> 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:
```> 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:
```> 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:
```> 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:
```> type Zucker_Algebra alph alph2 answer = (
>   alph -> alph2 -> alph -> answer,			  -- hl
>   alph -> alph2 -> answer -> alph -> answer,		  -- bulgeL
>   alph -> answer -> alph2 -> alph -> answer,		  -- bulgeR
>   alph -> alph2 -> answer -> alph2 -> alph -> answer,   -- il
>   )
```
Algebra cross product:
```> 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: