{-# LANGUAGE TypeSynonymInstances #-}

module Bio.Protein.Chain.Builder
    ( Buildable (..)
    , build
    ) where

import           Control.Lens
import           Data.Ix               (Ix)
import           Data.Kind             (Type)
import           Linear.V3             (V3 (..), _z)
import           Linear.Vector         (negated, unit, (*^))

import           Bio.Protein.AminoAcid
import           Bio.Protein.Chain
import           Bio.Utils.Geometry    hiding (angle)

class Buildable a where
    type Monomer a :: Type
    initB :: Monomer a -> a
    nextB :: Monomer a -> a -> a

build :: forall a m.(Buildable a, ChainLike m, Ix (Index m), IxValue m ~ Monomer a) => m -> ProteinChain (Index m) a
build :: m -> ProteinChain (Index m) a
build m
ch = Chain (Index m) a -> ProteinChain (Index m) a
forall i a. Chain i a -> ProteinChain i a
ProteinChain Chain (Index m) a
result
  where
    result :: Chain (Index m) a
    result :: Chain (Index m) a
result = (Index m, Index m) -> [(Index m, a)] -> Chain (Index m) a
forall i a. Ix i => (i, i) -> [(i, a)] -> Chain i a
chain (m -> (Index m, Index m)
forall m. ChainLike m => m -> (Index m, Index m)
bounds m
ch) [ (Index m
i, Index m -> Monomer a -> a
next Index m
i Monomer a
x) | (Index m
i, Monomer a
x) <- m -> [(Index m, IxValue m)]
forall m. ChainLike m => m -> [(Index m, IxValue m)]
assocs m
ch ]
    next :: Index m -> Monomer a -> a
    next :: Index m -> Monomer a -> a
next Index m
k Monomer a
x | Index m
k Index m -> Index m -> Bool
forall a. Eq a => a -> a -> Bool
== (Index m, Index m) -> Index m
forall a b. (a, b) -> a
fst (m -> (Index m, Index m)
forall m. ChainLike m => m -> (Index m, Index m)
bounds m
ch) = Monomer a -> a
forall a. Buildable a => Monomer a -> a
initB Monomer a
x
             | Bool
otherwise            = Monomer a -> a -> a
forall a. Buildable a => Monomer a -> a -> a
nextB Monomer a
x (Chain (Index m) a
result Chain (Index m) a -> Index m -> a
forall i e. Ix i => Array i e -> i -> e
! Index m -> Index m
forall a. Enum a => a -> a
pred Index m
k)

instance Buildable (BB V3R) where
    type Monomer (BB V3R) = AA

    -- | Place first amino acid backbone in some chain
    -- The placement will be like this:
    --        y /|\
    --           |
    --           |
    --      N    | Ca
    -- ----*-----*------------->
    --           |     C        x
    --           |    *
    --           |
    --
    initB :: Monomer (BB V3R) -> BB V3R
initB Monomer (BB V3R)
_ = let n_ :: V3R
n_ = R -> R -> R -> V3R
forall a. a -> a -> a -> V3 a
V3 R
n_x R
0.0 R
0.0
                  a_ :: V3R
a_ = R -> R -> R -> V3R
forall a. a -> a -> a -> V3 a
V3 R
0.0 R
0.0 R
0.0
                  c_ :: V3R
c_ = R -> R -> R -> V3R
forall a. a -> a -> a -> V3 a
V3 R
c_x R
c_y R
0.0
                  --
                  n_x :: R
n_x = - BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
N BackboneAtom
CA
                  c_x :: R
c_x = BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
CA BackboneAtom
C R -> R -> R
forall a. Num a => a -> a -> a
* R -> R
forall a. Floating a => a -> a
cos (R
forall a. Floating a => a
pi R -> R -> R
forall a. Num a => a -> a -> a
+ BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
N BackboneAtom
CA BackboneAtom
C)
                  c_y :: R
c_y = BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
CA BackboneAtom
C R -> R -> R
forall a. Num a => a -> a -> a
* R -> R
forall a. Floating a => a -> a
sin (R
forall a. Floating a => a
pi R -> R -> R
forall a. Num a => a -> a -> a
+ BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
N BackboneAtom
CA BackboneAtom
C)
              in  V3R -> V3R -> V3R -> BB V3R
forall a. Createable a => Create a
create @(BB V3R) V3R
n_ V3R
a_ V3R
c_

    -- | Place next amino acid backbone in some chain
    -- The placement can be done by two cases.
    -- First:
    --               Ca_i      N_i+1     C_i+1
    --              *         *         *
    --
    --         *         *         *
    --          N_i       C_i       Ca_i+1
    -- Second:
    --          N_i       C_i       Ca_i+1
    --         *         *         *
    --
    --              *         *         *
    --               Ca_i      N_i+1     C_i+1
    --
    -- Let us enumerate atoms: 1 for N_i, 2 for Ca_i, 3 for C_i, 4 for N_i+1, 5 for Ca_i+1, 6 for C_i+1.
    -- We have to find points 4, 5, 6 using 1, 2, 3. To find this points let us introduce vectors named
    -- like 'vij' from i to j, e.g. v12 is a vector from N_i to Ca_i. Our main idea will be to get a
    -- direction vector from i+1 to i, rotate it and then upscale by specified bond length. One thing to
    -- look at is the direction of rotations. If we have the first case, then the first rotation should be
    -- conterclock-wise, otherwise — clock-wise. To detect it we have to understand whether 3 is on the left
    -- of 12 vector (first case) or on the right. We can understand it using v21 and v23:
    -- if (v21 `cross` v23) ^. _z < 0 then First else Second. First means that every angle should be negated.
    -- So, we can determine coordinate of 4. First we get the v32 and normalize it, then we will rotate it to
    -- CA-C-N angle (multiplied by -1 or not), next multiply this direction vector by typical C-N bond length
    -- and at last add the obtained vector to 3. The same idea is used to find point 5, but now we should
    -- make out rotation in the opposite direction. At last we will do the same with point 6.
    --
    nextB :: Monomer (BB V3R) -> BB V3R -> BB V3R
nextB Monomer (BB V3R)
_ BB V3R
aa = let -- we will always rotate around Z
                     rot :: R -> V3R -> V3R
rot = V3R -> R -> V3R -> V3R
forall a. AffineTransformable a => V3R -> R -> a -> a
rotate (ASetter' V3R R -> V3R
forall (t :: * -> *) a.
(Additive t, Num a) =>
ASetter' (t a) a -> t a
unit ASetter' V3R R
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z)
                     -- determine the direction
                     v21 :: V3R
v21 = BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasN r, Functor f, Functor g) =>
Lens' (AminoAcid r f g a) a
n ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom V3R -> V3R -> V3R
forall a. Num a => a -> a -> a
- BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasCA r, Functor f, Functor g) =>
Lens' (AminoAcid f r g a) a
ca ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom
                     v23 :: V3R
