BiobaseNewick (empty) → 0.0.0.1
raw patch · 11 files changed
+431/−0 lines, 11 filesdep +BiobaseNewickdep +ForestStructuresdep +QuickChecksetup-changed
Dependencies added: BiobaseNewick, ForestStructures, QuickCheck, aeson, attoparsec, base, binary, cereal, cereal-text, containers, fgl, test-framework, test-framework-quickcheck2, test-framework-th, text, text-binary, vector
Files
- Biobase/Newick.hs +12/−0
- Biobase/Newick/Export.hs +29/−0
- Biobase/Newick/Import.hs +79/−0
- Biobase/Newick/StaticForest.hs +32/−0
- Biobase/Newick/Types.hs +62/−0
- BiobaseNewick.cabal +118/−0
- LICENSE +30/−0
- README.md +24/−0
- Setup.hs +2/−0
- changelog.md +7/−0
- tests/properties.hs +36/−0
+ Biobase/Newick.hs view
@@ -0,0 +1,12 @@++module Biobase.Newick+ ( module Biobase.Newick.Types+ , module Biobase.Newick.Export+ , module Biobase.Newick.Import+ )+ where++import Biobase.Newick.Export+import Biobase.Newick.Import+import Biobase.Newick.Types+
+ Biobase/Newick/Export.hs view
@@ -0,0 +1,29 @@++module Biobase.Newick.Export where++import Data.List (intersperse)+import Data.Monoid+import Data.Text.Lazy.Builder (Builder)+import Data.Text (Text)+import Data.Tree+import qualified Data.Text.Lazy as T (toStrict)+import qualified Data.Text.Lazy.Builder as B+import qualified Data.Text.Lazy.Builder.RealFloat as B++import Biobase.Newick.Types++++-- | Render a list of Newick trees to a newick string.++newicksToText :: [NewickTree] -> Text+newicksToText = T.toStrict . B.toLazyText . toTextBuilder++-- | Via builder++toTextBuilder :: [NewickTree] -> Builder+toTextBuilder = mconcat . map ((<> ";\n") . go . getNewickTree)+ where go (Node lbl []) = label lbl+ go (Node lbl cs) = "(" <> mconcat (intersperse "," $ map go cs) <> ")" <> label lbl+ label (Info lbl len) = B.fromText lbl <> (if len == 0 then mempty else ":" <> B.realFloat len)+
+ Biobase/Newick/Import.hs view
@@ -0,0 +1,79 @@++-- |+--+-- NOTE We need to make sure to be compatible to everything here:+-- @http://evolution.genetics.washington.edu/phylip/newicktree.html@ In+-- particular, we do not do any conversion from @_@ to @(space)@ right now.++module Biobase.Newick.Import where++import Control.Applicative+import Data.Attoparsec.Text (Parser,(<?>))+import Data.Char (isAlpha)+import Data.Text (Text)+import Data.Tree+import qualified Data.Attoparsec.Text as A+import qualified Data.Text as T+import qualified Data.Text.IO as T++import Biobase.Newick.Types++++type PNT = Parser (Tree Info)++newicksFromFile :: FilePath -> IO (Either String [NewickTree])+newicksFromFile f = newicksFromText <$> T.readFile f++newicksFromText :: Text -> Either String [NewickTree]+newicksFromText = A.parseOnly manyNewick++manyNewick = some (newick <* A.skipSpace) <* A.endOfInput++newick :: Parser NewickTree+newick = NewickTree <$> tree <* ";" <?> "newick"++tree :: PNT+tree = A.skipSpace *> (branched <|> leaf) <?> "tree"++branched :: PNT+branched = flip Node <$ "(" <*> tree `A.sepBy1` "," <* ")" <*> info <?> "branched"++leaf :: PNT+leaf = (flip Node []) <$> info <?> "leaf"++info :: Parser Info+info = Info <$> name <*> plength <?> "info"++-- |+--+-- NOTE http://evolution.genetics.washington.edu/phylip/newicktree.html+--+-- A name can be any string of printable characters except blanks, colons,+-- semicolons, parentheses, and square brackets.+--+-- I am excluding commas as well.++name :: Parser Text+name = A.takeWhile accept <?> "name"+ where accept a = not $ A.isHorizontalSpace a || A.inClass ",:;()[]" a -- isAlpha a || A.inClass "_." a || A.isHorizontalSpace a++plength :: Parser Double+plength = ":" *> A.double <|> pure 0 <?> "plength"+++{-+test = mapM_ (\x -> (either error (putStr . drawTree . fmap show . head . map getNewickTree) $ A.parseOnly manyNewick x) >> putStrLn "\n\n\n")+ [ "B:0.2;"+ , "A;"+ , ";"+ , "(,);"+ , "((raccoon:19.19959,bear:6.80041):0.84600,((sea_lion:11.99700, seal:12.00300):7.52973,((monkey:100.85930,cat:47.14069):20.59201, weasel:18.87953):2.09460):3.87382,dog:25.46154);"+ , "(Bovine:0.69395,(Gibbon:0.36079,(Orang:0.33636,(Gorilla:0.17147,(Chimp:0.19268, Human:0.11927):0.08386):0.06124):0.15057):0.54939,Mouse:1.21460):0.10;"+ , "(Bovine:0.69395,(Hylobates:0.36079,(Pongo:0.33636,(G._Gorilla:0.17147, (P._paniscus:0.19268,H._sapiens:0.11927):0.08386):0.06124):0.15057):0.54939, Rodent:1.21460);"+ , "A;"+ , "((A,B),(C,D));"+ , "(Alpha,Beta,Gamma,Delta,,Epsilon,,,);"+ ]+-}+
+ Biobase/Newick/StaticForest.hs view
@@ -0,0 +1,32 @@++module Biobase.Newick.StaticForest where++import Data.Tree (drawForest,flatten)+import qualified Data.Tree as T+import qualified Data.Vector as V++import Data.Forest.Static++import Biobase.Newick.Types++import Data.Graph.Inductive.Basic -- only for @test@+import Biobase.Newick.Import++++test = do+ let ts = map (addIndices 0 . getNewickTree) $ either error id $ newicksFromText t+ let ss = either error id $ newicksFromText t+ mapM_ (putStrLn . T.drawTree . fmap show) ts+ putStrLn ""+ mapM_ (mapM_ (putStrLn . show) . postorder) ts+ putStrLn ""+ mapM_ (mapM_ (putStrLn . show) . preorder) ts+ putStrLn ""+ mapM_ (mapM_ print . T.levels) ts+ putStrLn ""+ print (forestPre $ map getNewickTree ss :: Forest Pre V.Vector Info)+ putStrLn ""+ print (forestPost $ map getNewickTree ss :: Forest Post V.Vector Info)+ where t = "((raccoon:19.19959,bear:6.80041):0.84600,((sea_lion:11.99700, seal:12.00300):7.52973,((monkey:100.85930,cat:47.14069):20.59201, weasel:18.87953):2.09460):3.87382,dog:25.46154)Root;"+
+ Biobase/Newick/Types.hs view
@@ -0,0 +1,62 @@++module Biobase.Newick.Types where++import Control.Applicative+import Control.Monad+import Data.Aeson (FromJSON,ToJSON)+import Data.Binary (Binary)+import Data.Monoid+import Data.Serialize (Serialize)+import Data.Serialize.Text+import Data.Text.Binary+import Data.Text (Text)+import Data.Tree+import GHC.Generics+import Test.QuickCheck++++-- | Node and leaf information in Newick trees.++data Info = Info+ { label :: Text+ , distance :: Double+ } deriving (Eq,Show,Generic)++instance Binary Info+instance Serialize Info+instance FromJSON Info+instance ToJSON Info++instance Arbitrary Info where+ arbitrary = Info <$> pure "" <*> (maybe 0 getPositive <$> arbitrary)+ shrink (Info lbl d)+ | d == 0 = []+ | otherwise = [Info lbl 0]++++-- | Newick tree newtype wrapper.++newtype NewickTree = NewickTree { getNewickTree :: Tree Info }+ deriving (Eq,Show,Generic)++instance Binary NewickTree+instance Serialize NewickTree+instance FromJSON NewickTree+instance ToJSON NewickTree++instance Arbitrary NewickTree where+ arbitrary = NewickTree <$> (arbNewickTree =<< (getSmall <$> arbitrary))+ shrink (NewickTree (Node lbl [])) = [NewickTree (Node l []) | l <- shrink lbl]+ shrink (NewickTree (Node lbl cs)) = [NewickTree (Node l ds) | l <- shrink lbl+ , ds <- map (map getNewickTree) . shrink $ map NewickTree cs]++arbNewickTree :: Int -> Gen (Tree Info)+arbNewickTree k | k<=0 = Node <$> arbitrary <*> pure []+arbNewickTree k = do+ n <- choose (0,5)+ ds <- replicateM n $ choose (0,k-1)+ cs <- mapM arbNewickTree ds+ Node <$> arbitrary <*> pure cs+
+ BiobaseNewick.cabal view
@@ -0,0 +1,118 @@+Name: BiobaseNewick+Version: 0.0.0.1+License: BSD3+License-file: LICENSE+Author: Christian Hoener zu Siederdissen+Maintainer: choener@bioinf.uni-leipzig.de+Copyright: Christian Hoener zu Siederdissen, 2015-2016+Homepage: https://github.com/choener/BiobaseNewick+bug-reports: https://github.com/choener/BiobaseNewick/issues+Stability: Experimental+Category: Bioinformatics+Build-type: Simple+Cabal-version: >= 1.10+tested-with: GHC == 7.10.3+Synopsis: Newick file format parser.+Description:+ This is a simple parser for Newick trees. The parser returns a+ rose tree. Each node is labelled with the node name (or an+ empty string for anonymous nodes) and a distance (0 if not+ given).+ .+ Includes conversion to an efficient static forest.++extra-source-files:+ changelog.md+ README.md++++library+ exposed-modules:+ Biobase.Newick+ Biobase.Newick.Export+ Biobase.Newick.Import+ Biobase.Newick.StaticForest+ Biobase.Newick.Types++ build-depends: base >= 4.7 && < 4.9+ , aeson >= 0.8 && < 0.11+ , attoparsec >= 0.12 && < 0.14+ , binary >= 0.7 && < 0.8+ , cereal >= 0.4 && < 0.6+ , cereal-text >= 0.1.0 && < 0.1.1+ , containers >= 0.5 && < 0.6+ , fgl >= 5.5 && < 6.0+ , ForestStructures >= 0.0.0 && < 0.0.1+ , QuickCheck >= 2.7 && < 2.9+ , text >= 1.2 && < 1.3+ , text-binary >= 0.1.0 && < 0.2.2+ , vector >= 0.10 && < 0.12+ ghc-options:+ -O2+ -funbox-strict-fields+ default-language:+ Haskell2010+ default-extensions: DeriveGeneric+ , DataKinds+ , OverloadedStrings++++-- A small helper that turns a Newick tree in a diagram.++--executable Newick-diagrams+-- build-depends: base+-- , BiobaseNewick+-- , cmdargs >= 0.10 && < 0.11+-- , diagrams >= 1.3 && < 1.4+-- , diagrams-postscript >= 1.3 && < 1.4+-- , diagrams-rasterific >= 1.3 && < 1.4+-- hs-source-dirs:+-- src+-- main-is:+-- diagram.hs+-- default-language:+-- Haskell2010+-- default-extensions: BangPatterns+-- , FlexibleContexts+-- , FlexibleInstances+-- , MultiParamTypeClasses+-- , RecordWildCards+-- , TemplateHaskell+-- , TypeFamilies+-- , TypeOperators+-- ghc-options:+-- -O2++++test-suite properties+ type:+ exitcode-stdio-1.0+ main-is:+ properties.hs+ ghc-options:+ -threaded -rtsopts -with-rtsopts=-N+ hs-source-dirs:+ tests+ default-language:+ Haskell2010+ default-extensions: ScopedTypeVariables+ , TemplateHaskell+ build-depends: base+ , aeson+ , binary+ , BiobaseNewick+ , cereal+ , QuickCheck+ , test-framework >= 0.8 && < 0.9+ , test-framework-quickcheck2 >= 0.3 && < 0.4+ , test-framework-th >= 0.2 && < 0.3++++source-repository head+ type: git+ location: git://github.com/choener/BiobaseNewick+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Christian Hoener zu Siederdissen 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Christian Hoener zu Siederdissen nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,24 @@+[](https://travis-ci.org/choener/BiobaseNewick)++# BiobaseNewick++This is a simple parser for Newick trees. The parser returns a rose tree. Each+node is labelled with the node name (or an empty string for anonymous nodes)+and a distance (0 if not given).++Newick trees can be ex- and imported into the Newick tree format. We also have+serialization to the usual serializers.++This package was written mostly to complement a course a Univ. Leipzig. There+is a more comprehensive package written by R. Newton+<http://hackage.haskell.org/package/phybin> which you might want instead.++++#### Contact++Christian Hoener zu Siederdissen +Leipzig University, Leipzig, Germany +choener@bioinf.uni-leipzig.de +http://www.bioinf.uni-leipzig.de/~choener/ +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,7 @@+0.0.0.1+-------++- initial creation+- travis-ci integration+- simple test framework+- depends on ForestStructures for conversion into efficient static forest
+ tests/properties.hs view
@@ -0,0 +1,36 @@++module Main where++import Debug.Trace+import qualified Data.Aeson as A+import qualified Data.Binary as B+import qualified Data.Serialize as S+import Test.Framework.Providers.QuickCheck2+import Test.Framework.TH++import Biobase.Newick+import qualified Biobase.Newick as N++++-- * Serialization to and from the canonical Newick format.++prop_Newick (t :: NewickTree) = Right [t] == ss+ where ss = newicksFromText tt+ tt = newicksToText [t]++-- * Serialization with default Haskell machinery++-- | Correct @Binary@ serialization++prop_Binary (t :: NewickTree) = t == B.decode (B.encode t)++-- | Correct @Cerial@ serialization++prop_Serialize (t :: NewickTree) = Right t == S.decode (S.encode t)++prop_Aeson (t :: NewickTree) = Right t == A.eitherDecode (A.encode t)++main :: IO ()+main = $(defaultMainGenerator)+