-- | This module provides facilities to modify values in the tables and return
-- the modified tables. The main reason for the modules' existence are the 'E'
-- nucleotides and 'NS' base pairs used by the ViennaRNA package to denote
-- unknown or missing nucleotides. For each table type, we have a small
-- function.

module Biobase.Vienna.Modification.NonStandard
  ( nonStandardMax
  ) where

import Biobase.RNA
import Biobase.Vienna
import Biobase.Turner.Tables
import Data.Ix.Tuple
import Biobase.Constants
import Biobase.Types.Energy

import Data.PrimitiveArray


-- | Each table-changing operation makes the promise that all individual
-- changes in a batch are independent of the changes in the same batch

changeTable f tbl = fromAssocs l u z . map (f tbl) $ assocs tbl where
  (l,u) = bounds tbl
  z = Energy eInf



-- |* Replace each occurrance of a value with a strange key according to this
-- rule. The rule is to take the maximum over all sane keys in the
-- neighborhood. Yes, this takes long...

fPPBBBBmax tbl (k@(p1,p2,b1,b2,b3,b4),v)
  | p1==vpNP || p2==vpNP = (k,v) -- don't do anything
  | otherwise = (k,maximum'
    [ tbl ! (p1n,p2n,b1n,b2n,b3n,b4n)
    | p1n <- genKeyP p1
    , p2n <- genKeyP p2
    , b1n <- genKeyB b1
    , b2n <- genKeyB b2
    , b3n <- genKeyB b3
    , b4n <- genKeyB b4
    ])

fPPBBBmax tbl (k@(p1,p2,b1,b2,b3),v)
  | p1==vpNP || p2==vpNP = (k,v)
  | otherwise = (k,maximum'
    [ tbl ! (p1n,p2n,b1n,b2n,b3n)
    | p1n <- genKeyP p1
    , p2n <- genKeyP p2
    , b1n <- genKeyB b1
    , b2n <- genKeyB b2
    , b3n <- genKeyB b3
    ])

fPPBBmax tbl (k@(p1,p2,b1,b2),v)
  | p1==vpNP || p2==vpNP = (k,v)
  | otherwise = (k,maximum'
    [ tbl ! (p1n,p2n,b1n,b2n)
    | p1n <- genKeyP p1
    , p2n <- genKeyP p2
    , b1n <- genKeyB b1
    , b2n <- genKeyB b2
    ])

fPPmax tbl (k@(p1,p2),v)
  | p1==vpNP || p2==vpNP = (k,v)
  | otherwise = (k,maximum'
    [ tbl ! (p1n,p2n)
    | p1n <- genKeyP p1
    , p2n <- genKeyP p2
    ])

fPBBmax tbl (k@(p1,b1,b2),v)
  | p1==vpNP = (k,v)
  | otherwise = (k,maximum'
    [ tbl ! (p1n,b1n,b2n)
    | p1n <- genKeyP p1
    , b1n <- genKeyB b1
    , b2n <- genKeyB b2
    ])

fPBmax tbl (k@(p1,b1),v)
  | p1==vpNP = (k,v)
  | otherwise = (k,maximum'
    [ tbl ! (p1n,b1n)
    | p1n <- genKeyP p1
    , b1n <- genKeyB b1
    ])

maximum' = Energy . maximum . map unEnergy


-- * Generate keys. If the key is of the non-standard kind, then we go fishing,
-- otherwise we keep the key itself.

genKeyP k = if k==vpNS then cguaP else [k]
genKeyB k = if k==nucE then acgu else [k]



-- | The max operation applied to all relevant tables. (This serves as a
-- pointer, which tables to manipulate).

nonStandardMax :: ViennaEnergyTables -> ViennaEnergyTables
nonStandardMax tbl = tbl
  { iloop1x1   = changeTable fPPBBmax   $ iloop1x1 tbl
  , iloop1x2   = changeTable fPPBBBmax  $ iloop1x2 tbl
  , iloop2x2   = changeTable fPPBBBBmax $ iloop2x2 tbl
  , hairpinMM  = changeTable fPBBmax    $ hairpinMM tbl
  , iloopMM    = changeTable fPBBmax    $ iloopMM tbl
  , iloop1xnMM = changeTable fPBBmax    $ iloop1xnMM tbl
  , iloop2x3MM = changeTable fPBBmax    $ iloop2x3MM tbl
  , multiMM    = changeTable fPBBmax    $ multiMM tbl
  , extMM      = changeTable fPBBmax    $ extMM tbl
  , dangle3    = changeTable fPBmax     $ dangle3 tbl
  , dangle5    = changeTable fPBmax     $ dangle5 tbl
  , stack      = changeTable fPPmax     $ stack tbl
  }