v23 = BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasC r, Functor f, Functor g) =>
Lens' (AminoAcid f g r a) a
c ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom V3R -> V3R -> V3R
forall a. Num a => a -> a -> a
- BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasCA r, Functor f, Functor g) =>
Lens' (AminoAcid f r g a) a
ca ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom
                     cw :: R
cw  = if (V3R
v21 V3R -> V3R -> V3R
forall a. Num a => V3 a -> V3 a -> V3 a
`cross` V3R
v23) V3R -> Getting R V3R R -> R
forall s a. s -> Getting a s a -> a
^. Getting R V3R R
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z R -> R -> Bool
forall a. Ord a => a -> a -> Bool
< R
0 then R
1.0 else -R
1.0 :: R
                     -- determine the coordinate of n (point 4)
                     v32 :: V3R
v32 = V3R -> V3R
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V3R
v23
                     v34 :: V3R
v34 = BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
C BackboneAtom
N R -> V3R -> V3R
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ R -> V3R -> V3R
rot (R
cw R -> R -> R
forall a. Num a => a -> a -> a
* BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
CA BackboneAtom
C BackboneAtom
N) (V3R -> V3R
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize V3R
v32)
                     n_ :: V3R
n_  = BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasC r, Functor f, Functor g) =>
Lens' (AminoAcid f g r a) a
c ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom V3R -> V3R -> V3R
forall a. Num a => a -> a -> a
+ V3R
v34
                     -- determine the coordinate of ca (point 5)
                     v43 :: V3R
