-
Notifications
You must be signed in to change notification settings - Fork 6
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Version 0.1.2.9.
filterAtomsOfModel
function added (#28)
- Loading branch information
1 parent
94c652e
commit 4b53aff
Showing
8 changed files
with
163 additions
and
16 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,5 +1,5 @@ | ||
name: cobot-io | ||
version: 0.1.2.8 | ||
version: 0.1.2.9 | ||
github: "less-wrong/cobot-io" | ||
license: BSD3 | ||
category: Bio | ||
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,59 @@ | ||
module Bio.Structure.Functions | ||
( filterAtomsOfModel | ||
) where | ||
|
||
import Bio.Structure (Atom (..), Bond (..), Chain (..), | ||
GlobalID (..), LocalID (..), Model (..), | ||
Residue (..)) | ||
import qualified Data.Map.Strict as M (fromList, (!)) | ||
import Data.Set (Set) | ||
import qualified Data.Set as S (fromList, notMember, unions) | ||
import Data.Vector (Vector) | ||
import qualified Data.Vector as V (filter, fromList, length, toList, unzip) | ||
|
||
-- | Takes predicate on 'Atom's of 'Model' and returns new 'Model' containing only atoms | ||
-- satisfying given predicate. | ||
-- | ||
filterAtomsOfModel :: (Atom -> Bool) -> Model -> Model | ||
filterAtomsOfModel p Model{..} = Model newChains newBonds | ||
where | ||
removePred = not . p | ||
(newChains, indss) = V.unzip $ fmap (removeAtomsFromChain removePred) modelChains | ||
|
||
inds = S.unions $ V.toList indss | ||
newBonds = V.filter (\(Bond l r _) -> l `S.notMember` inds && r `S.notMember` inds) modelBonds | ||
|
||
removeAtomsFromChain :: (Atom -> Bool) -> Chain -> (Chain, Set GlobalID) | ||
removeAtomsFromChain p Chain{..} = (Chain chainName newResidues, S.unions $ V.toList indss) | ||
where | ||
(newResidues, indss) = V.unzip $ fmap (removeAtomsFromResidue p) chainResidues | ||
|
||
removeAtomsFromResidue :: (Atom -> Bool) -> Residue -> (Residue, Set GlobalID) | ||
removeAtomsFromResidue p r'@Residue{..} = (res, S.fromList $ V.toList $ fmap atomId withAtom) | ||
where | ||
(withAtom, withoutAtom, indsToDelete) = partitionAndInds resAtoms | ||
|
||
oldIndsToNew = M.fromList $ fmap (\i -> (i, newInd i)) [0 .. V.length resAtoms - 1] | ||
newBonds = fmap modifyBond $ V.filter leaveBond resBonds | ||
|
||
res = r' { resAtoms=withoutAtom, resBonds=newBonds } | ||
|
||
leaveBond :: Bond LocalID -> Bool | ||
leaveBond (Bond (LocalID l) (LocalID r) _) = l `notElem` indsToDelete && r `notElem` indsToDelete | ||
|
||
modifyBond :: Bond LocalID -> Bond LocalID | ||
modifyBond (Bond (LocalID l) (LocalID r) t) = Bond (LocalID $ oldIndsToNew M.! l) | ||
(LocalID $ oldIndsToNew M.! r) | ||
t | ||
|
||
newInd :: Int -> Int | ||
newInd i = i - (length $ filter (< i) indsToDelete) | ||
|
||
partitionAndInds :: Vector Atom -> (Vector Atom, Vector Atom, [Int]) | ||
partitionAndInds = go 0 ([], [], []) . V.toList | ||
where | ||
go :: Int -> ([Atom], [Atom], [Int]) -> [Atom] -> (Vector Atom, Vector Atom, [Int]) | ||
go _ (sat, notSat, inds) [] = (V.fromList $ reverse sat, V.fromList $ reverse notSat, reverse inds) | ||
go i (sat, notSat, inds) (x : xs) = go (i + 1) newState xs | ||
where | ||
newState = if p x then (x : sat, notSat, i : inds) else (sat, x : notSat, inds) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,79 @@ | ||
{-# LANGUAGE FlexibleInstances #-} | ||
{-# LANGUAGE OverloadedStrings #-} | ||
{-# LANGUAGE RecordWildCards #-} | ||
{-# OPTIONS_GHC -fno-warn-orphans #-} | ||
|
||
module StructureSpec where | ||
|
||
import Bio.MAE (fromFile) | ||
import Bio.Structure (Atom (..), Bond (..), Chain (..), | ||
LocalID (..), Model (..), | ||
Residue (..), StructureModels (..)) | ||
import Bio.Structure.Functions (filterAtomsOfModel) | ||
import Control.Monad (join) | ||
import Data.Map.Strict (Map) | ||
import qualified Data.Map.Strict as M (fromList, (!)) | ||
import Data.Maybe (fromJust, isJust) | ||
import Data.Set (Set) | ||
import qualified Data.Set as S (fromList, member) | ||
import Data.Vector (Vector) | ||
import qualified Data.Vector as V (all, filter, find, fromList, | ||
toList, zip) | ||
import Test.Hspec | ||
|
||
structureSpec :: Spec | ||
structureSpec = describe "Structure spec." $ do | ||
m <- runIO $ V.toList . modelsOf <$> fromFile "test/MAE/Capri.mae" >>= \[x] -> pure x | ||
|
||
it "atoms filtering works correctly. only N, CA, C" $ checkFiltering m $ (`elem` ["N", "CA", "C"]) . atomName | ||
it "atoms filtering works correctly. only CA" $ checkFiltering m $ (== "CA") . atomName | ||
it "atoms filtering works correctly. no atoms" $ checkFiltering m $ const False | ||
it "atoms filtering works correctly. all atoms" $ checkFiltering m $ const True | ||
where | ||
checkFiltering :: Model -> (Atom -> Bool) -> Expectation | ||
checkFiltering m p = do | ||
checkAtoms | ||
checkGlobalBonds | ||
checkLocalBonds | ||
where | ||
m' = filterAtomsOfModel p m | ||
|
||
checkAtoms :: Expectation | ||
checkAtoms = V.all (V.all (V.all p . resAtoms) . chainResidues) (modelChains m') `shouldBe` True | ||
|
||
checkGlobalBonds :: Expectation | ||
checkGlobalBonds = all (\(Bond l r _) -> l `S.member` inds && r `S.member` inds) (modelBonds m') `shouldBe` True | ||
where | ||
filteredAtoms = join $ fmap (join . fmap (V.filter p . resAtoms) . chainResidues) $ modelChains m | ||
inds = vecToSet $ fmap atomId filteredAtoms | ||
|
||
checkLocalBonds :: Expectation | ||
checkLocalBonds = all checkResiduePair pairsOfResidues `shouldBe` True | ||
where | ||
pairsOfResidues = zip (V.toList (join $ chainResidues <$> modelChains m)) | ||
(V.toList (join $ chainResidues <$> modelChains m')) | ||
|
||
checkResiduePair :: (Residue, Residue) -> Bool | ||
checkResiduePair (r, r') = vecToSet mappedBonds == vecToSet (resBonds r') | ||
where | ||
atInds = atomsWithIndices r | ||
atInds' = atomsWithIndices r' | ||
|
||
mappedBonds = fromJust <$> V.filter isJust (mapBond <$> resBonds r) | ||
|
||
mapBond :: Bond LocalID -> Maybe (Bond LocalID) | ||
mapBond (Bond l k t) = Bond <$> localMapping M.! l | ||
<*> localMapping M.! k | ||
<*> pure t | ||
|
||
localMapping :: Map LocalID (Maybe LocalID) | ||
localMapping = M.fromList $ V.toList forMap | ||
where | ||
forMap = fmap (\(a, i) -> (i, snd <$> V.find ((== atomId a) . atomId . fst) atInds')) atInds | ||
|
||
atomsWithIndices :: Residue -> Vector (Atom, LocalID) | ||
atomsWithIndices Residue{..} = V.zip resAtoms $ fmap LocalID $ V.fromList [0 ..] | ||
|
||
vecToSet :: Ord a => Vector a -> Set a | ||
vecToSet = S.fromList . V.toList | ||
|