module Bio.PDB.Functions
  ( groupChainByResidue
  ) where

import qualified Bio.PDB.Type  as PDB (Atom (..))
import qualified Bio.Utils.Map as M ((!?!))

import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M (fromList)
import           Data.List       (groupBy, 
                                  sortOn)
import           Data.Vector     (Vector)
import qualified Data.Vector      as V (toList)
import           Data.Char       (toUpper)

groupChainByResidue :: Vector PDB.Atom -> [[PDB.Atom]]
groupChainByResidue :: Vector Atom -> [[Atom]]
groupChainByResidue = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Atom -> Int
sortOnResidue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Atom -> Atom -> Bool
atomsFromSameResidue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList
  where 
    atomsFromSameResidue :: PDB.Atom -> PDB.Atom -> Bool
    atomsFromSameResidue :: Atom -> Atom -> Bool
atomsFromSameResidue Atom
atom1 Atom
atom2 = Atom -> Int
PDB.atomResSeq Atom
atom1 forall a. Eq a => a -> a -> Bool
== Atom -> Int
PDB.atomResSeq Atom
atom2 Bool -> Bool -> Bool
&& Atom -> Char
PDB.atomICode Atom
atom1 forall a. Eq a => a -> a -> Bool
== Atom -> Char
PDB.atomICode Atom
atom2
    
    sortOnResidue :: PDB.Atom -> Int
    sortOnResidue :: Atom -> Int
sortOnResidue PDB.Atom{Char
Float
Int
Text
atomCharge :: Atom -> Text
atomElement :: Atom -> Text
atomTempFactor :: Atom -> Float
atomOccupancy :: Atom -> Float
atomZ :: Atom -> Float
atomY :: Atom -> Float
atomX :: Atom -> Float
atomChainID :: Atom -> Char
atomResName :: Atom -> Text
atomAltLoc :: Atom -> Char
atomName :: Atom -> Text
atomSerial :: Atom -> Int
atomCharge :: Text
atomElement :: Text
atomTempFactor :: Float
atomOccupancy :: Float
atomZ :: Float
atomY :: Float
atomX :: Float
atomICode :: Char
atomResSeq :: Int
atomChainID :: Char
atomResName :: Text
atomAltLoc :: Char
atomName :: Text
atomSerial :: Int
atomICode :: Atom -> Char
atomResSeq :: Atom -> Int
..} = Int
atomSerial forall a. Num a => a -> a -> a
* Int
100 forall a. Num a => a -> a -> a
+ (Map Char Int
insertionCodeSortingCorrections forall k a.
(HasCallStack, Ord k, Show k, Show a) =>
Map k a -> k -> a
M.!?! Char -> Char
toUpper Char
atomICode)
    
    insertionCodeSortingCorrections :: Map Char Int
    insertionCodeSortingCorrections :: Map Char Int
insertionCodeSortingCorrections = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (Char
' 'forall a. a -> [a] -> [a]
:[Char
'A'..Char
'Z']) [Int
0..]