v43 = V3R -> V3R
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V3R
v34
                     v45 :: V3R
v45 = BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
N BackboneAtom
CA R -> V3R -> V3R
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ R -> V3R -> V3R
rot (-R
cw R -> R -> R
forall a. Num a => a -> a -> a
* BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
C BackboneAtom
N BackboneAtom
CA) (V3R -> V3R
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize V3R
v43)
                     ca_ :: V3R
ca_ = V3R
n_ V3R -> V3R -> V3R
forall a. Num a => a -> a -> a
+ V3R
v45
                     -- determine the coordinate of ca (point 6)
                     v54 :: V3R
v54 = V3R -> V3R
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V3R
v45
                     v56 :: V3R
v56 = BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
CA BackboneAtom
C R -> V3R -> V3R
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ R -> V3R -> V3R
rot (R
cw R -> R -> R
forall a. Num a => a -> a -> a
* BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
N BackboneAtom
CA BackboneAtom
C) (V3R -> V3R
forall a (f :: * -> *).
(Floating a, Metric f, Epsilon a) =>
f a -> f a
normalize V3R
v54)
                     c_ :: V3R
c_  = V3R
ca_ V3R -> V3R -> V3R
forall a. Num a => a -> a -> a
+ V3R
v56
                 in  V3R -> V3R -> V3R -> BB V3R
forall a. Createable a => Create a
create @(BB V3R) V3R
n_ V3R
ca_ V3R
c_

instance Buildable (BBT V3R) where
    type Monomer (BBT V3R) = AA

    initB :: Monomer (BBT V3R) -> BBT V3R
initB Monomer (BBT V3R)
t = let aa :: BB V3R
aa = Monomer (BB V3R) -> BB V3R
forall a. Buildable a => Monomer a -> a
initB Monomer (BB V3R)
Monomer (BBT V3R)
t :: BB V3R
              in  V3R -> V3R -> V3R -> AA -> BBT V3R
forall a. Createable a => Create a
create @(BBT V3R) (BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasN r, Functor f, Functor g) =>
Lens' (AminoAcid r f g a) a
n ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) (BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasCA r, Functor f, Functor g) =>
Lens' (AminoAcid f r g a) a
ca ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) (BB V3R
aa BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasC r, Functor f, Functor g) =>
Lens' (AminoAcid f g r a) a
c ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) AA
Monomer (BBT V3R)
t

    nextB :: Monomer (BBT V3R) -> BBT V3R -> BBT V3R
