diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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 diff --git a/biohazard.cabal b/biohazard.cabal --- a/biohazard.cabal +++ b/biohazard.cabal @@ -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: diff --git a/data/index_db.json b/data/index_db.json deleted file mode 100644 --- a/data/index_db.json +++ /dev/null @@ -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" - } -} diff --git a/man/man1/bam-fixpair.1 b/man/man1/bam-fixpair.1 deleted file mode 100644 --- a/man/man1/bam-fixpair.1 +++ /dev/null @@ -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 - -.SH "SEE ALSO" -.BR biohazard (7) - diff --git a/man/man1/bam-meld.1 b/man/man1/bam-meld.1 deleted file mode 100644 --- a/man/man1/bam-meld.1 +++ /dev/null @@ -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 - -.SH "SEE ALSO" -.BR biohazard (7) - diff --git a/man/man1/bam-rewrap.1 b/man/man1/bam-rewrap.1 deleted file mode 100644 --- a/man/man1/bam-rewrap.1 +++ /dev/null @@ -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 - -.SH "SEE ALSO" -.BR biohazard (7) - diff --git a/man/man1/bam-rmdup.1 b/man/man1/bam-rmdup.1 deleted file mode 100644 --- a/man/man1/bam-rmdup.1 +++ /dev/null @@ -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 - -.SH "SEE ALSO" -.BR biohazard (7) - diff --git a/man/man1/fastq2bam.1 b/man/man1/fastq2bam.1 deleted file mode 100644 --- a/man/man1/fastq2bam.1 +++ /dev/null @@ -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 - -.SH "SEE ALSO" -.BR biohazard (7) - diff --git a/man/man1/jivebunny.1 b/man/man1/jivebunny.1 deleted file mode 100644 --- a/man/man1/jivebunny.1 +++ /dev/null @@ -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 - -.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 diff --git a/man/man1/mt-anno.1 b/man/man1/mt-anno.1 deleted file mode 100644 --- a/man/man1/mt-anno.1 +++ /dev/null @@ -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 - -.SH "SEE ALSO" -.BR biohazard (7), fasta (5) - diff --git a/man/man7/biohazard.7 b/man/man7/biohazard.7 deleted file mode 100644 --- a/man/man7/biohazard.7 +++ /dev/null @@ -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 - -.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 - diff --git a/src/Bio/Bam/Rec.hs b/src/Bio/Bam/Rec.hs --- a/src/Bio/Bam/Rec.hs +++ b/src/Bio/Bam/Rec.hs @@ -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 diff --git a/src/Bio/Bam/Trim.hs b/src/Bio/Bam/Trim.hs --- a/src/Bio/Bam/Trim.hs +++ b/src/Bio/Bam/Trim.hs @@ -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 diff --git a/src/Bio/Genocall.hs b/src/Bio/Genocall.hs deleted file mode 100644 --- a/src/Bio/Genocall.hs +++ /dev/null @@ -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) diff --git a/src/Bio/Genocall/Estimators.hs b/src/Bio/Genocall/Estimators.hs deleted file mode 100644 --- a/src/Bio/Genocall/Estimators.hs +++ /dev/null @@ -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) ] diff --git a/src/Bio/Iteratee/ZLib.hsc b/src/Bio/Iteratee/ZLib.hsc --- a/src/Bio/Iteratee/ZLib.hsc +++ b/src/Bio/Iteratee/ZLib.hsc @@ -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 diff --git a/src/Bio/Prelude.hs b/src/Bio/Prelude.hs --- a/src/Bio/Prelude.hs +++ b/src/Bio/Prelude.hs @@ -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 diff --git a/src/Bio/Util/AD.hs b/src/Bio/Util/AD.hs deleted file mode 100644 --- a/src/Bio/Util/AD.hs +++ /dev/null @@ -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 diff --git a/src/Bio/Util/AD2.hs b/src/Bio/Util/AD2.hs deleted file mode 100644 --- a/src/Bio/Util/AD2.hs +++ /dev/null @@ -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 ] - diff --git a/src/Bio/Util/Jacobi.hs b/src/Bio/Util/Jacobi.hs deleted file mode 100644 --- a/src/Bio/Util/Jacobi.hs +++ /dev/null @@ -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 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 - diff --git a/src/cbits/jive.c b/src/cbits/jive.c deleted file mode 100644 --- a/src/cbits/jive.c +++ /dev/null @@ -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 ; -} - diff --git a/src/cbits/trim.c b/src/cbits/trim.c new file mode 100644 --- /dev/null +++ b/src/cbits/trim.c @@ -0,0 +1,46 @@ +#include + +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 ; +} + diff --git a/tests/test-pileup.hs b/tests/test-pileup.hs deleted file mode 100644 --- a/tests/test-pileup.hs +++ /dev/null @@ -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 diff --git a/tools/Align.hs b/tools/Align.hs deleted file mode 100644 --- a/tools/Align.hs +++ /dev/null @@ -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' let nc2 :< rest = Z.viewl nrs - b' = vote_for votes (U.head qs) b - in mkNC is b' ins nc nrs (0::Int) qs cigs - - ( 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.!) diff --git a/tools/Anno.hs b/tools/Anno.hs deleted file mode 100644 --- a/tools/Anno.hs +++ /dev/null @@ -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" ] diff --git a/tools/Index.hs b/tools/Index.hs deleted file mode 100644 --- a/tools/Index.hs +++ /dev/null @@ -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 |] - - diff --git a/tools/Seqs.hs b/tools/Seqs.hs deleted file mode 100644 --- a/tools/Seqs.hs +++ /dev/null @@ -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" - diff --git a/tools/SimpleSeed.hs b/tools/SimpleSeed.hs deleted file mode 100644 --- a/tools/SimpleSeed.hs +++ /dev/null @@ -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 - diff --git a/tools/Xlate.hs b/tools/Xlate.hs deleted file mode 100644 --- a/tools/Xlate.hs +++ /dev/null @@ -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 - diff --git a/tools/afroengineer.hs b/tools/afroengineer.hs deleted file mode 100644 --- a/tools/afroengineer.hs +++ /dev/null @@ -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 } ] - diff --git a/tools/bam-fixpair.hs b/tools/bam-fixpair.hs deleted file mode 100644 --- a/tools/bam-fixpair.hs +++ /dev/null @@ -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 - diff --git a/tools/bam-meld.hs b/tools/bam-meld.hs deleted file mode 100644 --- a/tools/bam-meld.hs +++ /dev/null @@ -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 ] - diff --git a/tools/bam-resample.hs b/tools/bam-resample.hs deleted file mode 100644 --- a/tools/bam-resample.hs +++ /dev/null @@ -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 ++ " [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] diff --git a/tools/bam-rewrap.hs b/tools/bam-rewrap.hs deleted file mode 100644 --- a/tools/bam-rewrap.hs +++ /dev/null @@ -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 - diff --git a/tools/bam-rmdup.hs b/tools/bam-rmdup.hs deleted file mode 100644 --- a/tools/bam-rmdup.hs +++ /dev/null @@ -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) - diff --git a/tools/bam-trim.hs b/tools/bam-trim.hs deleted file mode 100644 --- a/tools/bam-trim.hs +++ /dev/null @@ -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 - diff --git a/tools/fastq2bam.hs b/tools/fastq2bam.hs deleted file mode 100644 --- a/tools/fastq2bam.hs +++ /dev/null @@ -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 - - diff --git a/tools/jivebunny.hs b/tools/jivebunny.hs deleted file mode 100644 --- a/tools/jivebunny.hs +++ /dev/null @@ -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 '%' - diff --git a/tools/mt-anno.hs b/tools/mt-anno.hs deleted file mode 100644 --- a/tools/mt-anno.hs +++ /dev/null @@ -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 == '>' - diff --git a/tools/mt-ccheck.hs b/tools/mt-ccheck.hs deleted file mode 100644 --- a/tools/mt-ccheck.hs +++ /dev/null @@ -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 ) ; - } - } - } -} - -} - diff --git a/tools/redeye-dar.hs b/tools/redeye-dar.hs deleted file mode 100644 --- a/tools/redeye-dar.hs +++ /dev/null @@ -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 - - diff --git a/tools/redeye-flow.hs b/tools/redeye-flow.hs deleted file mode 100644 --- a/tools/redeye-flow.hs +++ /dev/null @@ -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) - - diff --git a/tools/redeye-single.hs b/tools/redeye-single.hs deleted file mode 100644 --- a/tools/redeye-single.hs +++ /dev/null @@ -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 ( 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=" - , "##INFO=" - , "##FORMAT=" - , "##FORMAT=" - , "##FORMAT=" - , "##FORMAT=" ] ++ - [ S.concat [ "##contig=" ] | 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