module Biobase.Secondary.Constraint where
import Data.Char (toLower)
import Data.Primitive.Types
import Prelude as P
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU
import Data.PrimitiveArray
import Biobase.Secondary.Diagrams
class MkConstraint a where
mkConstraint :: a -> Constraint
newtype Constraint = Constraint {unConstraint :: VU.Vector (Char,Int)}
deriving (Show,Read,Eq)
bonusCC :: VU.Vector Char
bonusCC = VU.fromList "()<>|"
nobonusCC :: VU.Vector Char
nobonusCC = VU.fromList ".x"
bonusTable :: Double -> Double -> Constraint -> Unboxed (Z:.Int:.Int) Double
bonusTable bonus malus (Constraint constraint) = arr where
arr = fromAssocs (Z:.0:.0) (Z:.n:.n) 0 $ bonusBr ++ bonusAn ++ bonusBa ++ malusBr ++ malusAn ++ malusX
n = VU.length constraint 1
infixl 1 `xor`
xor a b = a && not b || not a && b
bonusBr = [ (Z:.i:.j,bonus)
| (i,('(',j)) <- zip [0..] $ VU.toList constraint
]
malusBr = [ (Z:.i:.j,malus)
| i <- [0..n]
, j <- [i..n]
, let bi = constraint VU.! i
, let bj = constraint VU.! j
, fst bi == '(' && snd bi /= j || fst bj == ')' && snd bj /= i
]
bonusAn = [ (Z:.i:.j,bonus)
| i<-[0..n]
, fst (constraint VU.! i) == '<'
, j<-[i+1..n]
] ++
[ (Z:.i:.j,bonus)
| j<-[0..n]
, fst (constraint VU.! j) == '>'
, i<-[0..j1]
]
malusAn = [ (Z:.i:.j,malus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! j) == '<'
] ++
[ (Z:.i:.j,malus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! i) == '>'
]
bonusBa = [ (Z:.i:.j,bonus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! i) == '|' || fst (constraint VU.! j) == '|'
]
malusX = [ (Z:.i:.j,malus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! i) == 'x' || fst (constraint VU.! j) == 'x'
]
instance MkConstraint String where
mkConstraint xs = mkConstraint . VU.fromList . P.map toLower $ xs
instance MkConstraint (VU.Vector Char) where
mkConstraint cs = Constraint $ VU.zip cs ks where
(D1S ks) = mkD1S cs