nextB Monomer (BBT V3R)
t BBT V3R
aaT = let aa :: BB V3R
aa = V3R -> V3R -> V3R -> BB V3R
forall a. Createable a => Create a
create @(BB V3R) (BBT V3R
aaT BBT V3R -> Getting V3R (BBT V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BBT V3R -> Const V3R (BBT V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasN r, Functor f, Functor g) =>
Lens' (AminoAcid r f g a) a
n ((Identity V3R -> Const V3R (Identity V3R))
 -> BBT V3R -> Const V3R (BBT V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BBT V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) (BBT V3R
aaT BBT V3R -> Getting V3R (BBT V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BBT V3R -> Const V3R (BBT V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasCA r, Functor f, Functor g) =>
Lens' (AminoAcid f r g a) a
ca ((Identity V3R -> Const V3R (Identity V3R))
 -> BBT V3R -> Const V3R (BBT V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BBT V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) (BBT V3R
aaT BBT V3R -> Getting V3R (BBT V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BBT V3R -> Const V3R (BBT V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasC r, Functor f, Functor g) =>
Lens' (AminoAcid f g r a) a
c ((Identity V3R -> Const V3R (Identity V3R))
 -> BBT V3R -> Const V3R (BBT V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BBT V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom)
                      ab :: BB V3R
ab = Monomer (BB V3R) -> BB V3R -> BB V3R
forall a. Buildable a => Monomer a -> a -> a
nextB Monomer (BB V3R)
Monomer (BBT V3R)
t BB V3R
aa :: BB V3R
                  in  V3R -> V3R -> V3R -> AA -> BBT V3R
forall a. Createable a => Create a
create @(BBT V3R) (BB V3R
ab BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasN r, Functor f, Functor g) =>
Lens' (AminoAcid r f g a) a
n ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) (BB V3R
ab BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasCA r, Functor f, Functor g) =>
Lens' (AminoAcid f r g a) a
ca ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) (BB V3R
ab BB V3R -> Getting V3R (BB V3R) V3R -> V3R
forall s a. s -> Getting a s a -> a
^. (Identity V3R -> Const V3R (Identity V3R))
-> BB V3R -> Const V3R (BB V3R)
forall (r :: * -> *) (f :: * -> *) (g :: * -> *) a.
(HasC r, Functor f, Functor g) =>
Lens' (AminoAcid f g r a) a
c ((Identity V3R -> Const V3R (Identity V3R))
 -> BB V3R -> Const V3R (BB V3R))
-> ((V3R -> Const V3R V3R)
    -> Identity V3R -> Const V3R (Identity V3R))
-> Getting V3R (BB V3R) V3R
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V3R -> Const V3R V3R) -> Identity V3R -> Const V3R (Identity V3R)
forall (f :: * -> *) a. HasAtom f => Lens' (f a) a
atom) AA
Monomer (BBT V3R)
t

-- Helper types and functions

-- | Atoms of amino acid backbone
--
data BackboneAtom = N | CA | C
  deriving (Int -> BackboneAtom -> ShowS
[BackboneAtom] -> ShowS
BackboneAtom -> String
(Int -> BackboneAtom -> ShowS)
-> (BackboneAtom -> String)
-> ([BackboneAtom] -> ShowS)
-> Show BackboneAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackboneAtom] -> ShowS
$cshowList :: [BackboneAtom] -> ShowS
show :: BackboneAtom -> String
$cshow :: BackboneAtom -> String
showsPrec :: Int -> BackboneAtom -> ShowS
$cshowsPrec :: Int -> BackboneAtom -> ShowS
Show, BackboneAtom -> BackboneAtom -> Bool
(BackboneAtom -> BackboneAtom -> Bool)
-> (BackboneAtom -> BackboneAtom -> Bool) -> Eq BackboneAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackboneAtom -> BackboneAtom -> Bool
$c/= :: BackboneAtom -> BackboneAtom -> Bool
== :: BackboneAtom -> BackboneAtom -> Bool
$c== :: BackboneAtom -> BackboneAtom -> Bool
Eq, Eq BackboneAtom
Eq BackboneAtom
-> (BackboneAtom -> BackboneAtom -> Ordering)
-> (BackboneAtom -> BackboneAtom -> Bool)
-> (BackboneAtom -> BackboneAtom -> Bool)
-> (BackboneAtom -> BackboneAtom -> Bool)
-> (BackboneAtom -> BackboneAtom -> Bool)
-> (BackboneAtom -> BackboneAtom -> BackboneAtom)
-> (BackboneAtom -> BackboneAtom -> BackboneAtom)
-> Ord BackboneAtom
BackboneAtom -> BackboneAtom -> Bool
BackboneAtom -> BackboneAtom -> Ordering
BackboneAtom -> BackboneAtom -> BackboneAtom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BackboneAtom -> BackboneAtom -> BackboneAtom
$cmin :: BackboneAtom -> BackboneAtom -> BackboneAtom
max :: BackboneAtom -> BackboneAtom -> BackboneAtom
$cmax :: BackboneAtom -> BackboneAtom -> BackboneAtom
>= :: BackboneAtom -> BackboneAtom -> Bool
$c>= :: BackboneAtom -> BackboneAtom -> Bool
> :: BackboneAtom -> BackboneAtom -> Bool
$c> :: BackboneAtom -> BackboneAtom -> Bool
<= :: BackboneAtom -> BackboneAtom -> Bool
$c<= :: BackboneAtom -> BackboneAtom -> Bool
< :: BackboneAtom -> BackboneAtom -> Bool
$c< :: BackboneAtom -> BackboneAtom -> Bool
compare :: BackboneAtom -> BackboneAtom -> Ordering
$ccompare :: BackboneAtom -> BackboneAtom -> Ordering
$cp1Ord :: Eq BackboneAtom
Ord, BackboneAtom
BackboneAtom -> BackboneAtom -> Bounded BackboneAtom
forall a. a -> a -> Bounded a
maxBound :: BackboneAtom
$cmaxBound :: BackboneAtom
minBound :: BackboneAtom
$cminBound :: BackboneAtom
Bounded, Int -> BackboneAtom
BackboneAtom -> Int
BackboneAtom -> [BackboneAtom]
BackboneAtom -> BackboneAtom
BackboneAtom -> BackboneAtom -> [BackboneAtom]
BackboneAtom -> BackboneAtom -> BackboneAtom -> [BackboneAtom]
(BackboneAtom -> BackboneAtom)
-> (BackboneAtom -> BackboneAtom)
-> (Int -> BackboneAtom)
-> (BackboneAtom -> Int)
-> (BackboneAtom -> [BackboneAtom])
-> (BackboneAtom -> BackboneAtom -> [BackboneAtom])
-> (BackboneAtom -> BackboneAtom -> [BackboneAtom])
-> (BackboneAtom -> BackboneAtom -> BackboneAtom -> [BackboneAtom])
-> Enum BackboneAtom
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BackboneAtom -> BackboneAtom -> BackboneAtom -> [BackboneAtom]
$cenumFromThenTo :: BackboneAtom -> BackboneAtom -> BackboneAtom -> [BackboneAtom]
enumFromTo :: BackboneAtom -> BackboneAtom -> [BackboneAtom]
$cenumFromTo :: BackboneAtom -> BackboneAtom -> [BackboneAtom]
enumFromThen :: BackboneAtom -> BackboneAtom -> [BackboneAtom]
$cenumFromThen :: BackboneAtom -> BackboneAtom -> [BackboneAtom]
enumFrom :: BackboneAtom -> [BackboneAtom]
$cenumFrom :: BackboneAtom -> [BackboneAtom]
fromEnum :: BackboneAtom -> Int
$cfromEnum :: BackboneAtom -> Int
toEnum :: Int -> BackboneAtom
$ctoEnum :: Int -> BackboneAtom
pred :: BackboneAtom -> BackboneAtom
$cpred :: BackboneAtom -> BackboneAtom
succ :: BackboneAtom -> BackboneAtom
$csucc :: BackboneAtom -> BackboneAtom
Enum)

-- | Atoms of amino acid radicals (TODO: fill this)
--
-- data RadicalAtom

-- | Distance between two basic backbone atom types
dist :: BackboneAtom -> BackboneAtom -> R
dist :: BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
N  BackboneAtom
CA = R
1.460
dist BackboneAtom
CA BackboneAtom
C  = R
1.509
dist BackboneAtom
C  BackboneAtom
N  = R
1.290
dist BackboneAtom
x  BackboneAtom
y  = BackboneAtom -> BackboneAtom -> R
dist BackboneAtom
y BackboneAtom
x

-- | Angles between every triple of succesive atoms
angle :: BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle :: BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
N  BackboneAtom
CA BackboneAtom
C  = R
forall a. Floating a => a
pi R -> R -> R
forall a. Num a => a -> a -> a
* R
110.990 R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
180.0
angle BackboneAtom
CA BackboneAtom
C  BackboneAtom
N  = R
forall a. Floating a => a
pi R -> R -> R
forall a. Num a => a -> a -> a
* R
118.995 R -> R -> R
forall a. Fractional a => a -> a -> a
/ R
180.0
angle BackboneAtom
C  BackboneAtom
N  BackboneAtom
CA = BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
CA BackboneAtom
C BackboneAtom
N
angle BackboneAtom
x  BackboneAtom
y  BackboneAtom
z  = BackboneAtom -> BackboneAtom -> BackboneAtom -> R
angle BackboneAtom
z BackboneAtom
y BackboneAtom
x