A quadratic version for affine cost functions (Gotoh) (sequence alignment)
Gotoh's algorithm generalizes Waterman's by introducing affine gap scores. It retains runtime O(n^2), but uses two additional tables. Read the full description in Systematic Dynamic Programming in Bioinformatics.
ADP Source Code Try DP online
Haskell header: showcode
> module Gotoh where

> import Array
> import List
> import TTCombinators
The signature: showcode
> data Alignment = Nil                    |
>                  D  Char Alignment      |
>                  I       Alignment Char |
>                  R  Char Alignment Char |
>                  Dx Char Alignment      |
>                  Ix      Alignment Char
>                                            deriving (Eq, Show)
The yield grammar: showcode
> gotoh_alignments alg inpX inpY   = axiom alignment where

>   (nil, d, i, r, dx, ix, h) = alg
> 
>   alignment = tabulated (
>                nil ><< empty                          |||
>                r   <<< xbase  -~~ alignment ~~- ybase |||
>                d   <<< xbase  -~~ xDel                |||
>                i   <<<            xIns      ~~- ybase ... h)
> 
>   xDel      = tabulated (
>                alignment              |||
>                dx <<< xbase  -~~ xDel ... h )
> 
>   xIns      = tabulated (
>                alignment              |||
>                ix <<< xIns ~~- ybase  ... h )
Bind input: showcode
>   infixl 7  -~~, ~~-
>   (_, _, xbase, ybase, empty, _, _, (-~~), (~~-), tabulated) 
>     = bindParserCombinators inpX inpY
Enumeration algebra: showcode
> enum :: Gotoh_Algebra Char Alignment
> enum = (nil, d, i, r, dx, ix, h) where
>    nil = Nil
>    d   = D
>    i   = I
>    r   = R
>    dx  = Dx
>    ix  = Ix
>    h   = id
Pretty printing algebra: showcode
> prettyprint :: Gotoh_Algebra Char (String, String)
> prettyprint = (nil, d, i, r, dx, ix, h) where
>   nil          = ("","")
>   d  x (l,r)   = (x:l, open:r)
>   i    (l,r) y = (open:l, y:r)
>   r  x (l,r) y = (x:l,y:r)
>   dx x (l,r) 	 = (x:l, extend:r)
>   ix   (l,r) y = (extend:l, y:r)
>   h            = id
>   open         = '='
>   extend	 = '-'
Counting Algebra: showcode
> count :: Gotoh_Algebra Char Int
> count = (nil, d, i, r, dx, ix, h) where
>    nil     = 1
>    d x s   = s
>    i s y   = s
>    r a s b = s
>    dx x s  = s
>    ix s y  = s
>    h []    = []
>    h l     = [sum l]
Affine gap score algebra: showcode
> affine :: Gotoh_Algebra Char Int
> affine = (nil, d, i, r, dx, ix, h) where
>    nil     = 0
>    d x s   = s + open + extend
>    i s y   = s + open + extend
>    r a s b = s + w a b
>    dx x s  = s + extend
>    ix s y  = s + extend
>    h []    = []
>    h l     = [maximum l]

>  -- simple definitions for open, extend and w:
>    open   = (-15)
>    extend = (-1)
>    w a b  = if a==b then 4 else -3
Algebra type: showcode
> type Gotoh_Algebra alphabet answer = (
>   answer,                                   -- nil
>   alphabet -> answer ->             answer, -- d
>               answer -> alphabet -> answer, -- i
>   alphabet -> answer -> alphabet -> answer, -- r
>   alphabet -> answer ->             answer, -- dx
>               answer -> alphabet -> answer, -- ix
>   [answer] -> [answer]                      -- h
>   )
Algebra cross product: showcode
> infix ***
> (***) :: Eq answer1 =>
>          Gotoh_Algebra alphabet answer1 ->
>          Gotoh_Algebra alphabet answer2 ->
>          Gotoh_Algebra alphabet (answer1, answer2)
> alg1 *** alg2 = (nil, d, i, r, dx, ix, h) where
>    (nil1, d1, i1, r1, dx1, ix1, h1) = alg1
>    (nil2, d2, i2, r2, dx2, ix2, h2) = alg2
> 
>    nil            = (nil1, nil2)
>    d  x (s1,s2)   = (d1 x s1, d2 x s2)
>    i    (s1,s2) y = (i1 s1 y, i2 s2 y)
>    r  x (s1,s2) y = (r1 x s1 y, r2 x s2 y)
>    dx x (s1,s2)   = (dx1 x s1, dx2 x s2)
>    ix   (s1,s2) y = (ix1 s1 y, ix2 s2 y)
> 
>    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