biohazard 0.6.9 → 0.6.10
raw patch · 43 files changed
+208/−7799 lines, 43 filesdep −aeson-prettydep −biohazarddep −hybrid-vectorsdep ~aesondep ~asyncdep ~basesetup-changed
Dependencies removed: aeson-pretty, biohazard, hybrid-vectors, nonlinear-optimization, process, shake, template-haskell, vector-binary-instances
Dependency ranges changed: aeson, async, base, binary, bytestring, containers, directory, filepath, random, stm, text, transformers, unix, unordered-containers, vector, vector-algorithms, vector-th-unbox
Files
- Setup.hs +1/−32
- biohazard.cabal +6/−284
- data/index_db.json +0/−635
- man/man1/bam-fixpair.1 +0/−152
- man/man1/bam-meld.1 +0/−86
- man/man1/bam-rewrap.1 +0/−56
- man/man1/bam-rmdup.1 +0/−238
- man/man1/fastq2bam.1 +0/−181
- man/man1/jivebunny.1 +0/−177
- man/man1/mt-anno.1 +0/−55
- man/man7/biohazard.7 +0/−28
- src/Bio/Bam/Rec.hs +2/−2
- src/Bio/Bam/Trim.hs +149/−78
- src/Bio/Genocall.hs +0/−221
- src/Bio/Genocall/Estimators.hs +0/−264
- src/Bio/Iteratee/ZLib.hsc +1/−0
- src/Bio/Prelude.hs +3/−7
- src/Bio/Util/AD.hs +0/−137
- src/Bio/Util/AD2.hs +0/−150
- src/Bio/Util/Jacobi.hs +0/−89
- src/cbits/jive.c +0/−93
- src/cbits/trim.c +46/−0
- tests/test-pileup.hs +0/−12
- tools/Align.hs +0/−307
- tools/Anno.hs +0/−186
- tools/Index.hs +0/−34
- tools/Seqs.hs +0/−173
- tools/SimpleSeed.hs +0/−105
- tools/Xlate.hs +0/−55
- tools/afroengineer.hs +0/−282
- tools/bam-fixpair.hs +0/−684
- tools/bam-meld.hs +0/−234
- tools/bam-resample.hs +0/−62
- tools/bam-rewrap.hs +0/−79
- tools/bam-rmdup.hs +0/−419
- tools/bam-trim.hs +0/−49
- tools/fastq2bam.hs +0/−199
- tools/jivebunny.hs +0/−536
- tools/mt-anno.hs +0/−58
- tools/mt-ccheck.hs +0/−584
- tools/redeye-dar.hs +0/−250
- tools/redeye-flow.hs +0/−192
- tools/redeye-single.hs +0/−334
Setup.hs view
@@ -1,33 +1,2 @@-import Control.Exception ( try, IOException )-import Distribution.PackageDescription ( PackageDescription(..) ) import Distribution.Simple-import Distribution.Simple.InstallDirs ( mandir, CopyDest (NoCopyDest) )-import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..), absoluteInstallDirs )-import Distribution.Simple.Setup ( copyDest, copyVerbosity, fromFlag, installVerbosity )-import Distribution.Simple.Utils-import Distribution.Verbosity ( Verbosity )-import System.Exit ( exitSuccess )-import System.FilePath ( splitDirectories, joinPath, (</>) )--main :: IO ()-main = do- defaultMainWithHooks $ simpleUserHooks- { postCopy = \ _ flags pkg lbi ->- installManpages pkg lbi (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags)-- , postInst = \ _ flags pkg lbi ->- installManpages pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest- }- exitSuccess--installManpages :: PackageDescription -> LocalBuildInfo -> Verbosity -> CopyDest -> IO ()-installManpages pkg lbi verbosity copy = do- installOrdinaryFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy))- [ ("man", joinPath mp) | ("man":mp) <- map splitDirectories $ extraSrcFiles pkg ]--installOrdinaryFiles' :: Verbosity -> FilePath -> [(FilePath, FilePath)] -> IO ()-installOrdinaryFiles' verb dest = mapM_ go- where- go :: (FilePath, FilePath) -> IO (Either IOException ())- go (base,src) = try $ installOrdinaryFile verb (base </> src) (dest </> src)-+main = defaultMain
biohazard.cabal view
@@ -1,5 +1,5 @@ Name: biohazard-Version: 0.6.9+Version: 0.6.10 Synopsis: bioinformatics support library Description: This is a collection of modules I separated from various bioinformatics tools. The hope is to make@@ -16,39 +16,21 @@ Maintainer: udo.stenzel@eva.mpg.de Copyright: (C) 2010-2017 Udo Stenzel -Extra-Source-Files: man/man7/biohazard.7- man/man1/bam-fixpair.1- man/man1/bam-meld.1- man/man1/bam-rewrap.1- man/man1/bam-rmdup.1- man/man1/fastq2bam.1- man/man1/jivebunny.1- man/man1/mt-anno.1--Data-Files: index_db.json-Data-Dir: data- Cabal-version: >= 1.10-Build-type: Custom+Build-type: Simple Tested-With: GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1 source-repository head type: git location: https://bitbucket.org/ustenzel/biohazard.git -source-repository this- type: git- location: https://bitbucket.org/ustenzel/biohazard.git- tag: 0.6.9- Flag debug Description: enable additional sanity checks Default: False Manual: True Library- Exposed-modules: Bio.Base,- Bio.Adna,+ Exposed-modules: Bio.Adna, Bio.Align, Bio.Bam, Bio.Bam.Evan,@@ -63,8 +45,7 @@ Bio.Bam.Rmdup, Bio.Bam.Trim, Bio.Bam.Writer,- Bio.Genocall,- Bio.Genocall.Estimators,+ Bio.Base, Bio.Iteratee, Bio.Iteratee.Bgzf, Bio.Iteratee.Builder,@@ -72,15 +53,11 @@ Bio.Prelude, Bio.PriorityQueue, Bio.TwoBit,- Bio.Util.AD,- Bio.Util.AD2,- Bio.Util.Jacobi, Bio.Util.Numeric, Bio.Util.Zlib, Paths_biohazard Build-depends: aeson >= 0.7 && < 1.1,- aeson-pretty == 0.8.*, async >= 2.0 && < 2.2, attoparsec >= 0.10 && < 0.14, base >= 4.6 && < 4.10,@@ -93,22 +70,18 @@ exceptions >= 0.6 && < 0.9, filepath >= 1.3 && < 2.0, hashable >= 1.0 && < 1.3,- hybrid-vectors == 0.2.*, iteratee >= 0.8.9.6 && < 0.8.10, ListLike >= 3.0 && < 5.0,- nonlinear-optimization == 0.3.*, primitive >= 0.5 && < 0.7, random >= 1.0 && < 1.2, scientific == 0.3.*, stm == 2.4.*,- template-haskell == 2.*, text >= 1.0 && < 2.0, transformers >= 0.4.1 && < 0.6, unix >= 2.5 && < 2.8, unordered-containers >= 0.2.3 && < 0.3, vector == 0.11.*, vector-algorithms >= 0.3 && < 1.0,- vector-binary-instances == 0.2.*, vector-th-unbox == 0.2.*, zlib >= 0.5 && < 0.7 @@ -139,260 +112,9 @@ Hs-source-dirs: src Install-Includes: src/cbits/myers_align.h- C-sources: src/cbits/myers_align.c+ C-sources: src/cbits/myers_align.c,+ src/cbits/trim.c CC-options: -fPIC - -- Modules not exported by this package.- -- Other-modules: -- -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.- -- Build-tools: ---- Test-Suite test-biohazard- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- -- Type: exitcode-stdio-1.0- -- Main-is: test-biohazard.hs--Executable test-pileup- Main-is: test-pileup.hs- Hs-Source-Dirs: tests- Ghc-options: -Wall -fprof-auto- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings, BangPatterns- Build-depends: async,- base,- biohazard,- bytestring,- filepath,- unordered-containers,- random,- text,- vector--Executable redeye-dar- Main-is: redeye-dar.hs- Hs-Source-Dirs: tools- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards- Build-depends: aeson-pretty,- async,- base,- binary,- biohazard,- bytestring,- containers,- filepath,- unordered-containers,- text,- vector--Executable redeye-single- Main-is: redeye-single.hs- Ghc-options: -Wall -rtsopts -fprof-auto- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards, FlexibleContexts- Hs-Source-Dirs: tools- Build-depends: aeson,- base,- binary,- biohazard,- bytestring,- containers,- directory,- filepath,- random,- text,- unix,- unordered-containers,- vector--Executable redeye-flow- Main-is: redeye-flow.hs- Ghc-options: -Wall -rtsopts- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, DeriveGeneric- Hs-Source-Dirs: tools- Build-depends: aeson,- aeson-pretty,- base,- binary,- biohazard,- bytestring,- containers,- directory,- shake == 0.15.*,- text,- unordered-containers,- vector--Executable afroengineer- Main-is: afroengineer.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards, Rank2Types- Hs-source-dirs: tools- Other-Modules: Align, SimpleSeed- Build-Depends: base,- biohazard,- bytestring,- containers,- directory,- unordered-containers,- vector--Executable bam-fixpair- Main-is: bam-fixpair.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards, FlexibleContexts- Hs-Source-Dirs: tools- Build-depends: async,- base,- binary,- biohazard,- bytestring,- process,- stm,- transformers,- unix,- vector--Executable bam-meld- Main-is: bam-meld.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, FlexibleContexts- Hs-Source-Dirs: tools- Build-depends: base,- biohazard,- bytestring,- containers--Executable bam-resample- Main-is: bam-resample.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings, BangPatterns- Hs-Source-Dirs: tools- Build-depends: base,- biohazard,- bytestring,- random--Executable bam-rewrap- Main-is: bam-rewrap.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings, BangPatterns- Hs-Source-Dirs: tools- Build-depends: base,- biohazard,- bytestring,- containers--Executable bam-rmdup- Main-is: bam-rmdup.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards, FlexibleContexts- Hs-Source-Dirs: tools- Build-depends: base,- biohazard,- bytestring,- containers,- -- primitive,- unordered-containers,- vector--Executable bam-trim- Main-is: bam-trim.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings, BangPatterns- Hs-Source-Dirs: tools- Build-depends: base,- biohazard,- bytestring--Executable fastq2bam- Main-is: fastq2bam.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings, BangPatterns- Hs-Source-Dirs: tools- Build-depends: base,- biohazard,- bytestring,- containers,- vector--Executable jivebunny- Main-is: jivebunny.hs- Hs-Source-Dirs: tools- C-sources: src/cbits/jive.c- CC-options: -std=c99 -ffast-math- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, TypeFamilies, RecordWildCards- Other-modules: Index- Build-depends: aeson,- base,- biohazard,- bytestring,- containers,- directory,- random,- text,- transformers,- unordered-containers,- vector,- vector-algorithms,- vector-th-unbox--Executable mt-anno- Main-is: mt-anno.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards- Hs-Source-Dirs: tools- Other-Modules: Anno, Seqs, Xlate- Build-Depends: base,- bytestring,- biohazard,- containers--Executable mt-ccheck- Main-is: mt-ccheck.hs- Ghc-options: -Wall -rtsopts- -- Ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N- Default-Language: Haskell2010- Default-Extensions: NoImplicitPrelude, OverloadedStrings,- BangPatterns, RecordWildCards- Hs-Source-Dirs: tools- Build-Depends: base,- bytestring,- biohazard,- containers,- unordered-containers -- :vim:tw=132:
− data/index_db.json
@@ -1,635 +0,0 @@-{- "p5index": {- "is4": "AGATCTC",-- "PhiA": "AAAAAAAA",- "PhiC": "CCCCCCCC",- "PhiG": "GGGGGGGG",- "PhiT": "TTTTTTTT",-- "1": "TCGCAGG",- "2": "CTCTGCA",- "3": "CCTAGGT",- "4": "GGATCAA",- "5": "GCAAGAT",- "6": "ATGGAGA",- "7": "CTCGATG",- "8": "GCTCGAA",- "9": "ACCAACT",- "10": "CCGGTAC",- "11": "AACTCCG",- "12": "TTGAAGT",- "13": "ACTATCA",- "14": "TTGGATC",- "15": "CGACCTG",- "16": "TAATGCG",- "17": "AGGTACC",- "18": "TGCGTCC",- "19": "GAATCTC",- "20": "CATGCTC",- "21": "ACGCAAC",- "22": "GCATTGG",- "23": "GATCTCG",- "24": "CAATATG",- "25": "TGACGTC",- "26": "GATGCCA",- "27": "CAATTAC",- "28": "AGATAGG",- "29": "CCGATTG",- "30": "ATGCCGC",- "31": "CAGTACT",- "32": "AATAGTA",- "33": "CATCCGG",- "34": "TCATGGT",- "35": "AGAACCG",- "36": "TGGAATA",- "37": "CAGGAGG",- "38": "AATACCT",- "39": "CGAATGC",- "40": "TTCGCAA",- "41": "AATTCAA",- "42": "CGCGCAG",- "43": "AAGGTCT",- "44": "ACTGGAC",- "45": "AGCAGGT",- "46": "GTACCGG",- "47": "GGTCAAG",- "48": "AATGATG",- "49": "AGTCAGA",- "50": "AACTAGA",- "51": "CTATGGC",- "52": "CGACGGT",- "53": "AACCAAG",- "54": "CGGCGTA",- "55": "GCAGTCC",- "56": "CTCGCGC",- "57": "CTGCGAC",- "58": "ACGTATG",- "59": "ATACTGA",- "60": "TACTTAG",- "61": "AAGCTAA",- "62": "GACGGCG",- "63": "AGAAGAC",- "64": "GTCCGGC",- "65": "TCAGCTT",- "66": "AGAGCGC",- "67": "GCCTACG",- "68": "TAATCAT",- "69": "AACCTGC",- "70": "GACGATT",- "71": "TAGGCCG",- "72": "GGCATAG",- "73": "TTCAACC",- "74": "TTAACTC",- "75": "TAGTCTA",- "76": "TGCATGA",- "77": "AATAAGC",- "78": "AGCCTTG",- "79": "CCAACCT",- "80": "GCAGAAG",- "81": "AGAATTA",- "82": "CAGCATC",- "83": "TTCTAGG",- "84": "CCTCTAG",- "85": "CCGGATA",- "86": "GCCGCCT",- "87": "AACGACC",- "88": "CCAGCGG",- "89": "TAGTTCC",- "90": "TGGCAAT",- "91": "CGTATAT",- "92": "GCTAATC",- "93": "GACTTCT",- "94": "GTACTAT",- "95": "CGAGATC",- "96": "CGCAGCC",-- "501": "GCGATCTA",- "502": "ATAGAGAG",- "503": "AGAGGATA",- "504": "TCTACTCT",- "505": "CTCCTTAC",- "506": "TATGCAGT",- "507": "TACTCCTT",- "508": "AGGCTTAG",- "510": "ATTAGACG",- "511": "CGGAGAGA",- "513": "CTAGTCGA",- "515": "AGCTAGAA",- "516": "ACTCTAGG",- "517": "TCTTACGC",- "518": "CTTAATAG",- "520": "ATAGCCTT",- "521": "TAAGGCTC",- "522": "TCGCATAA",-- "592": "GATTTCCA",- "593": "ATCATGTT",- "594": "TTTCATCA",- "595": "AGTCCGAC",- "596": "GCTAGAAA",- "597": "CTTGGTTA",- "598": "CGATACAC",- "599": "TTGATGGA",-- "t1": "ATCACG",- "t2": "CGATGT",- "t3": "TTAGGC",- "t4": "TGACCA",- "t5": "ACAGTG",- "t6": "GCCAAT",- "t7": "CAGATC",- "t8": "ACTTGA",- "t9": "GATCAG",- "t10": "TAGCTT",- "t11": "GGCTAC",- "t12": "CTTGTA",- "t13": "AGTCAA",- "t14": "AGTTCC",- "t15": "ATGTCA",- "t16": "CCGTCC",- "t17": "GTAGAG",- "t18": "GTCCGC",- "t19": "GTGAAA",- "t20": "GTGGCC",- "t21": "GTTTCG",- "t22": "CGTACG",- "t23": "GAGTGG",- "t24": "GGTAGC",- "t25": "ACTGAT",- "t26": "ATGAGC",- "t27": "ATTCCT",- "t28": "CAAAAG",- "t29": "CAACTA",- "t30": "CACCGG",- "t31": "CACGAT",- "t32": "CACTCA",- "t33": "CAGGCG",- "t34": "CATGGC",- "t35": "CATTTT",- "t36": "CCAACA",- "t37": "CGGAAT",- "t38": "CTAGCT",- "t39": "CTATAC",- "t40": "CTCAGA",- "t41": "GACGAC",- "t42": "TAATCG",- "t43": "TACAGC",- "t44": "TATAAT",- "t45": "TCATTC",- "t46": "TCCCGA",- "t47": "TCGAAG",- "t48": "TCGGCA"- },-- "p7index": {- "1": "ACAGTG",- "2": "GATCAG",- "3": "ATCACG",- "4": "CGATGT",- "5": "CTTGTA",- "6": "GGCTAC",- "7": "TGACCA",- "8": "AAAGCA",- "9": "AAATGC",- "10": "AAGCGA",- "11": "AAGGAC",- "12": "AATAGG",- "13": "ACCCAG",- "14": "ACTCTC",- "15": "AGAAGA",- "16": "AGCATC",- "17": "AGGCCG",- "18": "ATACGG",- "19": "ATCCTA",- "20": "ATCTAT",- "21": "ATGAGC",- "22": "CATTTT",- "23": "CCGCAA",- "24": "CTCAGA",- "25": "GAATAA",- "26": "GCCGCG",- "27": "GCTCCA",- "28": "GGCACA",- "29": "GGCCTG",- "30": "TCGGCA",- "31": "TCTACC",- "32": "TGCCAT",- "33": "TGCTGG",- "34": "AGGTTT",- "35": "AGTCAA",- "36": "AGTTCC",- "37": "ATGTCA",- "38": "CCGTCC",- "39": "GTAGAG",- "40": "GTGAAA",- "41": "GTGGCC",- "42": "GTTTCG",- "43": "CGTACG",- "44": "GAGTGG",- "45": "GGTAGC",- "46": "ACTTGA",- "47": "CAGATC",- "48": "GCCAAT",- "49": "TAGCTT",- "50": "TTAGGC",- "51": "AACCGCC",- "52": "AACGAAC",- "53": "AACGCCT",- "54": "AACGGTA",- "55": "AACTAGT",- "56": "AACTGAG",- "57": "AAGAATT",- "58": "AAGATAG",- "59": "AAGCTCT",- "60": "AAGTCTG",- "61": "AATAACC",- "62": "AATCCGT",- "63": "ACCGATT",- "64": "ACCGTAG",- "65": "ACCTCAT",- "66": "ACCTTGC",- "67": "ACGACCT",- "68": "ACGATTC",- "69": "ACGCGGC",- "70": "ACGGAGG",- "71": "ACGTAAC",- "72": "ACTACTG",- "73": "ACTCGTT",- "74": "ACTGCGC",- "75": "AGACCTC",- "76": "AGACTAG",- "77": "AGAGACC",- "78": "AGAGCGT",- "79": "AGATATG",- "80": "AGATTCT",- "81": "AGCAAGC",- "82": "AGCAGTT",- "83": "AGCGCTG",- "84": "AGTATAC",- "85": "ATAAGTC",- "86": "ATAATGG",- "87": "ATACTCC",- "88": "ATAGAAG",- "89": "ATCTCCG",- "90": "ATGCAGT",- "91": "ATGGTAT",- "92": "ATTATCT",- "93": "ATTCGAC",- "94": "ATTGCTA",- "95": "CAACCGG",- "96": "CAACTAA",- "97": "AATCTTC",- "98": "ACCAACG",- "99": "AGATGGC",- "100": "CCAGGTT",- "101": "CCGTTAG",- "102": "CGCCTCT",- "103": "CTTGCGG",- "104": "GGCGGAG",- "105": "TGGACGT",- "106": "AACCATG",- "107": "CAGGAAG",- "108": "CATACCT",- "109": "CCAATCC",- "110": "CCGGCGT",- "111": "CGCATAG",- "112": "CGTAATC",- "113": "CGTTGGT",- "114": "CTATACG",- "115": "GACCTAC",- "116": "GATATTG",- "117": "AAGACGC",- "118": "GCAGTAT",- "119": "GGTCCGC",- "120": "GTCGACT",- "121": "GTTAGAT",- "122": "TAACTCG",- "123": "TGCTTCC",- "124": "TGGCGCT",- "125": "AATGGCG",- "126": "ACCAGAC",- "127": "ACGCCAG",- "128": "ACTAAGT",- "129": "AGAACCG",- "130": "ATCGTTC",- "131": "CAACGTC",-- "193": "GAGGTTG",- "194": "TATGAGT",- "195": "CTTCGTT",- "196": "CCGTCCG",- "197": "AACGTTA",- "198": "GCATATT",- "199": "ACCTTCC",- "200": "TTCCGAG",- "201": "AACCGCA",- "202": "AGTCCTC",- "203": "ACGACTT",- "204": "ATCCATA",- "205": "CGGTCTC",- "206": "CTCATCG",- "207": "TCGCGTT",- "208": "CTTGACC",- "209": "ATAGCTG",- "210": "CGTTCCT",- "211": "CGCCTCA",- "212": "CAATCGA",- "213": "ACGCTCG",- "214": "CAGGCAA",- "215": "AGAGACT",- "216": "AATTGGT",- "217": "CAAGAAT",- "218": "AAGAGAT",- "219": "CTGACTA",- "220": "AAGCCTG",- "221": "CAACGAA",- "222": "CCATACC",- "223": "AAGTTGG",- "224": "ACCGAGG",- "225": "AACGCAT",- "226": "ATAGAAC",- "227": "CAAGGCC",- "228": "CGATTCG",-- "301": "TCGCAGG",- "302": "CTCTGCA",- "303": "CCTAGGT",- "304": "GGATCAA",- "305": "GCAAGAT",- "306": "ATGGAGA",- "307": "CTCGATG",- "308": "GCTCGAA",- "309": "ACCAACT",- "310": "CCGGTAC",- "311": "AACTCCG",- "312": "TTGAAGT",- "313": "ACTATCA",- "314": "TTGGATC",- "315": "CGACCTG",- "316": "TAATGCG",- "317": "AGGTACC",- "318": "TGCGTCC",- "319": "GAATCTC",- "320": "CATGCTC",- "321": "ACGCAAC",- "322": "GCATTGG",- "323": "GATCTCG",- "324": "CAATATG",- "325": "TGACGTC",- "326": "GATGCCA",- "327": "CAATTAC",- "328": "AGATAGG",- "329": "CCGATTG",- "330": "ATGCCGC",- "331": "CAGTACT",- "332": "AATAGTA",- "333": "CATCCGG",- "334": "TCATGGT",- "335": "AGAACCG",- "336": "TGGAATA",- "337": "CAGGAGG",- "338": "AATACCT",- "339": "CGAATGC",- "340": "TTCGCAA",- "341": "AATTCAA",- "342": "CGCGCAG",- "343": "AAGGTCT",- "344": "ACTGGAC",- "345": "AGCAGGT",- "346": "GTACCGG",- "347": "GGTCAAG",- "348": "AATGATG",- "349": "AGTCAGA",- "350": "AACTAGA",- "351": "CTATGGC",- "352": "CGACGGT",- "353": "AACCAAG",- "354": "CGGCGTA",- "355": "GCAGTCC",- "356": "CTCGCGC",- "357": "CTGCGAC",- "358": "ACGTATG",- "359": "ATACTGA",- "360": "TACTTAG",- "361": "AAGCTAA",- "362": "GACGGCG",- "363": "AGAAGAC",- "364": "GTCCGGC",- "365": "TCAGCTT",- "366": "AGAGCGC",- "367": "GCCTACG",- "368": "TAATCAT",- "369": "AACCTGC",- "370": "GACGATT",- "371": "TAGGCCG",- "372": "GGCATAG",- "373": "TTCAACC",- "374": "TTAACTC",- "375": "TAGTCTA",- "376": "TGCATGA",- "377": "AATAAGC",- "378": "AGCCTTG",- "379": "CCAACCT",- "380": "GCAGAAG",- "381": "AGAATTA",- "382": "CAGCATC",- "383": "TTCTAGG",- "384": "CCTCTAG",- "385": "CCGGATA",- "386": "GCCGCCT",- "387": "AACGACC",- "388": "CCAGCGG",- "389": "TAGTTCC",- "390": "TGGCAAT",- "391": "CGTATAT",- "392": "GCTAATC",- "393": "GACTTCT",- "394": "GTACTAT",- "395": "CGAGATC",- "396": "CGCAGCC",- "397": "GAGAGGC",- "398": "GCTTCAG",- "399": "ATATCCA",- "400": "GTTATAC",- "401": "CCTTAAT",- "402": "CGCCAAC",- "403": "TACTCGC",- "404": "AGCGCCA",- "405": "TAAGTAA",- "406": "TTGGTCA",- "407": "GTTGCAT",- "408": "ATCCTCT",- "409": "GGCGGTC",- "410": "ATATGAT",- "411": "GGTACGC",- "412": "AAGAACG",- "413": "CCGTTGA",- "414": "AGCAATC",- "415": "GCTCCGT",- "416": "CAACTCT",- "417": "AGACTCC",- "418": "CTATCTT",- "419": "AAGCAGT",- "420": "GTTACCG",- "421": "CCTAACG",- "422": "ATCATAA",- "423": "TGATAAC",- "424": "TCTCCTA",- "425": "CAGAGCA",- "426": "CGGCTGG",- "427": "CGCTATT",- "428": "GATCGTC",- "429": "ACGGCAG",- "430": "GACCGAT",- "431": "ACTTGCG",- "432": "GTAAGCC",- "433": "GCCATGC",- "434": "ATAACGT",- "435": "CGGACGT",- "436": "GCGAGTA",- "437": "ACGCGGA",- "438": "GTCTAAT",- "439": "GAAGCGT",- "440": "CGGTAAG",- "441": "GGTAACT",- "442": "AATATAG",- "443": "CCTCGCC",- "444": "TTAATAG",- "445": "CCGAAGC",- "446": "TCGTTAT",- "447": "GGCTCTG",- "448": "CCAAGTC",- "449": "CTTGGAA",- "450": "TGAAGCT",- "451": "GGTTGAC",- "452": "CCGCCAT",- "453": "ACCAGAG",- "454": "GCTGAGA",- "455": "CCTTCGC",- "456": "CTGGCCT",- "457": "CGCAAGG",- "458": "TGAGAGA",- "459": "AAGATTC",- "460": "ATCGGTT",- "461": "ACGAGCC",- "462": "TGGATAC",- "463": "ATTCCAG",- "464": "ACTCATT",- "465": "ACCTCGT",- "466": "AGCTTAT",- "467": "GCGATCT",- "468": "CTCCAGT",- "469": "GAACTTA",- "470": "CCAATAA",- "471": "AGGCGAG",- "472": "CTCAGAT",- "473": "AAGACGA",- "474": "ACCGCTC",- "475": "AACTGAC",- "476": "GCAACTG",- "477": "GAGTAAC",- "478": "GATTAGG",- "479": "AGTCGCT",- "480": "CATAGAC",- "481": "ACTACGG",- "482": "GGCTAGC",- "483": "CCATGAG",- "484": "GCTGGTT",- "485": "AGAGTAG",- "486": "TATCAAC",- "487": "ATACGCG",- "488": "GACGTAC",- "489": "CTACTTC",- "490": "TGGTCGG",- "491": "AGACCAT",- "492": "TCCGAAC",-- "701": "TAAGGCGA",- "702": "CGTACTAG",- "703": "AGGCAGAA",- "704": "TCCTGAGC",- "705": "GGACTCCT",- "706": "TAGGCATG",- "707": "CTCTCTAC",- "708": "CAGAGAGG",- "709": "GCTACGCT",- "710": "CGAGGCTG",- "711": "AAGAGGCA",- "712": "GTAGAGGA",- "714": "GCTCATGA",- "715": "ATCTCAGG",- "716": "ACTCGCTA",- "718": "GGAGCTAC",- "719": "GCGTAGTA",- "720": "CGGAGCCT",- "721": "TACGCTGC",- "722": "ATGCGCAG",- "723": "TAGCGCTC",- "724": "ACTGAGCG",- "726": "CCTAAGAC",- "727": "CGATCAGT",- "728": "TGCAGCTA",- "729": "TCGACGTC",-- "796": "TGGATCTG",- "797": "CCGTTTGT",- "798": "TGCTGGGT",- "799": "AGGTTGGG",-- "PhiX": "TTGCCGC",- "PhiA": "AAAAAAAA",- "PhiC": "CCCCCCCC",- "PhiG": "GGGGGGGG",- "PhiT": "TTTTTTTT",-- "t1": "ATCACG",- "t2": "CGATGT",- "t3": "TTAGGC",- "t4": "TGACCA",- "t5": "ACAGTG",- "t6": "GCCAAT",- "t7": "CAGATC",- "t8": "ACTTGA",- "t9": "GATCAG",- "t10": "TAGCTT",- "t11": "GGCTAC",- "t12": "CTTGTA",- "t13": "AGTCAA",- "t14": "AGTTCC",- "t15": "ATGTCA",- "t16": "CCGTCC",- "t17": "GTAGAG",- "t18": "GTCCGC",- "t19": "GTGAAA",- "t20": "GTGGCC",- "t21": "GTTTCG",- "t22": "CGTACG",- "t23": "GAGTGG",- "t24": "GGTAGC",- "t25": "ACTGAT",- "t26": "ATGAGC",- "t27": "ATTCCT",- "t28": "CAAAAG",- "t29": "CAACTA",- "t30": "CACCGG",- "t31": "CACGAT",- "t32": "CACTCA",- "t33": "CAGGCG",- "t34": "CATGGC",- "t35": "CATTTT",- "t36": "CCAACA",- "t37": "CGGAAT",- "t38": "CTAGCT",- "t39": "CTATAC",- "t40": "CTCAGA",- "t41": "GACGAC",- "t42": "TAATCG",- "t43": "TACAGC",- "t44": "TATAAT",- "t45": "TCATTC",- "t46": "TCCCGA",- "t47": "TCGAAG",- "t48": "TCGGCA"- }-}
− man/man1/bam-fixpair.1
@@ -1,152 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH BAM-FIXPAIR 1 "OCTOBER 2016" Applications "User Manuals"-.SH NAME-bam-fixpair \- bring read pairs together an repair them-.SH SYNOPSIS--.B bam-fixpair [-.I option-.B |-.I file-.B ... ]--.B bam-fixpair [-.I option-.B |-.I file-.B ... ] --exec [program] CLOWNS MIDDLE JOKERS--.SH DESCRIPTION-.B bam-fixpair-reads one or more BAM files, brings the paired end reads together, fixes-any flags as needed, and writes the result out in BAM format again or-pipes(!) it into another program that expects two(!) FastQ files as input.--.B bam-fixpair-should work with any input, but it performs best on sorted BAM input-that hasn't been filtered in a way to make it internally inconsistent.-Performance on inconsistent BAM files suffers, but the output will-always be an internally consistent file. Output is never sorted, but-the two mates of a pair appear next to each other.--.SH OPTIONS--.IP "-o, --output file"-Send BAM output to-.IR file .-The default is to pipe uncompressed BAM to stdout.--.IP "-X, --exec"-Pipe two streams in FastQ format to a program. This option ends the-command line for -.B bam-fixpair-and is followed by the command line of a program to execute. The-command line shall contain the literal words-.IR CLOWNS ", " MIDDLE " and " JOKERS-up to once each. If present, these will be replaced with file names-that refer to pipes such that reading from-.I CLOWNS-yields the first mates,-.I JOKERS-yields the second mates of each read pair in the same order and-.I MIDDLE-yields the unpaired reads. To avoid leaking memory, the executed-program should read from all these file descriptors in an interleaved-fashion. When done,-.B bam-fixpair-exists with the exit code of the external program. --.IP "-n, --dry-run, --validate"-Turns off output. Any errors or inconsistencies found by-.B bam-fixpair-will still be reported, so it serves to validate a BAM file.--.IP "-k, --kill-widows"-Delete reads that lost their mate. Widows typically result from well-intended filters that deal improperly with paired end data.--.IP "-u, --kill-unmapped"-Delete unmapped reads that lost their mate. The retained widows are-flagged as unpaired to make the output valid.--.IP "--kill-none"-Do not delete reads that lost their mate. They are flagged as unpaired-to make the output valid. This is the default.--.IP "-v, --verbose"-Print all informational messages. This is potentially very noisy.--.IP "-w, --warnings"-Print warnings and errors. Warnings are emitted for minor-inconveniences like mismatches flags, errors are emitted for outright-mistakes like missing reads. This would be a good setting when-combined with-.IR "--validate" .--.IP "--errors"-Print only errors. Errors are emitted for outright mistakes like-missing reads. This is the default setting.--.IP "-q, --quiet"-Print only fatal errors that prevent program continuation. Use this if-you don't care about how badly mutilated the file is, and just want to-feed it into some program somehow.--.IP "--report-mrnm, --no-report-mrnm"-Report / don't report mismatched mate reference names. Defaults to yes.--.IP "--report-mpos, --no-report-mpos"-Report / don't report mismatches mate position. Defaults to yes.--.IP "--report-isize, --no-report-isize"-Report / don't report wrong insert size. Slighly miscalculate insert-sizes are surprisingly common, so this defaults to no.--.IP "--report-flags, --no-report-flags"-Report / don't report mismatched flags. Defaults to yes.--.IP "--report-fflag, --no-report-fflag"-Report / don't report mismatched flags that are commonly inconsistent.-This applies to flags that are so often mishandled by common software-that they are more or less expected to be inconsistent, therefore it-defaults to no.--.IP "--report-ixs, --no-report-ixs"-Report / don't report mismatched index information. Defaults to yes.--.IP "--only-mapped"-Drop completely unmapped input. Single reads are retained in the output-if and only if they are mapped, paired reads are retained if and only if -.I at least one-of the two mates in a pair is mapped. This results in consistent-output, while the attempt to achieve the same by calling-.B samtools view -F4-results in an inconsistent output.--.IP "--fix-sven QUAL"-Trim the longest suffix off each read that has an average quality below-.IR QUAL .-If that causes a read to vanish, it is removed and leaves a widow, which-is then either flagged correctly or killed, depending on the setting-mentioned above. This option is a bad idea, don't use it.--.IP "-h, -?, --help, --usage"-Prints a short usage information and exit.--.IP "-V, --version"-Prints the version number and exits.--.SH BUGS-For large and badly messed up inputs, -.B bam-fixpair-will run out of memory. A possible fix would be to buffer in external-memory, and that is planned, but hasn't been done.--.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7)-
− man/man1/bam-meld.1
@@ -1,86 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH BAM-MELD 1 "DECEMBER 2012" Applications "User Manuals"-.SH NAME-bam-meld \- meld BAM files together, keeping best alignments-.SH SYNOPSIS-.B bam-meld [-.I option-.B |-.I file-.B ... ]-.SH DESCRIPTION-.B bam-meld-takes multiple BAM files as input and melds them into one by keeping the-best alignment for each read. Inputs must be in the same order with-mate pairs sorted together. One way to achieve that is to sort by query-name, another is to keep files in their original order.---.SH OPTIONS-.IP "-o, --output file"-Send output to-.I file-instead of standard output.--.IP "-s, --sorted"-Tells-.I bam-meld-that the input files are sorted by query name. They will be merged, and-all the records found for a given read are melded into one. This works-even if a particular read is missing from some, but not all input files.--.IP "-u, --unsorted"-Tells-.I bam-meld-the the input is unsorted. It is assumed to be grouped by query name-and all input files must have strictly the same order with no records-missing from any file.--.IP "-w, --weight XX:Y"-Sets the weight for the badness of field-.I XX-to value -.I Y.-The values of all fields (with integer or floating type) are multiplied-by their weight and summed up to obtain the badness of an alignment.-The alignment with the lowest badness is chosen as the best, the-difference in badness between the two best alignments becomes a new-upper limit on the mapping quality.--.IP "--bwa"-Sets a badness scheme suitable for programs that fill in the -.IR XM ", " XO ", and " XG-fields, e.g.-.I bwa aln.--.IP "--anfo"-Sets a badness scheme suitable for programs that fill in the -.IR UQ " and " PQ-fields, e.g.-.I anfo.--.IP "--blast"-Sets a badness scheme suitable for programs that fill in the -.I AS-field, e.g.-.I bwa bwasw-and presumably the-.I blast-family.--.IP "--blat"-Sets a badness scheme suitable for programs that fill in the -.I NM-field, which would be appropriate for -.I blat-style programs.---.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7)-
− man/man1/bam-rewrap.1
@@ -1,56 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH BAM-REWRAP 1 "SEPTEMBER 2013" Applications "User Manuals"-.SH NAME-bam-rewrap \- rewrap alignments in BAM file to real target length-.SH SYNOPSIS-.BI "bam-rewrap [" chrom : length " ...]"--.SH DESCRIPTION-.B bam-rewrap-reads a BAM file from standard input and writes a BAM file to standard-output where every alignment to a subset of target sequences has been-wrapped to the targets actual length, obtained from the command line.--The idea is that a circular reference sequence has been extended-artificially to facilitate alignment. Now the declared length in the-header is wrong, and some alignments overhang the end. -.B bam-rewrap-splits-those alignments into two, one for the beginning, one for the end of-the sequence, then soft-masks out the inappropriate parts. Alignments-falling completely behind the actual end of the target sequence are-wrapped to natural coordinates.--.B bam-rewrap-tries to fix the map quality (MAPQ) for the affected reads as follows: if-a read has zero map quality, meaning multiple equally good hits, -.B bam-rewrap-checks the -.I XA-field. If it reports exactly one additional alignment,-and it matches the primary alignment when transformed to natural-coordinates, -.I XA -is removed and -.I MAPQ-set to 37, indicating a unique hit. This logic is not standardized and-is only known to work if alignments were produced by-.BR bwa .-It may or may not make sense for other aligners.- -.SH OPTIONS-.IP "chrom:length"-Indicates that the length of target sequence-.IR chrom " is " length .-This option can be repeated and each will cause alignments to the-specified target to be wrapped. A unique prefix of the sequence name is-sufficient.--.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7)-
− man/man1/bam-rmdup.1
@@ -1,238 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH BAM-RMDUP 1 "DECEMBER 2012" Applications "User Manuals"-.SH NAME-bam-rmdup \- remove PCR duplicates from BAM files-.SH SYNOPSIS-.B bam-rmdup [-.I option-.B |-.I file-.B ... ]-.SH DESCRIPTION-.B bam-rmdup-searches for PCR duplicates in BAM files. From each set of duplicates,-a consensus is formed, which replaces the whole set. Input files must-be sorted by coordinate, all inputs will be merged into a single sorted-output file. Finally, a summary of the number of removed duplicates and-and estimate of library complexity is printed to standard output.--.SH OPTIONS-.IP "-o, --output file"-Send BAM output to-.IR file .-The default is to produce no output and count duplicates only. If -.I file-is '-', BAM output is sent to stdout and the final tally is instead sent-to stderr.--.IP "-O, --output-lib pat"-Split output by library (see notes below) and write each into a file-with the name created from -.IR pat .-If -.I pat-contains the characters-.IR '%s' ,-they will be replaced by the name of the library. Note that there can-be reads assigned to no read group, these will have the empty string-substituted. The characters-.IR '%%'-will be replaced by a single percent sign.--.IP "-R, --refseq REF"-Specify which parts of the input to read. Selective reading requires an-index file for the input. It allows separate processing of individual-reference sequences and hence parallelization. If-.IR REF " is " A ,-the whole input is processed, which is the default. If-.I REF-is a number, only alignments to one reference sequence are processed.-If-.IR REF " is " X-Y ", where " X " and " Y-are numbers, alignments to reference sequences numbered -.IR X " through " Y-are processed. Reference sequences are numbered starting from-.IR 1 ,-asking for references that do not exist results in no error, but an-empty output file. If-.IR REF " is " U ,-only reads with invalid reference sequence (unaligned reads at the end-of the file) are processed. This only makes sense to simulate the-effect of -.IR --unaligned ,-therefore -.IR "--refseq U" " implies " --unaligned .--.IP "-z, --circular CHR:LEN"-Specify that the reference sequence starting with the string-.I CHR-is circular and has length -.IR LEN .--The effect is that reads that align to one or more position that is-duplicated in the reference are normalized to a small start coordinate-and have their mapping quality (MAPQ) fixed where possible. After removal of-duplicates, reads that overhang the end of the reference sequence are-duplicated to the beginning and invalid parts of the alignment are-masked. The correct length is also entered in the BAM header.--Assuming that reads were mapped to a reference that has a part from the-beginning pasted to its end, a subsequent genotype caller should now see-even coverage over the whole length of the reference. At the same time,-duplicate removal and complexity estimation should still work fine.-(Arguably, this is all way too complicated, but simple solutions seem-unattainable within the constraints of the BAM file format.)--.IP "-p, --improper-pairs"-Retain improper pairs, that is, mate-pairs of which only one mate is-mapped. These are discarded by default.--.IP "-u, --unaligned"-Retain unaligned reads and completely unaligned pairs. This amounts to-a simple copy operation at the end and may only be sensible in-conjunction with -.I --keep -if the output file is intended to replace the input file without loss of-any data.--.IP "-1, --single-read"-Treat all reads as single. This might be a workaround for a very bad-second read, but is generally considered a bad idea. Reads will no-longer be marked as "paired" after running with this setting.--.IP "-c, --cheap"-Run in cheap mode. Cheap mode does not compute a consensus sequence for-a cluster of duplicates, but selects one of the reads as representative.-Its advantage is that it runs faster. Cheap mode is the default if no-output file is specified, else a consensus is computed by default.--.IP "-k, --keep, --mark-only"-Keep duplicates and mark them as such. Setting this option has the-effect that all reads that would have been discarded during duplicate-removal are instead retained and marked as duplicates.--Note that -.I --keep-does not affect the operation of the filter settings! It may make sense-to combine -.I --keep -with -.IR --improper-pairs ,-it may not make sense to combine it with-.IR --min-length .--.IP "-Q, --max-qual qual"-Set the maximum quality score after consensus calling to-.I qual.-Consensus calling can result in unrealistically high quality scores due-to effects outside this program's scope (presumably errors in PCR).-Quality score are therefore limited to an upper value, even if we didn't-actually remove any duplicates. The default is 60, corresponding to a-very high fidelity polymerase.--.IP "-l, --min-length len"-Discard reads shorter than-.IR len .-This option may conserve time if the plan is to discard short reads-later anyway.--.IP "-q, --min-mapq qual"-Discard reads with a map quality (MAPQ) lower than -.IR qual .-If the-.IR --circular -option is in use, the filter is applied after reads have been wrapped-and their map quality has been corrected. This option may conserve time-if the plan is to discard short reads later anyway. --.IP "-s, --no-strand"-Treat the strand information as uninformative. Normally, PCR duplicates-should always map to the same strand, however, in certain types of-library (e.g. Illumina fork adapter preparation) the two strands of the-same original molecule map to different strands. With the-.I --no-strand-option, these are considered duplicates, without it, they are distinct.--.IP "-r, --ignore-rg"-Ignore read groups. Normally, no duplicates are expected across-different libraries, and this information is gleaned from the read group-headers. With-.IR --ignore-rg ,-everything is treated as a single read group with duplicates potentially-everywhere.--.SH THEORY OF OPERATION--.SS Filtering Of Input--In normal operation, unaligned single reads and completely unaligned-pairs, half-aligned pairs, and duplicate reads are discarded. The-rationale is that these will usually be dropped later anyway. If this-loss of information is undesirable, -.I --improper-pairs-retains half-aligned pairs and includes them in the duplicate removal-process, -.I --unaligned-includes unaligned single reads and completely unaligned read pairs in-the output, and-.I --keep-keeps duplicates and marks them as such. In summary, running with-.I -p -u -k -and without any of-.I -1 -l-should retain all information from the original file.--.SS Definition of Duplicates--To find duplicates, reads are grouped into sets of equal alignment-coordinate, equal library, and equal strand. Alignment coordinate means-the 5' coordinate and length for merged reads, the two leftmost-coordinates for read pairs, and just the leftmost coordinate for single-ended reads, the library is the one defined for the read group else the-sample specified for the read group, else the read group, else the empty-string, The assumption here is that different libraries cannot contain-libraries. This works best if the RG-LB field specifies the-"ur-library" before amplification.--The choice of what constitutes a duplicate is made such that a read pair-can be dealt with using only the information available at one mate's-site (-.IR POS , MPOS and FLAG-in BAM files). This way,-.B bam-rmdup-can stream a file with no additional sorting pass, and it can be-parallized over target sequences.--For each set, a consensus is called by first determining the most common-CIGAR line and then calling the consensus of all reads that match the-CIGAR line. Note that this means reads with a different CIGAR line are-effectively discarded, but that also makes dealing with indels rather-easy. Quality scores are afterwards limited to a sensible maximum. --.SS Mixed Data--In principle, BAM files can contain a mix of paired end data, single-ended data, merges pairs, and half discarded pairs. The latter is-invalid, but surprisingly common in practice. We try to deal with the-mess as best as we can. The biggest difficulty arises from a mix of-single ended and paired reads, because it is is possible that a single-ended reads looks like a duplicate of two sets of pairs that are clearly-not duplicates of each other.--.B bam-rmdup-solved this problem by treating single ended and paired data mostly-separately. If a set of single ended reads could be a duplicate of at-least one set of paired end, the singles are removed or marked, but they-are not included into any consensus.--.SH BUGS-It's way too slow.--.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7)-
− man/man1/fastq2bam.1
@@ -1,181 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH FASTQ2BAM 1 "OCTOBER 2014" Applications "User Manuals"-.SH NAME-fastq2bam \- convert fastq files to bam-.SH SYNOPSIS-.B fastq2bam [-.I option-.B ... ]-.SH DESCRIPTION-.B fastq2bam-takes FastQ or FastA files as input and converts them to BAM, honoring-various common conventions. Paired end and singly or doubly indexed-reads are supported in most encodings encountered in the wild.--Most syntactic conventions employed in FastQ are recognized, see below.-Multiple files can be given as input, they are combined sensibly and-finally concatenated. Bare file arguments behave the same as if they-were given with the -.I --read-one-option.---.SH OPTIONS-.IP "-o, --output file"-Send output to-.I file-instead of standard output. Absent-.IR -o ,-uncompressed BAM is piped to stdout.--.IP "-1, --read-one file"-Read -.I file-and turn each contained sequence into a BAM record. -.I file-may contain an arbitrary mix of paired and unpaired reads, first and-second mates, and so on.--.IP "-2, --read-two file"-Read-.I file-and interpret the contents as second mates of read pairs. Each read is-paired up with one from the source previously given with-.I --read-one-(or stdin if no-.I --read-one-was encountered), and the pair is appropriately flagged a 1st mate and-2nd mate.--.IP "-I, --index-one file"-Read -.I file-and interpret the contents as the first index sequence, which is-combined with reads from the source previously given with-.I --read-one-(or stdin if no-.I --read-one-was encountered). --.IP "-J, --index-two file"-Read -.I file-and interpret the contents as the second index sequence, which is-combined with reads from the source previously given with-.I --read-one-(or stdin if no-.I --read-one-was encountered).--.IP "-v, --verbose"-Causes-.I fastq2bam -to print a progress report to stderr.--.SH INPUT FILES--Input files can be FastQ or FastA, even a mix of the two,-optionally compressed using -.IR gzip "(1)."-If the input is FastA, the output will not have quality scores-associated with the sequences, but nothing else changes. Many-annotations in the header are recognized:--.IP \(bu 4 -A name suffix of "/1" or "/2" is turned into the first mate or second-mate flag, respectively (Illumina convention).--.IP \(bu 4-The name prefixes "F_" and "R_" are turned into the first mate or-second mate flag, respectively (legacy MPI EVAN convention).--.IP \(bu 4-The name prefix "M_" flags the sequence as unpaired and merged (legacy-MPI EVAN convention).--.IP \(bu 4 -The name prefix "T_" flags the sequence as unpaired and trimmed-(legacy MPI EVAN convention).--.IP \(bu 4-The name prefix of "C_", either before or after any of the other-prefixes, is turned into the extra flag -.IR XP:i:-1 ,-meaning the result of duplicate removal with unknown duplicate count-(legacy MPI EVAN convention, I'm really sorry for this one).--.IP \(bu 4-A nucleotide sequence separated from the name by an octothorpe ("#") is-removed and treated as the first index. Two such sequences, separated-by a comma, are treated as first and second index (legacy convention,-possibly MPI EVAN only).--.IP \(bu 4-If the first word of the description has at least four colon separated-subfields, the first is used to flag first/second mate if it has the-value -.IR 1 or 2 ,-respectively, the second is interpreted as the "QC failed" flag if it-has the value-.IR Y ,-, and the fourth is used as the first index sequence.--If multiple files are read and combined, later files override the-appropriate values parsed from earlier files. This makes it possible-to, e.g. have one file containing the first mates with their index-sequences, another with the second mates with their index sequences, and-a third file that supplies the second index sequence only.---.SH OUTPUT FILES--Output is BAM. Most information is encoded in the standard fields and-flags. In addition, the first index sequence is placed into the -.I XI-field with string type, its quality score into the -.I YI-field with string type, encoded just like in FastQ files.-Likewise, the second index goes into-.IR XJ and YJ .-If a read is recognized as being a replacement for a cluster of-duplicates, this is encoded by setting-.I XP-to-.I -1 -with integer type. If a read is to be flagged as trimmed, the -.I FF-field is set to-.I 1-, or to -.I 2-if the read resulted from merging of a read pair (MPI EVAN convention).--.SH NOTES--Whenever multiple files are to be combined, they must run parallel, that-is, each file must contain sequences with the same read names in the-same order.--If only a-.I --read-one-argument is combined with one or two index files, the normal parsing-logic applies, so a mix of paired and unpaired reads, even with indices-is allowed. The index sequences are overridden with those from the-separate input files.--If one -.I --read-one-argument is combined with one-.I --read-two-argument, the pairing flags are forced. While the normal parsing logic-still applies, a mix of paired and unpaired reads will not work as-desired and will probably lead to errors.--.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7)-
− man/man1/jivebunny.1
@@ -1,177 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH JIVEBUNNY 1 "JULY 2015" Applications "User Manuals"-.SH NAME-jivebunny \- demultiplex Illumina sequences-.SH SYNOPSIS-.B jivebunny [-.I option-.B |-.I file-.B ... ]-.SH DESCRIPTION-.B jivebunny-demultiplexes double-index Illumina sequencing data from one or more BAM-files. In a first pass, the present mixture is analyzed, which serves-to estimate possibly uneven mixture ratios and to assess unexpected-contaminants. In a second pass, each read is assigned to the most-probable read group given the estimated mixture ratios. For both-passes, all input files are concatenated. Summary statistics and-quality scores are computed globally and per read as appropriate.--.SH OPTIONS-.IP "-o, --output file"-Send BAM output to-.IR file .-The default is to produce no output and estimate mixture ratios only. If -.I file-is '-', BAM output is sent to-.I stdout-and the final tally is instead sent-to-.IR stderr .--.IP "-I, --index-database file"-Read the database of possible indices from-.IR file .-Every combination of a P7 index and a P5 index from this file is-considered a possible component of the mix. The default is a file-containing all Illumina Truseq indices and indices from the-Meyer/Kircher paper. See below for the format of this file.--.IP "-r, --read-groups file"-Read read group definitions from file, see below for the format of this-file. Read group definitions are not necessary to identify a mixture-component, but only known components can be named and assigned.--.IP "--threshold frac"-Set the threshold for the estimation of mixture components to -.IR frac .-The iteration stops as soon as no estimate for any component changes by-more than-.IR frac .-The default of 1/200000 seems to work well in practice.--.IP "--sample num"-Sample-.I num-reads for the mixture estimation. The default is 50000, which is-usually good enough. By sampling more, the ability to detect-contaminants at low concentration can be improved at the cost of longer-computation.--.IP "--components num"-Print the top-.I num-components of the mixture after estimation. By default, 25% more than-the number of defined read groups, but at least 20 are printed. Setting-this to a higher number may be a good idea if you're trying to reverse-engineer a pipetting accident.--.IP "-s, --single-index"-Pretend there is only one index. This switch doesn't change the-program's logic (it still pretends everything is doubly indexed), but it-helps to make the output more readable if only one index was really-sequenced.--.IP "--pedantic"-Be pedantic about read groups. Normally, -.I jivebunny-will assign reads to undeclared read groups by placing the names of the-two most likely indices into the -.I RG-field. However, since it is not feasible to provide a header that-declares all these potential read groups, the BAM file will technically-be invalid. -.I samtools-will still happily filter on this field, though. If the-.I --pedantic-switch is set, these reads are not assigned to any read group.---.IP "--verbose"-Print progress reports during computation. The estimation process can-be observed and a counter runs while reading or writing BAM files.--.IP "--quiet"-Don't print anything, not even the summary statistics.--.IP "-h, -?, --help, --usage"-Prints a short usage message and exits the program.--.IP "-V, --version"-Prints the version of biohazard used and exits the program.--.SH FILES--.SS Input Files--All input files must be double index BAM files. Indices are stored in-tagged fields where-.IR XI " and " XJ-contain the first and second ASCII codes index sequence (only A,C,G,T-and N are allowed) and -.IR YI " and " YJ-contain the quality scores encoded as a string just like in FastaQ-(ASCII codepoint of value plus 33). Single indexed BAM files should-work in principle, but the output may be hard to interpret.--.SS Output File--The ouput is a single BAM file which is equivalent to the concatenated-inputs with the following modifications: The header contains an-additional -.I @PG-line and one-.I @RG-line for each read group. Each read gains the appropriate -.I @RG-field if a known read group can be assigned; otherwise the -.I @RG -field is deleted. The fields -.IR @Z0 " and " @Z2-are deleted and the field-.I @Z1-is added with a Phred scaled quality score for the assigned read group.-(In other words, -.I @Z1 -is the probability that some other assignment is actually correct,-expressed in deciban. If no read group could be assigned, this value-may not be of much value.)--.SS Read Group File--The read group file is TAB separated table containg an optional header-line starting with a hash mark ('#') and then one line per read group.-The first field is the name of the read group, the second field is the-name (not the sequence) of the first index, the third is the name of the-second index. Further fields must have the form-.I XY:val-and are copied into the-.I @RG-header of the output. This facility can be used to assign libraries or-samples to read groups for easier downstream processing.--.SS Index Database--The index database is a JSON file containing a single object with two-fields named ``p7index'' and ``p5index''. Each of these is an object-mapping index names to index sequences, the latter encoded as a string.--It is permissible for multiple indices to have the same sequence. These-will be treated as aliases when parsing read group files, only the first-name is used when producing output.---.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7), bam (5), fastq (5), json (5)--Kircher -.I et.al -(2012). Double indexing overcomes inaccuracies in multiplex sequencing on the Illumina platform. -.IR "Nucleic Acids Research, 40" (1), -e3. doi:10.1093/nar/gkr771
− man/man1/mt-anno.1
@@ -1,55 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH MT-ANNO 1 "JANUARY 2014" Applications "User Manuals"-.SH NAME-mt-anno \- annotate a-.IR human (!)-mitochondrion--.SH SYNOPSIS-.B mt-anno -<-.I junk.fa-> -.I crap.txt--.SH DESCRIPTION-.B mt-anno-reads a set of-.IR human (!)-mitochondrial sequences in fasta format from stdin and for each of them-writes a Genbank formatted annotation and the set of coded protein-sequences in fasta format to stdout.--The annotation is built in and applied blindly. This is a -.IR "very stupid" ", " "very useless" " and " "very wasteful"-thing to do, but biologists have been asking for it repeatedly. -.B DO NOT USE-this tool if you like to think of yourself as a scientist!--.SH OPTIONS--.B mt-anno-comes without options and is not customizable. If you think any options-or any further documentation might be useful, you are confused.-Actually, if you want to use it at all, you are confused.--.SH BUGS--All -.B mt-anno-does is take the "official" annotation of rCRS and translate its-coordinates. If after translation the annotation doesn't make sense-anymore, there is no warning. If translated proteins lost their start-codon or gained a stop codon, there is no warning. If there is a-frame shift mutation, there is no warning. Arguable, the whole idea of-.B mt-anno-is one big bug, but it's considered unfixable.--.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR biohazard (7), fasta (5)-
− man/man7/biohazard.7
@@ -1,28 +0,0 @@-.\" Process this file with-.\" groff -man -Tascii bam-rmdup.1-.\"-.TH BIOHAZARD 1 "DECEMBER 2012" Miscellanea "User Manuals"-.SH NAME-biohazard \- library and tools working mostly with BAM files-.SH SYNOPSIS-.B bam-meld-.B bam-rmdup--.SH DESCRIPTION-.B biohazard-is chiefly a Haskell library that reads and writes BAM files, along with-some algorithms and tools. See the Haskell Library documentation and-the individual programs' man pages for details.--.SH AUTHOR-Udo Stenzel <udo_stenzel@eva.mpg.de>--.SH "SEE ALSO"-.BR bam-fixpair (1)-.BR bam-meld (1)-.BR bam-rewrap (1)-.BR bam-rmdup (1)-.BR fastq2bam (1)-.BR jivebunny (1)-.BR http://samtools.sourceforge.net/SAM1.pdf-
src/Bio/Bam/Rec.hs view
@@ -176,8 +176,8 @@ {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (Vector_Nucs_half o _ fp) i- | even (o+i) = return . Ns $ (b `shiftR` 4) .&. 0xF- | otherwise = return . Ns $ b .&. 0xF+ | even (o+i) = return . Ns $! (b `shiftR` 4) .&. 0xF+ | otherwise = return . Ns $! b .&. 0xF where !b = unsafeInlineIO $ withForeignPtr fp $ \p -> peekByteOff p ((o+i) `shiftR` 1) instance VM.MVector MVector_Nucs_half Nucleotides where
src/Bio/Bam/Trim.hs view
@@ -9,14 +9,12 @@ import Bio.Iteratee import Bio.Prelude +import Foreign.C.Types ( CInt(..) )+import Foreign.Ptr ( Ptr )+ import qualified Data.ByteString as B-import qualified Data.Vector.Fusion.Bundle.Size as S-import qualified Data.Vector.Fusion.Bundle.Monadic as S-import qualified Data.Vector.Fusion.Stream.Monadic as SS-import qualified Data.Vector.Fusion.Util as SS-import qualified Data.Vector.Hybrid.Internal as Hybrid import qualified Data.Vector.Generic as V-import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Storable as W -- | Trims from the 3' end of a sequence. -- @trim_3\' p b@ trims the 3' end of the sequence in @b@ at the@@ -166,25 +164,27 @@ -- would further limit the returned quality! (In practice, map quality -- later imposes a limit anyway, so no worries...) -merge_overlap :: BamRec -> [ U.Vector Nucleotides ]- -> BamRec -> [ U.Vector Nucleotides ]+merge_overlap :: BamRec -> [ W.Vector Nucleotides ]+ -> BamRec -> [ W.Vector Nucleotides ] -> Maybe ( BamRec, BamRec, BamRec, Int, Int )-merge_overlap r1 ads1 r2 ads2 =- case possible_merges of- [ ] -> Nothing- (score, len) : [ ] -> result len score plain_score- (score1, len) : (score2, _) : _ -> result len score1 score2+merge_overlap r1 ads1 r2 ads2+ | V.null (b_seq r1) && V.null (b_seq r2) = Nothing+ | otherwise = result mlen score1 score2 where- rq1 = Hybrid.V (b_seq r1) (b_qual r1)- rq2 = Hybrid.V (b_seq r2) (b_qual r2)- -- the "merge" score if there is no overlap- plain_score = 6 * fromIntegral (V.length rq1 + V.length rq2)+ plain_score = 6 * fromIntegral (len_r1 + len_r2) - possible_merges = sortBy (\a b -> fst a `compare` fst b)- [ ( merge_score ads1 ads2 rq1 rq2 l, l )- | l <- [0 .. V.length rq1 + V.length rq2 - 1] ]+ len_r1 = V.length $ b_seq r1+ len_r2 = V.length $ b_seq r2 + b_seq_r1 = V.convert $ b_seq r1+ b_seq_r2 = V.convert $ b_seq r2+ b_qual_r1 = V.convert $ b_qual r1+ b_qual_r2 = V.convert $ b_qual r2++ (score1, mlen, score2) = twoMins plain_score (len_r1 + len_r2) $+ merge_score ads1 ads2 b_seq_r1 b_qual_r1 b_seq_r2 b_qual_r2+ flag_vestigial br = br { b_exts = updateE "FF" (Int $ extAsInt 0 "FF" br .|. eflagVestigial) $ b_exts br } store_quals s1 s2 br = br { b_exts = updateE "YM" (Int $ s2 - s1) $ updateE "YN" (Int $ plain_score - s1) $ b_exts br }@@ -199,46 +199,60 @@ | otherwise = nullBamRec { b_qname = b_qname r1, b_flag = flagUnmapped .|. complement pair_flags .&. b_flag r1,- b_seq = V.unstream $ flip S.fromStream (S.Exact $ V.length merged_seq) $ SS.map fst $ S.elements $ V.stream merged_seq,- b_qual = V.unstream $ flip S.fromStream (S.Exact $ V.length merged_seq) $ SS.map snd $ S.elements $ V.stream merged_seq,- b_exts = let ff = if l < V.length (b_seq r1) then eflagTrimmed else 0+ b_seq = merged_seq,+ b_qual = merged_qual,+ b_exts = let ff = if l < len_r1 then eflagTrimmed else 0 in updateE "FF" (Int $ extAsInt 0 "FF" r1 .|. eflagMerged .|. ff) $ b_exts r1 } where- merged_seq = V.concat- [ V.take (l - V.length rq2) rq1- , merge_seqs qmax (V.take l $ V.drop (l - V.length rq2) rq1)- (V.reverse $ V.take l $ V.drop (l - V.length rq1) rq2)- , V.reverse $ V.take (l - V.length rq1) rq2 ]+ merged_seq = V.convert $ V.concat+ [ V.take (l - len_r2) (b_seq_r1)+ , merge_seqs (V.take l $ V.drop (l - len_r2) b_seq_r1)+ (V.take l $ V.drop (l - len_r2) b_qual_r1)+ (V.reverse $ V.take l $ V.drop (l - len_r1) b_seq_r2)+ (V.reverse $ V.take l $ V.drop (l - len_r1) b_qual_r2)+ , V.reverse $ V.take (l - len_r1) b_seq_r2 ] + merged_qual = V.convert $ V.concat+ [ V.take (l - len_r2) (b_qual_r1)+ , merge_quals qmax (V.take l $ V.drop (l - len_r2) b_seq_r1)+ (V.take l $ V.drop (l - len_r2) b_qual_r1)+ (V.reverse $ V.take l $ V.drop (l - len_r1) b_seq_r2)+ (V.reverse $ V.take l $ V.drop (l - len_r1) b_qual_r2)+ , V.reverse $ V.take (l - len_r1) b_qual_r2 ]+ pair_flags = flagPaired.|.flagProperlyPaired.|.flagMateUnmapped.|.flagMateReversed.|.flagFirstMate.|.flagSecondMate - merge_seqs qmax = V.zipWith $ \(!n1,!(Q q1)) (!n2,!(Q q2)) ->- if n1 == n2 then (n1, Q $ min qmax (q1 + q2))- else if q1 > q2 then (n1, Q $ q1 - q2 )- else (n2, Q $ q2 - q1 )+ merge_seqs v1 v2 v3 v4 = V.zipWith4 zz v1 v2 v3 v4+ where+ zz !n1 (Q !q1) !n2 (Q !q2) = if n1 == n2 then n1+ else if q1 > q2 then n1+ else n2 + merge_quals qmax v1 v2 v3 v4 = V.zipWith4 zz v1 v2 v3 v4+ where+ zz !n1 (Q !q1) !n2 (Q !q2) = Q $ if n1 == n2 then min qmax (q1 + q2)+ else if q1 > q2 then q1 - q2+ else q2 - q1 -- | Trimming for a single read: we need one adapter only (the one coming -- /after/ the read), here provided as a list of options, and then we -- merge with an empty second read. Results in up to two reads (the -- original, possibly flagged, and the trimmed one, definitely flagged, -- and two qualities).-trim_adapter :: BamRec -> [ U.Vector Nucleotides ] -> Maybe ( BamRec, BamRec, Int, Int )-trim_adapter r1 ads1 =- case possible_trims of- [ ] -> Nothing- (score, len) : [ ] -> result len score plain_score- (score1, len) : (score2, _) : _ -> result len score1 score2+trim_adapter :: BamRec -> [ W.Vector Nucleotides ] -> Maybe ( BamRec, BamRec, Int, Int )+trim_adapter r1 ads1+ | V.null (b_seq r1) = Nothing+ | otherwise = result mlen score1 score2 where- rq1 = Hybrid.V (b_seq r1) (b_qual r1)- -- the "merge" score if there is no trimming- plain_score = 6 * fromIntegral (V.length rq1)+ plain_score = 6 * fromIntegral (V.length (b_seq r1)) - possible_trims = sortBy (\a b -> fst a `compare` fst b)- [ ( merge_score ads1 [V.empty] rq1 V.empty l, l )- | l <- [0 .. V.length rq1 - 1] ]+ b_seq_r1 = V.convert $ b_seq r1+ b_qual_r1 = V.convert $ b_qual r1 + (score1, mlen, score2) = twoMins plain_score (V.length (b_seq r1)) $+ merge_score ads1 [V.empty] b_seq_r1 b_qual_r1 V.empty V.empty+ flag_vestigial br = br { b_exts = updateE "FF" (Int $ extAsInt 0 "FF" br .|. eflagVestigial) $ b_exts br } store_quals s1 s2 br = br { b_exts = updateE "YM" (Int $ s2 - s1) $ updateE "YN" (Int $ plain_score - s1) $ b_exts br }@@ -263,20 +277,20 @@ -- (defined here in the direction they would be sequenced in): Genomic -- R2, Multiplex R2, Fraft P7. -default_fwd_adapters :: [ U.Vector Nucleotides ]-default_fwd_adapters = map (U.fromList. map toNucleotides)- [ {- Genomic R2 -} "AGATCGGAAGAGCGGTTCAGCAGGAATGCCGAGACCG"- , {- Multiplex R2 -} "AGATCGGAAGAGCACACGTCTGAACTCCAGTCAC"- , {- Graft P7 -} "AGATCGGAAGAGCTCGTATGCCGTCTTCTGCTTG" ]+default_fwd_adapters :: [ W.Vector Nucleotides ]+default_fwd_adapters = map (W.fromList. map toNucleotides)+ [ {- Genomic R2 -} "AGATCGGAAGAGCGGTTCAG"+ , {- Multiplex R2 -} "AGATCGGAAGAGCACACGTC"+ , {- Graft P7 -} "AGATCGGAAGAGCTCGTATG" ] -- | Like 'default_rev_adapters', these are the few adapters needed for -- the reverse read (defined in the direction they would be sequenced in -- as part of the second read): Genomic R1, CL 72. -default_rev_adapters :: [ U.Vector Nucleotides ]-default_rev_adapters = map (U.fromList. map toNucleotides)- [ {- Genomic_R1 -} "AGATCGGAAGAGCGTCGTGTAGGGAAAGAGTGT"- , {- CL72 -} "GGAAGAGCGTCGTGTAGGGAAAGAGTGT" ]+default_rev_adapters :: [ W.Vector Nucleotides ]+default_rev_adapters = map (W.fromList. map toNucleotides)+ [ {- Genomic_R1 -} "AGATCGGAAGAGCGTCGTGT"+ , {- CL72 -} "GGAAGAGCGTCGTGTAGGGA" ] -- We need to compute the likelihood of a read pair given an assumed -- insert length. The likelihood of the first read is the likelihood of@@ -288,39 +302,96 @@ -- matter enough.) merge_score- :: ( V.Vector v Nucleotides, V.Vector u (Nucleotides, Qual) )- => [ v Nucleotides ] -- 3' adapters as they appear in the first read- -> [ v Nucleotides ] -- 5' adapters as they appear in the second read- -> u (Nucleotides, Qual) -- first read- -> u (Nucleotides, Qual) -- second read- -> Int -- assumed insert length- -> Int -- score (roughly sum of qualities at mismatches)-merge_score fwd_adapters rev_adapters read1 read2 l+ :: [ W.Vector Nucleotides ] -- 3' adapters as they appear in the first read+ -> [ W.Vector Nucleotides ] -- 5' adapters as they appear in the second read+ -> W.Vector Nucleotides -> W.Vector Qual -- first read, qual+ -> W.Vector Nucleotides -> W.Vector Qual -- second read, qual+ -> Int -- assumed insert length+ -> Int -- score (roughly sum of qualities at mismatches)+merge_score fwd_adapters rev_adapters !read1 !qual1 !read2 !qual2 !l = 6 * fromIntegral (l `min` V.length read1) -- read1, part before adapter + 6 * fromIntegral (max 0 (l - V.length read1)) -- read2, part before overlap - + minimum [ match_adapter (V.drop l read1) fwd_ad -- read1, match with forward adapter- + 6 * fromIntegral (max 0 (V.length read1 - V.length fwd_ad - l)) -- read1, part after (known) adapter- | fwd_ad <- fwd_adapters ]+ + foldl' (\acc fwd_ad -> min acc+ (match_adapter l read1 qual1 fwd_ad + -- read1, match with forward adapter+ 6 * fromIntegral (max 0 (V.length read1 - V.length fwd_ad - l))) -- read1, part after (known) adapter+ ) maxBound fwd_adapters - + minimum [ match_adapter (V.drop l read2) rev_ad -- read2, match with reverse adapter- + 6 * fromIntegral (max 0 (V.length read2 - V.length rev_ad - l)) -- read2, part after (known) adapter- | rev_ad <- rev_adapters ]+ + foldl' (\acc rev_ad -> min acc+ (match_adapter l read2 qual2 rev_ad + -- read2, match with reverse adapter+ 6 * fromIntegral (max 0 (V.length read2 - V.length rev_ad - l))) -- read2, part after (known) adapter+ ) maxBound rev_adapters - + match_reads (V.take l $ V.drop (l - V.length read2) read1)- (V.take l $ V.drop (l - V.length read1) read2) -- read2, overlap with read1+ + match_reads l read1 qual1 read2 qual2++{-# INLINE match_adapter #-}+match_adapter :: Int -> W.Vector Nucleotides -> W.Vector Qual -> W.Vector Nucleotides -> Int+match_adapter !off !rd !qs !ad+ | V.length rd /= V.length qs = error "read/qual length mismatch"+ | efflength <= 0 = 0+ | otherwise+ = fromIntegral . unsafePerformIO $+ W.unsafeWith rd $ \p_rd ->+ W.unsafeWith qs $ \p_qs ->+ W.unsafeWith ad $ \p_ad ->+ prim_match_ad (fromIntegral off)+ (fromIntegral efflength)+ p_rd p_qs p_ad where- -- match_adapter :: u (Nucleotides, Qual) -> v Nucleotides -> Double- match_adapter rd ad = SS.unId $ SS.foldl' (+) 0 $- SS.zipWith (\(!n, Q !q) m -> if n == m then 0 else min 25 (fromIntegral q))- (S.elements $ V.stream rd) (S.elements $ V.stream ad)+ !efflength = (V.length rd - off) `min` V.length ad - -- match_reads :: u (Nucleotides, Qual) -> u (Nucleotides, Qual) -> Double- match_reads rd1 rd2 = SS.unId $ SS.foldl' (+) 0 $- SS.zipWith (\(!n1, Q !q1) (!n2, Q !q2) -> if n1 == compls n2 then 0 else fromIntegral $ min q1 q2)- (S.elements $ V.stream rd1) (S.elements $ V.streamR rd2)+foreign import ccall unsafe "prim_match_ad"+ prim_match_ad :: CInt -> CInt+ -> Ptr Nucleotides -> Ptr Qual+ -> Ptr Nucleotides -> IO CInt -mergeTrimBam :: Monad m => [U.Vector Nucleotides] -> [U.Vector Nucleotides] -> Enumeratee [BamRec] [BamRec] m a++-- | Computes overlap score for two reads (with qualities) assuming an+-- insert length.+{-# INLINE match_reads #-}+match_reads :: Int -> W.Vector Nucleotides -> W.Vector Qual -> W.Vector Nucleotides -> W.Vector Qual -> Int+match_reads !l !rd1 !qs1 !rd2 !qs2+ | V.length rd1 /= V.length qs1 || V.length rd2 /= V.length qs2 = error "read/qual length mismatch"+ | efflength <= 0 = 0+ | otherwise+ = fromIntegral . unsafePerformIO $+ W.unsafeWith rd1 $ \p_rd1 ->+ W.unsafeWith qs1 $ \p_qs1 ->+ W.unsafeWith rd2 $ \p_rd2 ->+ W.unsafeWith qs2 $ \p_qs2 ->+ prim_match_reads (fromIntegral minidx1)+ (fromIntegral maxidx2)+ (fromIntegral efflength)+ p_rd1 p_qs1 p_rd2 p_qs2+ where+ -- vec1, forward+ !minidx1 = (l - V.length rd2) `max` 0+ -- vec2, backward+ !maxidx2 = l `min` V.length rd2+ -- effective length+ !efflength = ((V.length rd1 + V.length rd2 - l) `min` l) `max` 0+++foreign import ccall unsafe "prim_match_reads"+ prim_match_reads :: CInt -> CInt -> CInt+ -> Ptr Nucleotides -> Ptr Qual+ -> Ptr Nucleotides -> Ptr Qual -> IO CInt+++{-# INLINE twoMins #-}+twoMins :: (Bounded a, Ord a) => a -> Int -> (Int -> a) -> (a,Int,a)+twoMins a0 imax f = go a0 0 maxBound 0 0+ where+ go !m1 !i1 !m2 !i2 !i+ | i == imax = (m1,i1,m2)+ | otherwise =+ case f i of+ x | x < m1 -> go x i m1 i1 (i+1)+ | x < m2 -> go m1 i1 x i (i+1)+ | otherwise -> go m1 i1 m2 i2 (i+1)+++mergeTrimBam :: Monad m => [W.Vector Nucleotides] -> [W.Vector Nucleotides] -> Enumeratee [BamRec] [BamRec] m a mergeTrimBam fwd_ads rev_ads = convStream go where go = do r1 <- headStream
− src/Bio/Genocall.hs
@@ -1,221 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-module Bio.Genocall where--import Bio.Adna-import Bio.Bam.Pileup-import Bio.Prelude-import Data.Aeson--import qualified Data.HashMap.Strict as H-import qualified Data.Set as Set-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U---- | Simple indel calling. We don't bother with it too much, so here's--- the gist: We collect variants (simply different variants, details--- don't matter), so \(n\) variants give rise to \((n+1)*n/2\) GL values.--- (That's two out of \((n+1)\), the reference allele, represented here as--- no deletion and no insertion, is there, too.) To assign these, we--- need a likelihood for an observed variant given an assumed genotype.------ For variants of equal length, the likelihood is the sum of qualities--- of mismatching bases, but no higher than the mapping quality. That--- is roughly the likelihood of getting the observed sequence even--- though the real sequence is a different variant. For variants of--- different length, the likelihood is the map quality. This--- corresponds to the assumption that indel errors in sequencing are--- much less likely than mapping errors. Since this is hardly our--- priority, the approximations are hereby declared good enough.--{-# INLINE simple_indel_call #-}-simple_indel_call :: (DmgToken -> Int -> Bool -> Mat44D) -> (IndelPile,IndelPile) -> (GL, [IndelVariant])-simple_indel_call get_dmg (varsF,varsR)- | length (varsF++varsR) <= 1 = ( U.empty, [] )- | otherwise = ( simple_call $ map (mkpls False) varsF ++ map (mkpls True) varsR, vars' )- where- vars' = IndelVariant (V_Nucs U.empty) (V_Nuc U.empty) :- (Set.toList . Set.fromList)- [ IndelVariant (V_Nucs $ U.fromList d)- (V_Nuc $ U.fromList $ map db_call i)- | (_q,(d,i)) <- varsF ++ varsR- , not (null d) || not (null i) ]-- match str = zipWith $ \(DB b q dt di _) n -> let p = get_dmg dt di str `bang` n :-> b- p' = fromQual q- in toProb $ p + p' - p * p'-- mkpls :: Bool -> (Qual, ([Nucleotides], [DamagedBase])) -> U.Vector Prob- mkpls str (q,(d,i)) = U.fromList [ qualToProb q +- if length d /= U.length dr || length i /= U.length ir- then 0 else product (match str i $ U.toList ir)- | IndelVariant (V_Nucs dr) (V_Nuc ir) <- vars' ]---- | A completely universal, completely empirical substituion model.--- We make no attempt to distinguish damage from error. The model is--- cloned so we don't need to constantly flip matrices depending on--- strand.-data SubstModel_ m = SubstModel- { left_substs_fwd :: {-# UNPACK #-} !(V.Vector m)- , middle_substs_fwd :: !m- , right_substs_fwd :: {-# UNPACK #-} !(V.Vector m)- , left_substs_rev :: {-# UNPACK #-} !(V.Vector m)- , middle_substs_rev :: !m- , right_substs_rev :: {-# UNPACK #-} !(V.Vector m) }- deriving (Show, Generic)--instance ToJSON m => ToJSON (SubstModel_ m)-instance FromJSON m => FromJSON (SubstModel_ m)--type SubstModel = SubstModel_ Mat44D---- | Mutable version of SubstModel, we'll probably have to accumulate in--- this thing.-type MSubstModel = SubstModel_ MMat44D--lookupSubstModel :: SubstModel_ a -> Int -> Bool -> a-lookupSubstModel m i False- | i >= 0 && i < V.length (left_substs_fwd m) = V.unsafeIndex (left_substs_fwd m) i- | i < 0 && (-i) <= V.length (right_substs_fwd m) = V.unsafeIndex (right_substs_fwd m) (-i-1)- | otherwise = middle_substs_fwd m-lookupSubstModel m i True- | i >= 0 && i < V.length (left_substs_rev m) = V.unsafeIndex (left_substs_rev m) i- | i < 0 && (-i) <= V.length (right_substs_rev m) = V.unsafeIndex (right_substs_rev m) (-i-1)- | otherwise = middle_substs_rev m---- Freezes a mutable substitution model into an immutable one. Both--- strands are combined, the result is normalized, and duplicated to--- have a model for each strand again.-freezeSubstModel :: MSubstModel -> IO SubstModel-freezeSubstModel mm = do- new_left <- V.zipWithM freezeMats (left_substs_fwd mm) (right_substs_rev mm)- new_middle <- freezeMats (middle_substs_fwd mm) (middle_substs_rev mm)- new_right <- V.zipWithM freezeMats (right_substs_fwd mm) (left_substs_rev mm)-- return $ SubstModel new_left new_middle new_right- ( V.map complMat new_left )- ( complMat new_middle )- ( V.map complMat new_right )--newtype SubstModels = SubstModels (HashMap Bytes SubstModel)- deriving (Show, Generic)--instance ToJSON SubstModels where- toJSON (SubstModels m) = Object $ H.fromList- [ ( decodeBytes k, toJSON v ) | (k,v) <- H.toList m ]--instance FromJSON SubstModels where- parseJSON = withObject "map of substitution models" $ \o ->- SubstModels . H.fromList <$> sequence- [ (,) (encodeBytes k) <$> parseJSON v | (k,v) <- H.toList o ]------- | Naive SNP call; essentially the GATK model. We compute the--- likelihood for each base from an empirical error/damage model, then--- hand over to 'simple_call'. Base quality is ignored, but map quality--- is incorporated.--{-# INLINE simple_snp_call #-}-simple_snp_call :: (DmgToken -> Int -> Bool -> Mat44D) -> (BasePile,BasePile) -> Snp_GLs-simple_snp_call get_dmg (varsF,varsR) = mk_snp_gls (simple_call $ map (mkpls False) varsF ++ map (mkpls True) varsR) ref- where- ref = case varsF ++ varsR of (_, DB _ _ _ _ r) : _ -> r ; _ -> nucsN- mkpls str (qq, DB b _ dt di _) = U.generate 4 $ \n ->- let x = get_dmg dt di str `bang` N (fromIntegral n) :-> b- in toProb $ x + fromQual qq * (1-x)---- | Compute @GL@ values for the simple case. The simple case is where--- we sample two alleles with equal probability and assume that errors--- occur independently from each other. This is specialized for a few--- common cases: two variants, because that's a typical indel; four--- variants, because that's every SNP.--{-# INLINE simple_call #-}-simple_call :: [U.Vector Prob] -> GL-simple_call [ ] = U.empty-simple_call (gl:gls) = case U.length gl of- 2 -> foldl' (U.zipWith (*)) (step2 gl) $ map step2 gls- where- step2 v = U.fromListN 3 [ x0, (x0+x1) / 2, x1 ]- where x0 = U.unsafeIndex v 0- x1 = U.unsafeIndex v 1-- 4 -> foldl' (U.zipWith (*)) (step4 gl) $ map step4 gls- where- step4 v = U.fromListN 10 [ x0- , (x0+x1)/2, x1- , (x0+x2)/2, (x1+x2)/2, x2- , (x0+x3)/2, (x1+x3)/2, (x2+x3)/2, x3 ]- where x0 = U.unsafeIndex v 0- x1 = U.unsafeIndex v 1- x2 = U.unsafeIndex v 2- x3 = U.unsafeIndex v 3-- _ -> foldl' (U.zipWith (*)) (step gl) $ map step gls- where- step !ls = U.concatMap (\i -> let hd = U.unsafeIndex ls i- ls' = U.unsafeTake (i+1) ls- in U.map (\x -> 0.5 * (hd + x)) ls'- ) (U.enumFromN 0 $ U.length ls)----- | Make a list of genotypes, each represented as a vector of allele--- probabilities, from four possible alleles.------ This makes the most sense for SNPs. The implied order of alleles is--- A,C,G,T, and the resulting genotype vectors can straight forwardly be--- mutiplied with a substitution matrix to give a sensible result.--- (Something similar for indels could be imagined, but doesn't seem all--- that useful. We specialize for SNPs to get simpler types and--- efficient code.)------ "For biallelic sites the ordering is: AA,AB,BB; for triallelic--- sites the ordering is: AA,AB,BB,AC,BC,CC, etc."--mk_snp_gts :: [Vec4D]-mk_snp_gts = [ Vec4D (0.5*(a+w)) (0.5*(b+x)) (0.5*(c+y)) (0.5*(d+z))- | as@(_:_) <- inits [ Vec4D 1 0 0 0, Vec4D 0 1 0 0, Vec4D 0 0 1 0, Vec4D 0 0 0 1 ]- , let Vec4D a b c d = last as- , Vec4D w x y z <- as ]---getRow :: Int -> Mat44D -> Vec4D-getRow i (Mat44D v) = Vec4D (v U.! (4*i)) (v U.! (4*i+1)) (v U.! (4*i+2)) (v U.! (4*i+3))--setRow :: Int -> Vec4D -> Mat44D -> Mat44D-setRow i (Vec4D a b c d) (Mat44D v) = Mat44D $ v U.// [ (4*i,a), (4*i+1,b), (4*i+2,c), (4*i+3,d) ]---type Calls = Pile' Snp_GLs (GL, [IndelVariant])---- | This pairs up GL values and the reference allele. When--- constructing it, we make sure the GL values are in the correct order--- if the reference allele is listed first.-data Snp_GLs = Snp_GLs { snp_gls :: !GL, snp_refbase :: !Nucleotides }- deriving Show--mk_snp_gls :: GL -> Nucleotides -> Snp_GLs-mk_snp_gls gl ref | U.length gl /= 10 = error "only diploid genomes are supported!"- | otherwise = Snp_GLs gl ref--data Vec4D = Vec4D {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double--vecNucs :: (Nucleotide -> Double) -> Vec4D-vecNucs f = Vec4D (f nucA) (f nucC) (f nucG) (f nucT)--vecSum :: Vec4D -> Double-vecSum (Vec4D a b c d) = a + b + c + d--dot :: Vec4D -> Vec4D -> Double-dot (Vec4D a b c d) (Vec4D w x y z) = a*w + b*x + c*y + d*z--multmv :: Mat44D -> Vec4D -> Vec4D-multmv m v = Vec4D (dot (getRow 0 m) v) (dot (getRow 1 m) v)- (dot (getRow 2 m) v) (dot (getRow 3 m) v)--vecZip :: (Double -> Double -> Double) -> Vec4D -> Vec4D -> Vec4D-vecZip f (Vec4D a b c d) (Vec4D w x y z) = Vec4D (f a w) (f b x) (f c y) (f d z)--vecZipNucs :: (Double -> Nucleotide -> Double) -> Vec4D -> Vec4D-vecZipNucs f (Vec4D a b c d) = Vec4D (f a nucA) (f b nucC) (f c nucG) (f d nucT)
− src/Bio/Genocall/Estimators.hs
@@ -1,264 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# OPTIONS_GHC -O0 #-}-module Bio.Genocall.Estimators (- tabulateSingle,- estimateSingle,- DivEst(..),- ExtModel(..),- DivTable(..),- good_regions- ) where--import Bio.Bam-import Bio.Bam.Pileup ( p_snp_pile )-import Bio.Genocall ( Snp_GLs(..), Calls, SubstModels )-import Bio.Prelude-import Bio.Util.AD-import Bio.Util.AD2-import Bio.Util.Numeric ( log1pexp )-import Data.Aeson-import Data.Binary-import Data.Vector.Binary ()--import qualified Data.Vector.Generic as V-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as M---data DivTable = DivTable !Double !(U.Vector Int) deriving (Show, Generic)--instance Binary DivTable--instance Monoid DivTable where- mempty = DivTable 0 U.empty-- DivTable a u `mappend` DivTable b v = DivTable (a+b) w- where w | U.null u = v- | U.null v = u- | otherwise = U.zipWith (+) u v---- | Divergence estimate. Lists contain three or four floats, these are--- divergence, heterozygosity at W sites, heterozygosity at S sites, and--- optionally gappiness in this order.-data DivEst = DivEst {- point_est :: [Double],- conf_region :: [( [Double], [Double] )]- } deriving (Show, Generic)--instance ToJSON DivEst-instance FromJSON DivEst--data ExtModel = ExtModel { population :: DivEst- , pop_separate :: Maybe DivEst- , damage :: SubstModels }- deriving (Show, Generic)--instance ToJSON ExtModel-instance FromJSON ExtModel---- XXX the optimizations fit only two or three parameters.--- Newton-Iteration should be more efficient than the generic CG method.------ For Newton-Iteration, the update is \(x := x + dt\) where--- \(dt = -\Nabla^2 f(x)^{-1} \Nabla f(x)\) or \(\Nabla^2 f(x) dt = -\Nabla f(x)\)--estimateSingle :: DivTable -> IO (DivEst, DivEst)-estimateSingle (DivTable _llk_rr tab) = do- (fit1, _res1, _stats1) <- minimize quietParameters 0.0000001 (llk tab) (U.fromList [0,0])- (fit2, _res2, _stats2) <- minimize quietParameters 0.0000001 (llk tab) (U.fromList [0,0,0])-- let xform v = map (\x -> recip $ 1 + exp (-x)) $ V.toList v- !de1 = DivEst (xform fit1) (map (xform *** xform) $ confidenceIntervals (llk2 tab) (V.convert fit1))- !de2 = DivEst (xform fit2) (map (xform *** xform) $ confidenceIntervals (llk2 tab) (V.convert fit2))-- return (de1,de2)--llk :: U.Vector Int -> [AD] -> AD-llk tab [delta,eta] = llk' tab 0 delta eta + llk' tab 6 delta eta-llk tab [delta,eta,eta2] = llk' tab 0 delta eta + llk' tab 6 delta eta2-llk _ _ = error "Wtf? (3)"--llk2 :: U.Vector Int -> [AD2] -> AD2-llk2 tab [delta,eta] = llk' tab 0 delta eta + llk' tab 6 delta eta-llk2 tab [delta,eta,eta2] = llk' tab 0 delta eta + llk' tab 6 delta eta2-llk2 _ _ = error "Wtf? (4)"--{-# INLINE llk' #-}-llk' :: (Ord a, Floating a) => U.Vector Int -> Int -> a -> a -> a-llk' tab base delta eta = block (base+0) g_RR g_RA g_AA- + block (base+1) g_RR g_AA g_RA- + block (base+2) g_RA g_RR g_AA- + block (base+3) g_RA g_AA g_RR- + block (base+4) g_AA g_RR g_RA- + block (base+5) g_AA g_RA g_RR- where- !maxD2 = U.length tab `div` 12- !maxD = round (sqrt (fromIntegral maxD2) :: Double)-- !g_AA = Pr delta / Pr (log1pexp delta)- !g_RA = 1 / Pr (log1pexp delta) * Pr eta / Pr (log1pexp eta)- !g_RR = 1 / Pr (log1pexp delta) * 1 / Pr (log1pexp eta)-- block ix g1 g2 g3 = U.ifoldl' step 0 $ U.slice (ix * maxD2) maxD2 tab- where- step !acc !i !num = acc - fromIntegral num * unPr p- where- (!d1,!d2) = i `quotRem` maxD- p = g1 + Pr (- fromIntegral d1) * g2 + Pr (- fromIntegral (d1+d2)) * g3----- | Parameter estimation for a single sample. The parameters are--- divergence and heterozygosity. We tabulate the data here and do the--- estimation afterwards. Returns the product of the--- parameter-independent parts of the likehoods and the histogram--- indexed by D and H (see @genotyping.pdf@ for details).-tabulateSingle :: MonadIO m => Iteratee [Calls] m DivTable-tabulateSingle = do- tab <- liftIO $ M.replicate (12 * maxD * maxD) (0 :: Int)- DivTable `liftM` foldStreamM (\acc -> accum tab acc . p_snp_pile) (0 :: Double)- `ap` liftIO (U.unsafeFreeze tab)- where- maxD = 64-- -- We need GL values for the invariant, the three homozygous variant- -- and the three single-event heterozygous variant cases. The- -- ordering is like in BCF, with the reference first.- -- Ref ~ A ==> PL ~ AA, AC, CC, AG, CG, GG, AT, CT, GT, TT- {-# INLINE accum #-}- accum !tab !acc !snp- | ref `elem` [nucsC,nucsG] = accum' 0 tab acc gls ref- | ref `elem` [nucsA,nucsT] = accum' 6 tab acc gls ref- | otherwise = return acc -- unknown reference- where- ref = snp_refbase snp- gls = snp_gls snp-- -- The simple 2D table didn't work, it lacked resolution in some- -- cases. We make six separate tables instead so we can store two- -- differences with good resolution in every case.- {-# INLINE accum' #-}- accum' !refix !tab !acc !gls !ref- | g_RR >= g_RA && g_RA >= g_AA = store 0 g_RR g_RA g_AA- | g_RR >= g_AA && g_AA >= g_RA = store 1 g_RR g_AA g_RA- | g_RA >= g_RR && g_RR >= g_AA = store 2 g_RA g_RR g_AA- | g_RA >= g_AA && g_AA >= g_RR = store 3 g_RA g_AA g_RR- | g_RR >= g_RA = store 4 g_AA g_RR g_RA- | otherwise = store 5 g_AA g_RA g_RR-- where- g_RR | ref == nucsT = unPr $ U.unsafeIndex gls 9- | ref == nucsG = unPr $ U.unsafeIndex gls 5- | ref == nucsC = unPr $ U.unsafeIndex gls 2- | otherwise = unPr $ U.unsafeIndex gls 0-- g_RA = unPr $ (U.unsafeIndex gls 1 + U.unsafeIndex gls 3 + U.unsafeIndex gls 6) / 3-- g_AA | ref == nucsT = unPr $ (U.unsafeIndex gls 0 + U.unsafeIndex gls 2 + U.unsafeIndex gls 5) / 3- | ref == nucsG = unPr $ (U.unsafeIndex gls 0 + U.unsafeIndex gls 2 + U.unsafeIndex gls 9) / 3- | ref == nucsC = unPr $ (U.unsafeIndex gls 0 + U.unsafeIndex gls 5 + U.unsafeIndex gls 9) / 3- | otherwise = unPr $ (U.unsafeIndex gls 2 + U.unsafeIndex gls 5 + U.unsafeIndex gls 9) / 3-- store !t !a !b !c = do let d1 = min (maxD-1) . round $ a - b- d2 = min (maxD-1) . round $ b - c- ix = (t + refix) * maxD * maxD + d1 * maxD + d2- liftIO $ M.read tab ix >>= M.write tab ix . succ- return $! acc + a---- | These are the longest contiguous mappable regions (chromosome,--- start position, length) on the autosomes taken from Heng Li's--- "filt35_50" until their cumulative length is greater than 10MB.--- We'll use them for parameter fitting without worrying about--- mappability.--good_regions :: [( Bytes, Int, Int )]-good_regions = [ ("9",137210024,50801), ("18",72958402,47124), ("3",126700279,40864), ("4",20244708,36976),- ("7",50443055,36829), ("2",172933866,35408), ("6",50781199,35328), ("4",111534379,34160), ("9",23816847,33889),- ("12",5601165,33717), ("5",134654381,32840), ("1",87790801,32108), ("12",54342242,31191), ("2",72016632,31107),- ("3",47025806,30522), ("8",140633542,30431), ("3",49678222,30361), ("22",23433574,30325), ("18",31218235,29907),- ("5",94195249,29776), ("14",22842926,29664), ("3",10955664,29450), ("11",2701423,29287), ("6",47822738,29094),- ("2",179421187,29001), ("1",2975248,28500), ("11",15625359,28497), ("16",65235334,28387), ("11",17606351,28374),- ("11",6627401,28349), ("14",101962136,28122), ("11",131331738,28031), ("3",35676569,27919), ("20",23007246,27904),- ("16",86516836,27686), ("8",143601826,27591), ("4",105402662,27565), ("22",19954339,27544), ("8",142668520,27397),- ("7",27127108,27336), ("3",135073061,27276), ("1",49175564,27118), ("6",93965080,27113), ("7",50707378,27090),- ("5",66378246,27041), ("18",76730933,26975), ("13",44578644,26722), ("12",65886788,26632), ("9",124513463,26507),- ("11",31654911,26355), ("10",130630869,26343), ("3",96522468,26316), ("5",71281187,26300), ("18",72601061,26219),- ("8",89116777,26217), ("8",77595904,26119), ("7",36636342,26036), ("2",72353320,25820), ("3",112988383,25762),- ("7",155239629,25756), ("1",2789639,25749), ("1",48213405,25681), ("4",136124313,25649), ("1",196271156,25641),- ("10",11191315,25583), ("2",206608755,25468), ("12",54410147,25352), ("2",12854107,25292), ("11",11581616,25288),- ("12",13700919,25192), ("8",142864620,25147), ("2",179465162,25139), ("9",14514334,25107), ("3",35717320,25063),- ("22",19729058,24923), ("9",109680443,24899), ("6",94115565,24860), ("8",93505503,24846), ("4",158790023,24704),- ("10",131751339,24684), ("1",181704049,24484), ("10",80682212,24465), ("3",169164284,24463), ("11",17511342,24437),- ("14",33968191,24411), ("1",53992234,24288), ("4",183056381,24222), ("2",71820551,24155), ("9",137265761,24075),- ("15",36124467,24063), ("14",46406527,24053), ("1",83210498,24021), ("6",108476739,23964), ("5",131587752,23956),- ("3",48615599,23886), ("6",55728531,23880), ("7",127697189,23869), ("12",50346181,23863), ("3",144228991,23831),- ("4",8265418,23682), ("2",45148758,23679), ("5",134540523,23644), ("5",134371610,23626), ("1",42036301,23604),- ("8",116656966,23590), ("9",96702236,23589), ("1",37307947,23570), ("1",210850735,23541), ("9",135459556,23527),- ("2",51135518,23503), ("11",45670249,23503), ("3",122993389,23483), ("14",56745421,23461), ("12",5898019,23455),- ("2",163037779,23446), ("11",69447933,23373), ("2",212035036,23357), ("6",96460435,23294), ("18",44764982,23243),- ("10",101278523,23242), ("5",160036671,23241), ("1",49124538,23176), ("7",18260998,23158), ("2",99167682,23147),- ("14",29232562,23127), ("15",97239853,23121), ("10",50494407,23089), ("15",70369320,23071), ("3",168827492,23039),- ("8",77761638,23015), ("15",38157092,22957), ("10",11365418,22949), ("3",105255227,22893), ("1",34814158,22881),- ("1",37392280,22867), ("11",71705177,22832), ("12",2418673,22823), ("1",72511401,22645), ("7",1265072,22602),- ("13",112699565,22576), ("20",57188413,22568), ("21",16420477,22503), ("3",129287740,22468), ("9",125868895,22467),- ("1",160050031,22456), ("12",48128061,22430), ("18",5282725,22418), ("13",67789099,22414), ("6",40287102,22408),- ("18",5880352,22384), ("8",143528138,22367), ("12",85676068,22365), ("8",84320057,22352), ("9",37321783,22293),- ("1",209775949,22272), ("3",18389755,22252), ("4",147944592,22243), ("8",133906982,22224), ("11",133329130,22217),- ("3",173313782,22215), ("5",11889097,22179), ("11",79649083,22174), ("5",132731240,22137), ("7",157466401,22137),- ("2",179634275,22116), ("11",43589949,22100), ("4",52766804,22099), ("12",3355258,22074), ("5",131397743,22070),- ("10",80291692,21987), ("9",14296528,21964), ("10",98269731,21962), ("3",16914253,21948), ("1",197561249,21908),- ("6",120906102,21884), ("2",193650467,21851), ("2",128384358,21847), ("3",48662757,21839), ("6",43733826,21830),- ("4",10215804,21821), ("22",46353587,21773), ("1",239171473,21764), ("12",54373478,21741), ("15",88509335,21732),- ("18",35145944,21709), ("15",95071676,21703), ("1",3220853,21688), ("1",82261961,21677), ("13",26246199,21672),- ("2",121320633,21663), ("5",95664126,21658), ("18",53770513,21624), ("5",108573486,21615), ("10",1762508,21612),- ("8",131982804,21550), ("12",59791869,21536), ("2",164194661,21524), ("11",64389512,21519), ("10",48420962,21516),- ("12",55408280,21514), ("14",33881612,21508), ("8",93616886,21507), ("3",134838560,21418), ("1",32215568,21396),- ("1",88245563,21394), ("5",163625223,21390), ("1",154971490,21367), ("1",2393882,21354), ("2",119583947,21343),- ("10",125760979,21336), ("12",1928169,21298), ("11",15787032,21257), ("1",160020996,21256), ("14",34162064,21249),- ("5",152857671,21234), ("10",132906774,21228), ("12",91441003,21228), ("1",168471368,21187), ("11",6660346,21183),- ("15",93125306,21146), ("2",159569436,21136), ("7",114286123,21134), ("3",55497586,21131), ("20",61147962,21120),- ("18",31314083,21087), ("5",87948855,21077), ("12",107266456,21071), ("1",112382584,21045), ("1",44871084,21041),- ("8",59833303,21037), ("20",12185890,21016), ("1",175835258,20982), ("11",132197740,20962), ("6",128317896,20960),- ("1",216882694,20949), ("11",61329536,20948), ("4",24007933,20895), ("7",42485962,20843), ("10",44446025,20828),- ("11",2153220,20823), ("3",52112801,20818), ("1",75232624,20802), ("1",81018216,20782), ("21",17158618,20749),- ("11",15830777,20738), ("20",11895285,20734), ("10",52998525,20713), ("5",93635203,20708), ("17",80003858,20685),- ("9",129968922,20683), ("6",70561018,20671), ("4",97130238,20662), ("8",135136261,20658), ("2",23903685,20632),- ("22",24548899,20628), ("9",7497211,20620), ("13",110428506,20601), ("15",48384378,20563), ("12",70712242,20555),- ("7",149504838,20520), ("1",42189196,20518), ("2",109987828,20491), ("3",18073619,20438), ("1",239875096,20430),- ("11",124937110,20416), ("5",11382753,20401), ("20",39447354,20400), ("14",105252979,20394), ("9",24026887,20386),- ("5",132623090,20381), ("8",65608184,20365), ("6",33743378,20351), ("2",151329557,20344), ("20",37892360,20340),- ("1",3367177,20331), ("5",122512407,20331), ("10",102974441,20331), ("13",112755319,20326), ("3",12992872,20315),- ("13",42170961,20306), ("10",80874296,20300), ("20",60444066,20292), ("2",73146343,20284), ("3",50190348,20284),- ("22",50340074,20277), ("1",77030540,20253), ("13",102679591,20222), ("10",81040310,20197), ("9",9211551,20188),- ("18",22738887,20181), ("3",44052705,20176), ("2",54880032,20166), ("5",37822780,20150), ("18",53007829,20135),- ("9",129187481,20128), ("6",144270559,20091), ("1",205403570,20090), ("4",44421876,20045), ("10",44861946,20023),- ("4",67049100,19998), ("7",32096011,19967), ("7",34131372,19967), ("1",110017253,19938), ("1",77080436,19922),- ("5",88010450,19920), ("7",15716479,19911), ("15",33826577,19904), ("9",126521960,19877), ("14",58022067,19853),- ("7",27160875,19845), ("4",90823485,19825), ("18",45240281,19818), ("1",3005635,19809), ("2",157007834,19789),- ("12",114832107,19789), ("6",45288303,19788), ("6",99074944,19783), ("11",2670228,19779), ("5",73567689,19774),- ("6",51224143,19774), ("5",102223202,19766), ("15",89899715,19750), ("4",104970277,19740), ("15",70349377,19722),- ("6",101837270,19718), ("4",96325943,19709), ("2",168098209,19708), ("21",39746588,19693), ("3",59949020,19686),- ("2",119358552,19681), ("2",67497291,19679), ("12",105117749,19661), ("3",180017017,19638), ("4",1793613,19638),- ("7",92453277,19635), ("20",16315532,19598), ("5",169493896,19574), ("3",18469949,19564), ("4",2061136,19548),- ("1",175528763,19535), ("15",87190931,19514), ("14",101991199,19498), ("9",9497024,19493), ("11",15896925,19493),- ("22",43629376,19444), ("11",64363871,19436), ("3",50399986,19433), ("1",244210029,19431), ("11",2591551,19424),- ("11",1239413,19417), ("9",116776003,19416), ("1",198338602,19414), ("7",8501937,19411), ("1",120452998,19403),- ("14",24722981,19395), ("15",39870070,19395), ("2",134164180,19386), ("11",109293469,19365), ("3",113929897,19362),- ("4",107835785,19338), ("17",32778941,19337), ("5",122424884,19327), ("13",105234793,19317), ("21",18170750,19309),- ("5",134719430,19301), ("14",56588948,19294), ("6",39449811,19289), ("7",116762432,19282), ("8",79510243,19281),- ("11",75301993,19266), ("3",89452118,19229), ("6",40123796,19208), ("1",181452626,19207), ("14",33860687,19197),- ("11",124731491,19188), ("8",62768789,19187), ("9",124458437,19180), ("9",4097024,19172), ("2",205522223,19160),- ("1",166027772,19156), ("10",130504847,19155), ("17",7306011,19144), ("10",23479527,19123), ("4",2245744,19117),- ("3",46901850,19109), ("3",139771287,19105), ("9",34548966,19104), ("8",110811609,19093), ("2",220339781,19077),- ("16",1811705,19062), ("7",155530076,19061), ("3",110181036,19060), ("2",127805324,19050), ("7",55182828,19047),- ("7",27223390,19039), ("1",51432006,19038), ("4",88753129,19035), ("15",63122126,19030), ("5",87837753,19018),- ("2",36665285,19015), ("18",35186913,18942), ("5",129172415,18940), ("15",68111506,18935), ("7",25440487,18925),- ("8",93889992,18924), ("17",56398946,18921), ("13",107170684,18912), ("13",102563238,18908), ("10",43743824,18896),- ("15",50211905,18888), ("10",72530467,18883), ("11",113271284,18878), ("12",81086307,18874), ("1",175352300,18867),- ("4",10071903,18866), ("14",89644782,18857), ("3",50419448,18855), ("11",93212299,18848), ("7",44268521,18838),- ("12",123458577,18812), ("5",61089957,18811), ("2",19554179,18803), ("7",132105968,18781), ("15",97129465,18776),- ("20",21492872,18766), ("2",149670253,18746), ("10",49649785,18737), ("10",125062922,18725), ("22",51154624,18693),- ("20",57815879,18683), ("2",76497569,18675), ("8",96701949,18673), ("1",87612820,18670), ("5",158974585,18664),- ("13",58980956,18664), ("2",156229090,18654), ("5",159334986,18638), ("14",101316928,18631), ("3",42692075,18627),- ("7",55163429,18609), ("17",63881123,18590), ("9",73721557,18579), ("1",177235920,18568), ("3",10800230,18565),- ("2",66495731,18555), ("2",6162803,18553), ("6",102243030,18543), ("5",160945102,18539), ("7",94527596,18539),- ("11",128360895,18538), ("5",113693991,18537), ("3",127979662,18534) ]
src/Bio/Iteratee/ZLib.hsc view
@@ -717,6 +717,7 @@ case magic of (Just 0x1f, Just 0x8b) -> enumInflate GZip defaultDecompressParams it+ >>= enumInflateAny _ -> mapChunks id it enumSyncFlush :: Monad m => Enumerator ByteString m a
src/Bio/Prelude.hs view
@@ -2,6 +2,7 @@ module Bio.Prelude ( module Bio.Base, module BasePrelude,+ module System.IO, module System.Posix.Files, module System.Posix.IO, module System.Posix.Types,@@ -33,14 +34,9 @@ Hashable(..), Unpack(..),- hPutStr,- hPutStrLn, fdPut, fdPutLazy,- withFd,- stderr,- stdout,- stdin+ withFd ) where import BasePrelude@@ -68,7 +64,7 @@ import Data.Text.Encoding ( encodeUtf8, decodeUtf8With ) import Foreign.C.Error ( throwErrnoIf_ ) import Foreign.Ptr ( castPtr )-import System.IO ( hPutStr, hPutStrLn, stderr, stdout, stdin )+import System.IO ( hPrint, hPutStr, hPutStrLn, stderr, stdout, stdin ) import System.Posix.Files import System.Posix.IO import System.Posix.Types
− src/Bio/Util/AD.hs
@@ -1,137 +0,0 @@-module Bio.Util.AD- ( AD(..), paramVector, minimize- , module Numeric.Optimization.Algorithms.HagerZhang05- , debugParameters, quietParameters- , IsDouble(..)- ) where--import Numeric.Optimization.Algorithms.HagerZhang05-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Storable as V-import Prelude---- | Simple forward-mode AD to get a scalar valued function with gradient.-data AD = C !Double | D !Double !(U.Vector Double) deriving Show--instance Eq AD where- C x == C y = x == y- C x == D y _ = x == y- D x _ == C y = x == y- D x _ == D y _ = x == y--instance Ord AD where- C x `compare` C y = x `compare` y- C x `compare` D y _ = x `compare` y- D x _ `compare` C y = x `compare` y- D x _ `compare` D y _ = x `compare` y--instance Num AD where- {-# INLINE (+) #-}- C x + C y = C (x+y)- C x + D y v = D (x+y) v- D x u + C y = D (x+y) u- D x u + D y v = D (x+y) (U.zipWith (+) u v)-- {-# INLINE (-) #-}- C x - C y = C (x-y)- C x - D y v = D (x-y) (U.map negate v)- D x u - C y = D (x-y) u- D x u - D y v = D (x-y) (U.zipWith (-) u v)-- {-# INLINE (*) #-}- C x * C y = C (x*y)- C x * D y v = D (x*y) (U.map (x*) v)- D x u * C y = D (x*y) (U.map (y*) u)- D x u * D y v = D (x*y) (U.zipWith (+) (U.map (x*) v) (U.map (y*) u))-- {-# INLINE negate #-}- negate (C x) = C (negate x)- negate (D x u) = D (negate x) (U.map negate u)-- {-# INLINE fromInteger #-}- fromInteger = C . fromInteger-- {-# INLINE abs #-}- abs (C x) = C (abs x)- abs (D x u) | x < 0 = D (negate x) (U.map negate u)- | otherwise = D x u-- {-# INLINE signum #-}- signum (C x) = C (signum x)- signum (D x _) = C (signum x)---instance Fractional AD where- {-# INLINE (/) #-}- C x / C y = C (x/y)- D x u / C y = D (x*z) (U.map (z*) u) where z = recip y- C x / D y v = D (x/y) (U.map (w*) v) where w = negate $ x * z * z ; z = recip y- D x u / D y v = D (x/y) (U.zipWith (-) (U.map (z*) u) (U.map (w*) v))- where z = recip y ; w = x * z * z-- {-# INLINE recip #-}- recip = liftF recip (\x -> - recip (x*x))-- {-# INLINE fromRational #-}- fromRational = C . fromRational---instance Floating AD where- {-# INLINE pi #-}- pi = C pi-- {-# INLINE exp #-}- exp = liftF exp exp-- {-# INLINE sqrt #-}- sqrt = liftF sqrt $ \x -> recip (2 * sqrt x)-- {-# INLINE log #-}- log = liftF log recip-- sin = liftF sin cos- cos = liftF cos (negate . sin)- sinh = liftF sinh cosh- cosh = liftF cosh sinh-- tan = liftF tan $ \x -> recip (cos x * cos x)- tanh = liftF tanh $ \x -> recip (cosh x * cosh x)- asin = liftF asin $ \x -> recip (sqrt (1 - x * x))- acos = liftF acos $ \x -> - recip (sqrt (1 - x * x))- atan = liftF atan $ \x -> recip (1 + x * x)- asinh = liftF asinh $ \x -> recip (sqrt (x * x + 1))- acosh = liftF acosh $ \x -> - recip (sqrt (x * x - 1))- atanh = liftF atanh $ \x -> recip (1 - x * x)---{-# INLINE liftF #-}-liftF :: (Double -> Double) -> (Double -> Double) -> AD -> AD-liftF f _ (C x) = C (f x)-liftF f g (D x u) = D (f x) (U.map (* g x) u)--{-# INLINE paramVector #-}-paramVector :: [Double] -> [AD]-paramVector xs = [ D x (U.generate l (\j -> if i == j then 1 else 0)) | (i,x) <- zip [0..] xs ]- where l = length xs--{-# INLINE minimize #-}-minimize :: Parameters -> Double -> ([AD] -> AD) -> U.Vector Double -> IO (V.Vector Double, Result, Statistics)-minimize params eps func v0 =- optimize params eps v0 (VFunction $ fst . combofn)- (VGradient $ snd . combofn)- (Just . VCombined $ combofn)- where- combofn parms = case func $ paramVector $ U.toList parms of- D x g -> ( x, g )- C x -> ( x, U.replicate (U.length parms) 0 )---quietParameters :: Parameters-quietParameters = defaultParameters { printFinal = False, verbose = Quiet, maxItersFac = 123 }--debugParameters :: Parameters-debugParameters = defaultParameters { verbose = Verbose }--class IsDouble a where fromDouble :: Double -> a-instance IsDouble Double where fromDouble = id-instance IsDouble AD where fromDouble = C
− src/Bio/Util/AD2.hs
@@ -1,150 +0,0 @@-module Bio.Util.AD2 ( AD2(..), paramVector2, IsDouble(..), confidenceIntervals ) where--import Bio.Util.AD ( IsDouble(..) )-import Bio.Util.Jacobi-import Prelude--import qualified Data.Vector.Unboxed as U---- | Simple forward-mode AD to get a scalar valued function--- with gradient and Hessian.-data AD2 = C2 !Double | D2 !Double !(U.Vector Double) !(U.Vector Double)--instance IsDouble AD2 where fromDouble = C2--instance Show AD2 where- show (C2 x) = show x- show (D2 x y z) = show x ++ " " ++ show (U.toList y) ++ " "- ++ show [ U.toList (U.slice i d z) | i <- [0, d .. d*d-1] ]- where d = U.length y--instance Eq AD2 where- C2 x == C2 y = x == y- C2 x == D2 y _ _ = x == y- D2 x _ _ == C2 y = x == y- D2 x _ _ == D2 y _ _ = x == y--instance Ord AD2 where- C2 x `compare` C2 y = x `compare` y- C2 x `compare` D2 y _ _ = x `compare` y- D2 x _ _ `compare` C2 y = x `compare` y- D2 x _ _ `compare` D2 y _ _ = x `compare` y--instance Num AD2 where- {-# INLINE (+) #-}- C2 x + C2 y = C2 (x+y)- C2 x + D2 y v h = D2 (x+y) v h- D2 x u g + C2 y = D2 (x+y) u g- D2 x u g + D2 y v h = D2 (x+y) (U.zipWith (+) u v) (U.zipWith (+) g h)-- {-# INLINE (-) #-}- C2 x - C2 y = C2 (x-y)- C2 x - D2 y v h = D2 (x-y) (U.map negate v) (U.map negate h)- D2 x u g - C2 y = D2 (x-y) u g- D2 x u g - D2 y v h = D2 (x-y) (U.zipWith (-) u v) (U.zipWith (-) g h)-- {-# INLINE (*) #-}- C2 x * C2 y = C2 (x*y)- C2 x * D2 y v h = D2 (x*y) (U.map (x*) v) (U.map (x*) h)- D2 x u g * C2 y = D2 (x*y) (U.map (y*) u) (U.map (y*) g)- D2 x u g * D2 y v h = D2 (x*y) grad hess- where grad = U.zipWith (+) (U.map (x*) v) (U.map (y*) u)- hess = U.zipWith (+)- (U.zipWith (+) (U.map (x*) h) (U.map (y*) g))- (U.zipWith (+) (cross u v) (cross v u))-- {-# INLINE negate #-}- negate (C2 x) = C2 (negate x)- negate (D2 x u g) = D2 (negate x) (U.map negate u) (U.map negate g)-- {-# INLINE fromInteger #-}- fromInteger = C2 . fromInteger-- {-# INLINE abs #-}- abs (C2 x) = C2 (abs x)- abs (D2 x u g) | x < 0 = D2 (negate x) (U.map negate u) (U.map negate g)- | otherwise = D2 x u g-- {-# INLINE signum #-}- signum (C2 x) = C2 (signum x)- signum (D2 x _ _) = C2 (signum x)---instance Fractional AD2 where- {-# INLINE (/) #-}- C2 x / C2 y = C2 (x/y)- D2 x u g / C2 y = D2 (x*z) (U.map (z*) u) (U.map (z*) g) where z = recip y- x / y = x * recip y-- {-# INLINE recip #-}- recip = liftF recip (\x -> - recip (sqr x)) (\x -> 2 * recip (cube x))-- {-# INLINE fromRational #-}- fromRational = C2 . fromRational--instance Floating AD2 where- {-# INLINE pi #-}- pi = C2 pi-- {-# INLINE exp #-}- exp = liftF exp exp exp-- {-# INLINE sqrt #-}- sqrt = liftF sqrt (\x -> recip $ 2 * sqrt x) (\x -> - recip (sqrt (cube x)))-- {-# INLINE log #-}- log = liftF log recip (\x -> - recip (sqr x))-- sin = liftF sin cos (negate . sin)- cos = liftF cos (negate . sin) (negate . cos)- sinh = liftF sinh cosh sinh- cosh = liftF cosh sinh cosh-- tan = liftF tan (\x -> recip (sqr (cos x))) (\x -> 2 * tan x / sqr (cos x))- tanh = liftF tanh (\x -> recip (sqr (cosh x))) (\x -> -2 * tanh x / sqr (cosh x))-- asin = liftF asin (\x -> recip (sqrt (1 - sqr x))) (\x -> x / sqrt (cube (1 - sqr x)))- acos = liftF acos (\x -> - recip (sqrt (1 - sqr x))) (\x -> -x / sqrt (cube (1 - sqr x)))- asinh = liftF asinh (\x -> recip (sqrt (sqr x + 1))) (\x -> -x / sqrt (cube (sqr x + 1)))- acosh = liftF acosh (\x -> - recip (sqrt (sqr x - 1))) (\x -> x / sqrt (cube (sqr x - 1)))- atan = liftF atan (\x -> recip (1 + sqr x)) (\x -> -2 * x / sqr (1 + sqr x))- atanh = liftF atanh (\x -> recip (1 - sqr x)) (\x -> 2 * x / sqr (1 - sqr x))--{-# INLINE sqr #-}-sqr :: Double -> Double-sqr x = x * x--{-# INLINE cube #-}-cube :: Double -> Double-cube x = x * x * x--{-# INLINE liftF #-}-liftF :: (Double -> Double) -> (Double -> Double) -> (Double -> Double) -> AD2 -> AD2-liftF f _ _ (C2 x) = C2 (f x)-liftF f f' f'' (D2 x v g) = D2 (f x) (U.map (* f' x) v) hess- where- hess = U.zipWith (+) (U.map (* f' x) g) (U.map (* f'' x) (cross v v))--{-# INLINE cross #-}-cross :: U.Vector Double -> U.Vector Double -> U.Vector Double-cross u v = U.concatMap (\dy -> U.map (dy*) u) v--{-# INLINE paramVector2 #-}-paramVector2 :: [Double] -> [AD2]-paramVector2 xs = [ D2 x (U.generate l (\j -> if i == j then 1 else 0)) nil- | (i,x) <- zip [0..] xs ]- where l = length xs ; nil = U.replicate (l*l) 0---- | Confidence region: PCA on Hessian matrix, then for each--- eigenvalue λ add/subtract 1.96 / sqrt λ times the corresponding--- eigenvalue to the estimate. Should describe a nice spheroid.-confidenceIntervals :: ([AD2] -> AD2) -> U.Vector Double -> [(U.Vector Double, U.Vector Double)]-confidenceIntervals fun fit = intervs- where- D2 _val _grd hss = fun (paramVector2 $ U.toList fit)- (evals, evecs) = eigenS hss- intervs = [ ( U.zipWith (\a b -> a + lam * b) fit evec- , U.zipWith (\a b -> a - lam * b) fit evec )- | (eval, evec) <- zip (U.toList evals) evecs- , let lam = 1.96 / sqrt eval ]-
− src/Bio/Util/Jacobi.hs
@@ -1,89 +0,0 @@--- | Jacobi algorithm for Eigen decomposition of symmetric matrices.--module Bio.Util.Jacobi ( eigenS ) where--import Bio.Prelude--import qualified Data.Vector.Unboxed as U ( Vector, thaw, unsafeFreeze, fromListN, slice )-import qualified Data.Vector.Unboxed.Mutable as U ( read, write, MVector, length, replicate )--type Matrix = U.Vector Double-type Vector = U.Vector Double--type MMatrix s = U.MVector s Double----- | Decomposes a symmetric matrix into a vector of eigenvalues and a--- vector of eigenvectors.--eigenS :: Matrix -> ( Vector, [Vector] )-eigenS mat = runST (do- m <- U.thaw mat- let n = round (sqrt (fromIntegral (U.length m) :: Double))-- v <- U.replicate (n*n) 0- forM_ [0..n-1] $ \i -> U.write v (n*i+i) 1-- let j_iter !rd = do- sm <- sum . map abs <$> sequence- [ U.read m (p*n+q) | p <- [1..n-2], q <- [p+1..n-1] ]- case () of- _ | sm == 0 -> return () -- normal exit: convergence to machine precision- | rd == 50 -> return () -- 50 iters, weird, but IDGAF.- | otherwise -> do- let thresh = if rd < 3 then 0.2 * sm / fromIntegral (n*n) else 0- forM_ [1..n-1] $ \k ->- forM_ [0..k-1] $ \l ->- jacobi_rot n thresh (l,k) m v- j_iter (rd+1)- j_iter (0::Int)-- d <- U.fromListN n <$> forM [0..n-1] (\i -> U.read m (n*i+i))- v' <- U.unsafeFreeze v- return (d, [ U.slice i n v' | i <- [0,n..n*n-1] ]))----- | Performs one Jacobi rotation at @(p,q)@. We operate on the upper--- triangle, so at all times @p<q@. Algorithm inspired by "Numerical--- Recipes in C: The Art of Scientific Computing" (ISBN 0-521-43108-6)-jacobi_rot :: Int -> Double -> (Int,Int) -> MMatrix s -> MMatrix s -> ST s ()-jacobi_rot n thresh (p,q) m v = do- a_pp <- U.read m (p*n+p)- a_pq <- U.read m (p*n+q)- a_qq <- U.read m (q*n+q)- let g = 100 * abs a_pq-- case () of- _ | abs a_pq <= thresh -> return ()- | abs a_pp + g == abs a_pp &&- abs a_qq + g == abs a_qq -> U.write v (p*n+q) 0- | otherwise -> do- let theta = 0.5 * (a_qq-a_pp) / a_pq- t = if theta*theta + 1 == theta*theta- then recip $ 2 * theta -- approx for overflow case- else signum theta / ( abs theta + sqrt ( theta*theta +1 ) )- c = recip $ sqrt $ t*t + 1- s = c*t- tau = s / (1+c)-- forM_ [0..n-1] $ \r -> do- when (r/=p && r/=q) $ do- a_rp <- U.read m $ min (r*n+p) (p*n+r)- a_rq <- U.read m $ min (r*n+q) (q*n+r)-- let a_rp' = a_rp - s * (a_rq + tau * a_rp)- a_rq' = a_rq + s * (a_rp - tau * a_rq)-- U.write m (min (r*n+p) (p*n+r)) a_rp'- U.write m (min (r*n+q) (q*n+r)) a_rq'-- v_rp <- U.read v (p*n+r)- v_rq <- U.read v (q*n+r)-- U.write v (p*n+r) $ v_rp - s * (v_rq + tau * v_rp)- U.write v (q*n+r) $ v_rq + s * (v_rp - tau * v_rq)-- U.write m (p*n+q) 0- U.write m (p*n+p) $ a_pp - t * a_pq- U.write m (q*n+q) $ a_qq + t * a_pq-
− src/cbits/jive.c
@@ -1,93 +0,0 @@-/** Computes likelihoods for each pair of indices, given matching- * probabilities for each and a matrix of prior probabilities. Return- * the index pair that yields the maximum likelihood and the total- * likelihood. (The length of p5_ must be a multiple of 32 to make- * vectorization easier.)- *- * @param v_ matrix of dimension (n7,n5_*32) containing the prior- * @param p7_ vector of length n7 containing matching probabilities for- * the first index- * @param n7 length of vector p7_- * @param p5_ vector of length (n5_*32) containing matching- * probabilities for the second index- * @param n5 length of vector p5_ divided by 32- * @param pi7 pointer to location that receives index of the first index- * that yields the maximum likelihood (ignored if null)- * @param pi5 pointer to location that receives index of the second index- * that yields the maximum likelihood (ignored if null)- * @return the total likelihood- */-double c_unmix_total( const double *restrict v_- , const double *restrict p7_, unsigned n7- , const double *restrict p5_, unsigned n5_- , unsigned *pi7, unsigned *pi5 )-{- unsigned n5 = n5_ * 32 ;- const double *restrict v = v_ ; // __builtin_assume_aligned( v_, 16 ) ;- const double *restrict p5 = p5_ ; // __builtin_assume_aligned( p5_, 16 ) ;- const double *restrict p7 = p7_ ; // __builtin_assume_aligned( p7_, 16 ) ;-- double acc = 0 ;- double max = 0 ;- unsigned mi7 = 0 ;- unsigned mi5 = 0 ;- for( unsigned i = 0, k = 0 ; i != n7 ; ++i, k += n5 ) {- double p7i = p7[i] ;- for( unsigned j = 0 ; j != n5 ; ++j ) {- double p = v[k+j] * p7i * p5[j] ;- acc += p ;- if( p > max ) {- max = p ;- mi7 = i ;- mi5 = j ;- }- }- }- if( pi7 ) *pi7 = mi7 ;- if( pi5 ) *pi5 = mi5 ;- return acc ;-}--/** Computes posterior probabilities for each pair of indices, given- * matching probabilities for each and a matrix of prior probabilities,- * the total likelihood and the index pair that yields the maximum- * likelihood. The posterior is added to an accumulator, and a quality- * score is returned. (The length of p5_ must be a multiple of 32 to- * make vectorization easier.)- *- * @param w_ matrix of dimension (n7,n5_*32) to which the posterior is added (ignored if null)- * @param v_ matrix of dimension (n7,n5_*32) containing the prior- * @param p7_ vector of length n7 containing matching probabilities for the first index- * @param n7 length of vector p7_- * @param p5_ vector of length (n5_*32) containing matching probabilities for the second index- * @param n5 length of vector p5_ divided by 32- * @param total the total likelihood- * @param mi7 index of the first index that yields the maximum likelihood- * @param mi5 index of the second index that yields the maximum likelihood- * @return the posterior probability for any other than the most likely assignment- */-double c_unmix_qual( double *restrict w_- , const double *restrict v_- , const double *restrict p7_, unsigned n7- , const double *restrict p5_, unsigned n5_- , double total, unsigned mi7, unsigned mi5 )-{- unsigned n5 = n5_ * 32 ;- double *restrict w = w_ ; // __builtin_assume_aligned( w_, 16 ) ;- const double *restrict v = v_ ; // __builtin_assume_aligned( v_, 16 ) ;- const double *restrict p5 = p5_ ; // __builtin_assume_aligned( p5_, 16 ) ;- const double *restrict p7 = p7_ ; // __builtin_assume_aligned( p7_, 16 ) ;- double acc = 0 ;-- total = 1.0 / total ;- for( unsigned i = 0, k = 0 ; i != n7 ; ++i ) {- double p7i = p7[i] ;- for( unsigned j = 0 ; j != n5 ; ++j, ++k ) {- double p = total * v[k] * p7i * p5[j] ;- if( w ) w[k] += p ;- if( mi7 != i || mi5 != j ) acc += p ;- }- }- return acc ;-}-
+ src/cbits/trim.c view
@@ -0,0 +1,46 @@+#include <stdint.h>++static const uint8_t compls[] =+ { 0, 8, 4, 12, 2, 10, 6, 14, 1, 9, 5, 13, 3, 11, 7, 15 } ;++int prim_match_reads( int i1+ , int i2+ , int r+ , const uint8_t *rd1+ , const uint8_t *qs1+ , const uint8_t *rd2+ , const uint8_t *qs2 )+{+ int acc = 0 ;+ while( r != 0 )+ {+ --i2 ;+ uint8_t n1 = rd1[ i1 ] ;+ uint8_t n2 = rd2[ i2 ] ;+ uint8_t q1 = qs1[ i1 ] ;+ uint8_t q2 = qs2[ i2 ] ;++ acc += (n1 & 0xF) == compls[ n2 & 0xF ] ? 0 : 5 + (q1 < q2 ? q1 : q2) ;++ ++i1 ;+ --r ;+ }+ return acc ;+}++int prim_match_ad( int off+ , int i+ , const uint8_t *rd+ , const uint8_t *qs+ , const uint8_t *ad )+{+ int acc = 0 ;+ while( i > 0 )+ {+ --i;+ acc += rd[ i+off ] == ad[ i ] ? 0 : 5 ++ (qs[ i+off ] < 25 ? qs[ i+off ] : 25) ;+ }+ return acc ;+}+
− tests/test-pileup.hs
@@ -1,12 +0,0 @@-import Bio.Bam-import Bio.Bam.Pileup-import Bio.Prelude--main :: IO ()-main = do- bams <- getArgs- mergeInputs combineCoordinates bams >=> run $ \_ ->- takeWhileE (isValidRefseq . b_rname . unpackBam) =$- concatMapStream (decompose $ DmgToken 0) =$- pileup =$- skipToEof
− tools/Align.hs
@@ -1,307 +0,0 @@-module Align where--import Bio.Bam-import Bio.Prelude-import Data.Sequence ( (<|), (><), ViewL((:<)) )--import qualified Data.Foldable as F-import qualified Data.Sequence as Z-import qualified Data.Vector.Generic as V-import qualified Data.Vector.Storable as S-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as UM--data Base = A | C | G | T | None- deriving (Eq, Ord, Enum, Show)---- | For a reference sequence, we store five(!) probabilities for each--- base in phred format. The fifth is the probability of a gap.--newtype RefSeq = RS (U.Vector Word8) deriving Show--refseq_len :: RefSeq -> Int-refseq_len (RS v) = U.length v `div` 5--prob_of :: Base -> Int -> RefSeq -> Word8-prob_of b i (RS v) = indexV "prob_of" v ( 5*i + fromEnum b )---- | Turns a sequence into probabilities. @Right n@ is an ordinary--- 'Nucleotide', @Left n@ is one we think might be absent (e.g. because--- it was soft masked in the input).-prep_reference :: [Either Nucleotides Nucleotides] -> RefSeq-prep_reference = RS . U.concat . map (either (to probG) (to probB))- where- to ps n = U.slice (5 * fromIntegral (unNs n)) 5 ps-- -- XXX we should probably add some noise here, so the placement of- -- gaps isn't completely random, but merely unpredictable- probB = U.fromListN 80 $ concatMap (\l -> l ++ [255]) raw_probs- probG = U.fromListN 80 $ concatMap (\l -> map (+3) l ++ [3]) raw_probs-- raw_probs = [[ 25, 25, 25, 25 ] -- 0- ,[ 0, 25, 25, 25 ] -- A- ,[ 25, 0, 25, 25 ] -- C- ,[ 3, 3, 25, 25 ] -- M- ,[ 25, 25, 0, 25 ] -- G- ,[ 3, 25, 3, 25 ] -- R- ,[ 25, 3, 3, 25 ] -- S- ,[ 5, 5, 5, 25 ] -- V- ,[ 25, 25, 25, 0 ] -- T- ,[ 3, 25, 25, 3 ] -- W- ,[ 25, 3, 25, 3 ] -- Y- ,[ 5, 5, 25, 5 ] -- H- ,[ 25, 25, 3, 3 ] -- K- ,[ 5, 25, 5, 5 ] -- D- ,[ 25, 5, 5, 5 ] -- B- ,[ 6, 6, 6, 6 ]] -- N---- | Encoding of the query: one word per position, the two lowest bits--- encode the base, the rest is the quality score (shifted left by 2).-newtype QuerySeq = QS { unQS :: U.Vector Word8 } deriving Show---- | Prepare query for subsequent alignment to the forward strand.-prep_query_fwd :: BamRec -> QuerySeq-prep_query_fwd BamRec{..} = QS $ U.fromListN len $ zipWith pair (V.toList b_seq) (V.toList b_qual)- where- pair b (Q q) = q `shiftL` 2 .|. indexV "prep_query_fwd" code (fromIntegral $ unNs b)- code = U.fromListN 16 [0,0,1,0,2,0,0,0,3,0,0,0,0,0,0,0]- len = V.length b_seq--prep_query_rev :: BamRec -> QuerySeq-prep_query_rev = revcompl_query . prep_query_fwd- where- revcompl_query (QS v) = QS $ U.map (xor 3) $ U.reverse v--qseqToBamSeq :: QuerySeq -> Vector_Nucs_half Nucleotides-qseqToBamSeq = V.fromList . U.toList . U.map (\x -> Ns $ 1 `shiftL` fromIntegral (x .&. 3)) . unQS--qseqToBamQual :: QuerySeq -> S.Vector Qual-qseqToBamQual = S.convert . U.map (Q . (`shiftR` 2)) . unQS---- | Memoization matrix for dynamic programming. We understand it as a--- matrix B columns wide and L rows deep, where B is the bandwidth and L--- the query length. Successive rows are understood to be skewed to the--- right. (This means all operations need the bandwidth as an--- argument.)--newtype MemoMat = MemoMat (U.Vector Float) deriving Show-newtype Bandwidth = BW Int deriving Show-newtype RefPosn = RP Int deriving Show--data AlignResult = AlignResult- { viterbi_forward :: MemoMat -- DP matrix from running Viterbi- , viterbi_score :: Float -- alignment score (log scale, vs. radom alignment)- , viterbi_position :: Int -- position (start of the most probable alignment)- , viterbi_backtrace :: S.Vector Cigar } -- backtrace (most probable alignment)- deriving Show--data Traced = Tr { tr_op :: CigOp, tr_score :: Float }--instance Eq Traced where Tr _ a == Tr _ b = a == b-instance Ord Traced where Tr _ a `compare` Tr _ b = a `compare` b---- | All sorts of alignment shit collected in one place, mostly so I can--- reuse the scoring functions.-align :: Float -> RefSeq -> QuerySeq -> RefPosn -> Bandwidth -> AlignResult-align gp (RS rs) (QS qs) (RP p0) (BW bw_) = runST (do- let bw = abs bw_- v <- UM.unsafeNew $ bw * U.length qs + bw-- let readV row col | row < 0 || col < 0 || col >= bw || row > U.length qs = error $ "Read from memo: " ++ show (row,col)- | ix < 0 || ix >= UM.length v = error $ "Read from memo: " ++ show ix- | otherwise = UM.read v ix- where ix = bw*row + col-- let score qpos _ | qpos < 0 || qpos >= U.length qs = error $ "Read from QS: " ++ show qpos- score qpos rpos = let base = (indexV "align/score/base" qs qpos) .&. 3 :: Word8- qual = (indexV "align/score/qual" qs qpos) `shiftR` 2 :: Word8- prob = let ix = 5*rpos + fromIntegral base in- if ix < 0 then error ("Huh? " ++ show ix) else- if ix < U.length rs then indexV "align/score/prob/A" rs ix else- if ix - U.length rs < U.length rs then indexV "align/score/prob/B" rs (ix - U.length rs) :: Word8 else- error ("Huh? " ++ show (ix,qpos,rpos,p0,base))-- -- Improbability of a mismatch, it's the- -- probability of the reference not being- -- correct or the query not being correct,- -- whichever is higher.- mismatch = fromIntegral (min qual prob)-- -- Improbability of a random match. It's- -- 6 if we have a good base, corresponding- -- to randomness. If we have a bad base,- -- it's lower, because we aren't doing- -- better than random.- randmatch = fromIntegral (min qual 6)-- -- Score is our mismatch probability vs.- -- random sequences. Note that this ends- -- up being 0 for low quality bases, -6- -- for high quality matches, and 30+ for- -- high quality mismatches.- in mismatch - randmatch-- let gscore rpos = let prob = let ix = 5*rpos + 4 in- if ix < 0 then error ("Huh? " ++ show ix) else- if ix < U.length rs then indexV "align/gscore/prob/A" rs ix else- if ix - U.length rs < U.length rs then indexV "align/gscore/prob/B" rs (ix - U.length rs) :: Word8 else- error ("Huh? " ++ show (ix,rpos,p0))- in min gp $ fromIntegral prob-- let match row col = Tr Mat . (+ score (row-1) (p0+row+col-1)) <$> readV (row-1) (col+0)- let gapH row col = Tr Del . (+ gscore (p0+row+col-1)) <$> readV (row+0) (col-1)- let gapV row col = Tr Ins . (+ gp) <$> readV (row-1) (col+1)-- let cell row col = do x <- if row == 0 then return (Tr Nop 0) else match row col- y <- if col == 0 then return x else min x <$> gapH row col- z <- if row == 0 || col == bw-1 then return y else min y <$> gapV row col- return z-- -- Fill the DP matrix. XXX: there's got to be way to express this- -- using 'Vector's bulk operations. Would that be more readable?- -- Faster?- forM_ [0 .. U.length qs] $ \row ->- forM_ [0 .. bw-1] $ \col ->- UM.write v (bw*row + col) . tr_score =<< cell row col-- let pack_cigar = S.fromList . map (\x -> head x :* length x) . group- let traceback acc row col = do op <- tr_op <$> cell row col- case op of Mat -> traceback (Mat:acc) (row-1) (col+0)- Ins -> traceback (Ins:acc) (row-1) (col+1)- Del -> traceback (Del:acc) (row+0) (col-1)- Nop | row == 0 -> return (p0+col, pack_cigar acc)-- viterbi_forward <- MemoMat <$> U.unsafeFreeze v- (viterbi_score, mincol) <- minimum . flip zip [0..] <$> mapM (readV (U.length qs)) [0..bw-1]- (viterbi_position, viterbi_backtrace) <- traceback [] (U.length qs) mincol- return $ AlignResult{..})---- For each position, a vector of pseudocounts in the same order as in--- 'RefSeq', followed by the same for based inserted after the current--- one.-newtype NewRefSeq = NRS (Z.Seq NewColumn)---- Inserts come (conceptually) before the base whose coordinate they--- bear. So every column has inserts first, then the single aligned--- base.-data NewColumn = NC { nc_inserts :: !(U.Vector Float)- , nc_base :: !(U.Vector Float) }--new_ref_seq :: RefSeq -> NewRefSeq-new_ref_seq rs = NRS $ Z.replicate (refseq_len rs) (NC (U.replicate 0 0) (U.replicate 5 0))--mkNC :: U.Vector Float -> U.Vector Float -> NewColumn-mkNC !i !b | U.length b /= 5 = error "mkNC"- | otherwise = NC i b---- Add an alignment to the new reference. We compute the quality of the--- alignment (probability that it belongs vs. probability that it's--- random), that's how many votes we're going to cast. (A perfect--- alignment gives a whole vote, a random one gives none. Call this--- with an alignment that's worse than random at your own peril.)--- If we're voting for a base, we vote for the called one according to--- its quality and for all others with the error probability.--- A deletion is a vote against all bases, an insert is a vote for how--- ever many bases. The first five values sum up to the total votes so--- far, and they all count as votes against any further extension to an--- insert. We start with five pseudo-votes to get the numerics under--- control (or to have a uniform Dirichlet-prior, if you prefer).------ Note that this logic was arrived at by "thinking hard". A clean way--- to do it is to maximize the alignment score expected in the next--- round, assuming the alignments do not change. It might work out to--- the same thing... who knows?--add_to_refseq :: NewRefSeq -> QuerySeq -> AlignResult -> NewRefSeq-add_to_refseq (NRS nrs0) (QS qs0) AlignResult{..} =- NRS $ rotateZ (Z.length nrs0 - viterbi_position)- $ mat here back qs0 $ S.toList viterbi_backtrace- where- here :< back = Z.viewl $ rotateZ viterbi_position nrs0- rotateZ n = uncurry (flip (><)) . Z.splitAt n-- !odds = 10 ** (-viterbi_score / 10) -- often huge,- !votes = 1 - recip (1+odds) -- often exactly 1-- -- Grrr, this isn't going to work. We'll split it:- -- One function deals with inserts. As long as we get inserted- -- bases, we vote for them. Then we vote against the remainder and- -- pass the buck.- -- The other deals with a base. We vote for it if we matched it,- -- against it if we deleted it. Then we recurse.- ins !nc@(NC is b) !nrs !nins !qs cigs = case cigs of- [ ] -> nc <| nrs- ( _ :* 0 :cs) -> ins nc nrs nins qs cs-- (Ins :* n :cs) -> let is' = vote_for_at votes (U.sum b) nins (U.head qs) is- in ins (mkNC is' b) nrs (nins+1) (U.tail qs) (Ins :* (n-1) : cs)-- _ -> let is' = vote_against_from votes nins is- in mat (mkNC is' b) nrs qs cigs-- mat !nc@(NC is b) !nrs !qs cigs = case cigs of- [ ] -> nc <| nrs- ( _ :* 0 :cs) -> mat nc nrs qs cs-- (Del :* n :cs) -> let nc2 :< rest = Z.viewl nrs- b' = vote_against votes b- in mkNC is b' <!| mat nc2 rest qs (Del :* (n-1) : cs)-- (Mat :* n :cs) -> let nc2 :< rest = Z.viewl nrs- b' = vote_for votes (U.head qs) b- in mkNC is b' <!| mat nc2 rest (U.tail qs) (Mat :* (n-1) : cs)-- _ -> ins nc nrs (0::Int) qs cigs-- (<!|) !a !as = a <| as---vote_against_from :: Float -> Int -> U.Vector Float -> U.Vector Float--- vote_against_from votes ix ps | trace ("vote_against_from " ++ show (ix, U.length ps)) False = undefined-vote_against_from votes ix ps = U.accum (+) ps [(i,votes) | i <- [ix+4, ix+9 .. U.length ps-1]]--vote_against :: Float -> U.Vector Float -> U.Vector Float--- vote_against votes ps | trace ("vote_against " ++ show (U.length ps)) False = undefined-vote_against votes ps = U.accum (+) ps [(4,votes)]--vote_for :: Float -> Word8 -> U.Vector Float -> U.Vector Float-vote_for votes = vote_for_at votes 0 0--vote_for_at :: Float -> Float -> Int -> Word8 -> U.Vector Float -> U.Vector Float-vote_for_at votes v0 idx bq ps =- U.accum (+) ps' $ (base+5*idx,pt) : [(5*idx+i,pe)|i<-[0,1,2,3]]- where- base = fromIntegral $ bq .&. 3- qual = bq `shiftR` 2- perr = 10 ** (fromIntegral qual * (-0.1))- pe = votes * perr / 3- pt = votes * (1 - perr) - pe-- ps' | U.length ps >= 5*idx+5 = ps- | otherwise = U.concat (ps : replicate (idx+1 - U.length ps `div` 5) (U.fromList [0,0,0,0,v0]))----- Back to compact representation. Every group of five votes gets--- converted to five probabilities, and those to quality scores. Then--- we concatenate.-finalize_ref_seq :: NewRefSeq -> (RefSeq, XTab)-finalize_ref_seq (NRS z) =- ( RS $ U.concat $ F.foldr unpck [] z- , Z.fromList $ scanl (+) 0 $ F.foldr tolen [] z)- where- unpck (NC ins bas) k = map5 call ins ++ call bas : k- map5 f v = [ f (U.slice i 5 v) | i <- [0, 5 .. U.length v - 5] ]- call v = U.map (\x -> round $ (-10) / log 10 * log ((x+1) / total)) v where total = U.sum v + 5-- tolen (NC ins _bas) k = U.length ins `div` 5 + 1 : k---- Table for coordinate translation-type XTab = Z.Seq Int---{-# INLINE indexV #-}-indexV :: String -> U.Vector Word8 -> Int -> Word8--- indexV m v i | i < 0 = error $ m ++ ": index too large"- -- | i >= U.length v = error $ m ++ ": negative index"- -- | otherwise = v U.! i-indexV _ = (U.!)
− tools/Anno.hs
@@ -1,186 +0,0 @@-module Anno where--import Data.List-import Prelude---- What does this header mean?--- >Feature ref|NC_012920.1|--to_tab :: String -> [Anno] -> [String]-to_tab nm ann = (">Feature " ++ nm) : (map (intercalate "\t") $ concatMap to_tab1 ann)- where- to_tab1 :: Anno -> [[String]]- to_tab1 Gene{..} =- [ show start, show end, label what name ] :- ( if has_gene what then [[ "", "", "", "gene", name ]] else [] ) ++- [ [ "", "", "", "gene_syn", sy ] | sy <- syns ] ++- [ [ show start, show end, w ] | w <- describe what ] ++- [ [ "", "", "", "product", p ] | p <- [prod], not (null p) ] ++- [ [ "", "", "", "note", n ] | n <- notes ] ++- more what-- describe CDS = ["CDS"]- describe CDS' = ["CDS"]- describe TRNA = ["tRNA"]- describe RRNA = ["rRNA"]- describe _ = []-- has_gene (STS _) = False- has_gene Other = False- has_gene _ = True-- label (STS _) _ = "STS"- label Other n = n- label _ _ = "gene"-- more CDS' = [ [ "", "", "", "note", "TAA stop codon is completed by the addition of 3' A residues to the mRNA" ] ]- more (STS sn) = [ [ "", "", "", "standard_name", sn ] ]- more _ = []--data Anno- = Gene { start :: Int- , end :: Int- , name :: String- , syns :: [String]- , what :: What- , prod :: String- , notes :: [String] }- deriving Show--data What = CDS | CDS' | TRNA | RRNA | Other | STS String deriving Show--rCRS_anno :: [Anno]-rCRS_anno =- [ Gene 576 1 "D-loop" [] Other "" []- , Gene 16569 16024 "" [] Other "" []- , Gene 577 647 "TRNF" [] TRNA "tRNA-Phe" []- , Gene 648 1601 "RNR1" ["MTRNR1"] RRNA "s-rRNA" ["12S rRNA; 12S ribosomal RNA"]- , Gene 1602 1670 "TRNV" [] TRNA "tRNA-Val" []- , Gene 1671 3229 "RNR2" [] RRNA "l-rRNA" ["16S ribosomal RNA; 16S rRNA"]- , Gene 3230 3304 "TRNL1" ["MTTL1"] TRNA "tRNA-Leu" []- , Gene 3307 4262 "ND1" [] CDS' "NADH dehydrogenase subunit 1" []-- , Gene 4263 4331 "TRNI" [] TRNA "tRNA-Ile" []- , Gene 4400 4329 "TRNQ" [] TRNA "tRNA-Gln" []- , Gene 4402 4469 "TRNM" [] TRNA "tRNA-Met" []- , Gene 4470 5511 "ND2" [] CDS' "NADH dehydrogenase subunit 2" []- , Gene 5512 5579 "TRNW" [] TRNA "tRNA-Trp" []- , Gene 5655 5587 "TRNA" [] TRNA "tRNA-Ala" []- , Gene 5729 5657 "TRNN" [] TRNA "tRNA-Asn" []- , Gene 5826 5761 "TRNC" [] TRNA "tRNA-Cys" []- , Gene 5891 5826 "TRNY" [] TRNA "tRNA-Tyr" []- , Gene 5904 7445 "COX1" ["COI"] CDS "cytochrome c oxidase subunit I" ["cytochrome c oxidase I"]- , Gene 7514 7446 "TRNS1" [] TRNA "tRNA-Ser" []- , Gene 7518 7585 "TRND" [] TRNA "tRNA-Asp" []- , Gene 7586 8269 "COX2" [] CDS "cytochrome c oxidase subunit II" ["cytochrome c oxidase II"]- , Gene 8295 8364 "TRNK" [] TRNA "tRNA-Lys" []- , Gene 8366 8572 "ATP8" [] CDS "ATP synthase F0 subunit 8" ["ATP synthase 8; ATPase subunit 8"]- , Gene 8527 9207 "ATP6" [] CDS "ATP synthase F0 subunit 6" ["ATP synthase 6; ATPase subunit 6"]- , Gene 9207 9990 "COX3" [] CDS' "cytochrome c oxidase subunit III" []- , Gene 9342 9416 "" [] (STS "PMC55343P8") "" []- , Gene 9991 10058 "TRNG" [] TRNA "tRNA-Gly" []- , Gene 10059 10404 "ND3" [] CDS' "NADH dehydrogenase subunit 3" []- , Gene 10405 10469 "TRNR" [] TRNA "tRNA-Arg" []- , Gene 10470 10766 "ND4L" [] CDS "NADH dehydrogenase subunit 4L" []- , Gene 10760 12137 "ND4" [] CDS' "NADH dehydrogenase subunit 4" []- , Gene 12138 12206 "TRNH" [] TRNA "tRNA-His" []- , Gene 12207 12265 "TRNS2" [] TRNA "tRNA-Ser" []- , Gene 12266 12336 "TRNL2" [] TRNA "tRNA-Leu" []- , Gene 12337 14148 "ND5" [] CDS "NADH dehydrogenase subunit 5" []- , Gene 14673 14149 "ND6" [] CDS "NADH dehydrogenase subunit 6" []- , Gene 14742 14674 "TRNE" [] TRNA "tRNA-Glu" []- , Gene 14747 15887 "CYTB" [] CDS' "cytochrome b" []- , Gene 15888 15953 "TRNT" [] TRNA "tRNA-Thr" []- , Gene 16023 15956 "TRNP" [] TRNA "tRNA-Pro" [] ]--aas :: [(String, String)]-aas = [- (,) "ND1"- "MPMANLLLLIVPILIAMAFLMLTERKILGYMQLRKGPNVVGPYG\- \LLQPFADAMKLFTKEPLKPATSTITLYITAPTLALTIALLLWTPLPMPNPLVNLNLGL\- \LFILATSSLAVYSILWSGWASNSNYALIGALRAVAQTISYEVTLAIILLSTLLMSGSF\- \NLSTLITTQEHLWLLLPSWPLAMMWFISTLAETNRTPFDLAEGESELVSGFNIEYAAG\- \PFALFFMAEYTNIIMMNTLTTTIFLGTTYDALSPELYTTYFVTKTLLLTSLFLWIRTA\- \YPRFRYDQLMHLLWKNFLPLTLALLMWYVSMPITISSIPPQT",- (,) "ND2"- "MNPLAQPVIYSTIFAGTLITALSSHWFFTWVGLEMNMLAFIPVL\- \TKKMNPRSTEAAIKYFLTQATASMILLMAILFNNMLSGQWTMTNTTNQYSSLMIMMAM\- \AMKLGMAPFHFWVPEVTQGTPLTSGLLLLTWQKLAPISIMYQISPSLNVSLLLTLSIL\- \SIMAGSWGGLNQTQLRKILAYSSITHMGWMMAVLPYNPNMTILNLTIYIILTTTAFLL\- \LNLNSSTTTLLLSRTWNKLTWLTPLIPSTLLSLGGLPPLTGFLPKWAIIEEFTKNNSL\- \IIPTIMATITLLNLYFYLRLIYSTSITLLPMSNNVKMKWQFEHTKPTPFLPTLIALTT\- \LLLPISPFMLMIL",- (,) "COX1"- "MFADRWLFSTNHKDIGTLYLLFGAWAGVLGTALSLLIRAELGQP\- \GNLLGNDHIYNVIVTAHAFVMIFFMVMPIMIGGFGNWLVPLMIGAPDMAFPRMNNMSF\- \WLLPPSLLLLLASAMVEAGAGTGWTVYPPLAGNYSHPGASVDLTIFSLHLAGVSSILG\- \AINFITTIINMKPPAMTQYQTPLFVWSVLITAVLLLLSLPVLAAGITMLLTDRNLNTT\- \FFDPAGGGDPILYQHLFWFFGHPEVYILILPGFGMISHIVTYYSGKKEPFGYMGMVWA\- \MMSIGFLGFIVWAHHMFTVGMDVDTRAYFTSATMIIAIPTGVKVFSWLATLHGSNMKW\- \SAAVLWALGFIFLFTVGGLTGIVLANSSLDIVLHDTYYVVAHFHYVLSMGAVFAIMGG\- \FIHWFPLFSGYTLDQTYAKIHFTIMFIGVNLTFFPQHFLGLSGMPRRYSDYPDAYTTW\- \NILSSVGSFISLTAVMLMIFMIWEAFASKRKVLMVEEPSMNLEWLYGCPPPYHTFEEP\- \VYMKS",- (,) "COX2"- "MAHAAQVGLQDATSPIMEELITFHDHALMIIFLICFLVLYALFL\- \TLTTKLTNTNISDAQEMETVWTILPAIILVLIALPSLRILYMTDEVNDPSLTIKSIGH\- \QWYWTYEYTDYGGLIFNSYMLPPLFLEPGDLRLLDVDNRVVLPIEAPIRMMITSQDVL\- \HSWAVPTLGLKTDAIPGRLNQTTFTATRPGVYYGQCSEICGANHSFMPIVLELIPLKI\- \FEMGPVFTL",- (,) "ATP8"- "MPQLNTTVWPTMITPMLLTLFLITQLKMLNTNYHLPPSPKPMKM\- \KNYNKPWEPKWTKICSLHSLPPQS",- (,) "ATP6"- "MNENLFASFIAPTILGLPAAVLIILFPPLLIPTSKYLINNRLIT\- \TQQWLIKLTSKQMMTMHNTKGRTWSLMLVSLIIFIATTNLLGLLPHSFTPTTQLSMNL\- \AMAIPLWAGTVIMGFRSKIKNALAHFLPQGTPTPLIPMLVIIETISLLIQPMALAVRL\- \TANITAGHLLMHLIGSATLAMSTINLPSTLIIFTILILLTILEIAVALIQAYVFTLLV\- \SLYLHDNT",- (,) "COX3"- "MTHQSHAYHMVKPSPWPLTGALSALLMTSGLAMWFHFHSMTLLM\- \LGLLTNTLTMYQWWRDVTRESTYQGHHTPPVQKGLRYGMILFITSEVFFFAGFFWAFY\- \HSSLAPTPQLGGHWPPTGITPLNPLEVPLLNTSVLLASGVSITWAHHSLMENNRNQMI\- \QALLITILLGLYFTLLQASEYFESPFTISDGIYGSTFFVATGFHGLHVIIGSTFLTIC\- \FIRQLMFHFTSKHHFGFEAAAWYWHFVDVVWLFLYVSIYWWGS",- (,) "ND3"- "MNFALILMINTLLALLLMIITFWLPQLNGYMEKSTPYECGFDPM\- \SPARVPFSMKFFLVAITFLLFDLEIALLLPLPWALQTTNLPLMVMSSLLLIIILALSL\- \AYEWLQKGLDWTE",- (,) "ND4L"- "MPLIYMNIMLAFTISLLGMLVYRSHLMSSLLCLEGMMLSLFIMA\- \TLMTLNTHSLLANIVPIAMLVFAACEAAVGLALLVSISNTYGLDYVHNLNLLQC",- (,) "ND4"- "MLKLIVPTIMLLPLTWLSKKHMIWINTTTHSLIISIIPLLFFNQ\- \INNNLFSCSPTFSSDPLTTPLLMLTTWLLPLTIMASQRHLSSEPLSRKKLYLSMLISL\- \QISLIMTFTATELIMFYIFFETTLIPTLAIITRWGNQPERLNAGTYFLFYTLVGSLPL\- \LIALIYTHNTLGSLNILLLTLTAQELSNSWANNLMWLAYTMAFMVKMPLYGLHLWLPK\- \AHVEAPIAGSMVLAAVLLKLGGYGMMRLTLILNPLTKHMAYPFLVLSLWGMIMTSSIC\- \LRQTDLKSLIAYSSISHMALVVTAILIQTPWSFTGAVILMIAHGLTSSLLFCLANSNY\- \ERTHSRIMILSQGLQTLLPLMAFWWLLASLANLALPPTINLLGELSVLVTTFSWSNIT\- \LLLTGLNMLVTALYSLYMFTTTQWGSLTHHINNMKPSFTRENTLMFMHLSPILLLSLN\- \PDIITGFSS",- (,) "ND5"- "MTMHTTMTTLTLTSLIPPILTTLVNPNKKNSYPHYVKSIVASTF\- \IISLFPTTMFMCLDQEVIISNWHWATTQTTQLSLSFKLDYFSMMFIPVALFVTWSIME\- \FSLWYMNSDPNINQFFKYLLIFLITMLILVTANNLFQLFIGWEGVGIMSFLLISWWYA\- \RADANTAAIQAILYNRIGDIGFILALAWFILHSNSWDPQQMALLNANPSLTPLLGLLL\- \AAAGKSAQLGLHPWLPSAMEGPTPVSALLHSSTMVVAGIFLLIRFHPLAENSPLIQTL\- \TLCLGAITTLFAAVCALTQNDIKKIVAFSTSSQLGLMMVTIGINQPHLAFLHICTHAF\- \FKAMLFMCSGSIIHNLNNEQDIRKMGGLLKTMPLTSTSLTIGSLALAGMPFLTGFYSK\- \DHIIETANMSYTNAWALSITLIATSLTSAYSTRMILLTLTGQPRFPTLTNINENNPTL\- \LNPIKRLAAGSLFAGFLITNNISPASPFQTTIPLYLKLTALAVTFLGLLTALDLNYLT\- \NKLKMKSPLCTFYFSNMLGFYPSITHRTIPYLGLLTSQNLPLLLLDLTWLEKLLPKTI\- \SQHQISTSIITSTQKGMIKLYFLSFFFPLILTLLLIT",- (,) "ND6"- "MMYALFLLSVGLVMGFVGFSSKPSPIYGGLVLIVSGVVGCVIIL\- \NFGGGYMGLMVFLIYLGGMMVVFGYTTAMAIEEYPEAWGSGVEVLVSVLVGLAMEVGL\- \VLWVKEYDGVVVVVNFNSVGSWMIYEGEGSGLIREDPIGAGALYDYGRWLVVVTGWTL\- \FVGVYIVIEIARGN",- (,) "CYTB"- "MTPMRKTNPLMKLINHSFIDLPTPSNISAWWNFGSLLGACLILQ\- \ITTGLFLAMHYSPDASTAFSSIAHITRDVNYGWIIRYLHANGASMFFICLFLHIGRGL\- \YYGSFLYSETWNIGIILLLATMATAFMGYVLPWGQMSFWGATVITNLLSAIPYIGTDL\- \VQWIWGGYSVDSPTLTRFFTFHFILPFIIAALATLHLLFLHETGSNNPLGITSHSDKI\- \TFHPYYTIKDALGLLLFLLSLMTLTLFSPDLLGDPDNYTLANPLNTPPHIKPEWYFLF\- \AYTILRSVPNKLGGVLALLLSILILAMIPILHMSKQQSMMFRPLSQSLYWLLAADLLI\- \LTWIGGQPVSYPFTIIGQVASVLYFTTILILMPTISLIENKMLKWA" ]
− tools/Index.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell #-}-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, CPP #-}-module Index where---- ^ This tiny module defines the 'Index' type and derives the 'Unbox'--- instance. That dramatically lowers the chance that template haskell--- runs into problems :(--import Bio.Prelude-import Data.Vector.Unboxed.Deriving--#if __GLASGOW_HASKELL__ == 704-import Data.Vector.Generic ( Vector(..) )-import Data.Vector.Generic.Mutable ( MVector(..) )-#endif---- | An index sequence must have at most eight bases. We represent a--- base and its quality score in a single byte: the top three bits are--- the base ("ACGTN" = [0,1,3,2,7]), the lower five bits are the quality,--- clamped to 31.--newtype Index = Index Word64 deriving (Storable, Eq)--instance Hashable Index where- hashWithSalt salt (Index x) = hashWithSalt salt x- hash (Index x) = hash x--instance Show Index where- show (Index x) = [ "ACTGNNNN" !! fromIntegral b | i <- [56,48..0], let b = (x `shiftR` (i+5)) .&. 0x7 ]- ++ 'q' : [ chr (fromIntegral q+33) | i <- [56,48..0], let q = (x `shiftR` i) .&. 0x1F ]--derivingUnbox "Index" [t| Index -> Word64 |] [| \ (Index i) -> i |] [| Index |]--
− tools/Seqs.hs
@@ -1,173 +0,0 @@-module Seqs where--import Data.ByteString.Char8 (ByteString)--raw_rCRS :: ByteString-raw_rCRS =- "GATCACAGGTCTATCACCCTATTAACCACTCACGGGAGCTCTCCATGCATTTGGTATTTTCGTCTGGGGGGTATGCACGCGATAGCATTGCGAGACGCTG\- \GAGCCGGAGCACCCTATGTCGCAGTATCTGTCTTTGATTCCTGCCTCATCCTATTATTTATCGCACCTACGTTCAATATTACAGGCGAACATACTTACTA\- \AAGTGTGTTAATTAATTAATGCTTGTAGGACATAATAATAACAATTGAATGTCTGCACAGCCACTTTCCACACAGACATCATAACAAAAAATTTCCACCA\- \AACCCCCCCTCCCCCGCTTCTGGCCACAGCACTTAAACACATCTCTGCCAAACCCCAAAAACAAAGAACCCTAACACCAGCCTAACCAGATTTCAAATTT\- \TATCTTTTGGCGGTATGCACTTTTAACAGTCACCCCCCAACTAACACATTATTTTCCCCTCCCACTCCCATACTACTAATCTCATCAATACAACCCCCGC\- \CCATCCTACCCAGCACACACACACCGCTGCTAACCCCATACCCCGAACCAACCAAACCCCAAAGACACCCCCCACAGTTTATGTAGCTTACCTCCTCAAA\- \GCAATACACTGAAAATGTTTAGACGGGCTCACATCACCCCATAAACAAATAGGTTTGGTCCTAGCCTTTCTATTAGCTCTTAGTAAGATTACACATGCAA\- \GCATCCCCGTTCCAGTGAGTTCACCCTCTAAATCACCACGATCAAAAGGAACAAGCATCAAGCACGCAGCAATGCAGCTCAAAACGCTTAGCCTAGCCAC\- \ACCCCCACGGGAAACAGCAGTGATTAACCTTTAGCAATAAACGAAAGTTTAACTAAGCTATACTAACCCCAGGGTTGGTCAATTTCGTGCCAGCCACCGC\- \GGTCACACGATTAACCCAAGTCAATAGAAGCCGGCGTAAAGAGTGTTTTAGATCACCCCCTCCCCAATAAAGCTAAAACTCACCTGAGTTGTAAAAAACT\- \CCAGTTGACACAAAATAGACTACGAAAGTGGCTTTAACATATCTGAACACACAATAGCTAAGACCCAAACTGGGATTAGATACCCCACTATGCTTAGCCC\- \TAAACCTCAACAGTTAAATCAACAAAACTGCTCGCCAGAACACTACGAGCCACAGCTTAAAACTCAAAGGACCTGGCGGTGCTTCATATCCCTCTAGAGG\- \AGCCTGTTCTGTAATCGATAAACCCCGATCAACCTCACCACCTCTTGCTCAGCCTATATACCGCCATCTTCAGCAAACCCTGATGAAGGCTACAAAGTAA\- \GCGCAAGTACCCACGTAAAGACGTTAGGTCAAGGTGTAGCCCATGAGGTGGCAAGAAATGGGCTACATTTTCTACCCCAGAAAACTACGATAGCCCTTAT\- \GAAACTTAAGGGTCGAAGGTGGATTTAGCAGTAAACTAAGAGTAGAGTGCTTAGTTGAACAGGGCCCTGAAGCGCGTACACACCGCCCGTCACCCTCCTC\- \AAGTATACTTCAAAGGACATTTAACTAAAACCCCTACGCATTTATATAGAGGAGACAAGTCGTAACATGGTAAGTGTACTGGAAAGTGCACTTGGACGAA\- \CCAGAGTGTAGCTTAACACAAAGCACCCAACTTACACTTAGGAGATTTCAACTTAACTTGACCGCTCTGAGCTAAACCTAGCCCCAAACCCACTCCACCT\- \TACTACCAGACAACCTTAGCCAAACCATTTACCCAAATAAAGTATAGGCGATAGAAATTGAAACCTGGCGCAATAGATATAGTACCGCAAGGGAAAGATG\- \AAAAATTATAACCAAGCATAATATAGCAAGGACTAACCCCTATACCTTCTGCATAATGAATTAACTAGAAATAACTTTGCAAGGAGAGCCAAAGCTAAGA\- \CCCCCGAAACCAGACGAGCTACCTAAGAACAGCTAAAAGAGCACACCCGTCTATGTAGCAAAATAGTGGGAAGATTTATAGGTAGAGGCGACAAACCTAC\- \CGAGCCTGGTGATAGCTGGTTGTCCAAGATAGAATCTTAGTTCAACTTTAAATTTGCCCACAGAACCCTCTAAATCCCCTTGTAAATTTAACTGTTAGTC\- \CAAAGAGGAACAGCTCTTTGGACACTAGGAAAAAACCTTGTAGAGAGAGTAAAAAATTTAACACCCATAGTAGGCCTAAAAGCAGCCACCAATTAAGAAA\- \GCGTTCAAGCTCAACACCCACTACCTAAAAAATCCCAAACATATAACTGAACTCCTCACACCCAATTGGACCAATCTATCACCCTATAGAAGAACTAATG\- \TTAGTATAAGTAACATGAAAACATTCTCCTCCGCATAAGCCTGCGTCAGATTAAAACACTGAACTGACAATTAACAGCCCAATATCTACAATCAACCAAC\- \AAGTCATTATTACCCTCACTGTCAACCCAACACAGGCATGCTCATAAGGAAAGGTTAAAAAAAGTAAAAGGAACTCGGCAAATCTTACCCCGCCTGTTTA\- \CCAAAAACATCACCTCTAGCATCACCAGTATTAGAGGCACCGCCTGCCCAGTGACACATGTTTAACGGCCGCGGTACCCTAACCGTGCAAAGGTAGCATA\- \ATCACTTGTTCCTTAAATAGGGACCTGTATGAATGGCTCCACGAGGGTTCAGCTGTCTCTTACTTTTAACCAGTGAAATTGACCTGCCCGTGAAGAGGCG\- \GGCATAACACAGCAAGACGAGAAGACCCTATGGAGCTTTAATTTATTAATGCAAACAGTACCTAACAAACCCACAGGTCCTAAACTACCAAACCTGCATT\- \AAAAATTTCGGTTGGGGCGACCTCGGAGCAGAACCCAACCTCCGAGCAGTACATGCTAAGACTTCACCAGTCAAAGCGAACTACTATACTCAATTGATCC\- \AATAACTTGACCAACGGAACAAGTTACCCTAGGGATAACAGCGCAATCCTATTCTAGAGTCCATATCAACAATAGGGTTTACGACCTCGATGTTGGATCA\- \GGACATCCCGATGGTGCAGCCGCTATTAAAGGTTCGTTTGTTCAACGATTAAAGTCCTACGTGATCTGAGTTCAGACCGGAGTAATCCAGGTCGGTTTCT\- \ATCTACNTTCAAATTCCTCCCTGTACGAAAGGACAAGAGAAATAAGGCCTACTTCACAAAGCGCCTTCCCCCGTAAATGATATCATCTCAACTTAGTATT\- \ATACCCACACCCACCCAAGAACAGGGTTTGTTAAGATGGCAGAGCCCGGTAATCGCATAAAACTTAAAACTTTACAGTCAGAGGTTCAATTCCTCTTCTT\- \AACAACATACCCATGGCCAACCTCCTACTCCTCATTGTACCCATTCTAATCGCAATGGCATTCCTAATGCTTACCGAACGAAAAATTCTAGGCTATATAC\- \AACTACGCAAAGGCCCCAACGTTGTAGGCCCCTACGGGCTACTACAACCCTTCGCTGACGCCATAAAACTCTTCACCAAAGAGCCCCTAAAACCCGCCAC\- \ATCTACCATCACCCTCTACATCACCGCCCCGACCTTAGCTCTCACCATCGCTCTTCTACTATGAACCCCCCTCCCCATACCCAACCCCCTGGTCAACCTC\- \AACCTAGGCCTCCTATTTATTCTAGCCACCTCTAGCCTAGCCGTTTACTCAATCCTCTGATCAGGGTGAGCATCAAACTCAAACTACGCCCTGATCGGCG\- \CACTGCGAGCAGTAGCCCAAACAATCTCATATGAAGTCACCCTAGCCATCATTCTACTATCAACATTACTAATAAGTGGCTCCTTTAACCTCTCCACCCT\- \TATCACAACACAAGAACACCTCTGATTACTCCTGCCATCATGACCCTTGGCCATAATATGATTTATCTCCACACTAGCAGAGACCAACCGAACCCCCTTC\- \GACCTTGCCGAAGGGGAGTCCGAACTAGTCTCAGGCTTCAACATCGAATACGCCGCAGGCCCCTTCGCCCTATTCTTCATAGCCGAATACACAAACATTA\- \TTATAATAAACACCCTCACCACTACAATCTTCCTAGGAACAACATATGACGCACTCTCCCCTGAACTCTACACAACATATTTTGTCACCAAGACCCTACT\- \TCTAACCTCCCTGTTCTTATGAATTCGAACAGCATACCCCCGATTCCGCTACGACCAACTCATACACCTCCTATGAAAAAACTTCCTACCACTCACCCTA\- \GCATTACTTATATGATATGTCTCCATACCCATTACAATCTCCAGCATTCCCCCTCAAACCTAAGAAATATGTCTGATAAAAGAGTTACTTTGATAGAGTA\- \AATAATAGGAGCTTAAACCCCCTTATTTCTAGGACTATGAGAATCGAACCCATCCCTGAGAATCCAAAATTCTCCGTGCCACCTATCACACCCCATCCTA\- \AAGTAAGGTCAGCTAAATAAGCTATCGGGCCCATACCCCGAAAATGTTGGTTATACCCTTCCCGTACTAATTAATCCCCTGGCCCAACCCGTCATCTACT\- \CTACCATCTTTGCAGGCACACTCATCACAGCGCTAAGCTCGCACTGATTTTTTACCTGAGTAGGCCTAGAAATAAACATGCTAGCTTTTATTCCAGTTCT\- \AACCAAAAAAATAAACCCTCGTTCCACAGAAGCTGCCATCAAGTATTTCCTCACGCAAGCAACCGCATCCATAATCCTTCTAATAGCTATCCTCTTCAAC\- \AATATACTCTCCGGACAATGAACCATAACCAATACTACCAATCAATACTCATCATTAATAATCATAATAGCTATAGCAATAAAACTAGGAATAGCCCCCT\- \TTCACTTCTGAGTCCCAGAGGTTACCCAAGGCACCCCTCTGACATCCGGCCTGCTTCTTCTCACATGACAAAAACTAGCCCCCATCTCAATCATATACCA\- \AATCTCTCCCTCACTAAACGTAAGCCTTCTCCTCACTCTCTCAATCTTATCCATCATAGCAGGCAGTTGAGGTGGATTAAACCAAACCCAGCTACGCAAA\- \ATCTTAGCATACTCCTCAATTACCCACATAGGATGAATAATAGCAGTTCTACCGTACAACCCTAACATAACCATTCTTAATTTAACTATTTATATTATCC\- \TAACTACTACCGCATTCCTACTACTCAACTTAAACTCCAGCACCACGACCCTACTACTATCTCGCACCTGAAACAAGCTAACATGACTAACACCCTTAAT\- \TCCATCCACCCTCCTCTCCCTAGGAGGCCTGCCCCCGCTAACCGGCTTTTTGCCCAAATGGGCCATTATCGAAGAATTCACAAAAAACAATAGCCTCATC\- \ATCCCCACCATCATAGCCACCATCACCCTCCTTAACCTCTACTTCTACCTACGCCTAATCTACTCCACCTCAATCACACTACTCCCCATATCTAACAACG\- \TAAAAATAAAATGACAGTTTGAACATACAAAACCCACCCCATTCCTCCCCACACTCATCGCCCTTACCACGCTACTCCTACCTATCTCCCCTTTTATACT\- \AATAATCTTATAGAAATTTAGGTTAAATACAGACCAAGAGCCTTCAAAGCCCTCAGTAAGTTGCAATACTTAATTTCTGTAACAGCTAAGGACTGCAAAA\- \CCCCACTCTGCATCAACTGAACGCAAATCAGCCACTTTAATTAAGCTAAGCCCTTACTAGACCAATGGGACTTAAACCCACAAACACTTAGTTAACAGCT\- \AAGCACCCTAATCAACTGGCTTCAATCTACTTCTCCCGCCGCCGGGAAAAAAGGCGGGAGAAGCCCCGGCAGGTTTGAAGCTGCTTCTTCGAATTTGCAA\- \TTCAATATGAAAATCACCTCGGAGCTGGTAAAAAGAGGCCTAACCCCTGTCTTTAGATTTACAGTCCAATGCTTCACTCAGCCATTTTACCTCACCCCCA\- \CTGATGTTCGCCGACCGTTGACTATTCTCTACAAACCACAAAGACATTGGAACACTATACCTATTATTCGGCGCATGAGCTGGAGTCCTAGGCACAGCTC\- \TAAGCCTCCTTATTCGAGCCGAGCTGGGCCAGCCAGGCAACCTTCTAGGTAACGACCACATCTACAACGTTATCGTCACAGCCCATGCATTTGTAATAAT\- \CTTCTTCATAGTAATACCCATCATAATCGGAGGCTTTGGCAACTGACTAGTTCCCCTAATAATCGGTGCCCCCGATATGGCGTTTCCCCGCATAAACAAC\- \ATAAGCTTCTGACTCTTACCTCCCTCTCTCCTACTCCTGCTCGCATCTGCTATAGTGGAGGCCGGAGCAGGAACAGGTTGAACAGTCTACCCTCCCTTAG\- \CAGGGAACTACTCCCACCCTGGAGCCTCCGTAGACCTAACCATCTTCTCCTTACACCTAGCAGGTGTCTCCTCTATCTTAGGGGCCATCAATTTCATCAC\- \AACAATTATCAATATAAAACCCCCTGCCATAACCCAATACCAAACGCCCCTCTTCGTCTGATCCGTCCTAATCACAGCAGTCCTACTTCTCCTATCTCTC\- \CCAGTCCTAGCTGCTGGCATCACTATACTACTAACAGACCGCAACCTCAACACCACCTTCTTCGACCCCGCCGGAGGAGGAGACCCCATTCTATACCAAC\- \ACCTATTCTGATTTTTCGGTCACCCTGAAGTTTATATTCTTATCCTACCAGGCTTCGGAATAATCTCCCATATTGTAACTTACTACTCCGGAAAAAAAGA\- \ACCATTTGGATACATAGGTATGGTCTGAGCTATGATATCAATTGGCTTCCTAGGGTTTATCGTGTGAGCACACCATATATTTACAGTAGGAATAGACGTA\- \GACACACGAGCATATTTCACCTCCGCTACCATAATCATCGCTATCCCCACCGGCGTCAAAGTATTTAGCTGACTCGCCACACTCCACGGAAGCAATATGA\- \AATGATCTGCTGCAGTGCTCTGAGCCCTAGGATTCATCTTTCTTTTCACCGTAGGTGGCCTGACTGGCATTGTATTAGCAAACTCATCACTAGACATCGT\- \ACTACACGACACGTACTACGTTGTAGCCCACTTCCACTATGTCCTATCAATAGGAGCTGTATTTGCCATCATAGGAGGCTTCATTCACTGATTTCCCCTA\- \TTCTCAGGCTACACCCTAGACCAAACCTACGCCAAAATCCATTTCACTATCATATTCATCGGCGTAAATCTAACTTTCTTCCCACAACACTTTCTCGGCC\- \TATCCGGAATGCCCCGACGTTACTCGGACTACCCCGATGCATACACCACATGAAACATCCTATCATCTGTAGGCTCATTCATTTCTCTAACAGCAGTAAT\- \ATTAATAATTTTCATGATTTGAGAAGCCTTCGCTTCGAAGCGAAAAGTCCTAATAGTAGAAGAACCCTCCATAAACCTGGAGTGACTATATGGATGCCCC\- \CCACCCTACCACACATTCGAAGAACCCGTATACATAAAATCTAGACAAAAAAGGAAGGAATCGAACCCCCCAAAGCTGGTTTCAAGCCAACCCCATGGCC\- \TCCATGACTTTTTCAAAAAGGTATTAGAAAAACCATTTCATAACTTTGTCAAAGTTAAATTATAGGCTAAATCCTATATATCTTAATGGCACATGCAGCG\- \CAAGTAGGTCTACAAGACGCTACTTCCCCTATCATAGAAGAGCTTATCACCTTTCATGATCACGCCCTCATAATCATTTTCCTTATCTGCTTCCTAGTCC\- \TGTATGCCCTTTTCCTAACACTCACAACAAAACTAACTAATACTAACATCTCAGACGCTCAGGAAATAGAAACCGTCTGAACTATCCTGCCCGCCATCAT\- \CCTAGTCCTCATCGCCCTCCCATCCCTACGCATCCTTTACATAACAGACGAGGTCAACGATCCCTCCCTTACCATCAAATCAATTGGCCACCAATGGTAC\- \TGAACCTACGAGTACACCGACTACGGCGGACTAATCTTCAACTCCTACATACTTCCCCCATTATTCCTAGAACCAGGCGACCTGCGACTCCTTGACGTTG\- \ACAATCGAGTAGTACTCCCGATTGAAGCCCCCATTCGTATAATAATTACATCACAAGACGTCTTGCACTCATGAGCTGTCCCCACATTAGGCTTAAAAAC\- \AGATGCAATTCCCGGACGTCTAAACCAAACCACTTTCACCGCTACACGACCGGGGGTATACTACGGTCAATGCTCTGAAATCTGTGGAGCAAACCACAGT\- \TTCATGCCCATCGTCCTAGAATTAATTCCCCTAAAAATCTTTGAAATAGGGCCCGTATTTACCCTATAGCACCCCCTCTACCCCCTCTAGAGCCCACTGT\- \AAAGCTAACTTAGCATTAACCTTTTAAGTTAAAGATTAAGAGAACCAACACCTCTTTACAGTGAAATGCCCCAACTAAATACTACCGTATGGCCCACCAT\- \AATTACCCCCATACTCCTTACACTATTCCTCATCACCCAACTAAAAATATTAAACACAAACTACCACCTACCTCCCTCACCAAAGCCCATAAAAATAAAA\- \AATTATAACAAACCCTGAGAACCAAAATGAACGAAAATCTGTTCGCTTCATTCATTGCCCCCACAATCCTAGGCCTACCCGCCGCAGTACTGATCATTCT\- \ATTTCCCCCTCTATTGATCCCCACCTCCAAATATCTCATCAACAACCGACTAATCACCACCCAACAATGACTAATCAAACTAACCTCAAAACAAATGATA\- \ACCATACACAACACTAAAGGACGAACCTGATCTCTTATACTAGTATCCTTAATCATTTTTATTGCCACAACTAACCTCCTCGGACTCCTGCCTCACTCAT\- \TTACACCAACCACCCAACTATCTATAAACCTAGCCATGGCCATCCCCTTATGAGCGGGCACAGTGATTATAGGCTTTCGCTCTAAGATTAAAAATGCCCT\- \AGCCCACTTCTTACCACAAGGCACACCTACACCCCTTATCCCCATACTAGTTATTATCGAAACCATCAGCCTACTCATTCAACCAATAGCCCTGGCCGTA\- \CGCCTAACCGCTAACATTACTGCAGGCCACCTACTCATGCACCTAATTGGAAGCGCCACCCTAGCAATATCAACCATTAACCTTCCCTCTACACTTATCA\- \TCTTCACAATTCTAATTCTACTGACTATCCTAGAAATCGCTGTCGCCTTAATCCAAGCCTACGTTTTCACACTTCTAGTAAGCCTCTACCTGCACGACAA\- \CACATAATGACCCACCAATCACATGCCTATCATATAGTAAAACCCAGCCCATGACCCCTAACAGGGGCCCTCTCAGCCCTCCTAATGACCTCCGGCCTAG\- \CCATGTGATTTCACTTCCACTCCATAACGCTCCTCATACTAGGCCTACTAACCAACACACTAACCATATACCAATGATGGCGCGATGTAACACGAGAAAG\- \CACATACCAAGGCCACCACACACCACCTGTCCAAAAAGGCCTTCGATACGGGATAATCCTATTTATTACCTCAGAAGTTTTTTTCTTCGCAGGATTTTTC\- \TGAGCCTTTTACCACTCCAGCCTAGCCCCTACCCCCCAATTAGGAGGGCACTGGCCCCCAACAGGCATCACCCCGCTAAATCCCCTAGAAGTCCCACTCC\- \TAAACACATCCGTATTACTCGCATCAGGAGTATCAATCACCTGAGCTCACCATAGTCTAATAGAAAACAACCGAAACCAAATAATTCAAGCACTGCTTAT\- \TACAATTTTACTGGGTCTCTATTTTACCCTCCTACAAGCCTCAGAGTACTTCGAGTCTCCCTTCACCATTTCCGACGGCATCTACGGCTCAACATTTTTT\- \GTAGCCACAGGCTTCCACGGACTTCACGTCATTATTGGCTCAACTTTCCTCACTATCTGCTTCATCCGCCAACTAATATTTCACTTTACATCCAAACATC\- \ACTTTGGCTTCGAAGCCGCCGCCTGATACTGGCATTTTGTAGATGTGGTTTGACTATTTCTGTATGTCTCCATCTATTGATGAGGGTCTTACTCTTTTAG\- \TATAAATAGTACCGTTAACTTCCAATTAACTAGTTTTGACAACATTCAAAAAAGAGTAATAAACTTCGCCTTAATTTTAATAATCAACACCCTCCTAGCC\- \TTACTACTAATAATTATTACATTTTGACTACCACAACTCAACGGCTACATAGAAAAATCCACCCCTTACGAGTGCGGCTTCGACCCTATATCCCCCGCCC\- \GCGTCCCTTTCTCCATAAAATTCTTCTTAGTAGCTATTACCTTCTTATTATTTGATCTAGAAATTGCCCTCCTTTTACCCCTACCATGAGCCCTACAAAC\- \AACTAACCTGCCACTAATAGTTATGTCATCCCTCTTATTAATCATCATCCTAGCCCTAAGTCTGGCCTATGAGTGACTACAAAAAGGATTAGACTGAACC\- \GAATTGGTATATAGTTTAAACAAAACGAATGATTTCGACTCATTAAATTATGATAATCATATTTACCAAATGCCCCTCATTTACATAAATATTATACTAG\- \CATTTACCATCTCACTTCTAGGAATACTAGTATATCGCTCACACCTCATATCCTCCCTACTATGCCTAGAAGGAATAATACTATCGCTGTTCATTATAGC\- \TACTCTCATAACCCTCAACACCCACTCCCTCTTAGCCAATATTGTGCCTATTGCCATACTAGTCTTTGCCGCCTGCGAAGCAGCGGTGGGCCTAGCCCTA\- \CTAGTCTCAATCTCCAACACATATGGCCTAGACTACGTACATAACCTAAACCTACTCCAATGCTAAAACTAATCGTCCCAACAATTATATTACTACCACT\- \GACATGACTTTCCAAAAAACACATAATTTGAATCAACACAACCACCCACAGCCTAATTATTAGCATCATCCCTCTACTATTTTTTAACCAAATCAACAAC\- \AACCTATTTAGCTGTTCCCCAACCTTTTCCTCCGACCCCCTAACAACCCCCCTCCTAATACTAACTACCTGACTCCTACCCCTCACAATCATGGCAAGCC\- \AACGCCACTTATCCAGTGAACCACTATCACGAAAAAAACTCTACCTCTCTATACTAATCTCCCTACAAATCTCCTTAATTATAACATTCACAGCCACAGA\- \ACTAATCATATTTTATATCTTCTTCGAAACCACACTTATCCCCACCTTGGCTATCATCACCCGATGAGGCAACCAGCCAGAACGCCTGAACGCAGGCACA\- \TACTTCCTATTCTACACCCTAGTAGGCTCCCTTCCCCTACTCATCGCACTAATTTACACTCACAACACCCTAGGCTCACTAAACATTCTACTACTCACTC\- \TCACTGCCCAAGAACTATCAAACTCCTGAGCCAACAACTTAATATGACTAGCTTACACAATAGCTTTTATAGTAAAGATACCTCTTTACGGACTCCACTT\- \ATGACTCCCTAAAGCCCATGTCGAAGCCCCCATCGCTGGGTCAATAGTACTTGCCGCAGTACTCTTAAAACTAGGCGGCTATGGTATAATACGCCTCACA\- \CTCATTCTCAACCCCCTGACAAAACACATAGCCTACCCCTTCCTTGTACTATCCCTATGAGGCATAATTATAACAAGCTCCATCTGCCTACGACAAACAG\- \ACCTAAAATCGCTCATTGCATACTCTTCAATCAGCCACATAGCCCTCGTAGTAACAGCCATTCTCATCCAAACCCCCTGAAGCTTCACCGGCGCAGTCAT\- \TCTCATAATCGCCCACGGGCTTACATCCTCATTACTATTCTGCCTAGCAAACTCAAACTACGAACGCACTCACAGTCGCATCATAATCCTCTCTCAAGGA\- \CTTCAAACTCTACTCCCACTAATAGCTTTTTGATGACTTCTAGCAAGCCTCGCTAACCTCGCCTTACCCCCCACTATTAACCTACTGGGAGAACTCTCTG\- \TGCTAGTAACCACGTTCTCCTGATCAAATATCACTCTCCTACTTACAGGACTCAACATACTAGTCACAGCCCTATACTCCCTCTACATATTTACCACAAC\- \ACAATGGGGCTCACTCACCCACCACATTAACAACATAAAACCCTCATTCACACGAGAAAACACCCTCATGTTCATACACCTATCCCCCATTCTCCTCCTA\- \TCCCTCAACCCCGACATCATTACCGGGTTTTCCTCTTGTAAATATAGTTTAACCAAAACATCAGATTGTGAATCTGACAACAGAGGCTTACGACCCCTTA\- \TTTACCGAGAAAGCTCACAAGAACTGCTAACTCATGCCCCCATGTCTAACAACATGGCTTTCTCAACTTTTAAAGGATAACAGCTATCCATTGGTCTTAG\- \GCCCCAAAAATTTTGGTGCAACTCCAAATAAAAGTAATAACCATGCACACTACTATAACCACCCTAACCCTGACTTCCCTAATTCCCCCCATCCTTACCA\- \CCCTCGTTAACCCTAACAAAAAAAACTCATACCCCCATTATGTAAAATCCATTGTCGCATCCACCTTTATTATCAGTCTCTTCCCCACAACAATATTCAT\- \GTGCCTAGACCAAGAAGTTATTATCTCGAACTGACACTGAGCCACAACCCAAACAACCCAGCTCTCCCTAAGCTTCAAACTAGACTACTTCTCCATAATA\- \TTCATCCCTGTAGCATTGTTCGTTACATGGTCCATCATAGAATTCTCACTGTGATATATAAACTCAGACCCAAACATTAATCAGTTCTTCAAATATCTAC\- \TCATCTTCCTAATTACCATACTAATCTTAGTTACCGCTAACAACCTATTCCAACTGTTCATCGGCTGAGAGGGCGTAGGAATTATATCCTTCTTGCTCAT\- \CAGTTGATGATACGCCCGAGCAGATGCCAACACAGCAGCCATTCAAGCAATCCTATACAACCGTATCGGCGATATCGGTTTCATCCTCGCCTTAGCATGA\- \TTTATCCTACACTCCAACTCATGAGACCCACAACAAATAGCCCTTCTAAACGCTAATCCAAGCCTCACCCCACTACTAGGCCTCCTCCTAGCAGCAGCAG\- \GCAAATCAGCCCAATTAGGTCTCCACCCCTGACTCCCCTCAGCCATAGAAGGCCCCACCCCAGTCTCAGCCCTACTCCACTCAAGCACTATAGTTGTAGC\- \AGGAATCTTCTTACTCATCCGCTTCCACCCCCTAGCAGAAAATAGCCCACTAATCCAAACTCTAACACTATGCTTAGGCGCTATCACCACTCTGTTCGCA\- \GCAGTCTGCGCCCTTACACAAAATGACATCAAAAAAATCGTAGCCTTCTCCACTTCAAGTCAACTAGGACTCATAATAGTTACAATCGGCATCAACCAAC\- \CACACCTAGCATTCCTGCACATCTGTACCCACGCCTTCTTCAAAGCCATACTATTTATGTGCTCCGGGTCCATCATCCACAACCTTAACAATGAACAAGA\- \TATTCGAAAAATAGGAGGACTACTCAAAACCATACCTCTCACTTCAACCTCCCTCACCATTGGCAGCCTAGCATTAGCAGGAATACCTTTCCTCACAGGT\- \TTCTACTCCAAAGACCACATCATCGAAACCGCAAACATATCATACACAAACGCCTGAGCCCTATCTATTACTCTCATCGCTACCTCCCTGACAAGCGCCT\- \ATAGCACTCGAATAATTCTTCTCACCCTAACAGGTCAACCTCGCTTCCCCACCCTTACTAACATTAACGAAAATAACCCCACCCTACTAAACCCCATTAA\- \ACGCCTGGCAGCCGGAAGCCTATTCGCAGGATTTCTCATTACTAACAACATTTCCCCCGCATCCCCCTTCCAAACAACAATCCCCCTCTACCTAAAACTC\- \ACAGCCCTCGCTGTCACTTTCCTAGGACTTCTAACAGCCCTAGACCTCAACTACCTAACCAACAAACTTAAAATAAAATCCCCACTATGCACATTTTATT\- \TCTCCAACATACTCGGATTCTACCCTAGCATCACACACCGCACAATCCCCTATCTAGGCCTTCTTACGAGCCAAAACCTGCCCCTACTCCTCCTAGACCT\- \AACCTGACTAGAAAAGCTATTACCTAAAACAATTTCACAGCACCAAATCTCCACCTCCATCATCACCTCAACCCAAAAAGGCATAATTAAACTTTACTTC\- \CTCTCTTTCTTCTTCCCACTCATCCTAACCCTACTCCTAATCACATAACCTATTCCCCCGAGCAATCTCAATTACAATATATACACCAACAAACAATGTT\- \CAACCAGTAACTACTACTAATCAACGCCCATAATCATACAAAGCCCCCGCACCAATAGGATCCTCCCGAATCAACCCTGACCCCTCTCCTTCATAAATTA\- \TTCAGCTTCCTACACTATTAAAGTTTACCACAACCACCACCCCATCATACTCTTTCACCCACAGCACCAATCCTACCTCCATCGCTAACCCCACTAAAAC\- \ACTCACCAAGACCTCAACCCCTGACCCCCATGCCTCAGGATACTCCTCAATAGCCATCGCTGTAGTATATCCAAAGACAACCATCATTCCCCCTAAATAA\- \ATTAAAAAAACTATTAAACCCATATAACCTCCCCCAAAATTCAGAATAATAACACACCCGACCACACCGCTAACAATCAATACTAAACCCCCATAAATAG\- \GAGAAGGCTTAGAAGAAAACCCCACAAACCCCATTACTAAACCCACACTCAACAGAAACAAAGCATACATCATTATTCTCGCACGGACTACAACCACGAC\- \CAATGATATGAAAAACCATCGTTGTATTTCAACTACAAGAACACCAATGACCCCAATACGCAAAACTAACCCCCTAATAAAATTAATTAACCACTCATTC\- \ATCGACCTCCCCACCCCATCCAACATCTCCGCATGATGAAACTTCGGCTCACTCCTTGGCGCCTGCCTGATCCTCCAAATCACCACAGGACTATTCCTAG\- \CCATGCACTACTCACCAGACGCCTCAACCGCCTTTTCATCAATCGCCCACATCACTCGAGACGTAAATTATGGCTGAATCATCCGCTACCTTCACGCCAA\- \TGGCGCCTCAATATTCTTTATCTGCCTCTTCCTACACATCGGGCGAGGCCTATATTACGGATCATTTCTCTACTCAGAAACCTGAAACATCGGCATTATC\- \CTCCTGCTTGCAACTATAGCAACAGCCTTCATAGGCTATGTCCTCCCGTGAGGCCAAATATCATTCTGAGGGGCCACAGTAATTACAAACTTACTATCCG\- \CCATCCCATACATTGGGACAGACCTAGTTCAATGAATCTGAGGAGGCTACTCAGTAGACAGTCCCACCCTCACACGATTCTTTACCTTTCACTTCATCTT\- \GCCCTTCATTATTGCAGCCCTAGCAACACTCCACCTCCTATTCTTGCACGAAACGGGATCAAACAACCCCCTAGGAATCACCTCCCATTCCGATAAAATC\- \ACCTTCCACCCTTACTACACAATCAAAGACGCCCTCGGCTTACTTCTCTTCCTTCTCTCCTTAATGACATTAACACTATTCTCACCAGACCTCCTAGGCG\- \ACCCAGACAATTATACCCTAGCCAACCCCTTAAACACCCCTCCCCACATCAAGCCCGAATGATATTTCCTATTCGCCTACACAATTCTCCGATCCGTCCC\- \TAACAAACTAGGAGGCGTCCTTGCCCTATTACTATCCATCCTCATCCTAGCAATAATCCCCATCCTCCATATATCCAAACAACAAAGCATAATATTTCGC\- \CCACTAAGCCAATCACTTTATTGACTCCTAGCCGCAGACCTCCTCATTCTAACCTGAATCGGAGGACAACCAGTAAGCTACCCTTTTACCATCATTGGAC\- \AAGTAGCATCCGTACTATACTTCACAACAATCCTAATCCTAATACCAACTATCTCCCTAATTGAAAACAAAATACTCAAATGGGCCTGTCCTTGTAGTAT\- \AAACTAATACACCAGTCTTGTAAACCGGAGATGAAAACCTTTTTCCAAGGACAAATCAGAGAAAAAGTCTTTAACTCCACCATTAGCACCCAAAGCTAAG\- \ATTCTAATTTAAACTATTCTCTGTTCTTTCATGGGGAAGCAGATTTGGGTACCACCCAAGTATTGACTCACCCATCAACAACCGCTATGTATTTCGTACA\- \TTACTGCCAGCCACCATGAATATTGTACGGTACCATAAATACTTGACCACCTGTAGTACATAAAAACCCAATCCACATCAAAACCCCCTCCCCATGCTTA\- \CAAGCAAGTACAGCAATCAACCCTCAACTATCACACATCAACTGCAACTCCAAAGCCACCCCTCACCCACTAGGATACCAACAAACCTACCCACCCTTAA\- \CAGTACATAGTACATAAAGCCATTTACCGTACATAGCACATTACAGTCAAATCCCTTCTCGTCCCCATGGATGACCCCCCTCAGATAGGGGTCCCTTGAC\- \CACCATCCTCCGTGAAATCAATATCCCGCACAAGAGTGCTACTCTCCTCGCTCCGGGCCCATAACACTTGGGGGTAGCTAAAGTGAACTGTATCCGACAT\- \CTGGTTCCTACTTCAGGGTCATAAAGCCTAAATAGCCCACACGTTCCCCTTAAATAAGACATCACGATG"-
− tools/SimpleSeed.hs
@@ -1,105 +0,0 @@-module SimpleSeed where--import Bio.Bam.Rec-import Bio.Prelude--import qualified Data.IntMap as IM-import qualified Data.Vector.Generic as V-import qualified Data.Vector.Unboxed as U---- | Discontiguous template "12 of 16", stolen from MegaBLAST:--- 1,110,110,110,110,111, with two bits per base gives 0xFCF3CF3F--template :: Int-template = 0xFCF3CF3F--create_seed_words :: [Nucleotides] -> [(Int, Int)]-create_seed_words = drop 32 . go 0x0 (-16) 0x0 0- where- go !accf !i !accr !ir s =- (accf .&. template, i) : (accr .&. template, ir) : case s of- [ ] -> []- (Ns n:ns) -> go (accf `shiftR` 2 .|. (codef U.! fromIntegral n) `shiftL` 30) (i+1)- (accr `shiftL` 2 .|. (coder U.! fromIntegral n)) (ir-1) ns-- -- These codes are chosen so that ambiguity codes result in zeroes.- -- The seed word 0, which would otherwise be the low-complexity and- -- useless poly-A, is later ignored.- codef, coder :: U.Vector Int- codef = U.fromList [0,0,1,0,2,0,0,0,3,0,0,0,0,0,0,0]- coder = U.fromList [0,3,2,0,1,0,0,0,0,0,0,0,0,0,0,0]---- Turns a list of seed words into a map. Only the first entry is used,--- duplicates are discarded silenty.--data I2 = I2 !Int !Int--newtype SeedMap = SM { unSM :: IM.IntMap Int }- deriving Show--create_seed_map :: [Nucleotides] -> SeedMap-create_seed_map = SM . cleanup . foldl' (\m (k,v) -> IM.insertWith' add k v m) IM.empty .- map (\(x,y) -> (x,(I2 1 y))) . create_seed_words . pad- where pad ns = ns ++ take 15 ns- add (I2 x i) (I2 y _) = I2 (x+y) i- cleanup = IM.mapMaybe $ \(I2 n j) -> if n < 8 then Just j else Nothing--create_seed_maps :: [[Nucleotides]] -> SeedMap-create_seed_maps = SM . IM.unionsWith const . map (unSM . create_seed_map)---- | Actual seeding. We take every hit and guesstimate an alignment--- region from it (by adding the overhanging sequence parts and rounding--- a bit up). Regions are overlapped into larger ones, counting votes.--- The region with the most votes is used as seed region. (This will--- occasionally result in a very long initial alignment. We can afford--- that.)------ If we have PE data where only one read is seeded, we can either--- discard the pair or align the second mate very expensively. While--- possible, that sounds rather expensive and should probably depend on--- the quality of the first mates' alignment. Generally, we may want to--- check the quality of the initial alignment anyway.------ For proper overlapping, we need to normalize each region to strictly--- positive or strictly negative coordinates. After sorting and--- overlapping, we only need to check if the last region overlaps the--- first---there can be only one such overlap per strand. We should--- probably discard overly long regions.--do_seed :: Int -> SeedMap -> BamRec -> Maybe (Int,Int)-do_seed ln (SM sm) BamRec{..} = case rgns of [ ] -> Nothing- (a,b,_) : _ -> Just (a,b)- where- seeds = filter ((/= 0) . fst) $ filter ((/= template) . fst) $- filter ((>= 0) . snd) $ create_seed_words $ V.toList b_seq-- more x = (x * 9) `div` 8 + 16-- rgns = sortBy (\(_,_,c) (_,_,z) -> compare z c) $ filter reasonably_short $- (wrap_with id $ overlap $ sort $ map norm_right rgns_fwd) ++- (wrap_with norm_left $ overlap $ sort $ map norm_left rgns_rev)-- (rgns_fwd, rgns_rev) = let put (f,r) (i,j) | j >= 0 = (rgn:f, r)- | otherwise = (f, rgn:r)- where rgn = (j - more i, j + more (V.length b_seq - i), 1::Int)- in foldl put ([],[]) [ (i,j) | (k,i) <- seeds, j <- maybeToList $ IM.lookup k sm ]-- norm_right (a,b,n) = if a < 0 then (a+ln, b+ln, n) else (a,b,n)- norm_left (a,b,n) = if b >= 0 then (a-ln, b-ln, n) else (a,b,n)-- wrap_with _ [ ] = []- wrap_with _ [ r ] = [r]- wrap_with f rs@((x,y,n):rs')- | i <= y+ln && x+ln <= j = f (min (x+ln) i, max (y+ln) j, n+m) : init rs'- | otherwise = rs- where- (i,j,m) = last rs-- overlap ( (x,y,n) : (i,j,m) : rs ) | i <= y = overlap ( (x,max y j,n+m) : rs )- overlap ( (x,y,n) : rs ) = (x,y,n) : overlap rs- overlap [] = []-- -- First cut: reasonable is less than the whole MT. Tuning can- -- come later.- reasonably_short (x,y,_) = y-x < ln-
− tools/Xlate.hs
@@ -1,55 +0,0 @@-module Xlate where--import qualified Data.ByteString.Char8 as S-import qualified Data.IntMap as I-import qualified Data.List as L-import qualified Data.Map as M-import Prelude---- aligned sequences in, coodinate on first in, coordinate on second out-xpose :: S.ByteString -> S.ByteString -> Int -> Int-xpose ref smp = \p -> I.findWithDefault (-1) p mm- where- (!mm,_,_) = L.foldl' advance (I.empty, 0, 0) $ S.zip ref smp- advance (!m,!p1,!p2) (r,s) = let !p1' = if r == '-' then p1 else 1+p1- !p2' = if s == '-' then p2 else 1+p2- in if r == '-' then (m,p1',p2')- else (I.insert p1' p2' m, p1', p2')---- diffz :: CDS -> [(String, Int, Char, Char)]--- diffz cds@(CDS _ nm _) = [ (nm, i, r, b) | (i,r,b) <- zip3 [1..] aa_ref aa_bnt, r /= b ]- -- where (aa_ref, aa_bnt) = get_protein cds--get_protein :: S.ByteString -> (Int,Int) -> String-get_protein ns (s,e) = translate $ cutout- where- cutout | s <= e = (take (e-s+1) $ drop (s-1) $ filter (/= '-') $ S.unpack ns) ++ "AA"- | otherwise = (map compl $ reverse $- take (s-e+1) $ drop (e-1) $ filter (/= '-') $ S.unpack ns) ++ "AA"-- compl 'A' = 'T'- compl 'C' = 'G'- compl 'G' = 'C'- compl 'T' = 'A'- compl x = x---translate :: String -> String-translate (a:b:c:s) = m : translate s- where m = M.findWithDefault 'X' (a,b,c) mito_code-translate _ = []--standard_code :: M.Map (Char,Char,Char) Char-standard_code = M.fromList $ zip3 base1 base2 base3 `zip` aas- where- aas = "FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG"- base1 = "TTTTTTTTTTTTTTTTCCCCCCCCCCCCCCCCAAAAAAAAAAAAAAAAGGGGGGGGGGGGGGGG"- base2 = "TTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGG"- base3 = "TCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAG"--mito_code :: M.Map (Char,Char,Char) Char-mito_code = M.insert ('A','G','A') '*' $- M.insert ('A','G','G') '*' $- M.insert ('A','T','A') 'M' $- M.insert ('T','G','A') 'W' $ standard_code-
− tools/afroengineer.hs
@@ -1,282 +0,0 @@--- Cobble up a mitochondrion, or something similar. This is not an--- assembly, but something that could serve in stead of one :)------ The goal is to reconstruct a mitochondrion (or similar small, haploid--- locus) from a set of sequencing reads and a reference sequence. The--- idea is to first select reads using some sort of filtering strategy,--- simply for speed reasons. They are then aligned to the reference--- using banded Smith-Waterman algorithm, and a more likely reference is--- called. This is repeated till it converges. A bad implementation of--- the idea was called MIA.--import Align-import SimpleSeed--import Bio.Bam-import Bio.Prelude hiding ( round, left, right )-import System.Console.GetOpt-import System.Directory ( doesFileExist )--import qualified Bio.Iteratee.ZLib as ZLib-import qualified Data.ByteString.Char8 as S-import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.Sequence as Z-import qualified Data.Vector.Generic as V---- Read a FastA file, drop the names, yield the sequences.-readFasta :: L.ByteString -> [( S.ByteString, [Either Nucleotides Nucleotides] )]-readFasta = go . dropWhile (not . isHeader) . L.lines- where- isHeader s = not (L.null s) && L.head s == '>'-- go [ ] = []- go (hd:ls) = case break isHeader ls of- (body, rest) -> let ns = map toNuc . concat $ map L.unpack body- nm = S.concat . L.toChunks . L.tail . head $ L.words hd- in (nm,ns) : if null rest then [] else go rest-- toNuc x | isUpper x = Right $ toNucleotides x- | otherwise = Left $ toNucleotides (toUpper x)----- | A query record. We construct these after the seeding phase and--- keep the bare minimum: name, sequence/quality, seed region, flags--- (currently only the strand). Just enough to write a valig BAM file.--data QueryRec = QR { qr_name :: !Seqid -- from BAM- , qr_seq :: !QuerySeq -- sequence and quality- , qr_pos :: !RefPosn -- start position of band- , qr_band :: !Bandwidth } -- bandwidth (negative to indicate reversed sequence_- deriving Show--data Conf = Conf {- conf_references :: [FilePath] -> [FilePath],- conf_aln_outputs :: Maybe (Int -> FilePath),- conf_cal_outputs :: Maybe (Int -> FilePath) }--iniconf :: Conf-iniconf = Conf id Nothing Nothing--options :: [ OptDescr (Conf -> IO Conf) ]-options = [- Option "r" ["reference"] (ReqArg add_ref "FILE") "Read references from FILE",- Option "a" ["align-out"] (ReqArg set_aln_out "PAT") "Write intermediate alignments to PAT",- Option "c" ["called-out"] (ReqArg set_cal_out "PAT") "Write called references to PAT" ]- where- add_ref f c = return $ c { conf_references = conf_references c . (:) f }- set_aln_out p c = return $ c { conf_aln_outputs = Just (splice_pat p) }- set_cal_out p c = return $ c { conf_cal_outputs = Just (splice_pat p) }-- splice_pat [] _ = []- splice_pat ('%':'%':s) x = '%' : splice_pat s x- splice_pat ('%':'d':s) x = shows x $ splice_pat s x- splice_pat (c:s) x = c : splice_pat s x--main :: IO ()-main = do- (opts, files, errors) <- getOpt Permute options <$> getArgs- unless (null errors) $ mapM_ (hPutStrLn stderr) errors >> exitFailure- Conf{..} <- foldl (>>=) (return iniconf) opts-- inputs@((refname,reference):_) <- concatMap readFasta <$> mapM L.readFile (conf_references [])-- let !sm = create_seed_maps (map (map (either id id) . snd) inputs)- !rs = prep_reference reference-- let bamhdr = mempty { meta_hdr = BamHeader (1,4) Unsorted []- , meta_refs = Z.singleton $ BamSQ refname (length reference) [] }--- -- uhh.. termination condition?- let round n k = do let bamout = case conf_aln_outputs of- Nothing -> skipToEof- Just nf -> write_iter_bam (nf n) bamhdr- (newref, queries) <- k bamout- case conf_cal_outputs of Nothing -> return ()- Just nf -> write_ref_fasta (nf n) n newref- putStrLn $ "Round " ++ shows n ": Kept " ++ shows (length queries) " queries."- round (n+1) (\out -> enumPure1Chunk queries >=> run $ roundN newref out)-- round 1 (\out -> foldr ((>=>) . readFreakingInput) run files $ round1 sm rs out)-- -- print queries- -- return ()----- General plan: In the first round, we read, seed, align, call the new--- working sequence, and write a BAM file. Then write the new working--- sequence out. In subsequent rounds, the seeding is skipped and the--- sequences come from memory.------ XXX the bandwidth is too low, definitely in round 1, probably in--- subsequent rounds.--round1 :: MonadIO m- => SeedMap -> RefSeq- -> Iteratee [(QueryRec, AlignResult)] m () -- BAM output- -> Iteratee [BamRec] m -- queries in- (RefSeq, [QueryRec]) -- new reference & queries out-round1 sm rs out = convStream (headStream >>= seed) =$ roundN rs out- where- seed br@BamRec{..}- | low_qual = return []- | otherwise = case do_seed (refseq_len rs) sm br of- Nothing -> return []- Just (a,b) | a >= 0 -> return [ QR b_qname (prep_query_fwd br) (RP a ) (BW bw ) ]- | otherwise -> return [ QR b_qname (prep_query_rev br) (RP (-b)) (BW (-bw)) ]- where bw = b - a - V.length b_seq- where- low_qual = 2 * l1 < l2- l2 = V.length b_seq- l1 = V.length $ V.filter (> Q 10) b_qual--roundN :: Monad m- => RefSeq- -> Iteratee [(QueryRec, AlignResult)] m () -- BAM output- -> Iteratee [QueryRec] m -- queries in- (RefSeq, [QueryRec]) -- new reference & queries out-roundN rs out = do- ((), (rs', xtab), qry') <- mapStream aln =$ filterStream good =$- zipStreams3 out mkref collect- return (rs', reverse $ map (xlate xtab) qry')-- where- gap_cost = 50 -- Hmm, better suggestions?- pad = 8-- aln qr@QR{..} = let res = align gap_cost rs qr_seq qr_pos qr_band- in ( new_coords qr res, res )- good (_, res) = viterbi_score res < 0-- mkref = finalize_ref_seq `liftM` foldStream step (new_ref_seq rs)- step nrs (qr, res) = add_to_refseq nrs (qr_seq qr) res-- collect :: Monad m => Iteratee [(QueryRec, AlignResult)] m [(Int,Int,QueryRec)]- collect = foldStream (\l (!qr,!ar) ->- -- get alignment ends from ar, add some buffer- -- XXX does this yield invalid coordinates?- let !left = viterbi_position ar - 8- !right = viterbi_position ar + 8 + alignedLength (viterbi_backtrace ar)- in (left,right,qr) : l) []-- xlate :: XTab -> (Int, Int, QueryRec) -> QueryRec- xlate tab (l,r,qr)- | r <= l = error "confused reft and light"- | left < 0 || right < 0 = error "too far left"- | right' < left = error "flipped over"- | otherwise = qr { qr_pos = RP left, qr_band = BW $ right' - left }- where- lk x | x < 0 = Z.index tab (x + Z.length tab - 1)- | x < Z.length tab = Z.index tab x- | otherwise = Z.index tab (x - Z.length tab + 1)-- left = lk l ; right = lk r ; _ Z.:> newlen = Z.viewr tab- right' = if left < right then right else right + newlen-- new_coords qr rr = qr { qr_pos = RP $ viterbi_position rr - pad- , qr_band = BW $ (if reversed (qr_band qr) then negate else id) $- 2*pad + max_bandwidth (viterbi_backtrace rr) }-- reversed (BW x) = x < 0-- max_bandwidth = (+1) . (*2) . V.maximum . V.map abs . V.scanl plus 0-- plus a (Mat :* _) = a- plus a (Ins :* n) = a+n- plus a (Del :* n) = a-n------ Outline for further rounds: We keep the same queries, we use the new--- reference called in the previous round. Output is channelled to--- different files. However, we need to translate coordinates to keep--- the alignment windows in the correct places. This should actually--- come from the calling of the new reference. Note that coordinate--- translation may actually change the bandwidth. Also we have to--- compute a sensible bandwidth from the alignment.--write_iter_bam :: FilePath -> BamMeta -> Iteratee [(QueryRec, AlignResult)] IO ()-write_iter_bam fp hdr = mapStream conv =$ writeBamFile fp hdr- where- conv (QR{..}, AlignResult{..}) = BamRec- { b_qname = qname- , b_flag = if reversed qr_band then flagReversed else 0- , b_rname = Refseq 0- , b_pos = viterbi_position- , b_mapq = Q 255- , b_cigar = viterbi_backtrace- , b_mrnm = invalidRefseq- , b_mpos = 0- , b_isize = 0- , b_seq = qseqToBamSeq qr_seq- , b_qual = qseqToBamQual qr_seq- , b_virtual_offset = 0- , b_exts = [] }- where- qname = qr_name `S.append` S.pack (" " ++ showFFloat (Just 1) viterbi_score [])- reversed (BW x) = x < 0---- | Calls sequence and writes to file. We call a base only if the gap--- has a probability lower than 50%. We call a weak base if the gap has--- a probality of more than 25%. If the most likely base is at least--- twice as likely as the second most likely one, we call it. Else we--- call an N or n.-write_ref_fasta :: FilePath -> Int -> RefSeq -> IO ()-write_ref_fasta fp num rs = writeFile fp $ unlines $- (">genotype_call-" ++ show num) : chunk 70 (ref_to_ascii rs)- where- chunk n s = case splitAt n s of _ | null s -> [] ; (l,r) -> l : chunk n r--ref_to_ascii :: RefSeq -> String-ref_to_ascii (RS v) = [ base | i <- [0, 5 .. V.length v - 5]- , let pgap = indexV "ref_to_ascii/pgap" v (i+4)- , pgap > 3- , let letters = if pgap <= 6 then "acgtn" else "ACGTN"- , let (ix, p1, p2) = minmin i 4- , let good = p2 - p1 >= 3 -- probably nonsense- , let base = S.index letters $ if good then ix else trace (show (V.slice i 5 v)) 4 ]- where- minmin i0 l = V.ifoldl' step (l, 255, 255) $ V.slice i0 l v- step (!i, !m, !n) j x | x <= m = (j, x, m)- | x <= n = (i, m, x)- | otherwise = (i, m, n)----readFreakingInput :: (MonadIO m, MonadMask m) => FilePath -> Enumerator [BamRec] m b-readFreakingInput fp k | ".bam" `isSuffixOf` fp = do liftIO (hPutStrLn stderr $ "Reading BAM from " ++ fp)- decodeAnyBamFile fp . const $= mapStream unpackBam $ k- | otherwise = maybe_read_two fp unzipFastq k--check_r2 :: FilePath -> IO (Maybe FilePath)-check_r2 = go [] . reverse- where- go acc ('1':'r':fp) = do let fp' = reverse fp ++ 'r' : '2' : acc- e <- doesFileExist fp'- return $ if e then Just fp' else Nothing- go acc (c:fp) = go (c:acc) fp- go _ [ ] = return Nothing--maybe_read_two :: (MonadIO m, MonadMask m)- => FilePath- -> (forall m1 b . (MonadIO m1, MonadMask m1) => Enumeratee S.ByteString [BamRec] m1 b)- -> Enumerator [BamRec] m a-maybe_read_two fp e1 = (\k -> liftIO (check_r2 fp) >>= maybe (rd1 k) (rd2 k))- where- rd1 k = do liftIO (hPutStrLn stderr $ "Reading FastQ from " ++ fp)- enumFile defaultBufSize fp $= e1 $ k- rd2 k fp' = do liftIO (hPutStrLn stderr $ "Reading FastQ from " ++ fp ++ " and " ++ fp')- mergeEnums (enumFile defaultBufSize fp $= e1)- (enumFile defaultBufSize fp' $= e1)- (convStream unite_pairs) k---- No, we don't need to 'removeWarts'. This input is, of course, a special case. :-(-unzipFastq :: MonadIO m => Enumeratee S.ByteString [BamRec] m b-unzipFastq = ZLib.enumInflateAny ><> parseFastq--unite_pairs :: Monad m => Iteratee [BamRec] (Iteratee [BamRec] m) [BamRec]-unite_pairs = do a <- lift headStream- b <- headStream- return [ a { b_flag = b_flag a .|. flagFirstMate }- , b { b_flag = b_flag b .|. flagSecondMate } ]-
− tools/bam-fixpair.hs
@@ -1,684 +0,0 @@-{-# LANGUAGE CPP #-}-{--This is a validator/fixup for paired end BAM files, that is more-efficient than 'samtools sort -n' followed by 'samtools fixmate'.--We want both: to quickly join separate mates together again from the-information about the mate's mapping coordinate, but at the same time-deal with broken files where that doesn't actually work. Whenever we-join mates, we also check if the flags are consistent and fix them if-they aren't.--In the end, the code will work...-- - splendidly, if mates are already adjacent, in which case everything- is streamed.- - well, if the input is sorted properly, in which case most reads- stream, but improper pairs need to queue until the mate is reached.- - reasonably, if there are occasional widows, which will be queued- to the very end and sorted by hashed-qname before they are recognized- and repaired.- - awkwardly, if sorting is violated, flags are wrong or widows are- the rule, because then it degenerates to a full sort by qname.--TODO:- . upgrade to pqueue in external memory- . a companion program that sorts would be cool, but it should be an- opportunistic sort that is fast on almost sorted files.--}--import Bio.Bam hiding ( mergeInputs, combineCoordinates )-import Bio.Prelude hiding ( yield )-import Bio.PriorityQueue-import Bio.Util.Numeric ( showNum )-import Control.Concurrent.Async-import Control.Concurrent.STM.TQueue-import Control.Concurrent.STM.TVar-import Control.Monad.Trans.Class-import Data.Binary-import Paths_biohazard ( version )-import System.Console.GetOpt-import System.Process-#if MIN_VERSION_process(1,2,1)- hiding ( createPipe )-#endif--import qualified Data.ByteString as S-import qualified Data.ByteString.Builder as B-import qualified Data.Vector.Generic as V--data Verbosity = Silent | Errors | Warnings | Notices deriving (Eq, Ord)-data KillMode = KillNone | KillUu | KillAll deriving (Eq, Ord)--data Config = CF { report_mrnm :: !Bool- , report_mpos :: !Bool- , report_isize :: !Bool- , report_flags :: !Bool- , report_fflag :: !Bool- , report_ixs :: !Bool- , verbosity :: Verbosity- , killmode :: KillMode- , infilter :: BamPair -> Bool- , output :: BamMeta -> Iteratee [BamRec] IO ExitCode- , fixsven :: Maybe Int }--config0 :: IO Config-config0 = return $ CF True True False True False True Errors KillNone- (const True) (fmap (const ExitSuccess) . protectTerm . pipeBamOutput) Nothing--options :: [OptDescr (Config -> IO Config)]-options = [- Option "o" ["output"] (ReqArg set_output "FILE") "Write output to FILE",- Option "X" ["exec"] (NoArg return) "Send FastQ output to a program",- Option "n" ["dry-run","validate"] (NoArg set_validate) "No output, validate only",- Option "k" ["kill-widows"] (NoArg (\c -> return $ c { killmode = KillAll })) "Delete all widows",- Option "u" ["kill-unmapped"](NoArg (\c -> return $ c { killmode = KillUu })) "Delete unmapped widows",- Option [ ] ["kill-none"] (NoArg (\c -> return $ c { killmode = KillNone })) "Never delete widows (default)",-- Option "v" ["verbose"] (NoArg (\c -> return $ c { verbosity = Notices })) "Print informational messages",- Option "w" ["warnings"] (NoArg (\c -> return $ c { verbosity = Warnings })) "Print warnings and errors",- Option [ ] ["errors"] (NoArg (\c -> return $ c { verbosity = Errors })) "Print only errors (default)",- Option "q" ["quiet"] (NoArg (\c -> return $ c { verbosity = Silent })) "Print only fatal errors",-- Option "" ["report-mrnm"] (NoArg (\c -> return $ c { report_mrnm = True })) "Report wrong mate reference name (default yes)",- Option "" ["report-mpos"] (NoArg (\c -> return $ c { report_mpos = True })) "Report wrong mate position (default yes)",- Option "" ["report-isize"] (NoArg (\c -> return $ c { report_isize = True })) "Report wrong insert size (default no)",- Option "" ["report-flags"] (NoArg (\c -> return $ c { report_flags = True })) "Report wrong flags (default yes)",- Option "" ["report-fflag"] (NoArg (\c -> return $ c { report_fflag = True })) "Report commonly inconsistent flags (default no)",- Option "" ["report-ixs"] (NoArg (\c -> return $ c { report_ixs = False })) "Report mismatched index fields (default yes)",-- Option "" ["no-report-mrnm"] (NoArg (\c -> return $ c { report_mrnm = False })) "Do not report wrong mate reference name",- Option "" ["no-report-mpos"] (NoArg (\c -> return $ c { report_mpos = False })) "Do not report wrong mate position",- Option "" ["no-report-isize"] (NoArg (\c -> return $ c { report_isize = False })) "Do not report wrong insert size",- Option "" ["no-report-flags"] (NoArg (\c -> return $ c { report_flags = False })) "Do not report wrong flags",- Option "" ["no-report-fflag"] (NoArg (\c -> return $ c { report_fflag = False })) "Do not report commonly inconsistent flags",- Option "" ["no-report-ixs"] (NoArg (\c -> return $ c { report_ixs = False })) "Do not report mismatched index fields",-- Option "" ["only-mapped"] (NoArg (\c -> return $ c { infilter = mapped_only })) "Ignore totally unmapped input",- Option "" ["fix-sven"] (ReqArg set_fixsven "QUAL") "Trim 3' ends of avg qual lower than QUAL",-- Option "h?" ["help","usage"] (NoArg usage) "Print this helpful message and exit",- Option "V" ["version"] (NoArg vrsn) "Print version number and exit" ]- where- usage _ = do pn <- getProgName- let blah = "Usage: " ++ pn ++ " [OPTION...] [FILE...]\n" ++- "Merge BAM files, rearrange them to move mate pairs together, " ++- "output a file with consistent mate pair information."- hPutStrLn stderr $ usageInfo blah options- exitSuccess-- vrsn _ = do pn <- getProgName- hPutStrLn stderr $ pn ++ ", version " ++ showVersion version- exitSuccess-- set_output "-" c = return $ c { output = fmap (const ExitSuccess) . pipeBamOutput }- set_output f c = return $ c { output = fmap (const ExitSuccess) . writeBamFile f }- set_validate c = return $ c { output = \_ -> ExitSuccess <$ skipToEof }- set_fixsven a c = readIO a >>= \q -> return $ c { fixsven = Just q }--mapped_only :: BamPair -> Bool-mapped_only p = case p of- Singleton a -> okay a- LoneMate a -> okay a- Pair a b -> okay a || okay b- where- okay = (\r -> not (isUnmapped r) || (isPaired r && not (isMateUnmapped r))) . unpackBam--pipe_to :: FilePath -> [String] -> ([Config -> IO Config], t1, t2) -> ([Config -> IO Config], t1, t2)-pipe_to cmd args (opts, errs, fs) = (mkout : opts, errs, fs)- where- mk1out key test (as, flush, qs, vs, ps, rfds)- | all (/= key) as = return (as, flush, qs, vs, ps, rfds)- | otherwise = do- (pout, pin) <- createPipe- setFdOption pin CloseOnExec True- queue <- newTQueueIO- vnum <- newTVarIO (0::Int)- pid <- async $ flush_fastq queue vnum pin- link pid-- return ( map (\a -> if a == key then "/dev/fd/" ++ show pout else a) as- , \br -> when (test br) (modifyTVar' vnum succ >> writeTQueue queue (Just br)) >> flush br- , queue : qs- , vnum : vs- , pid : ps- , pout : rfds )-- mkout cfg = do- (args', flush_bam, queues, vars, pids, rfds) <- mk1out "CLOWNS" isFirstMate =<<- mk1out "JOKERS" isSecondMate =<<- mk1out "MIDDLE" (not . isPaired)- (args, const (return ()), [], [], [], [])- pid_cmd <- spawnProcess cmd args'- mapM_ closeFd rfds-- return $ cfg { output = \_ -> do- mapStreamM_ (\br -> atomically $ do ns <- mapM readTVar vars- when (minimum ns > 64) retry- flush_bam br)- liftIO $ do atomically $ mapM_ (flip writeTQueue Nothing) queues- mapM_ wait pids- waitForProcess pid_cmd }-- flush_fastq qq nn fd = do- mbr <- atomically $ readTQueue qq <* modifyTVar' nn pred- case mbr of- Just br -> do fdPutLazy fd . B.toLazyByteString $- B.char8 '@' <> B.byteString (b_qname br) <>- (if isFirstMate br then B.char8 '/' <> B.char8 '1' else mempty) <>- (if isSecondMate br then B.char8 '/' <> B.char8 '2' else mempty) <>- B.char8 '\n' <> V.foldr ((<>) . B.char8 . showNucleotides) mempty (b_seq br) <>- B.char8 '\n' <> B.char8 '+' <> B.char8 '\n' <>- V.foldr ((<>) . B.word8 . (+) 33 . unQ) (B.char8 '\n') (b_qual br)- flush_fastq qq nn fd- Nothing -> return ()----- XXX placeholder...-pqconf :: PQ_Conf-pqconf = PQ_Conf 1000 "/var/tmp/"--main :: IO ExitCode-main = do (args,cmd) <- break (`elem` ["-X","--exec"]) `fmap` getArgs- let (opts, files, errors) = (case cmd of _:cmd':args' -> pipe_to cmd' args' ; _ -> id)- $ getOpt Permute options args-- unless (null errors) $ mapM_ (hPutStrLn stderr) errors >> exitFailure- config <- foldl (>>=) config0 opts- add_pg <- addPG $ Just version- withQueues $ \queues ->- mergeInputs files >=> run $ \hdr ->- filterStream (infilter config) =$- re_pair queues config (meta_refs hdr) =$- mapChunks (maybe id do_trim (fixsven config)) =$- (output config) (add_pg hdr)----- | Fix a pair of reads. Right now fixes their order and checks that--- one is 1st mate, the other 2nd mate. More fixes to come.--fixmate :: MonadIO m => BamRaw -> BamRaw -> Mating r m [BamRec]-fixmate r s | isFirstMate (unpackBam r) && isSecondMate (unpackBam s) = sequence [go r s, go s r]- | isSecondMate (unpackBam r) && isFirstMate (unpackBam s) = sequence [go s r, go r s]- | otherwise = liftIO $ do hPutStrLn stderr $ "Names match, but 1st mate / 2nd mate flags do not: "- ++ unpack (b_qname (unpackBam r))- hPutStrLn stderr $ "There is no clear way to fix this file. Giving up."- exitFailure- where- -- position of 5' end- pos5 a = if isReversed a then b_pos a + alignedLength (b_cigar a) else b_pos a-- -- transfer info from b to a- go p q | null problems = return a- | otherwise = do infos <- filter (not . null) `fmap` sequence [ m | (_,_,m) <- problems ]- unless (null infos) $ liftIO $ hPutStrLn stderr $ message infos- return $ foldr (\(_,m,_) -> m) a problems- where- a = unpackBam p- b = unpackBam q-- problems = filter (\(x,_,_) -> not x) checks- checks = [ (b_mrnm a == b_rname b, \x -> x { b_mrnm = b_rname b }, count_mrnm)- , (b_mpos a == b_pos b, \x -> x { b_mpos = b_pos b }, count_mpos)- , (b_isize a == computedIsize, \x -> x { b_isize = computedIsize }, count_isize)- , (b_flag a === computedFlag, \x -> x { b_flag = computedFlag }, count_flags)- , (b_flag a =!= computedFlag, \x -> x { b_flag = computedFlag }, count_fflag)- , (b_indices a == common_indices, setIndices common_indices, count_ixs) ]-- message infos = "fixing " ++ shows (b_qname a `S.append` if isFirstMate a then "/1" else "/2")- ": \t" ++ intercalate ", " infos- !computedFlag' = (if b_rname a == invalidRefseq then (.|. flagUnmapped) else id) .- (if b_rname b == invalidRefseq then (.|. flagMateUnmapped) else id) .- (if isReversed b then (.|. flagMateReversed) else (.&. complement flagMateReversed)) .- (if isUnmapped b then (.|. flagMateUnmapped) else (.&. complement flagMateUnmapped)) .- (if isFailsQC b then (.|. flagFailsQC) else id) $- b_flag a-- !properly_paired = computedFlag' .&. (flagUnmapped .|. flagMateUnmapped) == 0 && b_rname a == b_rname b- !computedFlag = if properly_paired then computedFlag' else computedFlag' .&. complement flagProperlyPaired- !computedIsize = if properly_paired then pos5 b - pos5 a else 0-- reduce f | f .&. flagMateUnmapped == 0 = f .&. complement flagFailsQC- | otherwise = f .&. complement (flagFailsQC .|. flagMateReversed)-- f1 === f2 = reduce f1 == reduce f2- f1 =!= f2 = f1 /= f2 && f1 === f2-- onlyIf f m = (\z -> if z then m else "") `fmap` tells f-- count_mrnm = do modify $ \c -> c { num_mrnm = 1 + num_mrnm c }- let ra = unRefseq (b_mrnm a); rb = unRefseq (b_rname b)- onlyIf report_mrnm $ printf "MRNM %d is wrong (%d)" ra rb-- count_mpos = do modify $ \c -> c { num_mpos = 1 + num_mpos c }- onlyIf report_mpos $ printf "MPOS %d is wrong (%d)" (b_mpos a) (b_pos b)-- count_isize = do modify $ \c -> c { num_isize = 1 + num_isize c }- onlyIf report_isize $ printf "ISIZE %d is wrong (%d)" (b_isize a) computedIsize-- count_flags = do modify $ \c -> c { num_flags = 1 + num_flags c }- onlyIf report_flags $ printf "FLAG %03X is wrong (+%03X,-%03X)" (b_flag a) fp fm-- count_fflag = do modify $ \c -> c { num_fflag = 1 + num_fflag c }- onlyIf report_fflag $ printf "FLAG %03X is technically wrong (+%03X,-%03X)" (b_flag a) fp fm-- count_ixs = do modify $ \c -> c { num_ixs = 1 + num_ixs c }- onlyIf report_ixs $ printf "Index fields %s are wrong (%s)" (show $ b_indices a) (show common_indices)-- fp = computedFlag .&. complement (b_flag a)- fm = complement computedFlag .&. b_flag a-- index_fields = [ "XI", "XJ", "YI", "YJ", "RG", "BC" ]- b_indices x = [ extAsString key x | key <- index_fields ]- common_indices = zipWith max (b_indices a) (b_indices b)-- setIndices is x = x { b_exts = add_new . remove_old $ b_exts x }- where- add_new y = foldr (:) y $ zip index_fields $ map Text is- remove_old y = foldr deleteE y index_fields---- | Turns a widow into a single. Basically removes the pairing--- related flags and clear the information concerning the mate.-divorce :: BamRec -> BamRec-divorce b = b { b_flag = b_flag b .&. complement pair_flags- , b_mrnm = invalidRefseq- , b_mpos = invalidPos- , b_isize = 0 }- where- pair_flags = flagPaired .|. flagProperlyPaired .|.- flagFirstMate .|. flagSecondMate .|.- flagMateUnmapped .|. flagMateReversed---- I think this can work with priority queues alone:------ - One contains incomplete pairs ordered by mate position. When we--- reach a given position and find the 2nd mate, the minimum in this--- queue must be the 1st mate (or another 1st mate matching another--- read we'll find here).------ - One contains incomplete pairs ordered by (hash of) qname. This one--- is only used if we missed a mate for some reason. After we read--- the whole input, all remaining pairs can be pulled off this queue--- in order of increasing (hash of) qname.------ - At any given position, we will have a number of 1st mates that have--- been waiting in the queue and a number of 2nd mates that are coming--- in from the input. We dump both sets into a queue by qname, then--- pull them out in pairs. Stuff that comes off as anything else than--- a pair gets queued up again.--data MatingStats = MS { total_in :: !Int- , total_out :: !Int- , singletons :: !Int- , widows :: !Int- , num_mrnm :: !Int- , num_mpos :: !Int- , num_isize :: !Int- , num_flags :: !Int- , num_fflag :: !Int- , num_ixs :: !Int }--report_stats :: MatingStats -> String-report_stats ms = unlines [- "number of records read: " ++ showNum (total_in ms),- "number of records written: " ++ showNum (total_out ms),- "number of true singletons: " ++ showNum (singletons ms),- "number of widows: " ++ showNum (widows ms),- "number of repaired MRNM values: " ++ showNum (num_mrnm ms),- "number of repaired MPOS values: " ++ showNum (num_mpos ms),- "number of repaired ISIZE values: " ++ showNum (num_isize ms),- "number of repaired FLAGS values: " ++ showNum (num_flags ms),- "number of common FLAGS problems: " ++ showNum (num_fflag ms),- "number of index field problems: " ++ showNum (num_ixs ms) ]--data Queues = QS { right_here :: !(PQ ByQName)- , in_order :: !(PQ ByMatePos)- , messed_up :: !(PQ ByQName) }--withQueues :: (Queues -> IO r) -> IO r-withQueues k = withPQ pqconf $ \h ->- withPQ pqconf $ \o ->- withPQ pqconf $ \m ->- k $ QS h o m--ms0 :: MatingStats-ms0 = MS 0 0 0 0 0 0 0 0 0 0--getSize :: (MonadIO m, Ord a, Binary a, Sizeable a) => (Queues -> PQ a) -> Mating r m Int-getSize sel = getq sel >>= liftIO . sizePQ--enqueue :: (MonadIO m, Ord a, Binary a, Sizeable a) => a -> (Queues -> PQ a) -> Mating r m ()-enqueue a sel = getq sel >>= liftIO . enqueuePQ a--peekMin :: (MonadIO m, Ord a, Binary a, Sizeable a) => (Queues -> PQ a) -> Mating r m (Maybe a)-peekMin sel = getq sel >>= liftIO . peekMinPQ--fetchMin :: (MonadIO m, Ord a, Binary a, Sizeable a) => (Queues -> PQ a) -> Mating r m (Maybe a)-fetchMin sel = getq sel >>= liftIO . getMinPQ--discardMin :: (MonadIO m, Ord a, Binary a, Sizeable a) => (Queues -> PQ a) -> Mating r m ()-discardMin sel = getq sel >>= liftIO . getMinPQ >>= \_ -> return ()---note, warn, err :: MonadIO m => String -> Mating r m ()-note msg = do v <- tells verbosity ; unless (v < Notices) $ liftIO $ hPutStrLn stderr $ "[fixpair] info: " ++ msg-warn msg = do v <- tells verbosity ; unless (v < Warnings) $ liftIO $ hPutStrLn stderr $ "[fixpair] warning: " ++ msg-err msg = do v <- tells verbosity ; unless (v < Errors) $ liftIO $ hPutStrLn stderr $ "[fixpair] error: " ++ msg--report' :: MonadIO m => Mating r m ()-report' = do o <- gets total_out- when (o `mod` 0x40000 == 0) $ do- ms <- getSize messed_up- note $ printf "out: %d, mess: %d" o ms--report :: MonadIO m => BamRaw -> Mating r m ()-report br = do i <- gets total_in- o <- gets total_out- when (i `mod` 0x20000 == 0) $ do- hs <- getSize right_here- os <- getSize in_order- ms <- getSize messed_up- rr <- getRefseqs- let BamRec{..} = unpackBam br- rn = unpack . sq_name $ getRef rr b_rname- at = if b_rname == invalidRefseq || b_pos == invalidPos- then "" else printf "@%s/%d, " rn b_pos- note $ printf "%sin: %d, out: %d, here: %d, wait: %d, mess: %d" (at::String) i o hs os ms--no_mate_here :: MonadIO m => String -> BamRaw -> Mating r m ()-no_mate_here l br = do note $ let b = unpackBam br- in "[" ++ l ++ "] record "- ++ shows (b_qname b) (if isFirstMate b then "/1" else "/2")- ++ " did not have a mate at the right location."- let !br' = br_copy br- enqueue (byQName br') messed_up--no_mate_ever :: MonadIO m => BamRaw -> Mating r m ()-no_mate_ever b = do let b' = unpackBam b- err $ "record " ++ shows (b_qname b') " (" ++- shows (extAsInt 1 "XI" b') ") did not have a mate at all."- modify $ \c -> c { widows = 1 + widows c }- kill <- tells killmode- case kill of- KillAll -> return ()- KillUu -> unless (isUnmapped b') $ yield [divorce b']- KillNone -> yield [divorce b']---- Basically the CPS version of the State Monad. CPS is necessary to be--- able to call 'eneeCheckIfDone' in the middle, and that fixes the--- underlying monad to an 'Iteratee' and the ultimate return type to an--- 'Iteratee', too. Pretty to work with, not pretty to look at.-type Sink r m = Stream [BamRec] -> Iteratee [BamRec] m r-newtype Mating r m a = Mating { runMating ::- (a -> MatingStats -> Sink r m -> Queues -> Config -> Refs -> Iteratee [BamPair] m (Iteratee [BamRec] m r))- -> MatingStats -> Sink r m -> Queues -> Config -> Refs -> Iteratee [BamPair] m (Iteratee [BamRec] m r) }--instance Functor (Mating r m) where- fmap f m = Mating $ \k -> runMating m (k . f)--instance Applicative (Mating r m) where- pure a = Mating $ \k -> k a- u <*> v = Mating $ \k -> runMating u (\a -> runMating v (k . a))--instance Monad (Mating r m) where- return a = Mating $ \k -> k a- m >>= k = Mating $ \k2 -> runMating m (\a -> runMating (k a) k2)--instance MonadIO m => MonadIO (Mating r m) where- liftIO f = Mating $ \k s o q c r -> liftIO f >>= \a -> k a s o q c r--instance MonadTrans (Mating r) where- lift m = Mating $ \k s o q c r -> lift m >>= \a -> k a s o q c r--lift'it :: Monad m => Iteratee [BamPair] m a -> Mating r m a-lift'it m = Mating $ \k s o q c r -> m >>= \a -> k a s o q c r--tells :: (Config -> a) -> Mating r m a-tells f = Mating $ \k s o q c -> k (f c) s o q c--gets :: (MatingStats -> a) -> Mating r m a-gets f = Mating $ \k s -> k (f s) s--getq :: (Queues -> a) -> Mating r m a-getq f = Mating $ \k s o q -> k (f q) s o q--modify :: (MatingStats -> MatingStats) -> Mating r m ()-modify f = Mating $ \k s -> (k () $! f s)--getRefseqs :: Mating r m Refs-getRefseqs = Mating $ \k s o q c r -> k r s o q c r--fetchNext :: MonadIO m => Mating r m (Maybe BamPair)-fetchNext = do r <- lift'it tryHead- case r of Nothing -> return ()- Just (Singleton x) -> do modify $ \s -> s { total_in = 1 + total_in s } ; report x- Just (Pair _ x) -> do modify $ \s -> s { total_in = 2 + total_in s } ; report x- Just (LoneMate x) -> do modify $ \s -> s { total_in = 1 + total_in s } ; report x- return r--yield :: MonadIO m => [BamRec] -> Mating r m ()-yield rs = Mating $ \k s o q c r -> let !s' = s { total_out = length rs + total_out s }- in eneeCheckIfDone (\o' -> k () s' o' q c r) . o $ Chunk rs---- To ensure proper cleanup, we require the priority queues to be created--- outside. Since one is continually reused, it is important that a PQ--- that is emptied no longer holds on to files on disk.-re_pair :: MonadIO m => Queues -> Config -> Refs -> Enumeratee [BamPair] [BamRec] m a-re_pair qs cf rs = eneeCheckIfDone $ \out -> runMating go finish ms0 out qs cf rs- where- go = fetchNext >>= go'-- -- At EOF, flush everything.- go' Nothing = peekMin right_here >>= \mm -> case mm of- Just (ByQName _ _ qq) -> do complete_here (br_self_pos qq)- flush_here Nothing -- flush_here loops back here- Nothing -> flush_in_order -- this ends the whole operation-- -- Single read? Pass through and go on.- -- Paired read? Does it belong 'here'?- go' (Just (Singleton x)) = modify (\c -> c { singletons = 1 + singletons c }) >> yield [unpackBam x] >> go- go' (Just (Pair x y)) = fixmate x y >>= yield >> go- go' (Just (LoneMate r)) = peekMin right_here >>= \mm -> case mm of-- -- there's nothing else here, so here becomes redefined- Nothing -> enqueueThis r >> go-- Just (ByQName _ _ qq) -> case compare (br_self_pos r) (br_self_pos qq) of- -- nope, r is out of order and goes to 'messed_up'- LT -> do warn $ "record " ++ show (br_qname r) ++ " is out of order."- let !r' = br_copy r- enqueue (byQName r') messed_up- go-- -- nope, r comes later. we need to finish our business here- GT -> do complete_here (br_self_pos qq)- flush_here (Just (LoneMate r))-- -- it belongs here or there is nothing else here- EQ -> enqueueThis r >> go--- -- lonely guy, belongs either here or needs to wait for the mate- enqueueThis r | br_self_pos r >= br_mate_pos r = enqueue (byQName r) right_here- | otherwise = r' `seq` enqueue (ByMatePos r') in_order- where r' = br_copy r-- -- Flush the in_order queue to messed_up, since those didn't find- -- their mate the ordinary way. Afterwards, flush the messed_up- -- queue.- flush_in_order = fetchMin in_order >>= \zz -> case zz of- Just (ByMatePos b) -> no_mate_here "flush_in_order" b >> flush_in_order- Nothing -> flush_messed_up-- -- Flush the messed up queue. Everything should come off in pairs,- -- unless something is broken.- flush_messed_up = fetchMin messed_up >>= flush_mess1-- flush_mess1 Nothing = return ()- flush_mess1 (Just (ByQName _ ai a)) = fetchMin messed_up >>= flush_mess2 ai a-- flush_mess2 _ a Nothing = no_mate_ever a-- flush_mess2 ai a b'@(Just (ByQName _ bi b))- | ai /= bi || br_qname a /= br_qname b = no_mate_ever a >> report' >> flush_mess1 b'- | otherwise = fixmate a b >>= yield >> report' >> flush_messed_up--- -- Flush the right_here queue. Everything should come off in pairs,- -- if not, it goes to messed_up. When done, loop back to 'go'- flush_here r = fetchMin right_here >>= flush_here1 r-- flush_here1 r Nothing = go' r- flush_here1 r (Just a) = fetchMin right_here >>= flush_here2 r a-- flush_here2 r (ByQName _ _ a) Nothing = do no_mate_here "flush_here2/Nothing" a- flush_here r-- flush_here2 r (ByQName _ ai a) b'@(Just (ByQName _ bi b))- | ai /= bi || br_qname a /= br_qname b = no_mate_here "flush_here2/Just" a >> flush_here1 r b'- | otherwise = fixmate a b >>= yield >> flush_here r--- -- add stuff coming from 'in_order' to 'right_here'- complete_here pivot = do- zz <- peekMin in_order- case zz of- Nothing -> return ()- Just (ByMatePos b)- | pivot > br_mate_pos b -> do discardMin in_order- no_mate_here "complete_here" b- complete_here pivot-- | pivot == br_mate_pos b -> do discardMin in_order- enqueue (byQName b) right_here- complete_here pivot-- | otherwise -> return ()-- finish () st o _qs _cf _rs = do liftIO $ hPutStrLn stderr $ report_stats st- return (liftI o)--data ByQName = ByQName { _bq_hash :: !Int- , _bq_alnid :: !Int- , _bq_rec :: !BamRaw }--byQName :: BamRaw -> ByQName-byQName b = ByQName (hash $ br_qname b) (extAsInt 0 "XI" $ unpackBam b) b--instance Eq ByQName where- ByQName ah ai a == ByQName bh bi b =- (ah, ai, br_qname a) == (bh, bi, br_qname b)--instance Ord ByQName where- ByQName ah ai a `compare` ByQName bh bi b =- (ah, ai, b_qname (unpackBam a)) `compare` (bh, bi, b_qname (unpackBam b))--newtype ByMatePos = ByMatePos BamRaw--instance Eq ByMatePos where- ByMatePos a == ByMatePos b =- br_mate_pos a == br_mate_pos b--instance Ord ByMatePos where- ByMatePos a `compare` ByMatePos b =- br_mate_pos a `compare` br_mate_pos b--instance Binary ByQName where put = undefined ; get = undefined -- XXX-instance Binary ByMatePos where put = undefined ; get = undefined -- XXX--instance Sizeable ByQName where usedBytes = undefined -- XXX-instance Sizeable ByMatePos where usedBytes = undefined -- XXX--br_mate_pos :: BamRaw -> (Refseq, Int)-br_mate_pos = (b_mrnm &&& b_mpos) . unpackBam--br_self_pos :: BamRaw -> (Refseq, Int)-br_self_pos = (b_rname &&& b_pos) . unpackBam--br_qname :: BamRaw -> Seqid-br_qname = b_qname . unpackBam--br_copy :: BamRaw -> BamRaw-br_copy br = bamRaw (virt_offset br) $! S.copy (raw_data br)------ | To catch pairs whose mates are adjacent (either because the file--- has never been sorted or because it has been group-sorted), we apply--- preprocessing. The idea is that if we can catch these pairs early,--- the priority queues never fill up and we save a ton of processing.--- Now to make the re-pair algorithm work well, we need to merge-sort--- inputs. But after that, the pairs have been separated. So we apply--- the preprocessing to each input file, then merge then, then run--- re-pair.--data BamPair = Singleton BamRaw | Pair BamRaw BamRaw | LoneMate BamRaw---mergeInputs :: (MonadIO m, MonadMask m) => [FilePath] -> Enumerator' BamMeta [BamPair] m a-mergeInputs = go0- where- go0 [ ] = enumG $ enumHandle defaultBufSize stdin- go0 (fp0:fps0) = go fp0 fps0-- go fp [ ] = enum1 fp- go fp (fp1:fps) = mergeEnums' (go fp1 fps) (enum1 fp) combineCoordinates-- enum1 "-" = enumG $ enumHandle defaultBufSize stdin- enum1 fp = enumG $ enumFile defaultBufSize fp-- enumG ee k = ee >=> run $ joinI $ decodeAnyBam $ \h -> quick_pair (k h)---quick_pair :: Monad m => Enumeratee [BamRaw] [BamPair] m a-quick_pair = eneeCheckIfDone go0- where- go0 k = tryHead >>= maybe (return $ liftI k) (\x -> go1 x k)-- go1 x k | not (isPaired (unpackBam x)) = eneeCheckIfDone go0 . k $ Chunk [Singleton x]- | otherwise = tryHead >>= maybe (return . k $ Chunk [LoneMate x]) (\y -> go2 x y k)-- go2 x y k | b_qname (unpackBam x) == b_qname (unpackBam y) = eneeCheckIfDone go0 . k $ Chunk [Pair x y]- | otherwise = eneeCheckIfDone (go1 y) . k $ Chunk [LoneMate x]---combineCoordinates :: Monad m => BamMeta -> Enumeratee [BamPair] [BamPair] (Iteratee [BamPair] m) a-combineCoordinates _ = mergeSortStreams (?)- where u ? v = if (bp_rname u, bp_pos u) < (bp_rname v, bp_pos v) then Less else NotLess--bp_rname :: BamPair -> Refseq-bp_rname (Singleton u) = b_rname $ unpackBam u-bp_rname (Pair u _) = b_rname $ unpackBam u-bp_rname (LoneMate u) = b_rname $ unpackBam u--bp_pos :: BamPair -> Int-bp_pos (Singleton u) = b_pos $ unpackBam u-bp_pos (Pair u _) = b_pos $ unpackBam u-bp_pos (LoneMate u) = b_pos $ unpackBam u---do_trim :: Int -> [BamRec] -> [BamRec]-do_trim q = scan_empties . map trim1- where- trim1 b = case [ l | l <- [0 .. V.length (b_qual b) -1], avquallow (V.drop l qs) ] of- [ ] -> b- l:_ -> trim_3 l b- where- qs | isReversed b = V.reverse (b_qual b)- | otherwise = b_qual b-- scan_empties (x:y:z)- | b_qname x == b_qname y- = if V.null (b_qual x) || V.null (b_qual y)- then scan_empties z- else x : y : scan_empties z-- scan_empties (x:z)- = if V.null (b_qual x)- then scan_empties z- else x : scan_empties z-- scan_empties [] = []-- avquallow vec = V.sum (V.map (fromIntegral . unQ) vec) <= q * V.length vec-
− tools/bam-meld.hs
@@ -1,234 +0,0 @@--- Reads multiple BAM files, melds them by keeping the best hit for--- every entry. All input files must be parallel (same reads, same--- order, no omissions). The best hit and the new mapq are calculated--- by combining appropriate optional fields. Presets exist for common--- types of aligners, other schemes can be configured flexibly.------ Paired end support is easy: since all input files are either--- unsorted (and strictly parallel) or sorted by read name, pairs are--- also sorted together. So all we have to do is (maybe) exchange first--- and seocnd mate.--import Bio.Bam-import Bio.Prelude-import Paths_biohazard ( version )-import System.Console.GetOpt--import qualified Data.ByteString.Char8 as S-import qualified Data.Sequence as Z--data Conf = Conf {- c_score :: Maybe (BamPair -> Int),- c_output :: BamMeta -> Iteratee [BamRec] IO (),- c_merge :: Enumeratee [BamPair] [[BamPair]] (Iteratee [[BamPair]] IO) () }--defaultConf :: Conf-defaultConf = Conf Nothing (protectTerm . pipeBamOutput) iter_transpose--defaultScore :: BamPair -> Int-defaultScore r = 30 * getExt "XM" r + 45 * getExt "XO" r + 15 * getExt "XG" r--getExt :: BamKey -> BamPair -> Int-getExt k (Single a) = extAsInt 0 k a-getExt k (Pair a b) = extAsInt 0 k a + extAsInt 0 k b----- | Enumerates a list of BAM files. Meta records are merged sensibly,--- records are merged using the supplied "merging Enumeratee". Results--- in something close to an Enumerator (not quite, because the merged--- headers need to be passed along).-enum_bam_files :: (MonadIO m, MonadMask m)- => Enumeratee [BamPair] [[BamPair]] (Iteratee [[BamPair]] m) a- -> [ FilePath ]- -> Enumerator' BamMeta [[BamPair]] m a-enum_bam_files _etee [ ] = return . ($ mempty)-enum_bam_files etee (f1:fs1) = go (decodeAnyBamOrSamFile f1 $== find_pairs $== mapStream (:[])) fs1- where- go e1 [ ] k = e1 k- go e1 (f:fs) k = go e1 fs $- \h1 -> (decodeAnyBamOrSamFile f $== adjust h1 $== find_pairs)- (\h2 -> joinI . etee $ ilift lift (k $ h1 `mappend` h2)) >>= run-- -- How to merge? We keep the stream from e1 as is, the refids in- -- e2 are shifted down by the number of refseqs in h1. Headers- -- are merged by concatenating the reference lists and appending- -- the headers using mappend. The Monoid instance does- -- everything.-- adjust h = let o = Z.length . meta_refs $ h- f br = br { b_rname = b_rname br `plus` o- , b_mrnm = b_mrnm br `plus` o }- in mapStream f-- r `plus` _ | r == invalidRefseq = r- Refseq r `plus` o = Refseq (r + fromIntegral o)--data BamPair = Single BamRec | Pair BamRec BamRec--find_pairs :: Enumeratee [BamRec] [BamPair] m a-find_pairs = mapStream Single--unpair :: Enumeratee [BamPair] [BamRec] m a-unpair = mapChunks (concatMap unpair1)- where- unpair1 (Single a) = [a]- unpair1 (Pair a b) = [a,b]--p_qname :: BamPair -> Seqid-p_qname (Single a) = b_qname a-p_qname (Pair a _) = b_qname a--p_mapq :: BamPair -> Qual-p_mapq (Single a) = b_mapq a-p_mapq (Pair a _) = b_mapq a--p_is_unmapped :: BamPair -> Bool-p_is_unmapped (Single a) = isUnmapped a-p_is_unmapped (Pair a b) = isUnmapped a && isUnmapped b--set_mapq :: BamPair -> Qual -> BamPair-set_mapq (Single a) q = Single (a { b_mapq = q })-set_mapq (Pair a b) q = Pair (a { b_mapq = q }) (b { b_mapq = q })--meld :: BamMeta -> (BamPair -> Int) -> [BamPair] -> BamPair-meld hdr score rs | all p_is_unmapped rs = head rs- | all_equal (map p_qname rs) = set_mapq best' mapq- | otherwise = error $ "BAMs are not in the same order or sequences are missing: "- ++ show (map p_qname rs)- where- all_equal [] = error "no input (not supposed to happen)"- all_equal (x:xs) = all ((==) x) xs-- ( best : rs' ) = sortBy (\a b -> score a `compare` score b) $ filter (not . p_is_unmapped) rs- mapq = case rs' of [ ] -> p_mapq best- (r2:_) -> Q . fromIntegral $ fromIntegral (unQ (p_mapq best))- `min` (score r2 - score best)--- split_xa br = let s = extAsString "XA" br in if S.null s then id else (++) (S.split ';' s)-- get_xas (Single a) (one,two) = (split_xa a one, two)- get_xas (Pair a b) (one,two) = (split_xa a one, split_xa b two)-- (xas1, xas2) = foldr enc_xas (foldr get_xas ([],[]) (best:rs')) rs'-- add_xas xas b = b { b_exts = updateE "XA" (Text (S.intercalate (S.singleton ';') xas)) (b_exts b) }-- best' = case best of Single a -> Single (add_xas xas1 a)- Pair a b -> Pair (add_xas xas1 a) (add_xas xas2 b)-- enc_xas (Single a) (one,two) = (encode a one,two)- enc_xas (Pair a b) (one,two) = (encode a one,encode b two)-- encode b xas | isUnmapped b = xas- | otherwise = S.intercalate (S.singleton ',') [ rnm, pos, cig, nm ] : xas- where- nm = fromString $ show $ extAsInt 0 "NM" b- cig = fromString $ show $ b_cigar b- pos = fromString $ (if isReversed b then '-' else '+') : show (b_pos b)- rnm = sq_name $ getRef (meta_refs hdr) (b_rname b)---options :: [OptDescr (Conf -> IO Conf)]-options =- [ Option "o" ["output"] (ReqArg set_output "FILE") "Send output to FILE"- , Option "u" ["unsorted"] (NoArg set_unsorted) "Input is unsorted"- , Option "s" ["sorted"] (NoArg set_sorted) "Input is sorted by name"- , Option "w" ["weight"] (ReqArg set_weight "XX:Y") "Set the badness of field XX to Y"- , Option [ ] ["bwa"] (NoArg set_bwa) "Preset for alignments from 'bwa' (uses XM, XO, XG)"- , Option [ ] ["anfo"] (NoArg set_anfo) "Preset for alignments from 'anfo' (uses UQ, PQ)"- , Option [ ] ["blast"] (NoArg set_blast) "Preset for alignments from 'blast' (uses AS)"- , Option [ ] ["blat"] (NoArg set_blat) "Preset for alignments from 'blat' (uses NM)"- , Option "h?" ["help","usage"] (NoArg usage) "Display this information and exit"- , Option "V" ["version"] (NoArg vrsn) "Display version number and exit" ]--vrsn :: Conf -> IO Conf-vrsn _ = do pn <- getProgName- hPutStrLn stderr $ pn ++ ", version " ++ showVersion version- exitSuccess--usage :: Conf -> IO Conf-usage _ = putStrLn (usageInfo blurb options) >> exitSuccess- where- blurb = "Merges multiple bam files containing the same sequences, keeping only\n\- \the best hit for each. Attempts to be configurable to bam files from\n\- \various sources and attempts to calculate a sensible map quality.\n"--set_output :: String -> Conf -> IO Conf-set_output "-" c = return $ c { c_output = pipeBamOutput }-set_output fn c = return $ c { c_output = writeBamFile fn }--set_unsorted :: Conf -> IO Conf-set_unsorted c = return $ c { c_merge = iter_transpose }--set_sorted :: Conf -> IO Conf-set_sorted c = return $ c { c_merge = merge_by_name }--set_weight :: String -> Conf -> IO Conf-set_weight (a:b:':':rest) c = do- w <- readIO rest- let f = \r -> getExt (fromString [a,b]) r * w + maybe 0 ($ r) (c_score c)- return $ c { c_score = Just f }-set_weight s _ = error $ "illegal weight specification " ++ show s--set_bwa, set_anfo, set_blat, set_blast :: Conf -> IO Conf-set_bwa c = return $ c { c_score = Just defaultScore }-set_anfo c = return $ c { c_score = Just $ \r -> getExt "UQ" r }-set_blat c = return $ c { c_score = Just $ \r -> getExt "NM" r * 30 }-set_blast c = return $ c { c_score = Just $ \r -> getExt "AS" r * (-3) }--main :: IO ()-main = do- ( opts, files, errors ) <- getOpt Permute options `fmap` getArgs- conf <- foldM (flip id) defaultConf opts-- let errors' | null files = "no input files" : errors- | otherwise = errors-- unless (null errors') $ do- mapM_ (hPutStrLn stderr) errors'- exitFailure-- add_pg <- addPG (Just version)- enum_bam_files (c_merge conf) files >=> run $ \hdr ->- joinI $ mapStream (meld hdr $ maybe defaultScore id $ c_score conf) $- joinI $ unpair $ c_output conf (add_pg hdr)---iter_transpose :: Monad m => Enumeratee [BamPair] [[BamPair]] (Iteratee [[BamPair]] m) a-iter_transpose = eneeCheckIfDone step- where- step k = do mx <- tryHead ; my <- lift tryHead ; step' k mx my-- step' k Nothing Nothing = idone (liftI k) $ EOF Nothing- step' k (Just x) (Just ys) | p_qname x == p_qname (head ys) = iter_transpose . k $ Chunk [x:ys]- step' _ _ _ = error "files do not contain the same query records"--merge_by_name :: Monad m => Enumeratee [BamPair] [[BamPair]] (Iteratee [[BamPair]] m) a-merge_by_name = ensure_sorting ><> merge'- where- merge' = eneeCheckIfDone (\k -> tryHead >>= \mx -> lift tryHead >>= \my -> merge''' k mx my)- merge'x my = eneeCheckIfDone (\k -> tryHead >>= \mx -> merge''' k mx my)- merge'y mx = eneeCheckIfDone (\k -> lift tryHead >>= \my -> merge''' k mx my)-- merge''' k Nothing Nothing = idone (liftI k) $ EOF Nothing- merge''' k Nothing (Just ys) = merge'y Nothing . k $ Chunk [ys]- merge''' k (Just x) Nothing = merge'x Nothing . k $ Chunk [[x]]- merge''' k (Just x) (Just ys) = case p_qname x `compareNames` p_qname (head ys) of- LT -> merge'x (Just ys) . k $ Chunk [[ x ]]- EQ -> merge' . k $ Chunk [ x:ys ]- GT -> merge'y (Just x) . k $ Chunk [ ys ]--ensure_sorting :: Monad m => Enumeratee [BamPair] [BamPair] m a-ensure_sorting = eneeCheckIfDonePass (icont . step)- where- step k (EOF mx) = idone (liftI k) $ EOF mx- step k (Chunk [ ]) = liftI $ step k- step k (Chunk (x:xs)) = step' x k $ Chunk xs-- step' x1 k (EOF mx) = idone (k $ Chunk [ x1 ]) $ EOF mx- step' x1 k (Chunk []) = liftI $ step' x1 k- step' x1 k (Chunk (x2:xs)) = case p_qname x1 `compareNames` p_qname x2 of- GT -> error "input is not sorted by qname"- _ -> eneeCheckIfDone (\k' -> step' x2 k' (Chunk xs)) . k $ Chunk [ x1 ]-
− tools/bam-resample.hs
@@ -1,62 +0,0 @@--- Resample m out of n `virtual' BAM records.------ Strategy for fair down sampling: we first count the number of--- records, then scan again to sample. Input must be grouped by QNAME--- (sorted by QNAME is fine).------ Usage: resample [NUM] [FILE...]--import Bio.Bam-import Bio.Prelude-import Paths_biohazard ( version )-import System.Random--main :: IO ()-main = do- args <- getArgs- case args of- [] -> complain- [_num] -> complain- num_ : files -> case reads num_ of- [(num,"")] -> main' num files- _ -> complain--complain :: IO ()-complain = do pn <- getProgName- hPutStr stderr $ pn ++ ", version " ++ showVersion version- ++ "\nUsage: " ++ pn ++ " <num> [file...]\n"- exitFailure--main' :: Int -> [String] -> IO ()-main' num files = do- hPutStr stderr "counting... "- total <- enumInputs files >=> run $- joinI $ decodeAnyBam $ \_hdr ->- joinI $ groupOn (b_qname . unpackBam) $- foldStream (\a _ -> 1+a) 0- hPutStr stderr $ shows total " records.\n"-- add_pg <- addPG (Just version)- enumInputs files >=> run $- joinI $ decodeAnyBam $- joinI . groupOn (b_qname . unpackBam) .- joinI . resample num total .- protectTerm . pipeBamOutput . add_pg---resample :: MonadIO m => Int -> Int -> Enumeratee [[BamRaw]] [BamRaw] m a-resample m0 n0 | m0 > n0 = error "upsampling requested"-resample m0 n0 = eneeCheckIfDone (go m0 n0)- where- go !m !n k = tryHead >>= maybe (return (liftI k)) (go' m n k)- go' !m !n k a = do r <- liftIO $ randomRIO (0,n-1)- if r < m- then eneeCheckIfDone (go (m-1) (n-1)) . k $ Chunk a- else go m (n-1) k--groupOn :: (Monad m, Eq b) => (a -> b) -> Enumeratee [a] [[a]] m c-groupOn f = eneeCheckIfDone (\k -> tryHead >>= maybe (return $ liftI k) (\a -> go k [a] (f a)))- where- go k acc fa = tryHead >>= maybe (return . k $ Chunk [reverse acc]) (go' k acc fa)- go' k acc fa b | fa == f b = go k (b:acc) fa- | otherwise = eneeCheckIfDone (\k' -> go k' [b] (f b)) . k $ Chunk [reverse acc]
− tools/bam-rewrap.hs
@@ -1,79 +0,0 @@--- Re-wrap alignments to obey the given length of the reference--- sequence.------ The idea is that a circular reference sequence has been extended--- artificially to facilitate alignment. Now the declared length in the--- header is wrong, and the alignments overhang the end. Here we split--- those alignments into two, one for the beginning, one for the end of--- the sequence, then soft-mask out the inappropriate parts.------ What's the best course of action, operationally? As usual, we need--- to decide whether to rely on sorted input and whether to produce--- sorted output, and how much to copy senselessly.------ In a sane world, this program runs precisely once, after alignment,--- and output is piped somewhere. So that's what we do: input is--- unsorted, so is output, output is piped (and hence uncompressed).--- We also fix the header while we're at it.------ We try to fix the map quality for the affected reads as follows: if--- a read has map quality 0 (meaning multiple equally good hits), we--- check the XA field. If it reports exactly one additional alignment,--- and it matches the primary alignment when transformed to canonical--- coordinates, we remove XA and set MAPQ to 37.--import Bio.Bam-import Bio.Bam.Rmdup-import Bio.Prelude-import Paths_biohazard ( version )--import qualified Data.ByteString.Char8 as S-import qualified Data.Map as M-import qualified Data.Sequence as Z--usage :: IO a-usage = do pn <- getProgName- hPutStr stderr $ pn ++ ", version " ++ showVersion version ++- "\nUsage: " ++ pn ++ " [chrom:length...]\n\- \Pipes a BAM file from stdin to stdout and for every 'chrom'\n\- \mentioned on the command line, wraps alignments to a new \n\- \target length of 'length'.\n"- exitFailure--main :: IO ()-main = getArgs >>= \args ->- when (null args) usage >>= \_ ->- enumHandle defaultBufSize stdin >=> run $- joinI $ decodeAnyBam $ \hdr -> do- add_pg <- liftIO (addPG $ Just version)- let (ltab, seqs') = parseArgs (meta_refs hdr) args- joinI $ mapChunks (concatMap (rewrap (M.fromList ltab) . unpackBam))- $ protectTerm $ pipeBamOutput (add_pg hdr { meta_refs = seqs' })--parseArgs :: Refs -> [String] -> ([(Refseq,(Int,Bytes))], Refs)-parseArgs refs | Z.null refs = error $ "no target sequences found (empty input?)"- | otherwise = foldl parseArg ([],refs)- where- parseArg (sqs, h) arg = case break (==':') arg of- (nm,':':r) -> case reads r of- [(l,[])] | l > 0 -> case filter (S.isPrefixOf (fromString nm) . sq_name . snd) $ zip [0..] $ toList h of- [(k,a)] | sq_length a >= l -> ( (Refseq $ fromIntegral k,(l, sq_name a)):sqs, Z.update k (a { sq_length = l }) h )- | otherwise -> error $ "cannot wrap " ++ show nm ++ " to " ++ show l- ++ ", which is more than the original " ++ show (sq_length a)- [] -> error $ "no match for target sequence " ++ show nm- _ -> error $ "target sequence " ++ show nm ++ " is ambiguous"- _ -> error $ "couldn't parse length " ++ show r ++ " for " ++ show nm- _ -> error $ "couldn't parse argument " ++ show arg------ | This runs both stages of the rewrapping: First normalize alignments--- (POS must be in the canonical interval) and fix XA, MPOS, MAPQ where--- appropriate, then duplicate the read and softmask the noncanonical--- parts. Rmdup fits in between the two, hence the split. We ignore--- sorting in here.-rewrap :: M.Map Refseq (Int,Bytes) -> BamRec -> [BamRec]-rewrap m b = maybe [b] (\(l,nm) -> map (either id id) . wrapTo l .- either id id . normalizeTo nm l $ b)- $ M.lookup (b_rname b) m-
− tools/bam-rmdup.hs
@@ -1,419 +0,0 @@-import Bio.Bam-import Bio.Bam.Rmdup-import Bio.Iteratee.Builder-import Bio.Prelude-import Bio.Util.Numeric ( showNum, showOOM, estimateComplexity )-import Paths_biohazard ( version )-import System.Console.GetOpt--import qualified Data.ByteString.Char8 as S-import qualified Data.HashMap.Strict as M-import qualified Data.IntMap as I-import qualified Data.Sequence as Z-import qualified Data.Vector.Generic as V--data Conf = Conf {- output :: Maybe ((BamRec -> Seqid) -> BamMeta -> Iteratee [BamRec] IO ()),- strand_preserved :: Bool,- collapse :: Bool -> Collapse,- clean_multimap :: BamRec -> IO (Maybe BamRec),- keep_all :: Bool,- keep_unaligned :: Bool,- keep_improper :: Bool,- transform :: BamRec -> Maybe BamRec,- min_len :: Int,- min_qual :: Qual,- get_label :: HashMap Seqid Seqid -> BamRec -> Seqid,- putResult :: String -> IO (),- debug :: String -> IO (),- which :: Which,- circulars :: Refs -> IO (IntMap (Seqid,Int), Refs) }---- | Which reference sequences to scan-data Which = Allrefs | Some Refseq Refseq | Unaln deriving Show--defaults :: Conf-defaults = Conf { output = Nothing- , strand_preserved = True- , collapse = cons_collapse' (Q 60)- , clean_multimap = check_flags- , keep_all = False- , keep_unaligned = False- , keep_improper = False- , transform = Just- , min_len = 0- , min_qual = Q 0- , get_label = get_library- , putResult = putStr- , debug = \_ -> return ()- , which = Allrefs- , circulars = \rs -> return (I.empty, rs) }--options :: [OptDescr (Conf -> IO Conf)]-options = [- Option "o" ["output"] (ReqArg set_output "FILE") "Write to FILE (default: no output, count only)",- Option "O" ["output-lib"] (ReqArg set_lib_out "PAT") "Write each lib to file named following PAT",- Option [ ] ["debug"] (NoArg set_debug_out) "Write textual debugging output",- Option "z" ["circular"] (ReqArg add_circular "CHR:LEN") "Refseq CHR is circular with length LEN",- Option "R" ["refseq"] (ReqArg set_range "RANGE") "Read only range of reference sequences",- Option "p" ["improper-pairs"] (NoArg set_improper) "Include improper pairs",- Option "u" ["unaligned"] (NoArg set_unaligned) "Include unaligned reads and pairs",- Option "1" ["single-read"] (NoArg set_single) "Pretend there is no second mate",- Option "m" ["multimappers"] (NoArg set_multi) "Process multi-mappers (by dropping secondary alignments)",- Option "c" ["cheap"] (NoArg set_cheap) "Cheap computation: skip the consensus calling",- Option "k" ["keep","mark-only"](NoArg set_keep) "Mark duplicates, but include them in output",- Option "Q" ["max-qual"] (ReqArg set_qual "QUAL") "Set maximum quality after consensus call to QUAL",- Option "l" ["min-length"] (ReqArg set_len "LEN") "Discard reads shorter than LEN",- Option "q" ["min-mapq"] (ReqArg set_mapq "QUAL") "Discard reads with map quality lower than QUAL",- Option "s" ["no-strand"] (NoArg set_no_strand) "Strand of alignments is uninformative",- Option "r" ["ignore-rg"] (NoArg set_no_rg) "Ignore read groups when looking for duplicates",- Option "v" ["verbose"] (NoArg set_verbose) "Print more diagnostics",- Option "h?" ["help","usage"] (NoArg (const usage)) "Display this message",- Option "V" ["version"] (NoArg (const vrsn)) "Display version number and exit" ]-- where- set_output "-" c = return $ c { output = Just $ \_ -> pipeBamOutput, putResult = hPutStr stderr }- set_output f c = return $ c { output = Just $ \_ -> writeBamFile f }- set_lib_out f c = return $ c { output = Just $ writeLibBamFiles f }- set_debug_out c = return $ c { output = Just $ \_ -> pipeSamOutput, putResult = hPutStr stderr }- set_qual n c = readIO n >>= \q -> return $ c { collapse = cons_collapse' (Q q) }- set_no_strand c = return $ c { strand_preserved = False }- set_verbose c = return $ c { debug = hPutStr stderr }- set_improper c = return $ c { keep_improper = True }- set_single c = return $ c { transform = make_single }- set_cheap c = return $ c { collapse = cheap_collapse' }- set_keep c = return $ c { keep_all = True }- set_unaligned c = return $ c { keep_unaligned = True }- set_len n c = readIO n >>= \l -> return $ c { min_len = l }- set_mapq n c = readIO n >>= \q -> return $ c { min_qual = Q q }- set_no_rg c = return $ c { get_label = get_no_library }- set_multi c = return $ c { clean_multimap = clean_multi_flags }-- set_range a c- | a == "A" || a == "a" = return $ c { which = Allrefs }- | a == "U" || a == "u" = return $ c { which = Unaln }- | otherwise = case reads a of- [ (x,"") ] -> return $ c { which = Some (Refseq $ x-1) (Refseq $ x-1) }- [ (x,'-':b) ] -> readIO b >>= \y ->- return $ c { which = Some (Refseq $ x-1) (Refseq $ y-1) }- _ -> fail $ "parse error in " ++ show a-- add_circular a c = case break ((==) ':') a of- (nm,':':r) -> case reads r of- [(l,[])] | l > 0 -> return $ c { circulars = add_circular' (fromString nm) l (circulars c) }- _ -> fail $ "couldn't parse length " ++ show r ++ " for " ++ show nm- _ -> fail $ "couldn't parse \"circular\" argument " ++ show a-- add_circular' nm l io refs = do- (m1, refs') <- io refs- case filter (S.isPrefixOf nm . sq_name . snd) $ zip [0..] $ toList refs' of- [(k,a)] | sq_length a >= l -> let m2 = I.insert k (sq_name a,l) m1- refs'' = Z.update k (a { sq_length = l }) refs'- in return (m2, refs'')- | otherwise -> fail $ "cannot wrap " ++ show nm ++ " to " ++ show l- ++ ", which is more than the original " ++ show (sq_length a)- [] -> fail $ "no match for target sequence " ++ show nm- _ -> fail $ "target sequence " ++ show nm ++ " is ambiguous"--vrsn :: IO a-vrsn = do pn <- getProgName- hPutStrLn stderr $ pn ++ ", version " ++ showVersion version- exitSuccess--usage :: IO a-usage = do p <- getProgName- hPutStrLn stderr $ "Usage: " ++ usageInfo (p ++ info) options- exitSuccess- where- info = " [option...] [bam-file...]\n\- \Removes PCR duplicates from BAM files and calls a consensus for each duplicate set. \n\- \Input files must be sorted by coordinate and are merged on the fly. Options are:"--cons_collapse' :: Qual -> Bool -> Collapse-cons_collapse' m False = cons_collapse m-cons_collapse' m True = cons_collapse_keep m--cheap_collapse' :: Bool -> Collapse-cheap_collapse' False = cheap_collapse-cheap_collapse' True = cheap_collapse_keep---- | Get library from BAM record.--- This gets the read group from a bam record, then the library for read--- group. This will work correctly if and only if the RG-LB field is--- the name of the "Ur-Library", the common one before the first--- amplification.------ If no RG-LB field is present, RG-SM is used instead. This will work--- if and only if no libraries were aliquotted and then pooled again.------ Else the RG-ID field is used. This will work if and only if read--- groups correspond directly to libraries.------ If no RG is present, the empty string is returned. This serves as--- fall-back.--get_library, get_no_library :: M.HashMap Seqid Seqid -> BamRec -> Seqid-get_library tbl br = M.lookupDefault rg rg tbl where rg = extAsString "RG" br-get_no_library _ _ = S.empty--mk_rg_tbl :: BamMeta -> M.HashMap Seqid Seqid-mk_rg_tbl hdr = M.fromList- [ (rg_id, rg_lb)- | ("RG",fields) <- meta_other_shit hdr- , rg_id <- take 1 [ i | ("ID",i) <- fields ]- , rg_lb <- take 1 $ [ l | ("LB",l) <- fields ]- ++ [ s | ("SM",s) <- fields ]- ++ [ rg_id ] ]--data Counts = Counts { tin :: !Int- , tout :: !Int- , good_singles :: !Int- , good_total :: !Int }--main :: IO ()-main = do- args <- getArgs- when (null args) usage- let (opts, files, errors) = getOpt Permute options args- unless (null errors) $ mapM_ (hPutStrLn stderr) errors >> exitFailure- Conf{..} <- foldr (>=>) return opts defaults-- add_pg <- addPG $ Just version- (counts, ()) <- mergeInputRanges which files >=> run $ \hdr -> do- (circtable, refs') <- liftIO $ circulars (meta_refs hdr)- let tbl = mk_rg_tbl hdr- unless (M.null tbl) $ liftIO $ do- debug "mapping of read groups to libraries:\n"- mapM_ debug [ unpack k ++ " --> " ++ unpack v ++ "\n" | (k,v) <- M.toList tbl ]-- let cleanup = cleanup2 . transform . unpackBam-- cleanup2 Nothing = return []- cleanup2 (Just b) = cleanup3 <$> clean_multimap b-- cleanup3 (Just b)- | keep_unaligned || is_aligned b- , keep_improper || is_proper b- , eff_len b >= min_len = [b]- cleanup3 _ = [ ]-- (ct,ou) <- progressBam "Rmdup at" refs' 0x8000 debug =$- takeWhileE is_halfway_aligned =$- concatMapStreamM cleanup =$- normalizeSortWith circtable =$- filterStream (\b -> b_mapq b >= min_qual) =$- case output of- Nothing -> rmdup (get_label tbl) strand_preserved (cheap_collapse' keep_all) =$- count_all (get_label tbl) `zipStreams` (skipToEof <$ skipToEof)-- Just o -> rmdup (get_label tbl) strand_preserved (collapse keep_all) =$- zipStreams (count_all (get_label tbl))- (wrapSortWith circtable $- o (get_label tbl) (add_pg hdr { meta_refs = refs' }))-- let do_copy = progressBam "Copying junk at" refs' 0x8000 debug ><>- concatMapStreamM cleanup-- r <- case which of Unaln -> lift (run $ do_copy =$ ou)- _ | keep_unaligned -> lift (run $ do_copy =$ ou)- _ -> lift (run ou)- return (ct,r)-- putResult . unlines $- "\27[K#RG\tin\tout\tin@MQ20\tsingle@MQ20\tunseen\ttotal\t%unique\t%exhausted"- : map (uncurry do_report) (M.toList counts)---do_report :: Seqid -> Counts -> String-do_report lbl Counts{..} = intercalate "\t" fs- where- fs = label : showNum tin : showNum tout : showNum good_total : showNum good_singles :- report_estimate (estimateComplexity good_total good_singles)-- label = if S.null lbl then "--" else unpack lbl-- report_estimate Nothing = [ "N/A" ]- report_estimate (Just good_grand_total) =- [ showOOM (grand_total - fromIntegral tout)- , showOOM grand_total- , showFFloat (Just 1) rate []- , showFFloat (Just 1) exhaustion [] ]- where- grand_total = good_grand_total * fromIntegral tout / fromIntegral good_total- exhaustion = 100 * fromIntegral good_total / good_grand_total- rate = 100 * fromIntegral tout / fromIntegral tin :: Double----- | Counting reads: we count total read in (ti), total reads out (to),--- good (confidently mapped) singletons out (gs), total good--- (confidently mapped) reads out (gt). Paired reads count 1, unpaired--- reads count 2, and at the end we divide by 2. This ensures that we--- don't double count mate pairs, while still working mostly sensibly in--- the presence of broken BAM files.--count_all :: Monad m => (BamRec -> Seqid) -> Iteratee [BamRec] m (M.HashMap Seqid Counts)-count_all lbl = M.map fixup `liftM` foldStream plus M.empty- where- plus m b = M.insert (lbl b) cs m- where- !cs = plus1 (M.lookupDefault (Counts 0 0 0 0) (lbl b) m) b-- plus1 (Counts ti to gs gt) b = Counts ti' to' gs' gt'- where- !w = if isPaired b then 1 else 2- !ti' = ti + w * extAsInt 1 "XP" b- !to' = to + w- !gs' = if b_mapq b >= Q 20 && extAsInt 1 "XP" b == 1 then gs + w else gs- !gt' = if b_mapq b >= Q 20 then gt + w else gt-- fixup (Counts ti to gs gt) = Counts (div ti 2) (div to 2) (div gs 2) (div gt 2)--eff_len :: BamRec -> Int-eff_len b | isProperlyPaired b = abs $ b_isize b- | otherwise = V.length $ b_seq b--is_halfway_aligned :: BamRaw -> Bool-is_halfway_aligned = isValidRefseq . b_rname . unpackBam--is_aligned :: BamRec -> Bool-is_aligned b = not (isUnmapped b && isMateUnmapped b) && isValidRefseq (b_rname b)--is_proper :: BamRec -> Bool-is_proper b = not (isPaired b) || (isMateUnmapped b == isUnmapped b && isProperlyPaired b)--make_single :: BamRec -> Maybe BamRec-make_single b | isPaired b && isSecondMate b = Nothing- | isUnmapped b = Nothing- | not (isPaired b) = Just b- | otherwise = Just $ b { b_flag = b_flag b .&. complement pair_flags- , b_mrnm = invalidRefseq- , b_mpos = invalidPos- , b_isize = 0 }- where- pair_flags = flagPaired .|. flagProperlyPaired .|.- flagFirstMate .|. flagSecondMate .|.- flagMateUnmapped---mergeInputRanges :: (MonadIO m, MonadMask m)- => Which -> [FilePath] -> Enumerator' BamMeta [BamRaw] m a-mergeInputRanges Allrefs fps = mergeInputs combineCoordinates fps-mergeInputRanges _ [ ] = \k -> return $ k mempty-mergeInputRanges rng (fp0:fps0) = go fp0 fps0- where- enum1 fp k1 = case rng of Allrefs -> decodeAnyBamFile fp k1- Some x y -> decodeBamFileRange x y fp k1- Unaln -> decodeWithIndex eneeBamUnaligned fp k1-- go fp [ ] = enum1 fp- go fp (fp1:fps) = mergeEnums' (go fp1 fps) (enum1 fp) combineCoordinates-- decodeBamFileRange x y = decodeWithIndex $- \idx -> foldr ((>=>) . eneeBamRefseq idx) return [x..y]---decodeWithIndex :: (MonadIO m, MonadMask m)- => (BamIndex () -> Enumeratee [BamRaw] [BamRaw] m a)- -> FilePath -> (BamMeta -> Iteratee [BamRaw] m a)- -> m (Iteratee [BamRaw] m a)-decodeWithIndex enum fp k0 = do- idx <- liftIO $ readBamIndex fp- decodeAnyBamFile fp >=> run $ enum idx . k0---writeLibBamFiles :: MonadIO m- => FilePath -> (BamRec -> Seqid) -> BamMeta -> Iteratee [BamRec] m ()-writeLibBamFiles fp lbl hdr = tryHead >>= go M.empty- where- go m Nothing = liftIO . mapM_ run $ M.elems m- go m (Just br) = do- let !l = lbl br- let !it = M.lookupDefault (writeBamFile (fp `subst` l) hdr) l m- it' <- liftIO $ enumPure1Chunk [br] it- let !m' = M.insert l it' m- tryHead >>= go m'-- subst [ ] _ = []- subst ('%':'s':rest) l = unpack l ++ subst rest l- subst ('%':'%':rest) l = '%' : subst rest l- subst ( c : rest) l = c : subst rest l---check_flags :: Monad m => BamRec -> m (Maybe BamRec)-check_flags b | extAsInt 1 "HI" b /= 1 = fail "cannot deal with HI /= 1"- | extAsInt 1 "IH" b /= 1 = fail "cannot deal with IH /= 1"- | extAsInt 1 "NH" b /= 1 = fail "cannot deal with NH /= 1"- | otherwise = return $ Just b--clean_multi_flags :: Monad m => BamRec -> m (Maybe BamRec)-clean_multi_flags b = return $ if extAsInt 1 "HI" b /= 1 then Nothing else Just b'- where- b' = b { b_exts = deleteE "HI" $ deleteE "IH" $ deleteE "NH" $ b_exts b }---normalizeSortWith :: MonadIO m => IntMap (Seqid, Int) -> Enumeratee [BamRec] [BamRec] m a-normalizeSortWith m = mapSortAtGroups m $ \(nm,l) r -> [ normalizeTo nm l r ]--wrapSortWith :: MonadIO m => IntMap (Seqid, Int) -> Enumeratee [BamRec] [BamRec] m a-wrapSortWith m = mapSortAtGroups m $ \(_,l) -> wrapTo l---- Given a map from reference sequences to arguments, extract those--- groups as list, apply a function to the argument and the list, pass--- the result on. Absent groups are passed on as they are. Note that--- ordering within groups is messed up (it doesn't matter here).------ We accumulate the 'Left' and 'Right' 'BamRec's directly into two BBs.--- This should result in two sorted BAM streams. When done, we stream--- the buffers back (somehow...) and merge them.-mapSortAtGroups :: MonadIO m => IntMap a -> (a -> BamRec -> [Either BamRec BamRec]) -> Enumeratee [BamRec] [BamRec] m b-mapSortAtGroups m f = eneeCheckIfDonePass no_group- where- no_group k (Just e) = idone (liftI k) $ EOF (Just e)- no_group k Nothing = tryHead >>= maybe (idone (liftI k) $ EOF Nothing) (\a -> no_group_1 a k Nothing)-- no_group_1 _ k (Just e) = idone (liftI k) $ EOF (Just e)- no_group_1 a k Nothing =- case I.lookup (b_rname_int a) m of- Nothing -> eneeCheckIfDonePass no_group . k $ Chunk [a]- Just arg -> do bbs <- pushTo (f arg a) (collect, collect)- cont_group (b_rname a) arg bbs k Nothing-- cont_group _rn _arg _bbs k (Just e) = idone (liftI k) $ EOF (Just e)- cont_group rn arg bbs k Nothing = tryHead >>= maybe flush_eof check1- where- flush_eof = streamOut bbs (liftI k)- flush_go a = streamOut bbs (liftI k) >>= eneeCheckIfDonePass (no_group_1 a)- check1 a | b_rname a == rn = do bbs' <- pushTo (f arg a) bbs- cont_group rn arg bbs' k Nothing- | otherwise = flush_go a-- b_rname_int = fromIntegral . unRefseq . b_rname---collect :: MonadIO m => Iteratee [BamRec] m [Bytes]-collect = mapChunks (foldMap pushBam) ><> encodeBgzfWith 1 =$ liftI (chunksToList [])- where- chunksToList acc (Chunk x) = y `seq` liftI (chunksToList (y:acc)) where y = S.copy x- chunksToList acc (EOF mx) = idone (reverse acc) (EOF mx)---pushTo :: Monad m => [Either BamRec BamRec] -> (Iteratee [BamRec] m a, Iteratee [BamRec] m a)- -> m (Iteratee [BamRec] m a, Iteratee [BamRec] m a)-pushTo es (bb1,bb2) = liftM2 (,) (enumPure1Chunk ls bb1) (enumPure1Chunk rs bb2)- where (ls,rs) = partitionEithers es---streamOut :: (MonadIO m, Nullable x)- => (Iteratee s (Iteratee x m) [Bytes], Iteratee s1 (Iteratee x m) [Bytes])- -> Enumeratee x [BamRec] m a-streamOut (bb1,bb2) it = do- bs1 <- run bb1- bs2 <- run bb2- lift $ mergeEnums (streamBB bs1) (streamBB bs2) (mergeSortStreams (?)) it- where- (?) :: BamRec -> BamRec -> Ordering' BamRec- u ? v = if (b_rname &&& b_pos) u < (b_rname &&& b_pos) v then Less else NotLess-- streamBB :: MonadIO m => [Bytes] -> Enumerator [BamRec] m b1- streamBB bb = enumList bb $= decompressBgzfBlocks $= convStream (map unpackBam `liftM` getBamRaw)-
− tools/bam-trim.hs
@@ -1,49 +0,0 @@-import Bio.Bam-import Bio.Prelude-import Paths_biohazard ( version )-import System.Console.GetOpt--data Conf = Conf { c_trim_pred :: [Nucleotides] -> [Qual] -> Bool- , c_pass_pred :: BamRec -> Bool }--options :: [OptDescr (Conf -> IO Conf)]-options = [ Option "q" ["minq"] (ReqArg set_minq "Q") "Trim where quality is below Q"- , Option "m" ["mapped"] (NoArg set_monly) "Trim only mapped sequences"- , Option "h?" ["help"] (NoArg usage) "Display this text and exit"- , Option "V" ["version"] (NoArg vrsn) "Display version number and exit" ]--set_minq :: String -> Conf -> IO Conf-set_minq s c = readIO s >>= \q -> return $ c { c_trim_pred = trim_low_quality (Q q) }--set_monly :: Conf -> IO Conf-set_monly c = return $ c { c_pass_pred = \r -> isMerged r || isUnmapped r }--vrsn :: Conf -> IO Conf-vrsn _ = do pn <- getProgName- hPutStrLn stderr $ pn ++ ", version " ++ showVersion version- exitSuccess--usage :: Conf -> IO Conf-usage _ = do hPutStrLn stderr $ usageInfo info options ; exitSuccess- where info = "Simple trimming of sequences in Bam files. Reads a Bam file from stdin,\n\- \trims sequences of low quality, writes Bam to stdout. Does not trim\n\- \merged reads."---main :: IO ()-main = do- (opts, files, errors) <- getOpt Permute options `fmap` getArgs-- unless (null errors) $ mapM_ (hPutStrLn stderr) errors- c <- foldM (flip id) (Conf (trim_low_quality (Q 20)) isMerged) opts- unless (null errors && null files) exitFailure-- let do_trim r | c_pass_pred c r' = Left r- | otherwise = Right $ trim_3' (c_trim_pred c) r'- where r' = unpackBam r-- add_pg <- addPG (Just version)- concatDefaultInputs >=> run $- joinI . mapStream do_trim .- protectTerm . pipeBamOutput . add_pg-
− tools/fastq2bam.hs
@@ -1,199 +0,0 @@-import Bio.Bam-import Bio.Bam.Evan ( removeWarts )-import Bio.Iteratee.ZLib-import Bio.Prelude-import System.Console.GetOpt-import System.IO--import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as S-import qualified Data.Vector.Generic as V--data Opts = Opts { output :: BamMeta -> Iteratee [BamRec] IO ()- , inputs :: [Input]- , verbose :: Bool- , merge :: Bool }--defaultOpts :: Opts-defaultOpts = Opts { output = protectTerm . pipeBamOutput- , inputs = []- , verbose = False- , merge = False }--data Input = Input { _read1 :: FilePath -- ^ file with first read (or other stuff)- , read2 :: Maybe FilePath -- ^ optional file with second read- , index1 :: Maybe FilePath -- ^ optional file with first index- , index2 :: Maybe FilePath -- ^ optional file with second index- , lindex1 :: Int } -- ^ length of first index contained in first read- deriving Show--plainInput :: FilePath -> Input-plainInput fn = Input fn Nothing Nothing Nothing 0--getopts :: [String] -> ([Opts -> IO Opts], [String], [String])-getopts = getOpt (ReturnInOrder add_read1) options- where- options =- [ Option "o" ["output"] (ReqArg set_output "FILE") "Write output to FILE"- , Option "1" ["read-one"] (ReqArg add_read1 "FILE") "Parse FILE for anything"- , Option "2" ["read-two"] (ReqArg add_read2 "FILE") "Parse FILE for second mates"- , Option "I" ["index-one"] (ReqArg add_idx1 "FILE") "Parse FILE for first index"- , Option "J" ["index-two"] (ReqArg add_idx2 "FILE") "Parse FILE for second index"- , Option "l" ["length-index-one"] (ReqArg set_lidx1 "NUM") "Read 1 ends on NUM index bases"- , Option "m" ["merge-overlap"] (NoArg set_merge) "Attempt to merge or trim reads"- , Option "v" ["verbose"] (NoArg set_verbose) "Print progress information"- , Option "h?" ["help","usage"] (NoArg usage) "Print this helpful message" ]-- set_output "-" c = return $ c { output = pipeBamOutput }- set_output fn c = return $ c { output = writeBamFile fn }- set_verbose c = return $ c { verbose = True }- set_merge c = return $ c { merge = True }-- add_read1 fn c = return $ c { inputs = plainInput fn : inputs c }- add_read2 fn c = return $ c { inputs = at_head (\i -> i { read2 = Just fn }) (inputs c) }- add_idx1 fn c = return $ c { inputs = at_head (\i -> i { index1 = Just fn }) (inputs c) }- add_idx2 fn c = return $ c { inputs = at_head (\i -> i { index2 = Just fn }) (inputs c) }-- set_lidx1 a c = readIO a >>= \n -> return $ c { inputs = at_head (\i -> i { lindex1 = n}) (inputs c) }-- at_head f [ ] = [ f $ plainInput "-" ]- at_head f (i:is) = f i : is-- usage _ = do pn <- getProgName- let t = "Usage: " ++ pn ++ " [OPTION...]\n" ++- "Reads multiple FastA or FastQ files and converts them to BAM. See manpage for details."- hPutStrLn stderr $ usageInfo t options- exitSuccess---main :: IO ()-main = do (opts, [], errors) <- getopts `fmap` getArgs- unless (null errors) $ mapM_ (hPutStrLn stderr) errors >> exitFailure- conf <- foldl (>>=) (return defaultOpts) opts- pgm <- addPG Nothing-- let eff_inputs = if null (inputs conf) then [ plainInput "-" ] else inputs conf- when (verbose conf) $ mapM_ (hPrint stderr) eff_inputs-- foldr ((>=>) . enum_input) run (reverse eff_inputs) $- joinI $ progress (verbose conf) $- joinI $ mapChunks (if merge conf then mergeDuals else concatDuals) $- output conf (pgm mempty)---type UpToTwo a = (a, Maybe a)--one :: a -> UpToTwo a-one a = (a, Nothing)--two :: a -> a -> UpToTwo a-two a b = (a, Just b)--mapU2 :: (a -> b) -> UpToTwo a -> UpToTwo b-mapU2 f (a,b) = (f a, fmap f b)--concatDuals :: [UpToTwo a] -> [a]-concatDuals ((a,Just b):ds) = a : b : concatDuals ds-concatDuals ((a,Nothing):ds) = a : concatDuals ds-concatDuals [ ] = []--mergeDuals :: [UpToTwo BamRec] -> [BamRec]-mergeDuals ((r1,Just r2):ds)- = case merge_overlap r1 default_fwd_adapters r2 default_rev_adapters of- Nothing -> r1 : r2 : mergeDuals ds- Just (r1',r2',rm,_q1,_q2) -> rm : r1' : r2' : mergeDuals ds--mergeDuals ((r1,Nothing):ds)- = case trim_adapter r1 default_fwd_adapters of- Nothing -> r1 : mergeDuals ds- Just (r1',r1t,_q1,_q2) -> r1t : r1' : mergeDuals ds--mergeDuals [] = []---- Enumerates a file. Sequence and quality end up in b_seq and b_qual.-fromFastq :: (MonadIO m, MonadMask m) => FilePath -> Enumerator [BamRec] m a-fromFastq fp = enumAny fp $= enumInflateAny $= parseFastqCassava $= mapStream removeWarts- where- enumAny "-" = enumHandle defaultBufSize stdin- enumAny f = enumFile defaultBufSize f--enum_input :: (MonadIO m, MonadMask m) => Input -> Enumerator [UpToTwo BamRec] m a-enum_input (Input r1 mr2 mi1 mi2 il1) = enum $= mapStream (addIdx il1)- where- enum = withIndex mi1 "XI" "YI" $ withIndex mi2 "XJ" "YJ" $- maybe (fromFastq r1 $= mapStream one) (enumDual r1) mr2--addIdx :: Int -> UpToTwo BamRec -> UpToTwo BamRec-addIdx 0 brs = brs-addIdx l (br1, mbr2) = ( doext br1', fmap doext mbr2 )- where- l' = V.length (b_seq br1) - l-- br1' = br1 { b_seq = V.take l' (b_seq br1), b_qual = V.take l' (b_qual br1) }- doext br = br { b_exts = updateE "XI" (Text xi) $ updateE "YI" (Text yi) $ b_exts br }-- xi = S.pack . map showNucleotides . V.toList . V.drop l' $ b_seq br1- yi = B.pack . map ((+) 33 . unQ) . V.toList . V.drop l' $ b_qual br1---- Given an enumerator and maybe a filename, read index sequences from--- the file and merge them with the numerator.-withIndex :: (MonadIO m, MonadMask m)- => Maybe FilePath -> BamKey -> BamKey- -> Enumerator [UpToTwo BamRec] m a -> Enumerator [UpToTwo BamRec] m a-withIndex Nothing _ _ enum = enum-withIndex (Just fp) tagi tagq enum = mergeEnums enum (fromFastq fp) (convStream combine)- where- combine = do seqrecs <- lift headStream- idxrec <- headStream- when (b_qname (fst seqrecs) /= b_qname idxrec) . error $- "read names do not match: " ++ shows (b_qname (fst seqrecs)) " & " ++ show (b_qname idxrec)-- let idxseq = S.pack $ map showNucleotides $ V.toList $ b_seq idxrec- idxqual = B.pack $ map ((+33) . unQ) $ V.toList $ b_qual idxrec- return [ flip mapU2 seqrecs $- \r -> r { b_exts = (if B.null idxqual then id else insertE tagq (Text idxqual))- $ insertE tagi (Text idxseq) $ b_exts r } ]---- Enumerate dual files. We read two FastQ files and match them up. We--- must make sure the names match, and we will flag everything as--- 1st/2nd mate, no matter if the syntactic warts were present in the--- files themselves.-enumDual :: (MonadIO m, MonadMask m)- => FilePath -> FilePath -> Enumerator [UpToTwo BamRec] m a-enumDual f1 f2 = mergeEnums (fromFastq f1 $= mapStream one) (fromFastq f2) (convStream combine)- where- combine = do (firstMate, Nothing) <- lift headStream- secondMate <- headStream-- when (b_qname firstMate /= b_qname secondMate) . error $- "read names do not match: " ++ shows (b_qname firstMate) " & " ++ show (b_qname secondMate)-- let qc = (b_flag firstMate .|. b_flag secondMate) .&. flagFailsQC- addx k = maybe id (updateE k) $ maybe (lookup k (b_exts secondMate)) Just $ lookup k (b_exts firstMate)- add_indexes = addx "XI" . addx "XJ" . addx "YI" . addx "YJ"-- return [ two (firstMate { b_flag = qc .|. flagFirstMate .|. flagPaired .|. b_flag firstMate .&. complement flagSecondMate- , b_exts = add_indexes $ b_exts firstMate })- (secondMate { b_flag = qc .|. flagSecondMate .|. flagPaired .|. b_flag secondMate .&. complement flagFirstMate- , b_exts = add_indexes $ b_exts secondMate }) ]---progress :: MonadIO m => Bool -> Enumeratee [UpToTwo BamRec] [UpToTwo BamRec] m b-progress False = mapChunks id-progress True = eneeCheckIfDonePass (icont . go 0 0)- where- go !_ !_ k (EOF mx) = idone (liftI k) (EOF mx)- go !l !n k (Chunk [ ]) = liftI $ go l n k- go !l !n k (Chunk as@(a:_)) = do- let !n' = n + length as- !nm = b_qname (fst a)- !l' = l `max` S.length nm- when (n .&. complement 0x1fff /= n' .&. complement 0x1fff) $ liftIO $ do- hPutStr stderr $ "\27[K" ++- replicate (l' - S.length nm) ' '- ++ S.unpack nm ++ ", "- ++ shows n' " records processed\n"- hFlush stderr- eneeCheckIfDonePass (icont . go l' n') . k $ Chunk as--
− tools/jivebunny.hs
@@ -1,536 +0,0 @@--- Two-stage demultiplexing.------ We assume we know the list of i7 and i5 index oligos. We seek to--- decompose a set of reads into a mix of pairs of these by the Maximum--- Likelihood method. Once that's done, an empirical Bayesian Maximum--- Posterior call is done. All kinds of errors can be rolled into one--- quality score.------ - Input layer to gather index sequences. (Done.)--- - Input layer to gather read group defs. (Done.)--- - First pass to gather data. Any index read shall be represented--- in a single Word64. (Done. Reading BAM is slow. BCL would be--- much more suitable here.)--- - Multiple passes of the EM algorithm. (Done.)--- - Start with a naive mix, to avoid arguments. (Done.)--- - Final calling pass from BAM to BAM. (Done. BCL to BAM would be--- even nicer.)--- - Auxillary statistics: composition of the mix (Done.), false--- assignment rates per read group (Done.), maximum achievable false--- assignment rates (Done.)--import Bio.Bam-import Bio.Prelude-import Bio.Util.Numeric ( showNum )-import Data.Aeson-import Foreign.C.Types-import Foreign.Marshal.Alloc-import Foreign.Ptr-import Foreign.Storable-import Paths_biohazard ( version, getDataFileName )-import System.Console.GetOpt-import System.Random ( randomRIO )--import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BS-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as L hiding ( singleton )-import qualified Data.Text.Lazy.IO as L-import qualified Data.Text.Lazy.Builder as L-import qualified Data.Text.Lazy.Builder.Int as L-import qualified Data.Text.Lazy.Builder.RealFloat as L-import qualified Data.Vector as V-import qualified Data.Vector.Algorithms.Intro as V-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Storable as VS-import qualified Data.Vector.Storable.Mutable as VSM-import qualified Data.Vector.Generic as VG-import qualified Data.Vector.Generic.Mutable as VGM--import Index--fromS :: B.ByteString -> Index-fromS sq = fromSQ sq (B.replicate (B.length sq) 64)--fromSQ :: B.ByteString -> B.ByteString -> Index-fromSQ sq qs = Index . foldl' (\a b -> a `shiftL` 8 .|. fromIntegral b) 0 $- take 8 $ (++ repeat 0) $- B.zipWith (\b q -> shiftL (b .&. 0xE) 4 .|. (min 31 $ max 33 q - 33)) sq qs--fromTags :: BamKey -> BamKey -> BamRaw -> Index-fromTags itag qtag br = fromSQ sq (if B.null qs then "@@@@@@@@" else qs)- where- sq = extAsString itag $ unpackBam br- qs = extAsString qtag $ unpackBam br--gather :: MonadIO m => Int -> (String -> IO ()) -> (String -> IO ()) -> BamMeta -> Iteratee [BamRaw] m (U.Vector (Index, Index))-gather num say mumble hdr = case hdr_sorting $ meta_hdr hdr of- Unsorted -> greedy- Grouped -> greedy- Queryname -> greedy- Unknown -> safe- Coordinate -> fair- GroupSorted -> fair- where- greedy = do liftIO . say $ "File is unsorted, sampling up to "- ++ showNum num ++ " records from the beginning.\n"- go stream2vectorN-- fair = do liftIO . say $ "File is sorted, need to sample up to "- ++ showNum num ++ " from whole file.\n"- go subsam2vector-- safe = do liftIO . say $ "File might be sorted, need to sample up to "- ++ showNum num ++ " from whole file.\n"- go subsam2vector-- go k = filterStream ((\b -> not (isPaired b) || isFirstMate b) . unpackBam) =$- progressNum "reading " 0x100000 mumble =$- mapStream (fromTags "XI" "YI" &&& fromTags "XJ" "YJ") =$ k num---subsam2vector :: (MonadIO m, ListLike s a, Nullable s, VG.Vector v a) => Int -> Iteratee s m (v a)-subsam2vector sz = liftIO (VGM.new sz) >>= go 0- where- go !i !mv = tryHead >>= \x -> case x of- Nothing -> liftIO $ if i < sz then VG.unsafeFreeze $ VGM.take i mv- else VG.unsafeFreeze mv- Just a -> do liftIO $ if i < sz- then VGM.write mv i a- else do p <- randomRIO (0,i)- when (p < sz) $ VGM.write mv p a- go (i+1) mv--data IndexTab = IndexTab { unique_indices :: U.Vector Index- , canonical_names :: V.Vector T.Text- , alias_names :: HM.HashMap T.Text Int }--single_placeholder :: IndexTab-single_placeholder = IndexTab (U.singleton (fromS "")) (V.singleton "is4") $- HM.fromList [ (k,0) | [_,_,k] <- map T.words $ T.lines default_rgs ]--data Both = Both { p7is :: IndexTab, p5is :: IndexTab }--instance FromJSON Both where- parseJSON = withObject "toplevel object expected" $ \v ->- both <$> ((v .: "p7index") >>= parse_assocs)- <*> (((v .: "p5index") >>= parse_assocs) <|> pure [])- where- parse_assocs = withObject "association list expected" $ \o ->- sequence [ (,) k <$> withText "sequence expected" (return . T.encodeUtf8) v | (k,v) <- HM.toList o ]-- both as7 as5 = Both (canonical as7) (canonical as5)- where- canonical pps =- let hm = HM.toList $ HM.fromListWith (++) [ (fromS v,[k]) | (k,v) <- pps ]- in IndexTab (U.fromList $ map fst hm)- (V.fromList $ map (head . snd) hm)- (HM.fromList $ [ (k,i) | (i, ks) <- zip [0..] (map snd hm), k <- ks ])--data RG = RG { rgid :: B.ByteString- , rgi7 :: Int- , rgi5 :: Int- , tags :: BamOtherShit }---- | Parses read group defintions from a file. The file can have--- optional header lines, the remainder must be a tab-separated table,--- first column is the read group name, second is the P7 index name,--- third is the P5 index name (*must* be present), all others are tagged--- fields just like BAM expects them in the header.------ For integration with a LIMS, something structured like JSON would--- probably work better, however, absent such a LIMS, tables are easier--- to come by.--readRGdefns :: HM.HashMap T.Text Int -> HM.HashMap T.Text Int -> T.Text -> [ RG ]-readRGdefns p7is p5is = map repack . filter (not . null) . map (T.split (=='\t'))- . dropWhile ("#" `T.isPrefixOf`) . T.lines- where- repack (rg:_) | T.any (\c -> c == '/' || c == ',') rg = error $ "RG name must not contain ',' or '/': " ++ show rg- repack (rg:p7:p5:tags) = case HM.lookup p7 p7is of- Nothing -> error $ "unknown P7 index " ++ show p7- Just i7 -> case HM.lookup p5 p5is of- Nothing -> error $ "unknown P5 index " ++ show p5- Just i5 -> RG (T.encodeUtf8 rg) i7 i5 (map repack1 tags)- repack ws = error $ "short RG line " ++ show (T.intercalate "\t" ws)- repack1 w | T.length w > 3 && T.index w 2 == ':'- = (fromString [T.index w 0, T.index w 1], T.encodeUtf8 $ T.drop 3 w)- | otherwise = error $ "illegal tag " ++ show w--default_rgs :: T.Text-default_rgs = "PhiXA\tPhiA\tPhiA\nPhiXC\tPhiC\tPhiC\nPhiXG\tPhiG\tPhiG\nPhiXT\tPhiT\tPhiT\nPhiX\tPhiX\tis4\n"---- | Compute mismatch score: sum of the qualities in 'a' at positions--- where the bases don't match. Works by comparing through an xor,--- building a mask from it, then adding quality scores sideways.------ Since we keep quality scores in the lower 5 bits of each byte, adding--- all eight is guaranteed to fit into the highest 8 bits.-match :: Index -> Index -> Word64-match (Index a) (Index b) = score- where x = a `xor` b- y = (shiftR x 5 .|. shiftR x 6 .|. shiftR x 7) .&. 0x0101010101010101- bitmask = (0x2020202020202020 - y) .&. 0x1F1F1F1F1F1F1F1F- score = shiftR ((a .&. bitmask) * 0x0101010101010101) 56---- | A mixture description is one probability for each combination of p7--- and p5 index. They should sum to one.-type Mix = VS.Vector Double-type MMix = VSM.IOVector Double--padding :: Int-padding = 31--stride' :: Int -> Int-stride' n5 = (n5 + padding) .&. complement padding---- | Computing the naively assumed mix when nothing is known: uniform--- distribution.-naiveMix :: (Int,Int) -> Int -> Mix-naiveMix (n7,n5) total = VS.replicate vecsize (fromIntegral total / fromIntegral bins)- where- !vecsize = n7 * stride' n5- !bins = n7 * n5---- | Matches an index against both p7 and p5 lists, computes posterior--- likelihoods from the provided prior and accumulates them onto the--- posterior.-unmix1 :: U.Vector Index -> U.Vector Index -> Mix -> MMix -> (Index, Index) -> IO ()-unmix1 p7 p5 prior acc (x,y) =- let !m7 = VS.fromListN (U.length p7) . map (phredPow . match x) $ U.toList p7- !l5 = stride' (U.length p5)- !m5 = VS.fromListN l5 $ map (phredPow . match y) (U.toList p5) ++ repeat 0-- -- *sigh*, Vector doesn't fuse well. Gotta hand it over to gcc. :-(- in VSM.unsafeWith acc $ \pw ->- VS.unsafeWith prior $ \pv ->- VS.unsafeWith m7 $ \q7 ->- VS.unsafeWith m5 $ \q5 ->- c_unmix_total pv q7 (fromIntegral $ VS.length m7)- q5 (fromIntegral $ l5 `div` succ padding)- nullPtr nullPtr >>= \total ->- c_unmix_qual pw pv q7 (fromIntegral $ VS.length m7)- q5 (fromIntegral $ l5 `div` succ padding)- total 0 0 >>= \_qual ->- return () -- the quality is meaningless here--foreign import ccall unsafe "c_unmix_total"- c_unmix_total :: Ptr Double -- prior mix- -> Ptr Double -> CUInt -- P7 scores, length- -> Ptr Double -> CUInt -- P5 scores, length/32- -> Ptr CUInt -> Ptr CUInt -- out: ML P7 index, P5 index- -> IO Double -- total likelihood--foreign import ccall unsafe "c_unmix_qual"- c_unmix_qual :: Ptr Double -- posterior mix, mutable accumulator- -> Ptr Double -- prior mix- -> Ptr Double -> CUInt -- P7 scores, length- -> Ptr Double -> CUInt -- P5 scores, length/32- -> Double -- total likelihood- -> CUInt -> CUInt -- maximizing P7 index, P5 index- -> IO Double -- posterior probability for any other assignment---- | Matches an index against both p7 and p5 lists, computes MAP--- assignment and quality score.-class1 :: HM.HashMap (Int,Int) (B.ByteString, VSM.IOVector Double)- -> U.Vector Index -> U.Vector Index- -> Mix -> (Index, Index) -> IO (Double, Int, Int)-class1 rgs p7 p5 prior (x,y) =- let !m7 = VS.fromListN (U.length p7) . map (phredPow . match x) $ U.toList p7- !l5 = stride' (U.length p5)- !m5 = VS.fromListN l5 $ map (phredPow . match y) (U.toList p5) ++ repeat 0-- -- *sigh*, Vector doesn't fuse well. Gotta hand it over to gcc. :-(- in alloca $ \pi7 ->- alloca $ \pi5 ->- VS.unsafeWith prior $ \pv ->- VS.unsafeWith m7 $ \q7 ->- VS.unsafeWith m5 $ \q5 ->- ( {-# SCC "c_unmix_total" #-}- c_unmix_total pv q7 (fromIntegral $ VS.length m7)- q5 (fromIntegral $ l5 `div` succ padding)- pi7 pi5 ) >>= \total ->- peek pi7 >>= \i7 ->- peek pi5 >>= \i5 ->- withDirt (fromIntegral i7, fromIntegral i5) $ \pw ->- ( {-# SCC "c_unmix_qual" #-}- c_unmix_qual pw pv q7 (fromIntegral $ VS.length m7)- q5 (fromIntegral $ l5 `div` succ padding)- total i7 i5 ) >>= \qual ->- return ( qual, fromIntegral i7, fromIntegral i5 )- where- withDirt ix k = case HM.lookup ix rgs of- Just (_,dirt) -> VSM.unsafeWith dirt k- Nothing -> k nullPtr---phredPow :: Word64 -> Double-phredPow x = exp $ -0.1 * log 10 * fromIntegral x---- | One iteration of the EM algorithm. Input is a vector of pairs of--- indices, the p7 and p5 index collections, and a prior mixture; output--- is the posterior mixture.-iterEM :: U.Vector (Index, Index) -> U.Vector Index -> U.Vector Index -> Mix -> IO Mix-iterEM pps p7 p5 prior = do- acc <- VSM.replicate (VS.length prior) 0- U.mapM_ (unmix1 p7 p5 prior acc) pps- VS.unsafeFreeze acc--data Loudness = Quiet | Normal | Loud--unlessQuiet :: Monad m => Loudness -> m () -> m ()-unlessQuiet Quiet _ = return ()-unlessQuiet _ k = k---- should I have a config for merging here? adapter lists?--- does it ever make sense to skip the merging?-data Conf = Conf {- cf_index_list :: FilePath,- cf_output :: Maybe (BamMeta -> Iteratee [BamRec] IO ()),- cf_stats_hdl :: Handle,- cf_num_stats :: Int -> Int,- cf_threshold :: Double,- cf_loudness :: Loudness,- cf_single :: Bool,- cf_samplesize :: Int,- cf_readgroups :: [FilePath],- cf_implied :: [T.Text],- cf_merge :: Maybe ([U.Vector Nucleotides], [U.Vector Nucleotides]) }--defaultConf :: IO Conf-defaultConf = do ixdb <- getDataFileName "index_db.json"- return $ Conf {- cf_index_list = ixdb,- cf_output = Nothing,- cf_stats_hdl = stdout,- cf_num_stats = \l -> max 20 $ l * 5 `div` 4,- cf_threshold = 0.000005,- cf_loudness = Normal,- cf_single = False,- cf_samplesize = 50000,- cf_readgroups = [],- cf_implied = [default_rgs],- cf_merge = Nothing }--options :: [OptDescr (Conf -> IO Conf)]-options = [- Option "o" ["output"] (ReqArg set_output "FILE") "Send output to FILE",- Option "I" ["index-database"] (ReqArg set_index_db "FILE") "Read index database from FILE",- Option "r" ["read-groups"] (ReqArg set_rgs "FILE") "Read read group definitions from FILE",- Option "s" ["single-index"] (NoArg set_single) "Only consider first index",- Option [ ] ["threshold"] (ReqArg set_thresh "FRAC") "Iterate till uncertainty is below FRAC",- Option [ ] ["sample"] (ReqArg set_sample "NUM") "Sample NUM reads for mixture estimation",- Option [ ] ["components"] (ReqArg set_compo "NUM") "Print NUM components of the mixture",- Option [ ] ["nocontrol"] (NoArg set_no_control) "Suppress implied read groups for controls",- Option "F" ["forward-adapter"] (ReqArg set_forward "SEQ") "SEQ is a possible forward adapter",- Option "R" ["reverse-adapter"] (ReqArg set_reverse "SEQ") "SEQ is a possible reverse adapter",- Option "v" ["verbose"] (NoArg set_loud) "Print more diagnostic messages",- Option "q" ["quiet"] (NoArg set_quiet) "Print fewer diagnostic messages",- Option "h?"["help", "usage"] (NoArg $ const usage) "Print this message and exit",- Option "V" ["version"] (NoArg $ const vrsn) "Display version number and exit" ]- where- set_output "-" c = return $ c { cf_output = Just $ pipeBamOutput, cf_stats_hdl = stderr }- set_output fp c = return $ c { cf_output = Just $ writeBamFile fp }- set_index_db fp c = return $ c { cf_index_list = fp }- set_rgs fp c = return $ c { cf_readgroups = fp : cf_readgroups c }- set_loud c = return $ c { cf_loudness = Loud }- set_quiet c = return $ c { cf_loudness = Quiet }- set_single c = return $ c { cf_single = True }- set_no_control c = return $ c { cf_implied = [] }- set_thresh a c = readIO a >>= \x -> return $ c { cf_threshold = x }- set_sample a c = readIO a >>= \x -> return $ c { cf_samplesize = x }- set_compo a c = readIO a >>= \x -> return $ c { cf_num_stats = const x }-- set_forward a c = readIO a >>= \x -> return $ c { cf_merge = Just $ first (x:) $ fromMaybe ([],[]) $ cf_merge c }- set_reverse a c = readIO a >>= \x -> return $ c { cf_merge = Just $ second (x:) $ fromMaybe ([],[]) $ cf_merge c }-- usage = do pn <- getProgName- putStrLn $ usageInfo ("Usage: " ++ pn ++ " [options] [bam-files]\n" ++- "Decomposes a mix of libraries and assigns read groups.") options- exitSuccess-- vrsn = do pn <- getProgName- hPutStrLn stderr $ pn ++ ", version " ++ showVersion version- exitSuccess---adj_left :: Int -> Char -> L.Builder -> L.Builder-adj_left n c b = mconcat (replicate (n - fromIntegral (L.length t)) (L.singleton c)) <> L.fromLazyText t- where t = L.toLazyText b--adj_left_text :: Int -> Char -> T.Text -> L.Builder-adj_left_text n c t = mconcat (replicate (n - T.length t) (L.singleton c)) <> L.fromText t--main :: IO ()-main = do- (opts, files, errs) <- getOpt Permute options <$> getArgs- unless (null errs) $ mapM_ (hPutStrLn stderr) errs >> exitFailure- Conf{..} <- foldl (>>=) defaultConf opts- when (null files) $ hPutStrLn stderr "no input files." >> exitFailure- add_pg <- addPG $ Just version-- let notice = case cf_loudness of Quiet -> \_ -> return () ; _ -> hPutStr stderr- info = case cf_loudness of Loud -> hPutStr stderr ; _ -> \_ -> return ()-- Both{..} <- B.readFile cf_index_list >>= \raw -> case decodeStrict' raw of- Nothing -> hPutStrLn stderr "Couldn't parse index database." >> exitFailure- Just x | cf_single -> return $ x { p5is = single_placeholder }- | otherwise -> return x-- rgdefs <- concatMap (readRGdefns (alias_names p7is) (alias_names p5is)) . (++) cf_implied <$> mapM T.readFile cf_readgroups- notice $ "Got " ++ showNum (U.length (unique_indices p7is)) ++ " unique P7 indices and "- ++ showNum (U.length (unique_indices p5is)) ++ " unique P5 indices.\n"- notice $ "Declared " ++ showNum (length rgdefs) ++ " read groups.\n"-- let n7 = U.length $ unique_indices p7is- n5 = U.length $ unique_indices p5is- stride = stride' n5- vsize = n7 * stride-- !rgs <- do let dup_error x y = error $ "Read groups " ++ show (fst x) ++ " and "- ++ show (fst y) ++ " have the same indices."- HM.fromListWith dup_error <$> sequence- [ VSM.replicate vsize (0::Double) >>= \dirt -> return ((i7,i5),(rg,dirt))- | RG !rg !i7 !i5 _ <- rgdefs ]-- let inspect = inspect' rgs (canonical_names p7is) (canonical_names p5is)-- ixvec <- concatInputs files >=> run $ gather cf_samplesize notice info- notice $ "Got " ++ showNum (U.length ixvec) ++ " index pairs.\n"-- notice "decomposing mix "- let go !n v = do v' <- iterEM ixvec (unique_indices p7is) (unique_indices p5is) v- case cf_loudness of Loud -> hPutStrLn stderr [] >> inspect stderr 20 v'- Normal -> hPutStr stderr "."- Quiet -> return ()- let d = VS.foldl' (\a -> max a . abs) 0 $ VS.zipWith (-) v v'- if n > 0 && d > cf_threshold * fromIntegral (U.length ixvec)- then go (n-1) v'- else do notice (if n == 0 then "\nmaximum number of iterations reached.\n"- else "\nmixture ratios converged.\n")- return v'-- mix <- go (50::Int) $ naiveMix (U.length $ unique_indices p7is, U.length $ unique_indices p5is) (U.length ixvec)-- unlessQuiet cf_loudness $ do- T.hPutStrLn cf_stats_hdl "\nfinal mixture estimate:"- inspect cf_stats_hdl (cf_num_stats $ HM.size rgs) mix-- let maxlen = maximum $ map (B.length . rgid) rgdefs- ns7 = canonical_names p7is- ns5 = canonical_names p5is- num = 7-- case cf_output of- Nothing -> do unlessQuiet cf_loudness $ do- T.hPutStrLn cf_stats_hdl "\nmaximum achievable quality, top pollutants:"- forM_ (sortOn (fst.snd) $ HM.toList rgs) $ \((i7,i5), (rgid,_)) -> do- (p,_,_) <- class1 HM.empty (unique_indices p7is) (unique_indices p5is) mix- (unique_indices p7is U.! i7, unique_indices p5is U.! i5)-- let qmax = negate . round $ 10 / log 10 * log p :: Int- L.hPutStrLn cf_stats_hdl . L.toLazyText $- adj_left_text maxlen ' ' (T.decodeUtf8 rgid) <>- L.fromText ": " <>- adj_left 4 ' ' (L.singleton 'Q' <> L.decimal (max 0 qmax))-- Just out -> do concatInputs files >=> run $ \hdr ->- let hdr' = hdr { meta_other_shit =- [ os | os@(k,_) <- meta_other_shit hdr, k /= "RG" ] ++- HM.elems (HM.fromList [ (rgid, ("RG", ("ID",rgid):tags)) | RG{..} <- rgdefs ] ) }- in mapStreamM (\br -> do- let b = unpackBam br- eff_rgs | not (isPaired b) = rgs- | isFirstMate b = rgs- | otherwise = HM.empty- (p,i7,i5) <- class1 eff_rgs (unique_indices p7is) (unique_indices p5is) mix- (fromTags "XI" "YI" br, fromTags "XJ" "YJ" br)- let q = negate . round $ 10 / log 10 * log p- ex = deleteE "ZR" . deleteE "Z0" . deleteE "Z2" . updateE "Z1" (Int q) $- updateE "ZX" (Text $ T.encodeUtf8 $ T.concat [ ns7 V.! i7, ",", ns5 V.! i5 ]) $- case HM.lookup (i7,i5) rgs of- Nothing -> deleteE "RG" $ b_exts b- Just (rgn,_) -> updateE "RG" (Text rgn) $ b_exts b- return $ case lookup "ZQ" ex of- Just (Text t) | BS.null t' -> b { b_exts = deleteE "ZQ" ex- , b_flag = b_flag b .&. complement flagFailsQC }- | otherwise -> b { b_exts = updateE "ZQ" (Text t') ex }- where- t' = BS.filter (\c -> c /= 'C' && c /= 'I' && c /= 'W') t- _ -> b { b_exts = ex- , b_flag = b_flag b .&. complement flagFailsQC }) =$- progressNum "writing " 0x100000 info =$- maybe (mergeTrimBam default_fwd_adapters default_rev_adapters)- (uncurry mergeTrimBam) cf_merge =$- out (add_pg hdr')-- unlessQuiet cf_loudness $ do- grand_total <- foldM (\ !acc (_,dirt) -> VS.freeze dirt >>= return . (+) acc . VS.sum) 0 (HM.elems rgs)- T.hPutStrLn cf_stats_hdl "\nmaximum achievable and average quality, top pollutants:"- forM_ (sortOn (fst.snd) $ HM.toList rgs) $ \((i7,i5), (rgid,dirt_)) -> do- dirt <- VS.freeze dirt_- (p,_,_) <- class1 HM.empty (unique_indices p7is) (unique_indices p5is) mix- (unique_indices p7is U.! i7, unique_indices p5is U.! i5)-- let total = VS.sum dirt- others = VS.sum $ VS.ifilter (\i _ -> i /= i7 * stride + i5) dirt- qmax = negate . round $ 10 / log 10 * log p :: Int- qavg = negate . round $ 10 / log 10 * log (others/total) :: Int-- v <- U.unsafeThaw . U.fromListN (VS.length dirt) . zip [0..] . VS.toList $ dirt- V.sortBy (\(_,a) (_,b) -> compare b a) v -- meh.- v' <- U.unsafeFreeze v-- let fmt_one (i,n) =- let (i7', i5') = i `quotRem` stride- chunk = L.formatRealFloat L.Fixed (Just 2) (100*n/total) <> L.singleton '%' <>- L.singleton ' ' <> L.fromText (ns7 V.! i7') <>- L.singleton '/' <> L.fromText (ns5 V.! i5') <>- case HM.lookup (i7',i5') rgs of- Nothing -> mempty- Just (rg,_) -> L.singleton ' ' <> L.singleton '(' <>- L.fromText (T.decodeUtf8 rg) <> L.singleton ')'- in if (i7 == i7' && i5 == i5') || i5' >= n5 then id else (:) chunk-- when (total >= 1) . L.hPutStrLn cf_stats_hdl . L.toLazyText $- adj_left_text maxlen ' ' (T.decodeUtf8 rgid) <>- L.singleton ':' <> L.singleton ' ' <>- adj_left 4 ' ' (L.singleton 'Q' <> L.decimal (max 0 qmax)) <> L.fromText ", " <>- adj_left 4 ' ' (L.singleton 'Q' <> L.decimal (max 0 qavg)) <> L.fromText ", " <>- L.fromString (showNum (round total :: Int)) <> L.fromText " (" <>- L.formatRealFloat L.Fixed (Just 2) (100*total/grand_total) <> L.fromText "%); " <>- foldr1 (\a b -> a <> L.fromText ", " <> b)- (take num $ U.foldr fmt_one [] v')--inspect' :: HM.HashMap (Int,Int) (B.ByteString, t) -> V.Vector T.Text -> V.Vector T.Text -> Handle -> Int -> Mix -> IO ()-inspect' rgs n7 n5 hdl num_ mix = do- -- Due to padding, we get invalid indices here. Better filter them- -- out, because we sure can't print them later.- let num = min num_ $ V.length n5 * V.length n7- v <- U.unsafeThaw $ U.fromListN (V.length n5 * V.length n7) $- filter (\(i,_) -> i `rem` stride' (V.length n5) < V.length n5) $- zip [0..] $ VS.toList mix- V.partialSortBy (\(_,a) (_,b) -> compare b a) v num -- meh.- v' <- U.unsafeFreeze v-- let total = U.sum . U.map snd $ v'- others = U.sum . U.map snd . U.drop num $ v'-- U.forM_ (U.take num v') $ \(i,n) -> do- let (i7, i5) = i `quotRem` stride' (V.length n5)- L.hPutStrLn hdl . L.toLazyText $- adj_left_text 7 ' ' (n7 V.! i7) <> L.singleton ',' <> L.singleton ' ' <>- adj_left_text 7 ' ' (n5 V.! i5) <> L.singleton ':' <> L.singleton ' ' <>- adj_left 8 ' ' (L.formatRealFloat L.Fixed (Just 3) (100 * n / total)) <> L.singleton '%' <> L.singleton ' ' <>- case HM.lookup (i7,i5) rgs of- Nothing -> mempty- Just (rg,_) -> L.singleton '(' <> L.fromText (T.decodeUtf8 rg) <> L.singleton ')'-- L.hPutStrLn hdl . L.toLazyText $- L.fromLazyText " all others: " <>- adj_left 8 ' ' (L.formatRealFloat L.Fixed (Just 3) (100 * others / total)) <>- L.singleton '%'-
− tools/mt-anno.hs
@@ -1,58 +0,0 @@-import Anno-import Seqs-import Xlate--import Bio.Align-import Control.Applicative-import Data.Char-import Prelude-import Text.Printf--import qualified Data.ByteString.Char8 as S--main :: IO ()-main = do- smps <- fromFasta . S.lines . S.filter (/= '\r') <$> S.getContents-- let (tabs, fas) = unzip $ map (uncurry do_anno) smps-- putStrLn $ unlines $ concatMap (++ [[]]) tabs- putStrLn $ unlines $ concatMap (++ [[]]) fas---do_anno :: S.ByteString -> S.ByteString -> ([String], [String])-do_anno smp_name raw_sample = (tab, fa)- where- (_, rCRS, sample) = myersAlign 3000 {- maxd -} raw_rCRS Globally raw_sample- xpose1 = xpose rCRS sample- xpose_anno g = g { start = xpose1 (start g), end = xpose1 (end g) }-- tab = to_tab (S.unpack smp_name) $ map xpose_anno $ rCRS_anno- fa = concatMap (to_fasta smp_name sample xpose1) rCRS_anno---to_fasta :: S.ByteString -> S.ByteString -> (Int -> Int) -> Anno -> [String]-to_fasta smp_name smp f Gene{..} = case what of CDS -> go ; CDS' -> go ; _ -> []- where- go = let s' = f start- e' = f end- prot = case init $ get_protein smp (s',e') of- 'I' : rest -> 'M' : rest ; x -> x- hdr = printf ">%s [gene=%s] [protein=%s] [location=%s]"- (S.unpack smp_name) name prod loc- loc | s' <= e' = shows s' ".." ++ show e'- | otherwise = "complement(" ++ shows e' ".." ++ shows s' ")"- in hdr : chunk prot-- chunk s = case splitAt 70 s of (u,v) | null v -> [u]- | otherwise -> u : chunk v---fromFasta :: [S.ByteString] -> [(S.ByteString, S.ByteString)]-fromFasta ls = case dropWhile (not . isHeader) ls of- [ ] -> []- (h:rest) -> case break isHeader rest of- (body,rest') -> (S.drop 1 h, S.map toUpper $ S.concat body) : fromFasta rest'- where- isHeader s = not (S.null s) && S.head s == '>'-
− tools/mt-ccheck.hs
@@ -1,584 +0,0 @@--- Simple Mitochondrial Contamination Check on BAM files.------ This is based on Ye Olde Contamination Check for the Neanderthal--- genome; the method is the same (and will continue to not work on--- modern humans), but simplified and sanitized. Differences from--- before:------ * We use the alignment from the BAM file as is. Earlier we would--- have created *two* new alignments. That is silly, however. Two--- new alignments should not be followed by bean counting, but by an--- attempt to genotype both the sample and the contaminant.------ * Before, the sample and contaminant sequences were fixed. Now we--- instead input a list of the diagnostic positions. Instead of an--- explicit list, the two sequences can still be used, or only the--- contaminant can be supplied while the sample is genotype-called.----- TODO------ (1) Given a list of diagnostic positions, implement the contamination--- check. Structure of the code can be stolen from ccheck in the--- mia package.------ - What do we do about wrapped alignments? Mia has f/b/a labels,--- BAM doesn't. We can see if it overhangs, though.------ (2) Given a high-coverage sample, genotype call it and derive the--- diagnostic positions.------ - This method needs some definition of the contaminant consensus--- thingy.------ (3) Given a `correct' sample sequence, align it to the reference and--- derive diagnostic positions from that.------ - Needs the same description of the contaminant thingy.------ (4) Consider Read Groups.------ - One result per read group (or maybe per library, alternatively--- per file) should be produced.--- - The "aDNA" setting should be determined from either the @RG--- header or from an external source.---import Bio.Bam hiding ( Unknown )-import Bio.Prelude-import System.Console.GetOpt--import qualified Data.HashMap.Strict as HM-import qualified Data.IntMap as IM--data Conf = Conf {- conf_adna :: Adna,- conf_verbosity :: Int,- conf_header :: HeaderFn,- conf_output :: OutputFn,- conf_shoot_foot :: Bool,- conf_dp_list :: DpList- }--options :: [OptDescr (Conf -> IO Conf)]-options = public_options ++ hidden_options- where- public_options = [- Option "a" ["ancient","dsprot"] (NoArg (set_adna ancientDNAds)) "Treat DNA as ancient, double strand protocol",- Option "s" ["ssprot"] (NoArg (set_adna ancientDNAss)) "Treat DNA as ancient, single strand protocol",- Option "" ["fresh"] (NoArg (set_adna freshDNA)) "Treat DNA as fresh (not ancient)",- Option "T" ["table"] (NoArg set_output_table) "Print output in table form",-- Option "v" ["verbose"] (NoArg (mod_verbosity succ)) "Produce more debug output",- Option "q" ["quiet"] (NoArg (mod_verbosity pred)) "Produce less debug output",- Option "h?" ["help","usage"] (NoArg usage) "Print this message and exit"- ]-- hidden_options = [- Option "" ["shoot","foot"] (NoArg set_shoot_foot) []- ]-- usage _ = do pn <- getProgName- hPutStrLn stderr $ usageInfo ("Usage: " ++ pn ++ " [OPTION...] [Bam-File...]") public_options- exitSuccess-- set_shoot_foot c = return $ c { conf_shoot_foot = True }- set_adna a c = return $ c { conf_adna = a }- set_output_table c = return $ c { conf_output = show_result_table, conf_header = header_table }- mod_verbosity f c = return $ c { conf_verbosity = f (conf_verbosity c) }---conf0 :: IO Conf-conf0 = return $ Conf { conf_adna = freshDNA- , conf_verbosity = 1- , conf_header = ""- , conf_output = show_result_plain- , conf_shoot_foot = False- , conf_dp_list = error "no diagnostic positions defined"- }--{- Old options... may or may not be of much use.--struct option longopts[] = {- { "reference", required_argument, 0, 'r' },- { "transversions", no_argument, 0, 't' },- { "span", required_argument, 0, 's' },- { "maxd", required_argument, 0, 'd' },-} ;--void usage( const char* pname )-{- "Reads a maln file and tries to quantify contained contamination.\n"- "Options:\n"- " -r, --reference FILE FASTA file with the likely contaminant (default: builtin mt311)\n"- " -t, --transversions Treat only transversions as diagnostic\n"- " -s, --span M-N Look only at range from M to N\n"- " -n, --numpos N Require N diagnostic sites in a single read (default: 1)\n"-}--}---- | A list of diagnostic positions. We drop the failed idea of--- "weakly diagnostic positions". We also work in the coordinate system--- of the reference. Therefore, a diagnostic position is defined by--- position, allele in the clean sample and allele in the contaminant.--data Dp = Dp { _dp_clean_allele :: !Nucleotide- , _dp_dirty_allele :: !Nucleotide }- deriving Show--type DpList = IM.IntMap Dp--show_dp_list :: DpList -> ShowS-show_dp_list = flip IM.foldrWithKey id $ \pos (Dp cln drt) k ->- (:) '<' . shows pos . (:) ':' . shows drt .- (:) ',' . shows cln . (++) ">, " . k----- | Reads are classified into one of these.-data Klass = Unknown | Clean | Dirty | Conflict | Nonsense- deriving (Ord, Eq, Enum, Bounded, Show)--instance Monoid Klass where- mempty = Unknown- Clean `mappend` Dirty = Conflict- Dirty `mappend` Clean = Conflict- x `mappend` y = if x < y then y else x--newtype Summary = Summary (IM.IntMap Int)--sum_count :: Klass -> Summary -> Summary-sum_count kl (Summary m) = Summary $ IM.insertWith' (+) (fromEnum kl) 1 m--sum_get :: Klass -> Summary -> Int-sum_get kl (Summary m) = IM.findWithDefault 0 (fromEnum kl) m----- | Determines what an allele could come from. Does not take--- port-mortem modifications into account.-classify :: Dp -> Nucleotide -> Klass-classify (Dp cln drt) nuc- | maybe_clean && maybe_dirty = Unknown- | maybe_clean = Clean- | maybe_dirty = Dirty- | otherwise = Nonsense- where- maybe_clean = unN cln .&. unN nuc /= 0- maybe_dirty = unN drt .&. unN nuc /= 0----- | We deal with aDNA by transforming a base into all the bases it--- could have been. So the configuration is simply the transformation--- function.-type Adna = Nucleotide -> Nucleotide---- | Fresh DNA: no transformation.-freshDNA :: Adna-freshDNA = id---- | Ancient DNA, single strand protocol. Deamination can turn C into T--- only.-ancientDNAss :: Adna-ancientDNAss = N . app0 . unN- where app0 x = if x .&. unN nucT /= 0 then x .|. unN nucC else x---- | Ancient DNA, double strand protocol. Deamination can turn C into T--- and G into A.-ancientDNAds :: Adna-ancientDNAds = N . app1 . app2 . unN- where app1 x = if x .&. unN nucT /= 0 then x .|. unN nucC else x- app2 x = if x .&. unN nucA /= 0 then x .|. unN nucG else x----- | Classifying a read. In an ideal world, we'd be looking at a single--- read mapped in one piece. Instead, we may be looking at half a mate--- pair or even a single read mapped inconveniently across the origin.------ We will be reading a BAM stream. All reads with the same name (there--- maybe 1..4, assuming no major breakage) need to be processed--- together. We'll isolate that here: our input stream consists of--- reads that all have the same qname. Results in exactly one 'Klass'.--- We will ignore mate pairs that are improperly mapped or filtered.------ May need more options. Note that application of the aDNA function--- depends on the strandedness of the alignment. FIXME------ This is the only place where counting of votes was used before, and--- only for debugging purposes. Everything that was either dirty or--- clean (but not both) counted as a vote.--classify_read_set :: Monad m => DpList -> Adna -> Iteratee [BamRaw] m Klass-classify_read_set = undefined---- | Classifying a stream. We create a map from read name to iteratee.--- New names are inserted, known names fed to stored iteratees.--- ``Done'' iteratees are disposed of immediately.--classify_stream :: Monad m => DpList -> Adna -> Iteratee [BamRaw] m Summary-classify_stream dps adna = foldStreamM classify_read (Summary IM.empty, HM.empty) >>= lift . finish- where- classify0 = classify_read_set dps adna-- classify_read (summary, iters) rd = do- let nm = b_qname $ unpackBam rd- let it = HM.lookupDefault classify0 nm iters- (isdone, it') <- enumPure1Chunk [rd] it >>= enumCheckIfDone- if isdone then do cl <- run it'- return (sum_count cl summary, HM.delete nm iters)- else return (summary, HM.insert nm it' iters)-- finish (summary, iters) = foldM (\s it -> flip sum_count s `liftM` run it) summary $ HM.elems iters---{- Missing from the output right now:-- * filename (library would be better)- * alignment distance (only useful if DPs are derived from alignment)- * number of difference (likewise)- * number of DPs- * number of DPs which are transversions--}--result_labels :: [ String ]-result_labels = [ "unclassified", "clean", "polluting", "conflicting", "nonsensical", "LB", "ML", "UB" ]--type HeaderFn = String-type OutputFn = Summary -> Maybe [Double] -> String--show_result_plain :: OutputFn-show_result_plain summary ests = unlines $ zipWith fmt result_labels [minBound..maxBound] ++ [[]]- where- labellen = (+) 2 . maximum . map length $ zipWith const result_labels [minBound..maxBound::Klass]- pad n s = replicate (n - length s) ' ' ++ s-- fmt lbl kl = pad labellen lbl ++ " fragments: " ++ show (sum_get kl summary) ++- if kl == Dirty then maybe [] fmt_ests ests else []-- fmt_ests [lb,ml,ub] = " (" ++ showFFloat (Just 1) lb " .. "- ++ showFFloat (Just 1) ml " .. "- ++ showFFloat (Just 1) ub "%)"--header_table :: HeaderFn-header_table = intercalate "\t" result_labels--show_result_table :: OutputFn-show_result_table summary ests = intercalate "\t" $- [ show $ sum_get kl summary | kl <- [minBound..maxBound] ] ++- maybe (replicate 3 "N/A") (map (\x -> showFFloat (Just 1) x [])) ests---show_result_with :: (Summary -> Maybe [Double] -> a) -> Summary -> a-show_result_with f summary = f summary (if nn /= 0 then Just [lb,ml,ub] else Nothing)- where- z = 1.96 -- this is Z_{0.975}, giving a 95% confidence interval- k = fromIntegral (sum_get Dirty summary)- n = k + fromIntegral (sum_get Clean summary)- nn = sum_get Dirty summary + sum_get Clean summary-- p_ = k / n- c = p_ + 0.5 * z * z / n- w = z * sqrt( p_ * (1-p_) / n + 0.25 * z * z / (n*n) )- d = 1 + z * z / n-- lb = max 0 $ 100 * (c-w) / d -- lower bound of CI- ml = 100 * p_ -- ML estimate- ub = min 100 $ 100 * (c+w) / d -- upper bound of CI----- The following is old 'ccheck'... for reference and guidance.---{--/*- * Contamination Checker. Outline:- *- * - read the human reference (concsensus of contaminants); this will- * contain ambiguity codes- * - read maln file, including assembly and assembled reads- * - align contaminant-consensus and assembly globally- * This uses Myers' O(nd) aligner, for it grasps ambiguity codes and- * runs fast enough, in little memory, for long, but similar- * sequences.- * - find "strongly diagnostic positions", positions where ass and con- * are incompatible, and "weakly diagnostic positions", positions- * where ass and con are not always equal- * - for every "end" fragment: store it and later join with its other- * half to give an effectively "full" fragment- * - for every "full" fragment: if it crosses at least one (strongly or- * weakly) diagnostic position, cut out that range from ref and align- * to it globally using the mia aligner- * - pass 1: for every weakly diagnostic position where the bases agree,- * store whether a contaminant was discovered, and if so, turn them- * into "actually diagnostic positions".- * - pass 2: for every (strongly or actually) diagnostic position where- * the bases agree, classify it, then classify the fragment- * (conflicting, uninformative, contaminant, endogenous)- * - produce a summary- *- * Notable features:- * - operates sensibly on aDNA- * - has sensible commandline and doesn't make too much noise in operation- * - optionally considers only certain diagnostic positions- * (tranversions only and/or some region only)- * - new consensus sequence has other letters besides N- */--// Everything that differs is weakly diagnostic, unless it's a gap.-// Note that this mean that Ns are usually weakly diagnostic.-bool is_diagnostic( char aln1, char aln2 )-{- return aln1 != '-' && aln2 != '-' && toupper(aln1) != toupper(aln2) ;-}--// Interesting question... given ambiguity codes, what's a transversion?-// One way to put it: anything that is incompatible with all four-// transitions. Needs a different implementation.-bool is_transversion( char a, char b )-{- char u = a & ~32 ;- char v = b & ~32 ;- switch( u )- {- case 'A': return v != 'G' ;- case 'C': return v != 'T' ;- case 'G': return v != 'A' ;- case 'T':- case 'U': return v != 'C' ;- default: return false ;- }-}---dp_list mk_dp_list( const char* aln1, const char* aln2, int span_from, int span_to )-{- dp_list l ;- int index = 0 ;- while( index != span_from && *aln1 && *aln2 )- {- if( *aln2 != '-' ) ++index ;- ++aln1 ;- ++aln2 ;- }- while( index != span_to && *aln1 && *aln2 )- {- if( is_diagnostic( *aln1, *aln2 ) ) {- l[index].consensus = *aln1 ;- l[index].assembly = *aln2 ;- }- if( *aln2 != '-' ) ++index ;- ++aln1 ;- ++aln2 ;- }- return l ;-}--}---- We won't keep this. Mt311 should be stored as half a Dp list.--- extern char mt311_sequence[] ;--- extern const int mt311_sequence_size ;--main :: IO ()-main = do- (opts, files, errors) <- getOpt Permute options <$> getArgs- unless (null errors) $ mapM_ (hPutStrLn stderr) errors >> exitFailure- Conf{..} <- foldl (>>=) conf0 opts--{-- bool transversions = false ;- int min_diag_posns = 1 ;- int maxd = 0 ;- int span_from = 0, span_to = INT_MAX ;-- int opt ;- do {- opt = getopt_long( argc, argv, "r:avhts:d:n:MfTF", longopts, 0 ) ;- switch( opt )- {- case 'r': read_fasta_ref( &hum_ref, optarg ) ; break ;- case 't': transversions = true ; break ;- case 's': sscanf( optarg, "%u-%u", &span_from, &span_to ) ; if( span_from ) span_from-- ; break ;- case 'n': min_diag_posns = atoi( optarg ) ; break ;- case 'd': maxd = atoi( optarg ) ; break ;- }- } while( opt != -1 ) ;--}-- when (IM.size conf_dp_list < 40 && not conf_shoot_foot) $ do- hPutStrLn stderr $- "\n *** Low number (" ++ shows (IM.size conf_dp_list) ") of diagnostic positions found.\n\- \ *** I will stop now for your own safety.\n\- \ *** If you are sure you want to shoot yourself\n\- \ *** in the foot, read the man page to learn\n\- \ *** how to lift this restriction.\n\n"- exitFailure-- -- TODO We will usually want to seek to the mitochondrion, which- -- doesn't work with the simple 'mergeInputs' invocation.- r <- mergeInputs combineCoordinates files >=> run $ \hdr ->- classify_stream conf_dp_list conf_adna-- putStrLn $ unlines $ conf_header : show_result_with conf_output r : []-- {-- if( mktable ) {- fputs( infile.c_str(), stdout ) ;- putchar( '\t' ) ;- }- else {- puts( infile.c_str() ) ;- putchar( '\n' ) ;- }- -}-- -- if( !maxd ) maxd = max( strlen(hum_ref.seq), strlen(maln->ref->seq) ) / 10 ;--- char *aln_con = (char*)malloc( strlen(hum_ref.seq) + maxd + 2 ) ;- -- char *aln_ass = (char*)malloc( strlen(maln->ref->seq) + maxd + 2 ) ;- -- unsigned d = myers_diff( hum_ref.seq, myers_align_globally, maln->ref->seq, maxd, aln_con, aln_ass ) ;-- {-- if( d == UINT_MAX ) {- fprintf( stderr, "\n *** Could not align references with up to %d mismatches.\n"- " *** This is usually a sign of trouble, but\n"- " *** IF AND ONLY IF YOU KNOW WHAT YOU ARE DOING, you can\n"- " *** try the -d N option with N > %d.\n\n", maxd, maxd ) ;- return 1 ;- }- if( mktable ) printf( "%d\t", d ) ;- else printf( " %d alignment distance between reference and assembly.\n", d ) ;-- if( verbose >= 6 ) print_aln( aln_con, aln_ass ) ;-- dp_list l = mk_dp_list( aln_con, aln_ass, span_from, span_to ) ;- if( mktable ) printf( "%u\t", (unsigned)l.size() ) ;- else printf( " %u total differences between reference and assembly.\n", (unsigned)l.size() ) ;-- int num_strong = 0 ;- for( dp_list::const_iterator i = l.begin() ; i != l.end() ; ++i )- if( i->second.strength > weak ) ++num_strong ;- if( mktable ) printf( "%d\t", (int)l.size() ) ;- else {- printf( " %d diagnostic positions", (int)l.size() ) ;- if( span_from != 0 || span_to != INT_MAX )- printf( " in range [%d,%d)", span_from, span_to ) ;- printf( ", %d of which are strongly diagnostic.\n", num_strong ) ;- }-- if( verbose >= 3 ) {- print_dp_list( stderr, l.begin(), l.end(), '\n', 0 ) ;- print_dp_list( stderr, l.begin(), l.end(), '\n', 1 ) ;- }---}-- {-- if( verbose >= 2 ) fputs( "Pass one: finding actually diagnostic positions.\n", stderr ) ;- for( const AlnSeqP *s = maln->AlnSeqArray ; s != maln->AlnSeqArray + maln->num_aln_seqs ; ++s )- {- fixup_name( *s ) ;-- std::string the_ass( maln->ref->seq + (*s)->start, (*s)->end - (*s)->start + 1 ) ;- // are we overlapping anything at all?- std::pair< dp_list::const_iterator, dp_list::const_iterator > p =- overlapped_diagnostic_positions( l, *s ) ;-- if( verbose >= 3 )- {- fprintf( stderr, "%s/%c:\n %d potentially diagnostic positions",- (*s)->id, (*s)->segment, (int)std::distance( p.first, p.second ) ) ;- if( verbose >= 4 )- {- putc( ':', stderr ) ; putc( ' ', stderr ) ;- print_dp_list( stderr, p.first, p.second, 0 ) ;- }- fprintf( stderr, "; range: %d..%d\n", (*s)->start, (*s)->end ) ;- }--}--- {-- int t = 0 ;- for( dp_list::const_iterator i = l.begin() ; i != l.end() ; ++i )- if( is_transversion( i->second.consensus, i->second.assembly ) ) ++t ;- if( mktable ) printf( "%d\t%d\t", t, num_strong ) ;- else {- printf( " %d effectively diagnostic positions", (int)l.size() ) ;- if( span_from != 0 || span_to != INT_MAX )- printf( " in range [%d,%d)", span_from, span_to ) ;- printf( ", %d of which are transversions.\n\n", t ) ;- }- if( verbose >= 3 ) print_dp_list( stderr, l.begin(), l.end(), '\n' ) ;-- std::deque< cached_pwaln >::const_iterator cpwaln = cached_pwalns.begin() ;- for( const AlnSeqP *s = maln->AlnSeqArray ; s != maln->AlnSeqArray + maln->num_aln_seqs ; ++s, ++cpwaln )- {- whatsit klass = unknown ;- int votes = 0, votes2 = 0 ;-- std::string the_ass( maln->ref->seq + (*s)->start, (*s)->end - (*s)->start + 1 ) ;- // enough overlap? (we only have _actually_ diagnostic positions now)- std::pair< dp_list::const_iterator, dp_list::const_iterator > p =- overlapped_diagnostic_positions( l, *s ) ;- if( std::distance( p.first, p.second ) < min_diag_posns )- {- if( verbose >= 3 ) {- fputs( (*s)->id, stderr ) ;- putc( '/', stderr ) ;- putc( (*s)->segment, stderr ) ;- fputs( ": no diagnostic positions\n", stderr ) ;- }- }- else- {- if( verbose >= 3 )- {- fprintf( stderr, "%s/%c: %d diagnostic positions", (*s)->id, (*s)->segment, (int)std::distance( p.first, p.second ) ) ;- if( verbose >= 4 )- {- putc( ':', stderr ) ; putc( ' ', stderr ) ;- print_dp_list( stderr, p.first, p.second, 0 ) ;- }- fprintf( stderr, "; range: %d..%d\n", (*s)->start, (*s)->end ) ;- }-- // Hmm, all this iterator business is somewhat lacking...- char *paln1 = aln_con, *paln2 = aln_ass ;- int ass_pos = 0 ;- while( ass_pos != (*s)->start && *paln1 && *paln2 )- {- if( *paln2 != '-' ) ass_pos++ ;- ++paln1 ;- ++paln2 ;- }-- char *in_ass = maln->ref->seq + (*s)->start ;- char *in_frag_v_ass = (*s)->seq ;- std::string::const_iterator in_frag_v_ref = cpwaln->frag_seq.begin() ;-- std::string lifted = lift_over( aln_con, aln_ass, (*s)->start, (*s)->end + 1 ) ;- std::string in_ref = lifted.substr( 0, cpwaln->start ) ;- in_ref.append( cpwaln->ref_seq ) ;-- while( ass_pos != (*s)->end +1 && *paln1 && *paln2 && !in_ref.empty() && *in_ass && *in_frag_v_ass && *in_frag_v_ref )- {- if( *paln1 != '-' ) {- do {- in_ref=in_ref.substr(1) ;- in_frag_v_ref++ ;- } while( in_ref[0] == '-' ) ;- }- if( *paln2 != '-' ) {- ass_pos++ ;- do {- in_ass++ ;- in_frag_v_ass++ ;- } while( *in_ass == '-' ) ;- }- ++paln1 ;- ++paln2 ;- }- if( verbose >= 4 ) putc( '\n', stderr ) ;- }- }- }-}- -}-
− tools/redeye-dar.hs
@@ -1,250 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- Co-estimates aDNA damage with parameters for a simple genotype prior.------ We want to estimate on only a subset of the genome. For the time--- being, this is by definition a subset of the large blocks of the--- mappability track for the human genome (so this doesn't work for--- other genomes). To make this less crude, we need a differently--- prepared input, but right now, input is one BAM file with read group--- annotations.------ We run the EM algorithm, repeatedly estimating one damage/error model--- per read group and the global genotype parameters. Convergence is--- achieved when the changes in the damage models are sufficiently--- small. The damage/error model is one substitution matrix for each--- position within a read near the ends, and one for what remains in the--- middle.--import Bio.Adna-import Bio.Bam-import Bio.Bam.Pileup-import Bio.Genocall-import Bio.Genocall.Estimators-import Bio.Prelude-import Bio.Util.AD-import Data.Aeson.Encode.Pretty-import System.Console.GetOpt--import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.HashMap.Strict as H-import qualified Data.Sequence as Z-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as M--data Conf = Conf {- conf_output :: LazyBytes -> IO (),- conf_report :: LazyBytes -> IO (),- conf_params :: Parameters,- conf_length :: Int,- conf_eps :: Double }--defaultConf :: Conf-defaultConf = Conf (L.hPutStrLn stdout) (\_ -> return ()) quietParameters 16 1.0E-6--options :: [OptDescr (Conf -> IO Conf)]-options = [- Option "o" ["output"] (ReqArg set_output "FILE") "Write output to FILE (stdout)",- Option "l" ["model-length"] (ReqArg set_len "NUM") "Set size of subst. model to NUM (16)",- Option "e" ["precision"] (ReqArg set_prec "NUM") "Set precision for fit to NUM (1E-6)",- Option "v" ["verbose"] (NoArg set_verbose) "Print progress reports",- Option "h?" ["help","usage"] (NoArg disp_usage) "Print this message and exit" ]- where- set_verbose c = return $ c { conf_report = L.hPutStrLn stderr, conf_params = debugParameters }- set_output f c = return $ c { conf_output = L.writeFile f }- set_len a c = readIO a >>= \x -> return $ c { conf_length = x }- set_prec a c = readIO a >>= \x -> return $ c { conf_eps = x }-- disp_usage _ = do pn <- getProgName- let blah = "Usage: " ++ pn ++ " [OPTION...] [LIBRARY-NAME...]"- putStrLn $ usageInfo blah options- exitSuccess--main :: IO ()-main = do- (opts, files, errors) <- getOpt Permute options <$> getArgs- unless (null errors) $ mapM_ (hPutStrLn stderr) errors >> exitFailure- Conf{..} <- foldl (>>=) (return defaultConf) opts-- -- For each iteration: read the input, decompose, pileup. The- -- "prior" damage model is the usual 'SubstModel', the "posterior"- -- damage model needs to be a mutable 'MSubstModel'. We feed- -- likelihoods into the div/het estimation (just as in- -- 'redeye-pileup'), but also into a caller that will estimate- -- damage.- let iter sp0 mod0 = do (((de1,de2),mod1),syms) <- emIter conf_length sp0 mod0 files- conf_report $ encodePretty de2- if diffSubstMod mod0 mod1 > conf_eps- then iter (case point_est de1 of [a,b] -> SinglePop a b) mod1- else return . ExtModel de1 (Just de2) . SubstModels- $ H.map ((mod1 V.!) . fromDmgToken) syms-- final_model <- iter (SinglePop 0.001 0.002) V.empty- conf_output $ encodePretty (final_model :: ExtModel)--diffSubstMod :: V.Vector SubstModel -> V.Vector SubstModel -> Double-diffSubstMod v1 v2 =- V.foldl' max 0 (V.zipWith diff1 v1 v2) `max`- V.foldl' max 0 (V.map abs1 (V.drop (V.length v2) v1)) `max`- V.foldl' max 0 (V.map abs1 (V.drop (V.length v1) v2))- where- diff1 :: SubstModel -> SubstModel -> Double- diff1 sm1 sm2 = maximum $- [ V.maximum $ V.zipWith diff2 (left_substs_fwd sm1) (left_substs_fwd sm2)- , diff2 (middle_substs_fwd sm1) (middle_substs_fwd sm2)- , V.maximum $ V.zipWith diff2 (right_substs_fwd sm1) (right_substs_fwd sm2) ]-- diff2 :: Mat44D -> Mat44D -> Double- diff2 (Mat44D u) (Mat44D v) = U.maximum $ U.map abs $ U.zipWith (-) u v-- abs1 :: SubstModel -> Double- abs1 sm1 = V.maximum (V.map abs2 (left_substs_fwd sm1)) `max`- abs2 (middle_substs_fwd sm1) `max`- V.maximum (V.map abs2 (right_substs_fwd sm1))-- abs2 :: Mat44D -> Double- abs2 (Mat44D v) = U.maximum v----- One iteration of EM algorithm. We go in with a substitution model--- and het/div, we come out with new estimates for same. We get het/div from--- tabulation followed by numerical optimization. For damage, we have to--- compute posterior probabilities using the old model, then update the--- damage matrices with pseudo counts. (This amounts to a maximum--- likelihood estimate for a weighted multinomial distribution.)-emIter :: Int -> SinglePop -> V.Vector SubstModel -> [FilePath] -> IO (((DivEst,DivEst), V.Vector SubstModel), HashMap Bytes DmgToken)-emIter msize divest mod0 infiles =- liftIO (newIORef V.empty) >>= \mmod ->- liftIO (newIORef H.empty) >>= \symtab ->- concatInputs infiles >=> run $ \hdr ->- concatMapStreamM (decompose_dmg_from symtab) =$- pileup =$- filterPilesWith (the_regions hdr) =$- mapStream ( id &&& calls mod0 ) =$-- let div_estimation :: MonadIO m => Iteratee [(a, Calls)] m (DivEst,DivEst)- div_estimation = mapStream snd =$- tabulateSingle >>=- liftIO . estimateSingle-- dmg_estimation :: MonadIO m => Iteratee [(Pile, Calls)] m (V.Vector SubstModel)- dmg_estimation = mapStreamM_ (\(p,c) ->- liftIO . updateSubstModel msize mod0 mmod p $- single_pop_posterior divest- (refix $ snp_refbase $ p_snp_pile c)- (snp_gls $ p_snp_pile c)) >>- liftIO (readIORef mmod) >>=- liftIO . V.mapM freezeSubstModel-- in (,) <$> zipStreams div_estimation dmg_estimation- <*> liftIO (readIORef symtab)- where- the_regions hdr = sort [ Region (Refseq $ fromIntegral ri) p (p+l)- | (ch, p, l) <- good_regions- , let Just ri = Z.findIndexL ((==) ch . sq_name) (meta_refs hdr) ]-- refix ref = U.fromListN 16 [0,0,2,0,5,0,0,0,9,0,0,0,0,0,0,0] U.! fromIntegral (unNs ref)---filterPilesWith :: Monad m => [Region] -> Enumeratee [Pile] [Pile] m b-filterPilesWith = unfoldConvStream go- where- go [ ] = skipToEof >> return ([],[])- go (r:rs) = do mp <- peekStream- case mp of- Just p | (p_refseq p, p_pos p) < (refseq r, start r) -> headStream >> go (r:rs)- | (p_refseq p, p_pos p) >= (refseq r, end r) -> go rs- | otherwise -> (\x -> (r:rs, [x])) `liftM` headStream- Nothing -> return ([],[])----- Probabilistically count substitutions. We infer from posterior--- genotype probabilities what the base must have been, then count--- substitutions from that to the actual base.--updateSubstModel :: Int -> V.Vector SubstModel -> IORef (V.Vector MSubstModel) -> Pile -> U.Vector Prob -> IO ()-updateSubstModel msize mods0 vmods1 pile postp = case p_snp_pile pile of- (basesF, basesR) -> do mapM_ (count_base False) basesF- mapM_ (count_base True) basesR- where- -- Posterior probalities of the haploid base before damage- -- @P(H) = \sum_{G} P(H|G) P(G|D)@- pH_A = fromProb $ postp U.! 0 + 0.5 * ( postp U.! 1 + postp U.! 3 + postp U.! 6 )- pH_C = fromProb $ postp U.! 2 + 0.5 * ( postp U.! 1 + postp U.! 4 + postp U.! 7 )- pH_G = fromProb $ postp U.! 5 + 0.5 * ( postp U.! 3 + postp U.! 4 + postp U.! 8 )- pH_T = fromProb $ postp U.! 9 + 0.5 * ( postp U.! 6 + postp U.! 7 + postp U.! 8 )-- -- P(H:->X) = P(H|X)- -- = P(X|H) P(H) / P(X)- -- = P(X|H) P(H) / \sum_H' P(X|H') P(H')- --- -- We get P(X|H) from the old substitution model.-- count_base str (q,b) = do- let old_mat = case mods0 V.!? fromDmgToken (db_dmg_tk b) of- Nothing -> initmat- Just sm -> lookupSubstModel sm (db_dmg_pos b) str-- new_mat <- do mods1 <- readIORef vmods1- sm <- case mods1 V.!? fromDmgToken (db_dmg_tk b) of- Nothing -> do m <- new_mmodel- writeIORef vmods1 (V.snoc mods1 m)- return m- Just m -> return m- return $ lookupSubstModel sm (db_dmg_pos b) str-- -- Use map quality to de-emphasize badly mapped reads. If- -- everything is badly mapped, the estimation still works; if- -- some data is well mapped, that naturally dominates the- -- estimate.- let pHX = (1 - fromQual q) / (pHX_A + pHX_C + pHX_G + pHX_T)- pHX_A = (old_mat `bang` nucA :-> db_call b) * pH_A- pHX_C = (old_mat `bang` nucC :-> db_call b) * pH_C- pHX_G = (old_mat `bang` nucG :-> db_call b) * pH_G- pHX_T = (old_mat `bang` nucT :-> db_call b) * pH_T-- nudge new_mat (nucA :-> db_call b) (pHX_A * pHX)- nudge new_mat (nucC :-> db_call b) (pHX_C * pHX)- nudge new_mat (nucG :-> db_call b) (pHX_G * pHX)- nudge new_mat (nucT :-> db_call b) (pHX_T * pHX)--- new_mmodel = SubstModel <$> V.replicateM msize nullmat- <*> nullmat- <*> V.replicateM msize nullmat- <*> V.replicateM msize nullmat- <*> nullmat- <*> V.replicateM msize nullmat-- nullmat = MMat44D <$> M.replicate 16 (0::Double)--calls :: V.Vector SubstModel -> Pile -> Calls-calls dmg pile = pile { p_snp_pile = s, p_indel_pile = i }- where- !s = simple_snp_call get_dmg $ p_snp_pile pile- !i = simple_indel_call get_dmg $ p_indel_pile pile-- get_dmg :: DmgToken -> Int -> Bool -> Mat44D- get_dmg (DmgToken dt) di ds = case dmg V.!? dt of- Nothing -> initmat -- not found, happens in first round- Just sm -> lookupSubstModel sm di ds--initmat :: Mat44D-initmat = Mat44D $ U.fromListN 16 [ 0.91, 0.03, 0.03, 0.03- , 0.03, 0.91, 0.03, 0.03- , 0.03, 0.03, 0.91, 0.03- , 0.03, 0.03, 0.03, 0.91 ]--{-# INLINE decompose_dmg_from #-}-decompose_dmg_from :: IORef (HashMap Bytes DmgToken) -> BamRaw -> IO [PosPrimChunks]-decompose_dmg_from ref raw = do- hm <- readIORef ref- let rg = extAsString "RG" (unpackBam raw)- token <- case H.lookup rg hm of- Just tk -> return tk- Nothing -> do let tk = DmgToken $ H.size hm- writeIORef ref $! H.insert rg tk hm- return tk- return $ decompose token raw--
− tools/redeye-flow.hs
@@ -1,192 +0,0 @@--- Genotype call a bunch of samples. Dependency-driven, in parallel.------ - Small amounts of output land in files. Annoying, but easy.--- - We optionally run -dar and -single on the SGE. Other parts run locally.--import Bio.Bam-import Bio.Genocall.Estimators ( estimateSingle, good_regions )-import Bio.Prelude-import Data.Aeson-import Data.Aeson.Encode.Pretty-import Data.Aeson.Types-import Data.Binary ( decodeOrFail )-import Development.Shake-import Development.Shake.FilePath-import System.Directory-import System.Console.GetOpt-import System.IO--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import qualified Data.HashMap.Strict as H-import qualified Data.Sequence as Z-import qualified Data.Vector.Generic as V--data Sample = Sample {- sample_name :: Text,- sample_libraries :: [ Text ]- } deriving Show--parseSamples :: Value -> Parser [Sample]-parseSamples = withObject "samples" $ \o ->- sequence [ Sample k <$> parseStrings v | (k,v) <- H.toList o ]- where- parseStrings v = withText "file name" (return . (:[])) v- <|> withArray "file names"- (mapM (withText "file name" return) . V.toList) v---data Flags = GridEngine | Samples FilePath deriving Eq--flagOptions :: [ OptDescr (Either String Flags) ]-flagOptions = [ Option "G" ["grid-engine"] (NoArg $ Right GridEngine) "Run on grid engine (uses qrsh)."- , Option "S" ["samples"] (ReqArg (Right . Samples) "FILE") "Read samples from FILE" ]---main :: IO ()-main = shakeArgsWith shakeOptions flagOptions $ \flags targets -> return $ Just $ do- samples <- liftIO $ concat <$> sequence- [ do str <- B.readFile fp- case eitherDecodeStrict' str of- Left err -> error err- Right val -> case parseEither parseSamples val of- Left err -> error err- Right smps -> return smps- | Samples fp <- flags ]-- if null targets then do- -- final artefacts: one BCF per chromosome,- let chromosomes = map show [1..22::Int] ++ [ "X", "Y" ]- want [ "build/" ++ unpack (sample_name smp) ++ "." ++ chrom ++ ".bcf"- | chrom <- chromosomes, smp <- samples ]-- -- and div/het estimates- want [ "build/" ++ unpack (sample_name smp) ++ "." ++ part ++ ".divest"- | part <- ["auto","X","Y"], smp <- samples ]- else- want targets-- callz samples flags- divests- dmgests flags- rgn_files samples---divests :: Rules ()-divests = do- "build/*.auto.divest" %> \out -> do- let stem = dropExtension $ dropExtension out- raw <- lReadFiles' [ stem ++ "." ++ show c ++ ".divtab" | c <- [1..22::Int] ]- putLoud $ "estimate for " ++ out- either fail_decode (\tabs -> liftIO $ do- (de1,de2) <- estimateSingle $ mconcat [ t | (_,_,t) <- tabs ]- L.writeFile out $ encodePretty [ de1, de2 ])- $ mapM decodeOrFail raw-- "build/*.X.divest" %> \out -> do- raw <- lReadFile' (out -<.> "divtab")- putLoud $ "estimate for " ++ out- either fail_decode (\(_,_,tab) -> liftIO $ do- (de1,de2) <- estimateSingle tab- L.writeFile out $ encodePretty [ de1, de2 ])- $ decodeOrFail raw-- "build/*.Y.divest" %> \out -> do- raw <- lReadFile' (out -<.> "divtab")- putLoud $ "estimate for " ++ out- either fail_decode (\(_,_,tab) -> liftIO $ do- (de1,de2) <- estimateSingle tab- L.writeFile out $ encodePretty [ de1, de2 ])- $ decodeOrFail raw- where- fail_decode (rest,off,msg) = error $- msg ++ " at " ++ shows off " near " ++ show (L.take 16 rest)-- lReadFile' x = need [x] >> liftIO (L.readFile x)- lReadFiles' xs = need xs >> liftIO (mapM L.readFile xs)----- one pileup per chrmosome * sample; input is the--- bam files and one dmgest per sample-callz :: [Sample] -> [Flags] -> Rules ()-callz samples flags = [ "build/*.*.bcf", "build/*.*.divtab" ] &%> \[bcf,tab] -> do- let (sm,'.':c) = splitExtension $ dropExtension $ takeFileName bcf- dmg = "build" </> sm <.> "dmgest"- bams = [ unpack libf | s <- samples, sm == unpack (sample_name s)- , libf <- sample_libraries s ]- need $ dmg : bams-- if GridEngine `elem` flags- then- unsafeExtraThread $- command [] "qrsh" $- "-now" : "no" : "-cwd" : "-N" : (sm ++ "-" ++ c) :- "-l" : "h_vmem=3.4G,s_vmem=3.4G,virtual_free=3.4G,s_stack=2M" :- "redeye-single" : "-o" : bcf : "-c" : c : "-T" : tab : "-D" : dmg- : "-N" : sm : "-v" : bams- else- command [] "redeye-single" $- "-o" : bcf : "-c" : c : "-T" : tab : "-D" : dmg- : "-N" : sm : "-v" : bams---dmgests :: [Flags] -> Rules ()-dmgests flags = "build/*.dmgest" %> \out -> do- let sm = dropExtension $ takeFileName out- rgn_file = "build" </> sm <.> "good_regions.bam"- need [ rgn_file ]-- if GridEngine `elem` flags- then- unsafeExtraThread $- command [] "qrsh" $- "-now" : "no" : "-cwd" : "-N" : (sm ++ "-dar") :- "-l" : "h_vmem=3.4G,s_vmem=3.4G,virtual_free=3.4G,s_stack=2M" :- "redeye-dar" : "-o" : out : rgn_file : []- else- command [] "redeye-dar" $ "-o" : out : rgn_file : []--rgn_files :: [Sample] -> Rules ()-rgn_files samples = do- mem <- newResource "heavy IO" 1- "build/*.good_regions.bam" %> \out -> do- let sm = dropExtension $ dropExtension $ takeFileName out- lfs = [ unpack f | s <- samples, unpack (sample_name s) == sm- , f <- sample_libraries s ]- need lfs- withResource mem 1 $ do- putLoud $ "subsetting " ++ show lfs- liftIO $ subsetbams out lfs (takeLen 5000000 good_regions) 35- where- takeLen !n (x@(_,_,l):xs) | n > 0 = x : takeLen (n-l) xs- takeLen _ _ = []----- | Reads regions from many bam files, writes one.--- XXX It might make sense to serialize not BAM, but the result of--- piling up.-subsetbams :: FilePath -> [FilePath] -> [( Bytes, Int, Int )] -> Int -> IO ()-subsetbams ofp (ifp:ifps) rgns0 minlen = do- withFile (ofp ++ "~") WriteMode $ \hdl ->- go ifp ifps >=> run $ \hdr ->- filterStream ((>= minlen) . V.length . b_seq . unpackBam) =$- writeBamHandle hdl hdr- renameFile (ofp ++ "~") ofp- where- enum1 :: (MonadIO m, MonadMask m) => FilePath -> Enumerator' BamMeta [BamRaw] m a- enum1 fp k = do idx <- liftIO $ readBamIndex fp- enumFileRandom defaultBufSize fp >=> run >=> run $- decodeAnyBam $ \hdr ->- let rgns = sort [ Region (Refseq $ fromIntegral ri) p (p+l)- | (ch, p, l) <- rgns0- , let Just ri = Z.findIndexL ((==) ch . sq_name) (meta_refs hdr) ]- in eneeBamRegions idx rgns (k hdr)-- go :: (MonadIO m, MonadMask m) => FilePath -> [FilePath] -> Enumerator' BamMeta [BamRaw] m b- go fp [ ] = enum1 fp- go fp (fp1:fps) = mergeEnums' (go fp1 fps) (enum1 fp) combineCoordinates--subsetbams ofp [] rgns0 minlen =- error $ "Wait, what? " ++ show (ofp, rgns0, minlen)--
− tools/redeye-single.hs
@@ -1,334 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}--- Command line driver for simple genotype calling. We have two--- separate steps: We estimate parameters on a subset of the input,--- then we pile up. Output from pileup is a BCF file containing--- likelihoods, posterior probabilities, and genotype calls.--- Alternatively we could write a Heffalump, which has only genotype--- calls. We also write a table on the side, which can be used to--- estimate divergence and heterozygosity per chromosome or genome wide.------ The likelihoods depend on damage parameters and an error model,--- otherwise they are 'eternal'. (For the time being, it's probably--- wise to go with the naïve error model.) Technically, they also--- depend on ploidy, but since only diploid organisms are interesting--- right now, we fix that to two. We pay some overhead on the sex--- chromosomes, but the simplification is worth it.------ About damage parameters: Everything converged on an empirical model--- where damage and sequencing error are both modelled as one position--- specific substitution matrix. The damage model is specific to a read--- group, so read group annotations must be present.------ Calling is always diploid, for maximum flexibility. We don't really--- support higher ploidies, so the worst damage is that we output an--- overhead of 150% useless likelihood values for the sex chromosomes--- and maybe estimate heterozygosity where there is none.------ (This can be extended easily into a caller for a homogenous--- population where individuals are assumed to be randomly related (i.e.--- not family). In this case, the prior is the allele frequency--- spectrum, the call would be the set(!) of genotypes that has maximum--- posterior probability. Computation is possible in quadratic time and--- linear space using a DP scheme; see Heng Li's paper for details.)--import Bio.Adna-import Bio.Bam-import Bio.Bam.Pileup-import Bio.Genocall-import Bio.Genocall.Estimators-import Bio.Iteratee.Builder-import Bio.Prelude-import Data.Aeson-import GHC.Float ( double2Float )-import System.Console.GetOpt-import System.FilePath-import System.Random--import qualified Data.Binary as Bin-import qualified Data.ByteString.Char8 as S-import qualified Data.ByteString.Lazy as BL-import qualified Data.HashMap.Strict as H-import qualified Data.Sequence as Z-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U--type Reporter = String -> IO ()--data Conf = Conf {- conf_output :: FilePath,- conf_dmg :: ExtModel,- conf_chrom :: String,- conf_report :: Reporter,- conf_table :: Maybe FilePath,- conf_random :: Maybe StdGen,- sample_name :: Conf -> String }----- | We map read groups to damage models. The set of damage models is--- supplied in a JSON file.-defaultConf :: Conf-defaultConf = Conf { conf_output = error "no output file"- , conf_dmg = ExtModel (DivEst [0.001,0.0005] []) Nothing (SubstModels mempty)- , conf_chrom = ""- , conf_report = \_ -> return ()- , conf_table = Nothing- , conf_random = Nothing- , sample_name = takeWhile (/='.') . takeFileName . conf_output }---options :: [OptDescr (Conf -> IO Conf)]-options = [- Option "o" ["output"] (ReqArg set_output "FILE") "Set output filename to FILE",- Option "c" ["chromosome","region"] (ReqArg set_chrom "NAME") "Restrict to chromosome NAME",- Option "D" ["damage"] (ReqArg set_dmg "FILE") "Read damage model from FILE",- Option "T" ["table"] (ReqArg want_table "FILE") "Print table for divergence estimation to FILE",- Option "s" ["sample-genotypes"] (OptArg set_rnd "SEED") "Sample genotypes from posterior",- Option "N" ["name"] (ReqArg set_name "NAME") "Set sample name to NAME",- Option "v" ["verbose"] (NoArg be_verbose) "Print more diagnostics",- Option "h?" ["help","usage"] (NoArg disp_usage) "Display this message" ]- where- disp_usage _ = do pn <- getProgName- let blah = "Usage: " ++ pn ++ " [[OPTION...] [BAM-FILE...] ...]"- putStrLn $ usageInfo blah options- exitSuccess-- be_verbose c = return $ c { conf_report = hPutStrLn stderr }- want_table fp c = return $ c { conf_table = Just fp }-- set_dmg a c = BL.readFile a >>= \s -> case eitherDecode' s of- Left err -> error err- Right ds -> return $ c { conf_dmg = ds }-- set_chrom a c = return $ c { conf_chrom = a }- set_output fn c = return $ c { conf_output = fn }- set_name nm c = return $ c { sample_name = const nm }-- set_rnd Nothing c = newStdGen >>= \g -> return $ c { conf_random = Just g }- set_rnd (Just a) c = readIO a >>= \s -> return $ c { conf_random = Just (mkStdGen s) }---main :: IO ()-main = do- (opts, files, errs) <- getOpt Permute options <$> getArgs- conf@Conf{..} <- foldl (>>=) (return defaultConf) opts- unless (null errs) $ mapM_ (hPutStrLn stderr) errs >> exitFailure-- let symtab = H.fromList $ zip [ k | (k,_) <- case damage conf_dmg of SubstModels ms -> H.toList ms ] (map DmgToken [0..])- smodel = V.fromList [ v | (_,v) <- case damage conf_dmg of SubstModels ms -> H.toList ms ]-- let prior_div:prior_het:_ = point_est $ population conf_dmg- callz = ( call $ SinglePop prior_div prior_het- , call $ SinglePop (0.1 * prior_div) (0.1 * prior_het) )-- (tab,()) <- withOutputFd conf_output $ \ofd ->- mergeInputRgns combineCoordinates conf_chrom files >=> run $ \hdr ->- takeWhileE (isValidRefseq . b_rname . unpackBam) =$- concatMapStream (decompose_dmg_from symtab) =$- progressPos (\(a,b,_,_)->(a,b)) "GT call at" (meta_refs hdr) 0x4000 conf_report =$- pileup =$- mapStream (simple_calls smodel) =$- zipStreams tabulateSingle- (toBcf (meta_refs hdr) [fromString $ sample_name conf] callz conf_random =$- mapChunksM_ (liftIO . fdPut ofd))-- forM_ conf_table $ flip BL.writeFile $ Bin.encode tab-- (de1,de2) <- estimateSingle tab- putStrLn $ unlines $- showRes (point_est de1) :- [ "[ " ++ showRes u ++ " .. " ++ showRes v ++ " ]" | (u,v) <- conf_region de1 ] ++- [] : showRes (point_est de2) :- [ "[ " ++ showRes u ++ " .. " ++ showRes v ++ " ]" | (u,v) <- conf_region de2 ]- where- showRes [dv,h] = "D = " ++ showFFloat (Just 6) dv ", " ++- "H = " ++ showFFloat (Just 6) h ""- showRes [dv,hs,hw] = "D = " ++ showFFloat (Just 6) dv ", " ++- "Hs = " ++ showFFloat (Just 6) hs ", " ++- "Hw = " ++ showFFloat (Just 6) hw ""- showRes _ = error "Wtf? (showRes)"---withOutputFd :: FilePath -> (Fd -> IO a) -> IO a-withOutputFd "-" k = k stdOutput-withOutputFd f k = do- r <- withFd (f++".#") WriteOnly (Just 0o666) defaultFileFlags k- rename (f++".#") f- return r--simple_calls :: V.Vector SubstModel -> Pile -> Calls-simple_calls dmods pile = pile { p_snp_pile = s, p_indel_pile = i }- where- !s = simple_snp_call get_dmg $ p_snp_pile pile- !i = simple_indel_call get_dmg $ p_indel_pile pile-- get_dmg :: DmgToken -> Int -> Bool -> Mat44D- get_dmg (DmgToken dt) = case dmods V.!? dt of- Nothing -> error "shouldn't happen"- Just sm -> lookupSubstModel sm--{-# INLINE decompose_dmg_from #-}-decompose_dmg_from :: HashMap Bytes DmgToken -> BamRaw -> [PosPrimChunks]-decompose_dmg_from hm raw =- let rg = extAsString "RG" (unpackBam raw)- in case H.lookup rg hm of- Just tk -> decompose tk raw- Nothing -> error $ "no substitution model for " ++ unpack rg---mergeInputRgns :: (MonadIO m, MonadMask m)- => (BamMeta -> Enumeratee [BamRaw] [BamRaw] (Iteratee [BamRaw] m) a)- -> String -> [FilePath] -> Enumerator' BamMeta [BamRaw] m a-mergeInputRgns _ _ [ ] = \k -> return (k mempty)-mergeInputRgns (?) "" fps = mergeInputs (?) fps-mergeInputRgns (?) rs (fp0:fps0) = go fp0 fps0- where- enum1 fp k1 = do idx <- liftIO $ readBamIndex fp- enumFileRandom defaultBufSize fp >=> run >=> run $- decodeAnyBam $ \hdr ->- let Just ri = Z.findIndexL ((==) rs . unpack . sq_name) (meta_refs hdr)- in eneeBamRefseq idx (Refseq $ fromIntegral ri) $ k1 hdr-- go fp [ ] = enum1 fp- go fp (fp1:fps) = mergeEnums' (go fp1 fps) (enum1 fp) (?)----- | Ploidy is hardcoded as two here. Can be changed if the need--- arises.--call :: SinglePop -> U.Vector Prob -> Maybe StdGen -> (Int,Maybe StdGen)-call priors lks gen = case gen of- Nothing -> ( U.maxIndex ps, Nothing )- Just g -> ( ix, Just g' )- where- (p,g') = randomR (0, 1) g- ix = U.length $ U.takeWhile (<p) $ U.map fromProb $- U.init $ U.postscanl (+) 0 $ U.map (/ U.sum ps) ps- where- ps = single_pop_posterior priors 0 lks------ A function from likelihoods to called index. It's allowed to require--- a random number generator.-type CallFunc gen = U.Vector Prob -> gen -> (Int, gen)-type CallFuncs gen = (CallFunc gen, CallFunc gen)--vcf_header :: Refs -> [S.ByteString] -> Push-vcf_header refs smps = foldr (\a b -> pushByteString a <> pushByte 10 <> b) mempty $- [ "##fileformat=VCFv4.2"- , "##INFO=<ID=MQ,Number=1,Type=Integer,Description=\"RMS mapping quality\">"- , "##INFO=<ID=MQ0,Number=1,Type=Integer,Description=\"Number of MAPQ==0 reads covering this record\">"- , "##FORMAT=<ID=GT,Number=1,Type=String,Description=\"Genotype\">"- , "##FORMAT=<ID=DP,Number=1,Type=Integer,Description=\"read depth\">"- , "##FORMAT=<ID=PL,Number=G,Type=Integer,Description=\"genotype likelihoods in deciban\">"- , "##FORMAT=<ID=GQ,Number=1,Type=Integer,Description=\"conditional genotype quality in deciban\">" ] ++- [ S.concat [ "##contig=<ID=", sq_name s, ",length=", S.pack (show (sq_length s)), ">" ] | s <- toList refs ] ++- [ S.intercalate "\t" $ "#CHROM\tPOS\tID\tREF\tALT\tQUAL\tFILTER\tINFO\tFORMAT" : smps ]---toBcf :: MonadIO m => Refs -> [S.ByteString] -> CallFuncs gen -> gen -> Enumeratee [Calls] Bytes m r-toBcf refs smps (snp_call, indel_call) gen0 = eneeCheckIfDone go ><> encodeBgzfWith 6- where- go k = eneeCheckIfDone (go2 gen0) . k $ Chunk hdr- go2 g k = tryHead >>= \zz -> case zz of- Nothing -> return $ liftI k- Just cs -> let (p,g1) = encode1 cs g- in eneeCheckIfDone (go2 g1) . k $ Chunk p-- hdr = pushByteString "BCF\2\2" <> setMark <>- vcf_header refs smps <> pushByte 0 <> endRecord-- encode1 cs g0 = (p1 <> p2, g2)- where- (p1,g1) = encodeSNP cs snp_call g0- (p2,g2) = case snd $ p_indel_pile cs of- [ ] -> (mempty,g1)- [_] -> (mempty,g1)- v:_ | U.null d && U.null i -> encodeIndel cs indel_call g1- | otherwise -> error "First indel variant should always be the reference."- where- IndelVariant (V_Nucs d) (V_Nuc i) = v---encodeSNP :: Calls -> CallFunc gen -> gen -> (Push, gen)-encodeSNP cs = encodeVar (map S.singleton alleles) (gls `U.backpermute` U.fromList perm)- (p_snp_stat cs) (p_refseq cs) (p_pos cs)- where- Snp_GLs gls ref_allele = p_snp_pile cs-- -- Permuting the reference allele to the front in alleles and PLs- -- sucks. Since there are only four possibilities, I'm not going to- -- bother with an algorithm and just open-code it.- (alleles, perm) | ref_allele == nucsT = ("TACG", [9,6,0,7,1,2,8,3,4,5])- | ref_allele == nucsG = ("GACT", [5,3,0,4,1,2,8,6,7,9])- | ref_allele == nucsC = ("CAGT", [2,1,0,4,3,5,7,6,8,9])- | otherwise = ("ACGT", [0,1,2,3,4,5,6,7,8,9])--encodeIndel :: Calls -> CallFunc gen -> gen -> (Push, gen)-encodeIndel cs = encodeVar alleles (fst $ p_indel_pile cs)- (p_indel_stat cs) (p_refseq cs) (p_pos cs)- where- Snp_GLs _ ref_allele = p_snp_pile cs-- -- We're looking at the indel /after/ the current position. That's- -- sweet, because we can just prepend the current reference base and- -- make bcftools and friends happy. Longest reported deletion- -- becomes the reference allele. Others may need padding.- rallele = snd $ maximum [ (U.length r, r) | IndelVariant (V_Nucs r) _ <- snd $ p_indel_pile cs ]- alleles = [ S.pack $ showNucleotides ref_allele : show (U.toList a) ++ show (U.toList $ U.drop (U.length r) rallele)- | IndelVariant (V_Nucs r) (V_Nuc a) <- snd $ p_indel_pile cs ]--encodeVar :: [S.ByteString] -> U.Vector Prob -> CallStats -> Refseq -> Int -> CallFunc gen -> gen -> (Push, gen)-encodeVar alleles lks CallStats{..} ref pos do_call gen =- ( setMark <> setMark <> -- remember space for two marks- b_share <> endRecordPart1 <> -- store 1st length and 2nd mark- b_indiv <> endRecordPart2 -- store 2nd length- , gen' )- where- b_share = pushWord32 (unRefseq ref) <>- pushWord32 (fromIntegral pos) <>- pushWord32 0 <> -- rlen?! WTF?!- pushFloat (double2Float gq) <> -- QUAL- pushWord16 2 <> -- ninfo- pushWord16 (fromIntegral $ length alleles) <> -- n_allele- pushWord32 0x04000001 <> -- n_fmt, n_sample- pushByte 0x07 <> -- variant name (empty)- foldMap typed_string alleles <> -- alleles- pushByte 0x01 <> -- FILTER (an empty vector)-- pushByte 0x11 <> pushByte 0x01 <> -- INFO key 0 (MQ)- pushByte 0x11 <> pushByte rms_mapq <> -- MQ, typed word8- pushByte 0x11 <> pushByte 0x02 <> -- INFO key 1 (MQ0)- pushByte 0x12 <> pushWord16 (fromIntegral reads_mapq0) -- MQ0-- b_indiv = pushByte 0x01 <> pushByte 0x03 <> -- FORMAT key 2 (GT)- pushByte 0x21 <> -- two uint8s for GT- pushByte (2 + 2 * fromIntegral g) <> -- actual GT- pushByte (2 + 2 * fromIntegral h) <>-- pushByte 0x01 <> pushByte 0x04 <> -- FORMAT key 3 (DP)- pushByte 0x12 <> -- one uint16 for DP- pushWord16 (fromIntegral read_depth) <> -- depth-- pushByte 0x01 <> pushByte 0x05 <> -- FORMAT key 4 (PL)- ( let l = U.length lks in if l < 15- then pushByte (fromIntegral l `shiftL` 4 .|. 2)- else pushWord16 0x02F2 <> pushWord16 (fromIntegral l) ) <>- pl_vals <> -- vector of uint16s for PLs-- pushByte 0x01 <> pushByte 0x06 <> -- FORMAT key 5 (GQ)- pushByte 0x11 <> pushByte gq' -- uint8, genotype-- rms_mapq = round $ sqrt (fromIntegral sum_mapq_squared / fromIntegral read_depth :: Double)- typed_string s | S.length s < 15 = pushByte (fromIntegral $ S.length s `shiftL` 4 .|. 0x7) <> pushByteString s- | otherwise = pushByte 0xF7 <> pushByte 0x03 <> pushWord32 (fromIntegral $ S.length s) <> pushByteString s-- pl_vals = U.foldr ((<>) . pushWord16 . round . max 0 . min 0x7fff . (*) (-10/log 10) . unPr . (/ lks U.! maxidx)) mempty lks- maxidx = U.maxIndex lks-- gq = -10 * unPr (U.sum (U.ifilter (\i _ -> i /= maxidx) lks) / U.sum lks) / log 10- gq' = round . max 0 . min 127 $ gq-- (callidx, gen') = do_call lks gen- h = length $ takeWhile (<= callidx) $ scanl (+) 1 [2..]- g = callidx - h * (h+1) `div` 2