module Biobase.Secondary.Constraint where
import Data.Char (toLower)
import Data.Primitive.Types
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 Data.PrimitiveArray.Ix
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.fromList "()<>|"
nobonusCC = VU.fromList ".x"
bonusTable :: Double -> Double -> Constraint -> PrimArray (Int,Int) Double
bonusTable bonus malus (Constraint constraint) = arr where
arr = fromAssocs (0,0) (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 = [ ((i,j),bonus)
| (i,('(',j)) <- zip [0..] $ VU.toList constraint
]
malusBr = [ ((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 = [ ((i,j),bonus)
| i<-[0..n]
, fst (constraint VU.! i) == '<'
, j<-[i+1..n]
] ++
[ ((i,j),bonus)
| j<-[0..n]
, fst (constraint VU.! j) == '>'
, i<-[0..j1]
]
malusAn = [ ((i,j),malus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! j) == '<'
] ++
[ ((i,j),malus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! i) == '>'
]
bonusBa = [ ((i,j),bonus)
| i<-[0..n]
, j<-[i+1..n]
, fst (constraint VU.! i) == '|' || fst (constraint VU.! j) == '|'
]
malusX = [ ((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 . map toLower $ xs
instance MkConstraint (VU.Vector Char) where
mkConstraint cs = Constraint $ VU.zip cs ks where
(D1S ks) = mkD1S cs