diff --git a/Biobase/RNAcentralHTTPRequest.hs b/Biobase/RNAcentralHTTPRequest.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAcentralHTTPRequest.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | RNAcentralHTTPRequest
+-- Testcommand: dist/build/RNAcentralHTTPRequest/RNAcentralHTTPRequest -i ATACTTACCTGGCACAGGGGATACCACGATCACCAAGGTGGTTCCCCCAAGACGAGGCTCACCATTGCACTCCGGTGGCGCTGACCCTTGCAATGACCCCAAATGTGGGTTACTCGGGTGTGTAATTTCTGTTAGCTGGGGACTGCGTTCGCGCTTTCCCCTT
+module Main where
+
+import System.Console.CmdArgs
+import Biobase.RNAlien.RNAcentralHTTP
+
+data Options = Options
+ { inputSequence :: String
+ } deriving (Show,Data,Typeable)
+
+options :: Options
+options = Options
+ { inputSequence = def &= name "i" &= help "input sequence"
+ } &= summary "RNAcentralHTTPRequest" &= help "Florian Eggenhofer 2016" &= verbosity
+
+main :: IO ()
+main = do
+ Options{..} <- cmdArgs options
+ let query = buildStringViaMD5Query inputSequence
+ rnacentralentries <- getRNACentralEntries [query]
+ print rnacentralentries
+
diff --git a/Biobase/RNAlien.hs b/Biobase/RNAlien.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAlien.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Unsupervized construction of RNA family models
+-- For more information on RNA family models consult
+-- Usage example: RNAlien -i /path/input.fa -c 5 -o /outdir/
+-- Usage example offline mode: RNAlien -i /path/input.fa -b /backup/blast/nt_v5 -o /outdir/ -c 5 -t 1396 -j
+module Main where
+
+import System.Console.CmdArgs
+import System.Directory
+import Biobase.RNAlien.Types
+import Biobase.RNAlien.Library
+import Data.Maybe
+import Data.Either.Unwrap
+import Data.Time
+import qualified System.FilePath as FP
+import Paths_RNAlien (version)
+import Data.Version (showVersion)
+--import Biobase.Fasta.Streaming
+
+data Options = Options
+ { inputFastaFilePath :: String,
+ outputPath :: String,
+ inputTaxId :: Maybe Int,
+ inputnSCICutoff :: Maybe Double,
+ inputEvalueCutoff :: Maybe Double,
+ inputBlastDatabase :: Maybe String,
+ lengthFilter :: Bool,
+ coverageFilter :: Bool,
+ singleHitperTax :: Bool,
+ blastSoftmasking :: Bool,
+ inputQuerySelectionMethod :: String,
+ inputQueryNumber :: Int,
+ threads :: Int,
+ taxonomyRestriction :: Maybe String,
+ sessionIdentificator :: Maybe String,
+ performEvaluation :: Bool,
+ checkSetup :: Bool,
+ offlineMode :: Bool
+ } deriving (Show,Data,Typeable)
+
+options :: Options
+options = Options
+ { inputFastaFilePath = def &= name "i" &= help "Path to input fasta file",
+ outputPath = def &= name "o" &= help "Path to output directory. Default: current working directory",
+ inputTaxId = Nothing &= name "t" &= help "NCBI taxonomy ID number of input RNA organism",
+ inputnSCICutoff = Just (1 :: Double) &= name "z" &= help "Only candidate sequences with a normalized structure conservation index (nSCI) higher than this value are accepted. Default: 1",
+ inputEvalueCutoff = Just (0.001 :: Double) &= name "e" &= help "Evalue cutoff for cmsearch filtering. Default: 0.001",
+ inputBlastDatabase = Just "nt" &= name "b" &= help "Specify name of blast database to use, in offline mode the filepath to the blast database (/home/user/nt_v5). Default: nt",
+ lengthFilter = True &= name "l" &= help "Filter blast hits per genomic length. Default: True",
+ coverageFilter = True &= name "a" &= help "Filter blast hits by coverage of at least 80%. Default: True",
+ singleHitperTax = False &= name "s" &= help "Only the best blast hit per taxonomic entry is considered. Default: False",
+ blastSoftmasking = False &= name "f" &= help "Toggles blast query softmasking, meaning masking of non-conserved regions on the query. Default: False",
+ inputQuerySelectionMethod = "filtering" &= name "m" &= help "Method for selection of queries (filtering,clustering). Default: filtering",
+ inputQueryNumber = (5 :: Int) &= name "n" &= help "Number of queries used for candidate search. Default: 5",
+ threads = 1 &= name "c" &= help "Number of available cpu slots/cores. Default: 1",
+ taxonomyRestriction = Nothing &= name "r" &= help "Restrict search space to taxonomic kingdom (bacteria,archea,eukaryia). Default: not set",
+ sessionIdentificator = Nothing &= name "d" &= help "Optional session id that is used instead of automatically generated one.",
+ performEvaluation = True &= name "x" &= help "Perform evaluation step. Default: True",
+ checkSetup = False &= name "g" &= help "Just prints installed tool versions and performs connection check. Default: False",
+ offlineMode = False &= name "j" &= help "Uses locally installed blast and databases. Default: False"
+ } &= summary ("RNAlien " ++ alienVersion) &= help "Florian Eggenhofer, Ivo L. Hofacker, Christian Hoener zu Siederdissen - 2013 - 2019" &= verbosity
+
+main :: IO ()
+main = do
+ Options{..} <- cmdArgs options
+ verboseLevel <- getVerbosity
+ let tools = if inputQuerySelectionMethod == "clustering" then ["clustalo","mlocarna","RNAfold","RNAalifold","cmcalibrate","cmstat","cmbuild","RNAz","RNAcode"] else ["mlocarna","RNAfold","RNAalifold","cmcalibrate","cmstat","cmbuild","RNAz","RNAcode"]
+ -- Generate SessionID
+ sessionId <- createSessionID sessionIdentificator
+ timestamp <- getCurrentTime
+ currentWorkDirectory <- getCurrentDirectory
+ let selectedOutputPath = if null outputPath then currentWorkDirectory else outputPath
+ let temporaryDirectoryPath = FP.addTrailingPathSeparator selectedOutputPath ++ sessionId ++ "/"
+ createDirectoryIfMissing False temporaryDirectoryPath
+ networkCheck <- checkNCBIConnection
+ if checkSetup
+ then do
+ toolsCheck <- checkTools tools inputQuerySelectionMethod temporaryDirectoryPath
+ let setupCheckPath = temporaryDirectoryPath ++ "setupCheck"
+ let toolCheckResult = either id id toolsCheck
+ let networkCheckResult = either id id networkCheck
+ writeFile setupCheckPath (toolCheckResult ++ "\n" ++ networkCheckResult ++ "\n")
+ else
+ if isLeft networkCheck
+ then do
+ putStrLn ("Error - Could not contact NCBI server: " ++ fromLeft networkCheck ++ "\n")
+ logMessage ("Error - Could not contact NCBI server: " ++ fromLeft networkCheck ++ "\n") temporaryDirectoryPath
+ else do
+ createDirectoryIfMissing False (temporaryDirectoryPath ++ "log")
+ -- Create Log files
+ writeFile (temporaryDirectoryPath ++ "Log") ("RNAlien " ++ alienVersion ++ "\n")
+ writeFile (temporaryDirectoryPath ++ "log/warnings") ("")
+ logMessage ("Timestamp: " ++ (show timestamp) ++ "\n") temporaryDirectoryPath
+ logMessage ("Temporary Directory: " ++ temporaryDirectoryPath ++ "\n") temporaryDirectoryPath
+ inputFasta <- readFastaFile inputFastaFilePath
+ if null inputFasta
+ then do
+ putStrLn "Error: Input fasta file is empty."
+ logMessage "Error: Input fasta file is empty.\n" temporaryDirectoryPath
+ else do
+ let iterationNumber = 0
+ toolsCheck <- checkTools tools inputQuerySelectionMethod temporaryDirectoryPath
+ if isLeft toolsCheck
+ then do
+ putStrLn ("Error - Not all required tools could be found in $PATH: " ++ fromLeft toolsCheck ++ "\n")
+ logMessage ("Error - Not all required tools could be found in $PATH: " ++ fromLeft toolsCheck ++ "\n") temporaryDirectoryPath
+ else do
+ logToolVersions inputQuerySelectionMethod temporaryDirectoryPath
+ let inputSequence = reformatFasta (head inputFasta)
+ initialTaxId <- setInitialTaxId offlineMode threads inputBlastDatabase temporaryDirectoryPath inputTaxId inputSequence
+ let checkedTaxonomyRestriction = checkTaxonomyRestriction taxonomyRestriction
+ let staticOptions = StaticOptions temporaryDirectoryPath sessionId (fromJust inputnSCICutoff) inputTaxId singleHitperTax inputQuerySelectionMethod inputQueryNumber lengthFilter coverageFilter blastSoftmasking threads inputBlastDatabase checkedTaxonomyRestriction (setVerbose verboseLevel) offlineMode
+ let initialization = ModelConstruction iterationNumber inputFasta [] initialTaxId Nothing (fromJust inputEvalueCutoff) False [] []
+ logMessage (show initialization) temporaryDirectoryPath
+ modelConstructionResults <- modelConstructer staticOptions initialization
+ let resultTaxonomyRecordsCSVTable = constructTaxonomyRecordsCSVTable modelConstructionResults
+ writeFile (temporaryDirectoryPath ++ "result.csv") resultTaxonomyRecordsCSVTable
+ if performEvaluation
+ then do
+ resultEvaluation <- evaluateConstructionResult staticOptions modelConstructionResults
+ appendFile (temporaryDirectoryPath ++ "Log") resultEvaluation
+ resultSummary modelConstructionResults staticOptions
+ writeFile (temporaryDirectoryPath ++ "done") ""
+ else do
+ resultSummary modelConstructionResults staticOptions
+ writeFile (temporaryDirectoryPath ++ "done") ""
+
+alienVersion :: String
+alienVersion = showVersion version
diff --git a/Biobase/RNAlien/InfernalParser.hs b/Biobase/RNAlien/InfernalParser.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAlien/InfernalParser.hs
@@ -0,0 +1,340 @@
+-- | This module contains parsing functions for Infernal programs
+
+module Biobase.RNAlien.InfernalParser (
+ module Biobase.RNAlien.Types,
+ readCMSearch,
+ readCMSearches,
+ parseCMSearch,
+ parseCMSearches,
+ parseCMstat,
+ readCMstat
+ )
+where
+
+import Text.ParserCombinators.Parsec
+import Biobase.RNAlien.Types
+import qualified Data.ByteString.Char8 as B
+import qualified Control.Exception.Base as CE
+
+-- | parse from input filePath
+parseCMSearch :: String -> Either ParseError CMsearch
+parseCMSearch = parse genParserCMSearch "parseCMsearch"
+
+-- | parse from input filePath
+parseCMSearches :: String -> Either ParseError CMsearch
+parseCMSearches = parse genParserCMSearches "parseCMsearch"
+
+-- | parse from input filePath
+readCMSearch :: String -> IO (Either ParseError CMsearch)
+readCMSearch filePath = do
+ parsedFile <- parseFromFile genParserCMSearch filePath
+ CE.evaluate parsedFile
+
+-- | parse from input filePath
+readCMSearches :: String -> IO (Either ParseError CMsearch)
+readCMSearches filePath = do
+ parsedFile <- parseFromFile genParserCMSearches filePath
+ CE.evaluate parsedFile
+
+genParserCMSearches :: GenParser Char st CMsearch
+genParserCMSearches = do
+ string "# cmsearch :: search CM(s) against a sequence database"
+ newline
+ string "# INFERNAL "
+ many1 (noneOf "\n")
+ newline
+ string "# Copyright (C) 201"
+ many1 (noneOf "\n")
+ newline
+ string "# Freely distributed under the GNU General Public License (GPLv3)."
+ newline
+ string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
+ newline
+ string "# query CM file:"
+ many1 space
+ queryCMfile' <- many1 (noneOf "\n")
+ newline
+ string "# target sequence database:"
+ many1 space
+ targetSequenceDatabase' <- many1 (noneOf "\n")
+ newline
+ optional (try (genParserCMsearchHeaderField "# CM configuration"))
+ optional (try (genParserCMsearchHeaderField "# database size is set to"))
+ optional (try (genParserCMsearchHeaderField "# truncated sequence detection"))
+ string "# number of worker threads:"
+ many1 space
+ numberOfWorkerThreads' <- many1 (noneOf "\n")
+ newline
+ string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
+ newline
+ optional newline
+ cmSearchesHits <- many1 (try genParserMultipleCMSearch)
+ optional (string "[ok]\n")
+ eof
+ return $ CMsearch queryCMfile' targetSequenceDatabase' numberOfWorkerThreads' (concat cmSearchesHits)
+
+genParserCMSearch :: GenParser Char st CMsearch
+genParserCMSearch = do
+ string "# cmsearch :: search CM(s) against a sequence database"
+ newline
+ string "# INFERNAL "
+ many1 (noneOf "\n")
+ newline
+ string "# Copyright (C) 201"
+ many1 (noneOf "\n")
+ newline
+ string "# Freely distributed under the GNU General Public License (GPLv3)."
+ newline
+ string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
+ newline
+ string "# query CM file:"
+ many1 space
+ queryCMfile' <- many1 (noneOf "\n")
+ newline
+ string "# target sequence database:"
+ many1 space
+ targetSequenceDatabase' <- many1 (noneOf "\n")
+ newline
+ optional (try (genParserCMsearchHeaderField "# CM configuration"))
+ optional (try (genParserCMsearchHeaderField "# database size is set to"))
+ optional (try (genParserCMsearchHeaderField "# truncated sequence detection"))
+ string "# number of worker threads:"
+ many1 space
+ numberOfWorkerThreads' <- many1 (noneOf "\n")
+ newline
+ string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
+ newline
+ optional newline
+ string "Query:"
+ many1 (noneOf "\n")
+ newline
+ optional (try (genParserCMsearchHeaderField "Accession"))
+ optional (try (genParserCMsearchHeaderField "Description"))
+ string "Hit scores:"
+ newline
+ choice [try (string " rank"), try (string " rank") , try (string " rank"), try (string " rank"),try (string " rank"),try (string " rank")]
+ many1 space
+ string "E-value"
+ many1 space
+ string "score"
+ many1 space
+ string "bias"
+ many1 space
+ string "sequence"
+ many1 space
+ string "start"
+ many1 space
+ string "end"
+ many1 space
+ string "mdl"
+ many1 space
+ string "trunc"
+ many1 space
+ string "gc"
+ many1 space
+ string "description"
+ newline
+ string " -"
+ many1 (try (oneOf " -"))
+ newline
+ optional (try (string " ------ inclusion threshold ------"))
+ many newline
+ hitScores' <- many (try genParserCMsearchHit) --`endBy` (try (string "Hit alignments:"))
+ optional (try genParserCMsearchEmptyHit)
+ -- this is followed by hit alignments and internal cmsearch statistics which are not parsed
+ many anyChar
+ eof
+ return $ CMsearch queryCMfile' targetSequenceDatabase' numberOfWorkerThreads' hitScores'
+
+-- | Parsing function for CMSearches with multiple querymodels in one modelfile, e.g. clans
+genParserMultipleCMSearch :: GenParser Char st [CMsearchHit]
+genParserMultipleCMSearch = do
+ --optional newline
+ --optional string "//"
+ string "Query:"
+ many1 (noneOf "\n")
+ newline
+ optional (try (genParserCMsearchHeaderField "Accession"))
+ optional (try (genParserCMsearchHeaderField "Description"))
+ string "Hit scores:"
+ newline
+ choice [try (string " rank"), try (string " rank") , try (string " rank"), try (string " rank"),try (string " rank"),try (string " rank")]
+ many1 space
+ string "E-value"
+ many1 space
+ string "score"
+ many1 space
+ string "bias"
+ many1 space
+ string "sequence"
+ many1 space
+ string "start"
+ many1 space
+ string "end"
+ many1 space
+ string "mdl"
+ many1 space
+ string "trunc"
+ many1 space
+ string "gc"
+ many1 space
+ string "description"
+ newline
+ string " -"
+ many1 (try (oneOf " -"))
+ newline
+ optional (try (string " ------ inclusion threshold ------"))
+ many newline
+ hitScores' <- many (try genParserCMsearchHit) --`endBy` (try (string "Hit alignments:"))
+ optional (try genParserCMsearchEmptyHit)
+ -- this is followed by hit alignments and internal cmsearch statistics which are not parsed
+ --many anyChar
+ manyTill anyChar (try (string "//\n"))
+ return hitScores'
+
+genParserCMsearchHeaderField :: String -> GenParser Char st String
+genParserCMsearchHeaderField fieldname = do
+ string (fieldname ++ ":")
+ many1 space
+ many1 (noneOf "\n")
+ newline
+ return []
+
+genParserCMsearchEmptyHit :: GenParser Char st [CMsearchHit]
+genParserCMsearchEmptyHit = do
+ string " [No hits detected that satisfy reporting thresholds]"
+ newline
+ optional (try newline)
+ return []
+
+genParserCMsearchHit :: GenParser Char st CMsearchHit
+genParserCMsearchHit = do
+ many1 space
+ string "("
+ hitRank' <- many1 digit
+ string ")"
+ many1 space
+ hitSignificant' <- choice [char '!', char '?']
+ many1 space
+ hitEValue' <- many1 (oneOf "0123456789.e-")
+ many1 space
+ hitScore' <- many1 (oneOf "0123456789.e-")
+ many1 space
+ hitBias' <- many1 (oneOf "0123456789.e-")
+ many1 space
+ hitSequenceHeader' <- many1 (noneOf " ")
+ many1 space
+ hitStart' <- many1 digit
+ many1 space
+ hitEnd' <- many1 digit
+ many1 space
+ hitStrand' <- choice [char '+', char '-', char '.']
+ many1 space
+ hitModel' <- many1 letter
+ many1 space
+ hitTruncation' <- many1 (choice [alphaNum, char '\''])
+ many1 space
+ hitGCcontent' <- many1 (oneOf "0123456789.e-")
+ many1 space
+ hitDescription' <- many1 (noneOf "\n")
+ newline
+ optional (try (string " ------ inclusion threshold ------"))
+ optional (try newline)
+ return $ CMsearchHit (readInt hitRank') hitSignificant' (readDouble hitEValue') (readDouble hitScore') (readDouble hitBias') (B.pack hitSequenceHeader') (readInt hitStart') (readInt hitEnd') hitStrand' (B.pack hitModel') (B.pack hitTruncation') (readDouble hitGCcontent') (B.pack hitDescription')
+
+-- | parse from input filePath
+parseCMstat :: String -> Either ParseError CMstat
+parseCMstat = parse genParserCMstat "parseCMstat"
+
+-- | parse from input filePath
+readCMstat :: String -> IO (Either ParseError CMstat)
+readCMstat filePath = do
+ parsedFile <- parseFromFile genParserCMstat filePath
+ CE.evaluate parsedFile
+
+genParserCMstat :: GenParser Char st CMstat
+genParserCMstat = do
+ string "# cmstat :: display summary statistics for CMs"
+ newline
+ string "# INFERNAL "
+ many1 (noneOf "\n")
+ newline
+ string "# Copyright (C) 201"
+ many1 (noneOf "\n")
+ newline
+ string "# Freely distributed under the GNU General Public License (GPLv3)."
+ newline
+ string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
+ newline
+ char '#'
+ many1 (char ' ')
+ string "rel entropy"
+ newline
+ char '#'
+ many1 (char ' ')
+ many1 (char '-')
+ newline
+ char '#'
+ many1 space
+ string "idx"
+ many1 space
+ string "name"
+ many1 space
+ string "accession"
+ many1 space
+ string "nseq"
+ many1 space
+ string "eff_nseq"
+ many1 space
+ string "clen"
+ many1 space
+ string "W"
+ many1 space
+ string "bps"
+ many1 space
+ string "bifs"
+ many1 space
+ string "model"
+ many1 space
+ string "cm"
+ many1 space
+ string "hmm"
+ newline
+ string "#"
+ many1 (try (oneOf " -"))
+ newline
+ many1 space
+ _statIndex <- many1 digit
+ many1 space
+ _statName <- many1 letter
+ many1 space
+ _statAccession <- many1 (noneOf " ")
+ many1 space
+ _statSequenceNumber <- many1 digit
+ many1 space
+ _statEffectiveSequences <- many1 (oneOf "0123456789.e-")
+ many1 space
+ _statConsensusLength <- many digit
+ many1 space
+ _statW <- many1 digit
+ many1 space
+ _statBasepaires <- many1 digit
+ many1 space
+ _statBifurcations <- many1 digit
+ many1 space
+ _statModel <- many1 letter
+ many1 space
+ _relativeEntropyCM <- many1 (oneOf "0123456789.e-")
+ many1 space
+ _relativeEntropyHMM <- many1 (oneOf "0123456789.e-")
+ newline
+ char '#'
+ newline
+ eof
+ return $ CMstat (readInt _statIndex) _statName _statAccession (readInt _statSequenceNumber) (readDouble _statEffectiveSequences) (readInt _statConsensusLength) (readInt _statW) (readInt _statBasepaires) (readInt _statBifurcations) _statModel (readDouble _relativeEntropyCM) (readDouble _relativeEntropyHMM)
+--
+readInt :: String -> Int
+readInt = read
+
+readDouble :: String -> Double
+readDouble = read
diff --git a/Biobase/RNAlien/Library.hs b/Biobase/RNAlien/Library.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAlien/Library.hs
@@ -0,0 +1,2032 @@
+-- | This module contains functions for RNAlien
+{-# LANGUAGE RankNTypes #-}
+module Biobase.RNAlien.Library (
+ module Biobase.RNAlien.Types,
+ createSessionID,
+ logMessage,
+ logEither,
+ modelConstructer,
+ constructTaxonomyRecordsCSVTable,
+ resultSummary,
+ setVerbose,
+ logToolVersions,
+ checkTools,
+ systemCMsearch,
+ readCMSearch,
+ readCMSearches,
+ compareCM,
+ parseCMSearch,
+ cmSearchsubString,
+ setInitialTaxId,
+ evaluateConstructionResult,
+ readCMstat,
+ parseCMstat,
+ checkNCBIConnection,
+ preprocessClustalForRNAz,
+ preprocessClustalForRNAzExternal,
+ preprocessClustalForRNAcodeExternal,
+ rnaZEvalOutput,
+ reformatFasta,
+ checkTaxonomyRestriction,
+ evaluePartitionTrimCMsearchHits,
+ readFastaFile,
+ writeFastaFile
+ )
+where
+
+import System.Process
+import qualified System.FilePath as FP
+import Text.ParserCombinators.Parsec
+import Data.List
+import Data.Char
+import Biobase.Fasta.Strict
+import qualified Biobase.BLAST.Types as J
+import Bio.ClustalParser
+import Data.Int (Int16)
+import Biobase.RNAlien.Types
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Char8 as B
+import Bio.Taxonomy
+import Data.Either.Unwrap
+import Data.Maybe
+import Biobase.Entrez.HTTP
+import System.Exit
+import Data.Either (lefts,rights,Either)
+import qualified Text.EditDistance as ED
+import qualified Data.Vector as V
+import Control.Concurrent
+import System.Random
+import Data.Csv
+import Data.Matrix
+import Biobase.BLAST.HTTP
+import Data.Clustering.Hierarchical
+import System.Directory
+import System.Console.CmdArgs
+import qualified Control.Exception.Base as CE
+import Bio.RNAfoldParser
+import Bio.RNAalifoldParser
+import Bio.RNAzParser
+import qualified Network.HTTP.Conduit as N
+import Network.HTTP.Types.Status
+import qualified Bio.RNAcodeParser as RC
+import qualified Biobase.RNAlien.RNAcentralHTTP as RCH
+import Biobase.RNAlien.InfernalParser
+import qualified Data.Text as T
+import qualified Data.Text.IO as TI
+import qualified Data.Text.Encoding as E
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TIO
+import Text.Printf
+import qualified Data.Text.Metrics as TM
+import Control.Monad
+import qualified Data.Sequence as DS
+import Data.Foldable
+import Biobase.Types.BioSequence
+import qualified Biobase.BLAST.Import as BBI
+
+-- | Initial RNA family model construction - generates iteration number, seed alignment and model
+modelConstructer :: StaticOptions -> ModelConstruction -> IO ModelConstruction
+modelConstructer staticOptions modelConstruction = do
+ logMessage ("Iteration: " ++ show (iterationNumber modelConstruction) ++ "\n") (tempDirPath staticOptions)
+ iterationSummary modelConstruction staticOptions
+ let currentIterationNumber = iterationNumber modelConstruction
+ let foundSequenceNumber = length (concatMap sequenceRecords (taxRecords modelConstruction))
+ --extract queries
+ let queries = extractQueries foundSequenceNumber modelConstruction
+ logVerboseMessage (verbositySwitch staticOptions) ("Queries:" ++ show queries ++ "\n") (tempDirPath staticOptions)
+ let iterationDirectory = tempDirPath staticOptions ++ show currentIterationNumber ++ "/"
+ let maybeLastTaxId = extractLastTaxId (taxonomicContext modelConstruction)
+ Control.Monad.when (isNothing maybeLastTaxId) $ logMessage ("Lineage: Could not extract last tax id \n") (tempDirPath staticOptions)
+ --If highest node in linage was used as upper taxonomy limit, taxonomic tree is exhausted
+ if maybe True (\uppertaxlimit -> maybe True (\lastTaxId -> uppertaxlimit /= lastTaxId) maybeLastTaxId) (upperTaxonomyLimit modelConstruction)
+ then do
+ createDirectory iterationDirectory
+ let (upperTaxLimit,lowerTaxLimit) = setTaxonomicContextEntrez currentIterationNumber (taxonomicContext modelConstruction) (upperTaxonomyLimit modelConstruction)
+ logVerboseMessage (verbositySwitch staticOptions) ("Upper taxonomy limit: " ++ show upperTaxLimit ++ "\n " ++ "Lower taxonomy limit: "++ show lowerTaxLimit ++ "\n") (tempDirPath staticOptions)
+ --search queries
+ let expectThreshold = setBlastExpectThreshold modelConstruction
+ searchResults <- catchAll (searchCandidates staticOptions Nothing currentIterationNumber upperTaxLimit lowerTaxLimit expectThreshold queries)
+ (\e -> do logWarning ("Warning: Search results iteration" ++ show (iterationNumber modelConstruction) ++ " - exception: " ++ show e) (tempDirPath staticOptions)
+ return (SearchResult [] Nothing))
+ currentTaxonomicContext <- getTaxonomicContextEntrez upperTaxLimit (taxonomicContext modelConstruction)
+ if null (candidates searchResults)
+ then
+ alignmentConstructionWithoutCandidates currentTaxonomicContext upperTaxLimit staticOptions modelConstruction
+ else
+ alignmentConstructionWithCandidates currentTaxonomicContext upperTaxLimit searchResults staticOptions modelConstruction
+ else do
+ logMessage "Message: Modelconstruction complete: Out of queries or taxonomic tree exhausted\n" (tempDirPath staticOptions)
+ modelConstructionResult staticOptions modelConstruction
+
+catchAll :: IO a -> (CE.SomeException -> IO a) -> IO a
+catchAll = CE.catch
+
+setInitialTaxId :: Bool -> Int -> Maybe String -> String -> Maybe Int -> Fasta () ()-> IO (Maybe Int)
+setInitialTaxId offlineMode threads inputBlastDatabase tempdir inputTaxId inputSequence =
+ if (isNothing inputTaxId)
+ then do
+ initialTaxId <- findTaxonomyStart offlineMode threads inputBlastDatabase tempdir inputSequence
+ return (Just initialTaxId)
+ else do
+ return inputTaxId
+
+extractLastTaxId :: Maybe Taxon -> Maybe Int
+extractLastTaxId taxon
+ | isNothing taxon = Nothing
+ | V.null lineageExVector = Nothing
+ | otherwise = Just (lineageTaxId (V.head lineageExVector))
+ where lineageExVector = V.fromList (lineageEx (fromJust taxon))
+
+modelConstructionResult :: StaticOptions -> ModelConstruction -> IO ModelConstruction
+modelConstructionResult staticOptions modelConstruction = do
+ let currentIterationNumber = iterationNumber modelConstruction
+ let outputDirectory = tempDirPath staticOptions
+ logMessage ("Global search iteration: " ++ show currentIterationNumber ++ "\n") outputDirectory
+ iterationSummary modelConstruction staticOptions
+ let foundSequenceNumber = length (concatMap sequenceRecords (taxRecords modelConstruction))
+ --extract queries
+ --let querySeqIds = selectedQueries modelConstruction ---
+ let queries = extractQueries foundSequenceNumber modelConstruction ---
+ --let alignedSequences' = map nucleotideSequence (concatMap sequenceRecords (taxRecords modelConstruction)) ---
+ logVerboseMessage (verbositySwitch staticOptions) ("Queries:" ++ show queries ++ "\n") outputDirectory
+ let iterationDirectory = outputDirectory ++ show currentIterationNumber ++ "/"
+ createDirectory iterationDirectory
+ let logFileDirectoryPath = iterationDirectory ++ "log"
+ createDirectoryIfMissing False logFileDirectoryPath
+ let expectThreshold = setBlastExpectThreshold modelConstruction
+ (alignmentResults,currentPotentialMembers) <- if isJust (taxRestriction staticOptions)
+ then do
+ --taxonomic restriction
+ let (upperTaxLimit,lowerTaxLimit) = setRestrictedTaxonomyLimits (fromJust (taxRestriction staticOptions))
+ restrictedCandidates <- catchAll (searchCandidates staticOptions (taxRestriction staticOptions) currentIterationNumber upperTaxLimit lowerTaxLimit expectThreshold queries)
+ (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return (SearchResult [] Nothing))
+ let uniqueCandidates = filterDuplicates modelConstruction restrictedCandidates
+ (restrictedAlignmentResults,restrictedPotentialMembers) <- catchAll (alignCandidates staticOptions modelConstruction (fromJust (taxRestriction staticOptions)) uniqueCandidates)
+ (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return ([],[]))
+ let currentPotentialMembers = [SearchResult restrictedPotentialMembers (blastDatabaseSize restrictedCandidates)]
+ return (restrictedAlignmentResults,currentPotentialMembers)
+ else do
+ --taxonomic context archea
+ let (upperTaxLimit1,lowerTaxLimit1) = (Just (2157 :: Int), Nothing)
+ candidates1 <- catchAll (searchCandidates staticOptions (Just "archea") currentIterationNumber upperTaxLimit1 lowerTaxLimit1 expectThreshold queries)
+ (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return (SearchResult [] Nothing))
+ let uniqueCandidates1 = filterDuplicates modelConstruction candidates1
+ (alignmentResults1,potentialMembers1) <- catchAll (alignCandidates staticOptions modelConstruction "archea" uniqueCandidates1)
+ (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return ([],[]))
+ --taxonomic context bacteria
+ let (upperTaxLimit2,lowerTaxLimit2) = (Just (2 :: Int), Nothing)
+ candidates2 <- catchAll (searchCandidates staticOptions (Just "bacteria") currentIterationNumber upperTaxLimit2 lowerTaxLimit2 expectThreshold queries)
+ (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return (SearchResult [] Nothing))
+ let uniqueCandidates2 = filterDuplicates modelConstruction candidates2
+ (alignmentResults2,potentialMembers2) <- catchAll (alignCandidates staticOptions modelConstruction "bacteria" uniqueCandidates2)
+ (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return ([],[]))
+ --taxonomic context eukaryia
+ let (upperTaxLimit3,lowerTaxLimit3) = (Just (2759 :: Int), Nothing)
+ candidates3 <- catchAll (searchCandidates staticOptions (Just "eukaryia") currentIterationNumber upperTaxLimit3 lowerTaxLimit3 expectThreshold queries)
+ (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return (SearchResult [] Nothing))
+ let uniqueCandidates3 = filterDuplicates modelConstruction candidates3
+ (alignmentResults3,potentialMembers3) <- catchAll (alignCandidates staticOptions modelConstruction "eukaryia" uniqueCandidates3)
+ (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
+ return ([],[]))
+ let alignmentResults = alignmentResults1 ++ alignmentResults2 ++ alignmentResults3
+ let currentPotentialMembers = [SearchResult potentialMembers1 (blastDatabaseSize candidates1), SearchResult potentialMembers2 (blastDatabaseSize candidates2), SearchResult potentialMembers3 (blastDatabaseSize candidates3)]
+ return (alignmentResults,currentPotentialMembers)
+ let preliminaryFastaPath = iterationDirectory ++ "model.fa"
+ let preliminaryCMPath = iterationDirectory ++ "model.cm"
+ let preliminaryAlignmentPath = iterationDirectory ++ "model.stockholm"
+ let preliminaryCMLogPath = iterationDirectory ++ "model.cm.log"
+ let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults Nothing Nothing [] currentPotentialMembers (alignmentModeInfernal modelConstruction)
+ if (null alignmentResults) && not (alignmentModeInfernal modelConstruction)
+ then do
+ logVerboseMessage (verbositySwitch staticOptions) "Alignment result initial mode\n" outputDirectory
+ logMessage "Message: No sequences found that statisfy filters. Try to reconstruct model with less strict cutoff parameters." outputDirectory
+ let alignedSequences = extractAlignedSequences (iterationNumber modelConstruction) modelConstruction
+ let alignmentSequences = map snd (V.toList (V.concat [alignedSequences]))
+ writeFastaFile preliminaryFastaPath alignmentSequences
+ let cmBuildFilepath = iterationDirectory ++ "model" ++ ".cmbuild"
+ let refinedAlignmentFilepath = iterationDirectory ++ "modelrefined" ++ ".stockholm"
+ let cmBuildOptions ="--refine " ++ refinedAlignmentFilepath
+ let foldFilepath = iterationDirectory ++ "model" ++ ".fold"
+ _ <- systemRNAfold preliminaryFastaPath foldFilepath
+ foldoutput <- readRNAfold foldFilepath
+ let seqStructure = foldSecondaryStructure (fromRight foldoutput)
+ let stockholAlignment = convertFastaFoldStockholm (head alignmentSequences) seqStructure
+ writeFile preliminaryAlignmentPath stockholAlignment
+ _ <- systemCMbuild cmBuildOptions preliminaryAlignmentPath preliminaryCMPath cmBuildFilepath
+ _ <- systemCMcalibrate "fast" (cpuThreads staticOptions) preliminaryCMPath preliminaryCMLogPath
+ reevaluatePotentialMembers staticOptions nextModelConstructionInput
+ else
+ if (alignmentModeInfernal modelConstruction)
+ then do
+ logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - infernal mode\n") outputDirectory
+ constructModel nextModelConstructionInput staticOptions
+ writeFile (iterationDirectory ++ "done") ""
+ logMessage (iterationSummaryLog nextModelConstructionInput) outputDirectory
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInput) outputDirectory
+ resultModelConstruction <- reevaluatePotentialMembers staticOptions nextModelConstructionInput
+ return resultModelConstruction
+ else do
+ logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - initial mode\n") outputDirectory
+ constructModel nextModelConstructionInput staticOptions
+ let nextModelConstructionInputInfernalMode = nextModelConstructionInput {alignmentModeInfernal = True}
+ logMessage (iterationSummaryLog nextModelConstructionInputInfernalMode) outputDirectory
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputInfernalMode) outputDirectory
+ writeFile (iterationDirectory ++ "done") ""
+ resultModelConstruction <- reevaluatePotentialMembers staticOptions nextModelConstructionInputInfernalMode
+ return resultModelConstruction
+
+writeFastaFile :: String -> [Fasta () ()] -> IO ()
+writeFastaFile fastaFilePath alignmentSequences = do
+ let sequenceOutput = B.concat (map (fastaToByteString 80) alignmentSequences)
+ B.writeFile fastaFilePath sequenceOutput
+
+-- | Reevaluate collected potential members for inclusion in the result model
+reevaluatePotentialMembers :: StaticOptions -> ModelConstruction -> IO ModelConstruction
+reevaluatePotentialMembers staticOptions modelConstruction = do
+ let currentIterationNumber = iterationNumber modelConstruction
+ let outputDirectory = tempDirPath staticOptions
+ iterationSummary modelConstruction staticOptions
+ logMessage ("Reevaluation of potential members iteration: " ++ show currentIterationNumber ++ "\n") outputDirectory
+ let iterationDirectory = outputDirectory ++ show currentIterationNumber ++ "/"
+ createDirectory iterationDirectory
+ let indexedPotentialMembers = V.indexed (V.fromList (potentialMembers modelConstruction))
+ potentialMembersAlignmentResultVector <- V.mapM (\(i,searchresult) -> (alignCandidates staticOptions modelConstruction (show i ++ "_") searchresult)) indexedPotentialMembers
+ let potentialMembersAlignmentResults = V.toList potentialMembersAlignmentResultVector
+ let alignmentResults = concatMap fst potentialMembersAlignmentResults
+ let discardedMembers = concatMap snd potentialMembersAlignmentResults
+ writeFile (outputDirectory ++ "log/discarded") (concatMap show discardedMembers)
+ let resultFastaPath = outputDirectory ++ "result.fa"
+ let resultCMPath = outputDirectory ++ "result.cm"
+ let resultAlignmentPath = outputDirectory ++ "result.stockholm"
+ let resultClustalFilepath = outputDirectory ++ "result.clustal"
+ let resultCMLogPath = outputDirectory ++ "log/result.cm.log"
+ if null alignmentResults
+ then do
+ let lastIterationFastaPath = outputDirectory ++ show (currentIterationNumber - 1)++ "/model.fa"
+ let lastIterationAlignmentPath = outputDirectory ++ show (currentIterationNumber - 1) ++ "/model.stockholm"
+ let lastIterationCMPath = outputDirectory ++ show (currentIterationNumber - 1)++ "/model.cm"
+ copyFile lastIterationCMPath resultCMPath
+ --copyFile lastIterationCMPath (resultCMPath ++ ".bak1")
+ copyFile lastIterationFastaPath resultFastaPath
+ copyFile lastIterationAlignmentPath resultAlignmentPath
+ _ <- systemCMcalibrate "standard" (cpuThreads staticOptions) resultCMPath resultCMLogPath
+ systemCMalign ("--outformat=Clustal --cpu " ++ show (cpuThreads staticOptions)) resultCMPath resultFastaPath resultClustalFilepath
+ writeFile (iterationDirectory ++ "done") ""
+ return modelConstruction
+ else do
+ let lastIterationFastaPath = outputDirectory ++ show currentIterationNumber ++ "/model.fa"
+ let lastIterationAlignmentPath = outputDirectory ++ show currentIterationNumber ++ "/model.stockholm"
+ let lastIterationCMPath = outputDirectory ++ show currentIterationNumber ++ "/model.cm"
+ logVerboseMessage (verbositySwitch staticOptions) "Alignment construction with candidates - infernal mode\n" outputDirectory
+ let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults Nothing Nothing [] [] (alignmentModeInfernal modelConstruction)
+ constructModel nextModelConstructionInput staticOptions
+ copyFile lastIterationCMPath resultCMPath
+ --debug
+ --copyFile lastIterationCMPath (resultCMPath ++ ".bak2")
+ copyFile lastIterationFastaPath resultFastaPath
+ copyFile lastIterationAlignmentPath resultAlignmentPath
+ logMessage (iterationSummaryLog nextModelConstructionInput) outputDirectory
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInput) outputDirectory
+ _ <- systemCMcalibrate "standard" (cpuThreads staticOptions) resultCMPath resultCMLogPath
+ systemCMalign ("--outformat=Clustal --cpu " ++ show (cpuThreads staticOptions)) resultCMPath resultFastaPath resultClustalFilepath
+ writeFile (iterationDirectory ++ "done") ""
+ return nextModelConstructionInput
+
+---------------------------------------------------------
+
+alignmentConstructionWithCandidates :: Maybe Taxon -> Maybe Int -> SearchResult -> StaticOptions -> ModelConstruction -> IO ModelConstruction
+alignmentConstructionWithCandidates currentTaxonomicContext currentUpperTaxonomyLimit searchResults staticOptions modelConstruction = do
+ --candidates usedUpperTaxonomyLimit blastDatabaseSize
+ let currentIterationNumber = iterationNumber modelConstruction
+ let iterationDirectory = tempDirPath staticOptions ++ show currentIterationNumber ++ "/"
+ --let usedUpperTaxonomyLimit = (snd (head candidates))
+ --align search result
+ (alignmentResults,potentialMemberEntries) <- catchAll (alignCandidates staticOptions modelConstruction "" searchResults)
+ (\e -> do logWarning ("Warning: Alignment results iteration" ++ show (iterationNumber modelConstruction) ++ " - exception: " ++ show e) (tempDirPath staticOptions)
+ return ([],[]))
+ let currentPotentialMembers = [SearchResult potentialMemberEntries (blastDatabaseSize searchResults)]
+ if (null alignmentResults) && not (alignmentModeInfernal modelConstruction)
+ then do
+ logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - length 1 - inital mode" ++ "\n") (tempDirPath staticOptions)
+ --too few sequences for alignment. because of lack in sequences no cm was constructed before
+ --reusing previous modelconstruction with increased upperTaxonomyLimit but include found sequence
+ --prepare next iteration
+ let newTaxEntries = taxRecords modelConstruction ++ buildTaxRecords alignmentResults currentIterationNumber
+ let nextModelConstructionInputWithThreshold = modelConstruction {iterationNumber = currentIterationNumber + 1,upperTaxonomyLimit = currentUpperTaxonomyLimit, taxRecords = newTaxEntries,taxonomicContext = currentTaxonomicContext}
+ logMessage (iterationSummaryLog nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithThreshold) (tempDirPath staticOptions) ----
+ writeFile (iterationDirectory ++ "done") ""
+ modelConstructer staticOptions nextModelConstructionInputWithThreshold
+ else
+ if (alignmentModeInfernal modelConstruction)
+ then do
+ logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - infernal mode\n") (tempDirPath staticOptions)
+ --prepare next iteration
+ let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults currentUpperTaxonomyLimit currentTaxonomicContext [] currentPotentialMembers True
+ constructModel nextModelConstructionInput staticOptions
+ writeFile (iterationDirectory ++ "done") ""
+ logMessage (iterationSummaryLog nextModelConstructionInput) (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInput) (tempDirPath staticOptions)
+ --select queries
+ currentSelectedQueries <- selectQueries staticOptions modelConstruction alignmentResults
+ let nextModelConstructionInputWithQueries = nextModelConstructionInput {selectedQueries = currentSelectedQueries}
+ nextModelConstruction <- modelConstructer staticOptions nextModelConstructionInputWithQueries
+ return nextModelConstruction
+ else do
+ logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - initial mode\n") (tempDirPath staticOptions)
+ --First round enough candidates are available for modelconstruction, alignmentModeInfernal is set to true after this iteration
+ --prepare next iteration
+ let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults currentUpperTaxonomyLimit currentTaxonomicContext [] currentPotentialMembers False
+ constructModel nextModelConstructionInput staticOptions
+ currentSelectedQueries <- selectQueries staticOptions modelConstruction alignmentResults
+ --select queries
+ let nextModelConstructionInputWithInfernalMode = nextModelConstructionInput {alignmentModeInfernal = True, selectedQueries = currentSelectedQueries}
+ logMessage (iterationSummaryLog nextModelConstructionInputWithInfernalMode) (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithInfernalMode) (tempDirPath staticOptions)
+ writeFile (iterationDirectory ++ "done") ""
+ nextModelConstruction <- modelConstructer staticOptions nextModelConstructionInputWithInfernalMode
+ return nextModelConstruction
+
+alignmentConstructionWithoutCandidates :: Maybe Taxon -> Maybe Int -> StaticOptions -> ModelConstruction -> IO ModelConstruction
+alignmentConstructionWithoutCandidates currentTaxonomicContext upperTaxLimit staticOptions modelConstruction = do
+ let currentIterationNumber = iterationNumber modelConstruction
+ let iterationDirectory = tempDirPath staticOptions ++ show currentIterationNumber ++ "/"
+ --Found no new candidates in this iteration, reusing previous modelconstruction with increased upperTaxonomyLimit
+ let nextModelConstructionInputWithThreshold = modelConstruction {iterationNumber = currentIterationNumber + 1,upperTaxonomyLimit = upperTaxLimit,taxonomicContext = currentTaxonomicContext}
+ --copy model and alignment from last iteration in place if present
+ let previousIterationCMPath = tempDirPath staticOptions ++ show (currentIterationNumber - 1) ++ "/model.cm"
+ previousIterationCMexists <- doesFileExist previousIterationCMPath
+ if previousIterationCMexists
+ then do
+ logVerboseMessage (verbositySwitch staticOptions) "Alignment construction no candidates - previous cm\n" (tempDirPath staticOptions)
+ let previousIterationFastaPath = tempDirPath staticOptions ++ show (currentIterationNumber - 1) ++ "/model.fa"
+ let previousIterationAlignmentPath = tempDirPath staticOptions ++ show (currentIterationNumber - 1) ++ "/model.stockholm"
+ let thisIterationFastaPath = tempDirPath staticOptions ++ show (currentIterationNumber) ++ "/model.fa"
+ let thisIterationAlignmentPath = tempDirPath staticOptions ++ show (currentIterationNumber) ++ "/model.stockholm"
+ let thisIterationCMPath = tempDirPath staticOptions ++ show (currentIterationNumber) ++ "/model.cm"
+ copyFile previousIterationFastaPath thisIterationFastaPath
+ copyFile previousIterationAlignmentPath thisIterationAlignmentPath
+ copyFile previousIterationCMPath thisIterationCMPath
+ logMessage (iterationSummaryLog nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
+ writeFile (iterationDirectory ++ "done") ""
+ modelConstructer staticOptions nextModelConstructionInputWithThreshold
+ else do
+ logVerboseMessage (verbositySwitch staticOptions) "Alignment construction no candidates - no previous iteration cm\n" (tempDirPath staticOptions)
+ logMessage (iterationSummaryLog nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithThreshold) (tempDirPath staticOptions) ----
+ writeFile (iterationDirectory ++ "done") ""
+ modelConstructer staticOptions nextModelConstructionInputWithThreshold
+
+findTaxonomyStart :: Bool -> Int -> Maybe String -> String -> Fasta () () -> IO Int
+findTaxonomyStart offlineMode threads inputBlastDatabase temporaryDirectory querySequence = do
+ let queryIndexString = "1"
+ let hitNumberQuery = buildHitNumberQuery "&HITLIST_SIZE=10"
+ let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
+ let blastQuery = BlastHTTPQuery (Just "ncbi") (Just "blastn") inputBlastDatabase [querySequence] (Just (hitNumberQuery ++ registrationInfo)) (Just (5400000000 :: Int))
+ logMessage "No tax id provided - Sending find taxonomy start blast query \n" temporaryDirectory
+ let logFileDirectoryPath = temporaryDirectory ++ "taxonomystart" ++ "/"
+ createDirectory logFileDirectoryPath
+ blastOutput <-if offlineMode
+ then CE.catch (blast logFileDirectoryPath threads Nothing Nothing (Just (10 :: Double)) False blastQuery)
+ (\e -> do let err = show (e :: CE.IOException)
+ logWarning ("Warning: Blast attempt failed:" ++ " " ++ err) logFileDirectoryPath
+ return (Left ""))
+ else CE.catch (blastHTTP blastQuery)
+ (\e -> do let err = show (e :: CE.IOException)
+ logWarning ("Warning: Blast attempt failed:" ++ " " ++ err) logFileDirectoryPath
+ return (Left ""))
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_1blastOutput") (show blastOutput)
+ logEither blastOutput temporaryDirectory
+ let blastHitsArePresent = either (const False) blastMatchesPresent blastOutput
+ if blastHitsArePresent
+ then do
+ let rightBlast = fromRight blastOutput
+ let bestHit = getBestHit rightBlast
+ bestBlastHitTaxIdOutput <- retrieveBlastHitTaxIdEntrez [bestHit]
+ let taxIdFromEntrySummaries = extractTaxIdFromEntrySummaries (snd bestBlastHitTaxIdOutput)
+ Control.Monad.when (null taxIdFromEntrySummaries) (error "findTaxonomyStart: - head: empty list of taxonomy entry summary for best hit")
+ let rightBestTaxIdResult = head taxIdFromEntrySummaries
+ logMessage ("Initial TaxId: " ++ show rightBestTaxIdResult ++ "\n") temporaryDirectory
+ CE.evaluate rightBestTaxIdResult
+ else error "Find taxonomy start: Could not find blast hits to use as a taxonomic starting point"
+
+searchCandidates :: StaticOptions -> Maybe String -> Int -> Maybe Int -> Maybe Int -> Double -> [Fasta () ()] -> IO SearchResult
+searchCandidates staticOptions finaliterationprefix iterationnumber upperTaxLimit lowerTaxLimit expectThreshold inputQuerySequences = do
+ Control.Monad.when (null inputQuerySequences) $ error "searchCandidates: - head: empty list of query sequences"
+ let queryLength = fromIntegral (B.length (_bioSequence (_fasta (head inputQuerySequences))))
+ let queryIndexString = "1"
+ let entrezTaxFilter = buildTaxFilterQuery upperTaxLimit lowerTaxLimit
+ logVerboseMessage (verbositySwitch staticOptions) ("entrezTaxFilter" ++ show entrezTaxFilter ++ "\n") (tempDirPath staticOptions)
+ let hitNumberQuery = buildHitNumberQuery "&HITLIST_SIZE=5000&EXPECT=" ++ show expectThreshold
+ let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
+ let softmaskFilter = if blastSoftmaskingToggle staticOptions then "&FILTER=True&FILTER=m" else ""
+ let blastQuery = BlastHTTPQuery (Just "ncbi") (Just "blastn") (blastDatabase staticOptions) inputQuerySequences (Just (hitNumberQuery ++ entrezTaxFilter ++ softmaskFilter ++ registrationInfo)) (Just (5400000000 :: Int))
+ --appendFile "/scratch/egg/blasttest/queries" ("\nBlast query:\n" ++ show blastQuery ++ "\n")
+ logVerboseMessage (verbositySwitch staticOptions) ("Sending blast query " ++ show iterationnumber ++ "\n") (tempDirPath staticOptions)
+ let logFileDirectoryPath = tempDirPath staticOptions ++ show iterationnumber ++ "/" ++ fromMaybe "" finaliterationprefix ++ "log"
+ logDirectoryPresent <- doesDirectoryExist logFileDirectoryPath
+ Control.Monad.when (not logDirectoryPresent) $ createDirectory (logFileDirectoryPath)
+ blastOutput <- if (offline staticOptions)
+ then CE.catch (blast logFileDirectoryPath (cpuThreads staticOptions) upperTaxLimit lowerTaxLimit (Just expectThreshold) (blastSoftmaskingToggle staticOptions) blastQuery)
+ (\e -> do let err = show (e :: CE.IOException)
+ logWarning ("Warning: Blast attempt failed:" ++ " " ++ err) (tempDirPath staticOptions)
+ return (Left ""))
+ else CE.catch (blastHTTP blastQuery)
+ (\e -> do let err = show (e :: CE.IOException)
+ logWarning ("Warning: Blast attempt failed:" ++ " " ++ err) (tempDirPath staticOptions)
+ return (Left ""))
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_1blastOutput") (show blastOutput)
+ logEither blastOutput (tempDirPath staticOptions)
+ let blastHitsArePresent = either (const False) blastMatchesPresent blastOutput
+ if blastHitsArePresent
+ then do
+ let rightBlast = fromRight blastOutput
+ -- bestBlastHitTaxIdOutput <- retrieveBlastHitTaxIdEntrez [bestHit]
+ -- let taxIdFromEntrySummaries = extractTaxIdFromEntrySummaries bestBlastHitTaxIdOutput
+ -- if (null taxIdFromEntrySummaries) then (error "searchCandidates: - head: empty list of taxonomy entry summary for best hit") else return ()
+ -- let rightBestTaxIdResult = head taxIdFromEntrySummaries
+ -- logVerboseMessage (verbositySwitch staticOptions) ("rightbestTaxIdResult: " ++ (show rightBestTaxIdResult) ++ "\n") (tempDirPath staticOptions)
+ let blastHits = J._hits (J._search . J._results . J._report . J._blastoutput2 $ rightBlast)
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_2blastHits") (showlines blastHits)
+ --filter by length
+ let blastHitsFilteredByLength = filterByHitLength blastHits queryLength (lengthFilterToggle staticOptions)
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_3blastHitsFilteredByLength") (showlines blastHitsFilteredByLength)
+ let blastHitsFilteredByCoverage = filterByCoverage blastHitsFilteredByLength queryLength (coverageFilterToggle staticOptions)
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_3ablastHitsFilteredByLength") (showlines blastHitsFilteredByCoverage)
+ --tag BlastHits with TaxId
+ --blastHitsWithTaxIdOutput <- retrieveBlastHitsTaxIdEntrez blastHitsFilteredByCoverage
+ let blastHitsWithTaxId = extractBlastHitsTaxId blastHitsFilteredByCoverage
+ --let uncheckedBlastHitsWithTaxIdList = map (Control.Arrow.second extractTaxIdFromEntrySummaries) blastHitsWithTaxIdOutput
+ --let checkedBlastHitsWithTaxId = filter (\(_,taxids) -> not (null taxids)) uncheckedBlastHitsWithTaxIdList
+ --todo checked blasthittaxidswithblasthits need to be merged as taxid blasthit pairs
+ --let blastHitsWithTaxId = zip (concatMap fst checkedBlastHitsWithTaxId) (concatMap snd checkedBlastHitsWithTaxId)
+ blastHitsWithParentTaxIdOutput <- retrieveParentTaxIdsEntrez blastHitsWithTaxId
+ --let blastHitsWithParentTaxId = concat blastHitsWithParentTaxIdOutput
+ -- filter by ParentTaxId (only one hit per TaxId)
+ let blastHitsFilteredByParentTaxIdWithParentTaxId = filterByParentTaxId blastHitsWithParentTaxIdOutput True
+ --let blastHitsFilteredByParentTaxId = map fst blastHitsFilteredByParentTaxIdWithParentTaxId
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_4blastHitsFilteredByParentTaxId") (showlines blastHitsFilteredByParentTaxIdWithParentTaxId)
+ -- Filtering with TaxTree (only hits from the same subtree as besthit)
+ --let blastHitsWithTaxId = zip blastHitsFilteredByParentTaxId blastHittaxIdList
+ --let (_, filteredBlastResults) = filterByNeighborhoodTreeConditional alignndmentModeInfernalToggle upperTaxLimit blastHitsWithTaxId (inputTaxNodes staticOptions) (fromJust upperTaxLimit) (singleHitperTaxToggle staticOptions)
+ --writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_5filteredBlastResults") (showlines filteredBlastResults)
+ -- Coordinate generation
+ let nonEmptyfilteredBlastResults = filter (\(blasthit,_) -> not (null (J._hsps blasthit))) blastHitsFilteredByParentTaxIdWithParentTaxId
+ let requestedSequenceElements = map (getRequestedSequenceElement queryLength) nonEmptyfilteredBlastResults
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_6requestedSequenceElements") (showlines requestedSequenceElements)
+ -- Retrieval of full sequences from entrez
+ --fullSequencesWithSimilars <- retrieveFullSequences requestedSequenceElements
+ fullSequencesWithSimilars <- retrieveFullSequences staticOptions requestedSequenceElements
+ if null fullSequencesWithSimilars
+ then do
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_10afullSequencesWithSimilars") "No sequences retrieved"
+ CE.evaluate (SearchResult [] Nothing)
+ else do
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_10afullSequencesWithSimilars") (showlines fullSequencesWithSimilars)
+ let fullSequences = filterIdenticalSequences fullSequencesWithSimilars 100
+ --let fullSequencesWithOrigin = map (\(parsedFasta,taxid,seqSubject) -> (parsedFasta,taxid,seqSubject,'B')) fullSequences
+ writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_10fullSequences") (showlines fullSequences)
+ let maybeFractionEvalueMatch = getHitWithFractionEvalue rightBlast
+ if isNothing maybeFractionEvalueMatch
+ then CE.evaluate (SearchResult [] Nothing)
+ else do
+ let fractionEvalueMatch = fromJust maybeFractionEvalueMatch
+ let dbSize = computeDataBaseSize (J._evalue fractionEvalueMatch) (J._bit_score fractionEvalueMatch) (fromIntegral queryLength ::Double)
+ CE.evaluate (SearchResult fullSequences (Just dbSize))
+ else CE.evaluate (SearchResult [] Nothing)
+
+-- |Computes size of blast db in Mb
+computeDataBaseSize :: Double -> Double -> Double -> Double
+computeDataBaseSize evalue bitscore querylength = ((evalue * 2 ** bitscore) / querylength)/10^(6 :: Integer)
+
+alignCandidates :: StaticOptions -> ModelConstruction -> String -> SearchResult -> IO ([(Fasta () (),Int,B.ByteString)],[(Fasta () (),Int,B.ByteString)])
+alignCandidates staticOptions modelConstruction multipleSearchResultPrefix searchResults = do
+ let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/" ++ multipleSearchResultPrefix
+ createDirectoryIfMissing False (iterationDirectory ++ "log")
+ if null (candidates searchResults)
+ then do
+ writeFile (iterationDirectory ++ "log" ++ "/11candidates") "No candidates to align"
+ return ([],[])
+ else do
+ --refilter for similarity
+ writeFile (iterationDirectory ++ "log" ++ "/11candidates") (showlines (candidates searchResults))
+ let alignedSequences = map snd (V.toList (extractAlignedSequences (iterationNumber modelConstruction) modelConstruction))
+ let filteredCandidates = filterWithCollectedSequences (candidates searchResults) alignedSequences 99
+ writeFile (iterationDirectory ++ "log" ++ "/12candidatesFilteredByCollected") (showlines filteredCandidates)
+ if alignmentModeInfernal modelConstruction
+ then alignCandidatesInfernalMode staticOptions modelConstruction multipleSearchResultPrefix (blastDatabaseSize searchResults) filteredCandidates
+ else alignCandidatesInitialMode staticOptions modelConstruction multipleSearchResultPrefix filteredCandidates
+
+alignCandidatesInfernalMode :: StaticOptions -> ModelConstruction -> String -> Maybe Double -> [(Fasta () (),Int,B.ByteString)] -> IO ([(Fasta () (),Int,B.ByteString)],[(Fasta () (),Int,B.ByteString)])
+alignCandidatesInfernalMode staticOptions modelConstruction multipleSearchResultPrefix blastDbSize filteredCandidates = do
+ let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/" ++ multipleSearchResultPrefix
+ let candidateSequences = extractCandidateSequences filteredCandidates
+ logVerboseMessage (verbositySwitch staticOptions) "Alignment Mode Infernal\n" (tempDirPath staticOptions)
+ let indexedCandidateSequenceList = V.toList candidateSequences
+ let cmSearchFastaFilePaths = map (constructFastaFilePaths iterationDirectory) indexedCandidateSequenceList
+ let cmSearchFilePaths = map (constructCMsearchFilePaths iterationDirectory) indexedCandidateSequenceList
+ let covarianceModelPath = tempDirPath staticOptions ++ show (iterationNumber modelConstruction - 1) ++ "/" ++ "model.cm"
+ mapM_ (\(number,_nucleotideSequence) -> writeFastaFile (iterationDirectory ++ show number ++ ".fa") [_nucleotideSequence]) indexedCandidateSequenceList
+ let zippedFastaCMSearchResultPaths = zip cmSearchFastaFilePaths cmSearchFilePaths
+ --check with cmSearch
+ mapM_ (uncurry (systemCMsearch (cpuThreads staticOptions) ("-Z " ++ show (fromJust blastDbSize)) covarianceModelPath)) zippedFastaCMSearchResultPaths
+ cmSearchResults <- mapM readCMSearch cmSearchFilePaths
+ writeFile (iterationDirectory ++ "cm_error") (concatMap show (lefts cmSearchResults))
+ let rightCMSearchResults = rights cmSearchResults
+ let cmSearchCandidatesWithSequences = zip rightCMSearchResults filteredCandidates
+ let (trimmedSelectedCandidates,potentialCandidates,rejectedCandidates) = evaluePartitionTrimCMsearchHits (evalueThreshold modelConstruction) cmSearchCandidatesWithSequences
+ createDirectoryIfMissing False (iterationDirectory ++ "log")
+ writeFile (iterationDirectory ++ "log" ++ "/13selectedCandidates'") (showlines trimmedSelectedCandidates)
+ writeFile (iterationDirectory ++ "log" ++ "/14rejectedCandidates'") (showlines rejectedCandidates)
+ writeFile (iterationDirectory ++ "log" ++ "/15potentialCandidates'") (showlines potentialCandidates)
+ return (map snd trimmedSelectedCandidates,map snd potentialCandidates)
+
+alignCandidatesInitialMode :: StaticOptions -> ModelConstruction -> String -> [(Fasta () (),Int,B.ByteString)] -> IO ([(Fasta () (),Int,B.ByteString)],[(Fasta () (),Int,B.ByteString)])
+alignCandidatesInitialMode staticOptions modelConstruction multipleSearchResultPrefix filteredCandidates = do
+ let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/" ++ multipleSearchResultPrefix
+ --writeFile (iterationDirectory ++ "log" ++ "/11bcandidates") (showlines filteredCandidates)
+ createDirectoryIfMissing False (iterationDirectory ++ "log")
+ let candidateSequences = extractCandidateSequences filteredCandidates
+ --writeFile (iterationDirectory ++ "log" ++ "/11ccandidates") (showlines (V.toList candidateSequences))
+ logVerboseMessage (verbositySwitch staticOptions) "Alignment Mode Initial\n" (tempDirPath staticOptions)
+ --write Fasta sequences
+ let inputFastaFilepath = iterationDirectory ++ "input.fa"
+ let inputFoldFilepath = iterationDirectory ++ "input.fold"
+ writeFastaFile (iterationDirectory ++ "input.fa") [(head (inputFasta modelConstruction))]
+ logMessage (showlines (V.toList candidateSequences)) (tempDirPath staticOptions)
+ V.mapM_ (\(number,nucleotideSequence') -> writeFastaFile (iterationDirectory ++ show number ++ ".fa") [nucleotideSequence']) candidateSequences
+ let candidateFastaFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ ".fa") candidateSequences)
+ let candidateFoldFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ ".fold") candidateSequences)
+ let locarnainClustalw2FormatFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ "." ++ "clustalmlocarna") candidateSequences)
+ let candidateAliFoldFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ ".alifold") candidateSequences)
+ let locarnaFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ "." ++ "mlocarna") candidateSequences)
+ alignSequences "locarna" " --write-structure --free-endgaps=++-- " (replicate (V.length candidateSequences) inputFastaFilepath) candidateFastaFilepath locarnainClustalw2FormatFilepath locarnaFilepath
+ --compute SequenceIdentities
+ let sequenceIdentities = V.map (\(_,s) -> sequenceIdentity (head (inputFasta modelConstruction)) s/(100 :: Double)) candidateSequences
+ --compute SCI
+ systemRNAfold inputFastaFilepath inputFoldFilepath
+ inputfoldResult <- readRNAfold inputFoldFilepath
+ let inputFoldMFE = foldingEnergy (fromRight inputfoldResult)
+ mapM_ (uncurry systemRNAfold) (zip candidateFastaFilepath candidateFoldFilepath)
+ foldResults <- mapM readRNAfold candidateFoldFilepath
+ let candidateMFEs = map (foldingEnergy . fromRight) foldResults
+ let averageMFEs = map (\candidateMFE -> (candidateMFE + inputFoldMFE)/2) candidateMFEs
+ mapM_ (uncurry (systemRNAalifold "")) (zip locarnainClustalw2FormatFilepath candidateAliFoldFilepath)
+ alifoldResults <- mapM readRNAalifold candidateAliFoldFilepath
+ let consensusMFE = map (alignmentConsensusMinimumFreeEnergy . fromRight) alifoldResults
+ let sciidfraction = map (\(consMFE,averMFE,seqId) -> (consMFE/averMFE)/seqId) (zip3 consensusMFE averageMFEs (V.toList sequenceIdentities))
+ let idlog = concatMap (\(sciidfraction',consMFE,averMFE,seqId) -> show sciidfraction' ++ "," ++ show consMFE ++ "," ++ show averMFE ++ "," ++ show seqId ++ "\n")(zip4 sciidfraction consensusMFE averageMFEs (V.toList sequenceIdentities))
+ writeFile (iterationDirectory ++ "log" ++ "/idlog") idlog
+ let alignedCandidates = zip sciidfraction filteredCandidates
+ writeFile (iterationDirectory ++ "log" ++ "/zscores") (showlines alignedCandidates)
+ let (selectedCandidates,rejectedCandidates) = partition (\(sciidfraction',_) -> sciidfraction' > nSCICutoff staticOptions) alignedCandidates
+ mapM_ print (zip3 consensusMFE averageMFEs (V.toList sequenceIdentities))
+ writeFile (iterationDirectory ++ "log" ++ "/13selectedCandidates") (showlines selectedCandidates)
+ writeFile (iterationDirectory ++ "log" ++ "/14rejectedCandidates") (showlines rejectedCandidates)
+ return (map snd selectedCandidates,[])
+
+setClusterNumber :: Int -> Int
+setClusterNumber x
+ | x <= 5 = x
+ | otherwise = 5
+
+findCutoffforClusterNumber :: Dendrogram a -> Int -> Distance -> Distance
+findCutoffforClusterNumber clustaloDendrogram numberOfClusters currentCutoff
+ | currentClusterNumber >= numberOfClusters = currentCutoff
+ | otherwise = findCutoffforClusterNumber clustaloDendrogram numberOfClusters (currentCutoff-0.01)
+ where currentClusterNumber = length (cutAt clustaloDendrogram currentCutoff)
+
+-- Selects Query sequence ids from all collected seqeuences. Queries are then fetched by extractQueries function.
+selectQueries :: StaticOptions -> ModelConstruction -> [(Fasta () (),Int,B.ByteString)] -> IO [Fasta () ()]
+selectQueries staticOptions modelConstruction selectedCandidates = do
+ logVerboseMessage (verbositySwitch staticOptions) "SelectQueries\n" (tempDirPath staticOptions)
+ --Extract sequences from modelconstruction
+ let alignedSequences = extractAlignedSequences (iterationNumber modelConstruction) modelConstruction
+ let candidateSequences = extractQueryCandidates selectedCandidates
+ let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/"
+ let stockholmFilepath = iterationDirectory ++ "model" ++ ".stockholm"
+ let alignmentSequences = map snd (V.toList (V.concat [candidateSequences,alignedSequences]))
+ if length alignmentSequences > 3
+ then
+ if (querySelectionMethod staticOptions) == "clustering"
+ then do
+ --write Fasta sequences
+ writeFastaFile (iterationDirectory ++ "query" ++ ".fa") alignmentSequences
+ let fastaFilepath = iterationDirectory ++ "query" ++ ".fa"
+ let clustaloFilepath = iterationDirectory ++ "query" ++ ".clustalo"
+ let clustaloDistMatrixPath = iterationDirectory ++ "query" ++ ".matrix"
+ alignSequences "clustalo" ("--full --distmat-out=" ++ clustaloDistMatrixPath ++ " ") [fastaFilepath] [] [clustaloFilepath] []
+ idsDistancematrix <- readClustaloDistMatrix clustaloDistMatrixPath
+ logEither idsDistancematrix (tempDirPath staticOptions)
+ let (clustaloIds,clustaloDistMatrix) = fromRight idsDistancematrix
+ logVerboseMessage (verbositySwitch staticOptions) ("Clustalid: " ++ intercalate "," clustaloIds ++ "\n") (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) ("Distmatrix: " ++ show clustaloDistMatrix ++ "\n") (tempDirPath staticOptions)
+ let clustaloDendrogram = dendrogram UPGMA clustaloIds (getDistanceMatrixElements clustaloIds clustaloDistMatrix)
+ logVerboseMessage (verbositySwitch staticOptions) ("ClustaloDendrogram: " ++ show clustaloDendrogram ++ "\n") (tempDirPath staticOptions)
+ logVerboseMessage (verbositySwitch staticOptions) ("ClustaloDendrogram: " ++ show clustaloDistMatrix ++ "\n") (tempDirPath staticOptions)
+ let numberOfClusters = setClusterNumber (length alignmentSequences)
+ logVerboseMessage (verbositySwitch staticOptions) ("numberOfClusters: " ++ show numberOfClusters ++ "\n") (tempDirPath staticOptions)
+ let dendrogramStartCutDistance = 1 :: Double
+ let dendrogramCutDistance' = findCutoffforClusterNumber clustaloDendrogram numberOfClusters dendrogramStartCutDistance
+ logVerboseMessage (verbositySwitch staticOptions) ("dendrogramCutDistance': " ++ show dendrogramCutDistance' ++ "\n") (tempDirPath staticOptions)
+ let cutDendrogram = cutAt clustaloDendrogram dendrogramCutDistance'
+ --putStrLn "cutDendrogram: "
+ --print cutDendrogram
+ let currentSelectedSequenceIds = map B.pack (take (queryNumber staticOptions) (concatMap (take 1 . elements) cutDendrogram))
+ --let alignedSequences = fastaSeqData:map nucleotideSequence (concatMap sequenceRecords (taxRecords modelconstruction))
+ let fastaSelectedSequences = concatMap (filterSequenceById alignmentSequences) currentSelectedSequenceIds
+ stockholmSelectedSequences <- extractAlignmentSequencesByIds stockholmFilepath currentSelectedSequenceIds
+ --Stockholm sequnces contain conservation annotation from cmalign in infernal mode
+ let currentSelectedSequences = if (blastSoftmaskingToggle staticOptions) then stockholmSelectedSequences else fastaSelectedSequences
+ --let currentSelectedQueries = concatMap (\querySeqId -> filter (\alignedSeq -> L.unpack (fastaHeader alignedSeq) == querySeqId) alignmentSequences) querySeqIds
+ logVerboseMessage (verbositySwitch staticOptions) ("SelectedQueries: " ++ show currentSelectedSequences ++ "\n") (tempDirPath staticOptions)
+ writeFile (tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/log" ++ "/13selectedQueries") (showlines currentSelectedSequences)
+ CE.evaluate currentSelectedSequences
+ else do
+ let fastaSelectedSequences = filterIdenticalSequences' alignmentSequences (95 :: Double)
+ let currentSelectedSequenceIds = map fastaHeader (take (queryNumber staticOptions) fastaSelectedSequences)
+ stockholmSelectedSequences <- extractAlignmentSequencesByIds stockholmFilepath currentSelectedSequenceIds
+ let currentSelectedSequences = if (blastSoftmaskingToggle staticOptions) then stockholmSelectedSequences else fastaSelectedSequences
+ writeFile (tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/log" ++ "/13selectedQueries") (showlines currentSelectedSequences)
+ CE.evaluate currentSelectedSequences
+ else return []
+
+
+fastaHeader :: Fasta () () -> B.ByteString
+fastaHeader currentFasta = _sequenceIdentifier . _header $ currentFasta
+
+filterSequenceById :: [Fasta () ()] -> B.ByteString-> [Fasta () ()]
+filterSequenceById alignmentSequences querySequenceId = filter (seqenceHasId querySequenceId) alignmentSequences
+
+seqenceHasId :: B.ByteString -> Fasta () () -> Bool
+seqenceHasId querySequenceId alignmentSequence = fastaHeader alignmentSequence == querySequenceId
+
+constructModel :: ModelConstruction -> StaticOptions -> IO String
+constructModel modelConstruction staticOptions = do
+ --Extract sequences from modelconstruction
+ let alignedSequences = extractAlignedSequences (iterationNumber modelConstruction) modelConstruction
+ --The CM resides in the iteration directory where its input alignment originates from
+ let outputDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction - 1) ++ "/"
+ let alignmentSequences = map snd (V.toList (V.concat [alignedSequences]))
+ --write Fasta sequences
+ writeFastaFile (outputDirectory ++ "model" ++ ".fa") alignmentSequences
+ let fastaFilepath = outputDirectory ++ "model" ++ ".fa"
+ let locarnaFilepath = outputDirectory ++ "model" ++ ".mlocarna"
+ let stockholmFilepath = outputDirectory ++ "model" ++ ".stockholm"
+ --- let reformatedClustalFilepath = outputDirectory ++ "model" ++ ".clustal.reformated"
+ let updatedStructureStockholmFilepath = outputDirectory ++ "newstructuremodel" ++ ".stockholm"
+ let cmalignCMFilepath = tempDirPath staticOptions ++ show (iterationNumber modelConstruction - 2) ++ "/" ++ "model" ++ ".cm"
+ let cmFilepath = outputDirectory ++ "model" ++ ".cm"
+ let cmCalibrateFilepath = outputDirectory ++ "model" ++ ".cmcalibrate"
+ let cmBuildFilepath = outputDirectory ++ "model" ++ ".cmbuild"
+ let alifoldFilepath = outputDirectory ++ "model" ++ ".alifold"
+ let refinedAlignmentFilepath = outputDirectory ++ "modelrefined" ++ ".stockholm"
+ let cmBuildOptions ="--refine " ++ refinedAlignmentFilepath
+ if alignmentModeInfernal modelConstruction
+ then do
+ logVerboseMessage (verbositySwitch staticOptions) "Construct Model - infernal mode\n" (tempDirPath staticOptions)
+ systemCMalign ("--cpu " ++ show (cpuThreads staticOptions)) cmalignCMFilepath fastaFilepath stockholmFilepath
+ systemRNAalifold "-r --cfactor 0.6 --nfactor 0.5" stockholmFilepath alifoldFilepath
+ replaceStatus <- replaceStockholmStructure stockholmFilepath alifoldFilepath updatedStructureStockholmFilepath
+ if null replaceStatus
+ then do
+ systemCMbuild cmBuildOptions updatedStructureStockholmFilepath cmFilepath cmBuildFilepath
+ systemCMcalibrate "fast" (cpuThreads staticOptions) cmFilepath cmCalibrateFilepath
+ return cmFilepath
+ else do
+ logWarning ("Warning: A problem occured updating the secondary structure of iteration " ++ show (iterationNumber modelConstruction) ++ " stockholm alignment: " ++ replaceStatus) (tempDirPath staticOptions)
+ systemCMbuild cmBuildOptions stockholmFilepath cmFilepath cmBuildFilepath
+ systemCMcalibrate "fast" (cpuThreads staticOptions) cmFilepath cmCalibrateFilepath
+ return cmFilepath
+ else do
+ logVerboseMessage (verbositySwitch staticOptions) "Construct Model - initial mode\n" (tempDirPath staticOptions)
+ alignSequences "mlocarna" ("--threads=" ++ show (cpuThreads staticOptions) ++ " ") [fastaFilepath] [] [locarnaFilepath] []
+ mlocarnaAlignment <- readStructuralClustalAlignment locarnaFilepath
+ logEither mlocarnaAlignment (tempDirPath staticOptions)
+ let stockholAlignment = convertClustaltoStockholm (fromRight mlocarnaAlignment)
+ TI.writeFile stockholmFilepath stockholAlignment
+ _ <- systemCMbuild cmBuildOptions stockholmFilepath cmFilepath cmBuildFilepath
+ _ <- systemCMcalibrate "fast" (cpuThreads staticOptions) cmFilepath cmCalibrateFilepath
+ return cmFilepath
+
+-- | Replaces structure of input stockholm file with the consensus structure of alifoldFilepath and outputs updated stockholmfile
+replaceStockholmStructure :: String -> String -> String -> IO String
+replaceStockholmStructure stockholmFilepath alifoldFilepath updatedStructureStockholmFilepath = do
+ inputAln <- readFile stockholmFilepath
+ inputRNAalifold <- readRNAalifold alifoldFilepath
+ if isLeft inputRNAalifold
+ then
+ return (show (fromLeft inputRNAalifold))
+ else do
+ let alifoldstructure = alignmentConsensusDotBracket (fromRight inputRNAalifold)
+ let seedLinesVector = V.fromList (lines inputAln)
+ let structureIndices = V.toList (V.findIndices isStructureLine seedLinesVector)
+ let updatedStructureElements = updateStructureElements seedLinesVector alifoldstructure structureIndices
+ let newVector = seedLinesVector V.// updatedStructureElements
+ let newVectorString = unlines (V.toList newVector)
+ writeFile updatedStructureStockholmFilepath newVectorString
+ return []
+
+updateStructureElements :: V.Vector String -> String -> [Int] -> [(Int,String)]
+updateStructureElements inputVector structureString indices
+ | null indices = []
+ | otherwise = newElement ++ updateStructureElements inputVector (drop structureLength structureString) (tail indices)
+ where currentIndex = head indices
+ currentElement = inputVector V.! currentIndex
+ elementLength = length currentElement
+ structureStartIndex = maximum (elemIndices ' ' currentElement) + 1
+ structureLength = elementLength - structureStartIndex
+ newElementHeader = take structureStartIndex currentElement
+ newElementStructure = take structureLength structureString
+ newElement = [(currentIndex,newElementHeader ++ newElementStructure)]
+
+isStructureLine :: String -> Bool
+isStructureLine input = "#=GC SS_cons" `isInfixOf` input
+
+-- Generates iteration string for Log
+iterationSummaryLog :: ModelConstruction -> String
+iterationSummaryLog mC = output
+ where upperTaxonomyLimitOutput = maybe "not set" show (upperTaxonomyLimit mC)
+ output = "Upper taxonomy id limit: " ++ upperTaxonomyLimitOutput ++ ", Collected members: " ++ show (length (concatMap sequenceRecords (taxRecords mC))) ++ "\n"
+
+-- | Used for passing progress to Alien server
+iterationSummary :: ModelConstruction -> StaticOptions -> IO()
+iterationSummary mC sO = do
+ --iteration -- tax limit -- bitscore cutoff -- blastresult -- aligned seqs --queries --fa link --aln link --cm link
+ let upperTaxonomyLimitOutput = maybe "not set" show (upperTaxonomyLimit mC)
+ let output = show (iterationNumber mC) ++ "," ++ upperTaxonomyLimitOutput ++ "," ++ show (length (concatMap sequenceRecords (taxRecords mC)))
+ writeFile (tempDirPath sO ++ "/log/" ++ show (iterationNumber mC) ++ ".log") output
+
+-- | Used for passing progress to Alien server
+resultSummary :: ModelConstruction -> StaticOptions -> IO()
+resultSummary mC sO = do
+ --iteration -- tax limit -- bitscore cutoff -- blastresult -- aligned seqs --queries --fa link --aln link --cm link
+ let upperTaxonomyLimitOutput = maybe "not set" show (upperTaxonomyLimit mC)
+ let output = show (iterationNumber mC) ++ "," ++ upperTaxonomyLimitOutput ++ "," ++ show (length (concatMap sequenceRecords (taxRecords mC)))
+ writeFile (tempDirPath sO ++ "/log/result" ++ ".log") output
+
+readClustaloDistMatrix :: String -> IO (Either ParseError ([String],Matrix Double))
+readClustaloDistMatrix = parseFromFile genParserClustaloDistMatrix
+
+genParserClustaloDistMatrix :: GenParser Char st ([String],Matrix Double)
+genParserClustaloDistMatrix = do
+ _ <- many1 digit
+ newline
+ clustaloDistRow <- many1 (try genParserClustaloDistRow)
+ eof
+ return (map fst clustaloDistRow,fromLists (map snd clustaloDistRow))
+
+genParserClustaloDistRow :: GenParser Char st (String,[Double])
+genParserClustaloDistRow = do
+ entryId <- many1 (noneOf " ")
+ many1 space
+ distances <- many1 (try genParserClustaloDistance)
+ newline
+ return (entryId,distances)
+
+genParserClustaloDistance :: GenParser Char st Double
+genParserClustaloDistance = do
+ distance <- many1 (oneOf "1234567890.")
+ optional (try (char ' ' ))
+ return (readDouble distance)
+
+getDistanceMatrixElements :: [String] -> Matrix Double -> String -> String -> Double
+getDistanceMatrixElements ids distMatrix id1 id2 = distance
+ -- Data.Matrix is indexed starting with 1
+ where indexid1 = fromJust (elemIndex id1 ids) + 1
+ indexid2 = fromJust (elemIndex id2 ids) + 1
+ distance = getElem indexid1 indexid2 distMatrix
+
+-- | Filter duplicates removes hits in sequences that were already collected. This happens during revisiting the starting subtree.
+filterDuplicates :: ModelConstruction -> SearchResult -> SearchResult
+filterDuplicates modelConstruction inputSearchResult = uniqueSearchResult
+ where alignedSequences = map snd (V.toList (extractAlignedSequences (iterationNumber modelConstruction) modelConstruction))
+ collectedIdentifiers = map fastaHeader alignedSequences
+ uniques = filter (\(s,_,_) -> notElem (fastaHeader s) collectedIdentifiers) (candidates inputSearchResult)
+ uniqueSearchResult = SearchResult uniques (blastDatabaseSize inputSearchResult)
+
+-- | Filter a list of similar extended blast hits
+--filterIdenticalSequencesWithOrigin :: [(Fasta,Int,String,Char)] -> Double -> [(Fasta,Int,String,Char)]
+--filterIdenticalSequencesWithOrigin (headSequence:rest) identitycutoff = result
+-- where filteredSequences = filter (\x -> (sequenceIdentity (firstOfQuadruple headSequence) (firstOfQuadruple x)) < identitycutoff) rest
+-- result = headSequence:(filterIdenticalSequencesWithOrigin filteredSequences identitycutoff)
+--filterIdenticalSequencesWithOrigin [] _ = []
+
+-- | Filter a list of similar extended blast hits
+filterIdenticalSequences :: [(Fasta () (),Int,B.ByteString)] -> Double -> [(Fasta () (),Int,B.ByteString)]
+filterIdenticalSequences (headSequence:rest) identitycutoff = result
+ where filteredSequences = filter (\x -> sequenceIdentity (firstOfTriple headSequence) (firstOfTriple x) < identitycutoff) rest
+ result = headSequence:filterIdenticalSequences filteredSequences identitycutoff
+filterIdenticalSequences [] _ = []
+
+-- | Filter sequences too similar to already aligned sequences
+filterWithCollectedSequences :: [(Fasta () (),Int,B.ByteString)] -> [Fasta () ()] -> Double -> [(Fasta () (),Int,B.ByteString)]
+filterWithCollectedSequences inputCandidates collectedSequences identitycutoff = filter (isUnSimilarSequence collectedSequences identitycutoff . firstOfTriple) inputCandidates
+--filterWithCollectedSequences [] [] _ = []
+
+-- | Filter alignment entries by similiarity
+filterIdenticalSequences' :: [Fasta () ()] -> Double -> [Fasta () ()]
+filterIdenticalSequences' (headEntry:rest) identitycutoff = result
+ where filteredEntries = filter (\ x -> sequenceIdentity headEntry x < identitycutoff) rest
+ result = headEntry:filterIdenticalSequences' filteredEntries identitycutoff
+filterIdenticalSequences' [] _ = []
+
+---- | Filter alignment entries by similiarity
+--filterIdenticalAlignmentEntry :: [ClustalAlignmentEntry] -> Double -> [ClustalAlignmentEntry]
+--filterIdenticalAlignmentEntry (headEntry:rest) identitycutoff = result
+-- where filteredEntries = filter (\x -> (stringIdentity (entryAlignedSequence headEntry) (entryAlignedSequence x)) < identitycutoff) rest
+-- result = headEntry:filterIdenticalAlignmentEntry filteredEntries identitycutoff
+--filterIdenticalAlignmentEntry [] _ = []
+
+isUnSimilarSequence :: [Fasta () ()] -> Double -> Fasta () () -> Bool
+isUnSimilarSequence collectedSequences identitycutoff checkSequence = any (\ x -> sequenceIdentity checkSequence x < identitycutoff) collectedSequences
+
+firstOfTriple :: (t, t1, t2) -> t
+firstOfTriple (a,_,_) = a
+
+-- | Check if the result field of BlastResult is filled and if hits are present
+blastMatchesPresent :: J.BlastJSON2 -> Bool
+blastMatchesPresent blastJS2
+ | null resultList = False
+ | otherwise = True
+ where resultList = concatMap J._hsps ((Data.Foldable.toList . J._hits . J._search . J._results . J._report . J._blastoutput2 $ blastJS2))
+
+-- | Compute identity of sequences
+textIdentity :: T.Text -> T.Text -> Double
+textIdentity text1 text2 = identityPercent
+ where distance = TM.hamming text1 text2
+ --Replication of RNAz select sequences requires only allowing substitutions
+ --costs = ED.defaultEditCosts {ED.deletionCosts = ED.ConstantCost 100,ED.insertionCosts = ED.ConstantCost 100,ED.transpositionCosts = ED.ConstantCost 100}
+ maximumDistance = maximum [T.length text1, T.length text2]
+ distanceDouble = toInteger ( fromJust distance )
+ identityPercent = 1 - (fromIntegral distanceDouble/fromIntegral maximumDistance)
+
+
+-- | Compute identity of sequences
+-- stringIdentity :: String -> String -> Double
+-- stringIdentity string1 string2 = identityPercent
+-- where distance = ED.levenshteinDistance costs string1 string2
+-- --Replication of RNAz select sequences requires only allowing substitutions
+-- costs = ED.defaultEditCosts {ED.deletionCosts = ED.ConstantCost 100,ED.insertionCosts = ED.ConstantCost 100,ED.transpositionCosts = ED.ConstantCost 100}
+-- maximumDistance = maximum [length string1,length string2]
+-- identityPercent = 1 - (fromIntegral distance/fromIntegral maximumDistance)
+
+-- | Compute identity of sequences
+sequenceIdentity :: Fasta () () -> Fasta () () -> Double
+sequenceIdentity sequence1 sequence2 = identityPercent
+ where distance = ED.levenshteinDistance ED.defaultEditCosts sequence1string sequence2string
+ sequence1string = B.unpack . _bioSequence . _fasta $ sequence1
+ sequence2string = B.unpack . _bioSequence . _fasta $ sequence2
+ maximumDistance = maximum [length sequence1string,length sequence2string]
+ identityPercent = 100 - ((fromIntegral distance/fromIntegral maximumDistance) * (read "100" ::Double))
+
+getTaxonomicContextEntrez :: Maybe Int -> Maybe Taxon -> IO (Maybe Taxon)
+getTaxonomicContextEntrez upperTaxLimit currentTaxonomicContext =
+ if isJust upperTaxLimit
+ then if isJust currentTaxonomicContext
+ then return currentTaxonomicContext
+ else retrieveTaxonomicContextEntrez (fromJust upperTaxLimit)
+ --return retrievedTaxonomicContext
+ else return Nothing
+
+setTaxonomicContextEntrez :: Int -> Maybe Taxon -> Maybe Int -> (Maybe Int, Maybe Int)
+setTaxonomicContextEntrez currentIterationNumber currentTaxonomicContext subTreeTaxId
+ | currentIterationNumber == 0 = (subTreeTaxId, Nothing)
+ | otherwise = setUpperLowerTaxLimitEntrez (fromJust subTreeTaxId) (fromJust currentTaxonomicContext)
+
+-- setTaxonomic Context for next candidate search, the upper bound of the last search become the lower bound of the next
+setUpperLowerTaxLimitEntrez :: Int -> Taxon -> (Maybe Int, Maybe Int)
+setUpperLowerTaxLimitEntrez subTreeTaxId currentTaxonomicContext = (upperLimit,lowerLimit)
+ where upperLimit = raiseTaxIdLimitEntrez subTreeTaxId currentTaxonomicContext
+ lowerLimit = Just subTreeTaxId
+
+raiseTaxIdLimitEntrez :: Int -> Taxon -> Maybe Int
+raiseTaxIdLimitEntrez subTreeTaxId taxon = parentNodeTaxId
+ where lastUpperBoundNodeIndex = fromJust (V.findIndex (\node -> lineageTaxId node == subTreeTaxId) lineageExVector)
+ linageNodeTaxId = Just (lineageTaxId (lineageExVector V.! (lastUpperBoundNodeIndex -1)))
+ lineageExVector = V.fromList (lineageEx taxon)
+ --the input taxid is not part of the lineage, therefor we look for further taxids in the lineage after we used the parent tax id of the input node
+ parentNodeTaxId = if subTreeTaxId == taxonTaxId taxon then Just (taxonParentTaxId taxon) else linageNodeTaxId
+
+constructNext :: Int -> ModelConstruction -> [(Fasta () (),Int,B.ByteString)] -> Maybe Int -> Maybe Taxon -> [Fasta () ()] -> [SearchResult] -> Bool -> ModelConstruction
+constructNext currentIterationNumber modelconstruction alignmentResults upperTaxLimit inputTaxonomicContext inputSelectedQueries inputPotentialMembers toggleInfernalAlignmentModeTrue = nextModelConstruction
+ where newIterationNumber = currentIterationNumber + 1
+ taxEntries = taxRecords modelconstruction ++ buildTaxRecords alignmentResults currentIterationNumber
+ potMembers = potentialMembers modelconstruction ++ inputPotentialMembers
+ currentAlignmentMode = toggleInfernalAlignmentModeTrue || alignmentModeInfernal modelconstruction
+ nextModelConstruction = ModelConstruction newIterationNumber (inputFasta modelconstruction) taxEntries upperTaxLimit inputTaxonomicContext (evalueThreshold modelconstruction) currentAlignmentMode inputSelectedQueries potMembers
+
+buildTaxRecords :: [(Fasta () (),Int,B.ByteString)] -> Int -> [TaxonomyRecord]
+buildTaxRecords alignmentResults currentIterationNumber = taxonomyRecords
+ where taxIdGroups = groupBy sameTaxIdAlignmentResult alignmentResults
+ taxonomyRecords = map (buildTaxRecord currentIterationNumber) taxIdGroups
+
+sameTaxIdAlignmentResult :: (Fasta () (),Int,B.ByteString) -> (Fasta () (),Int,B.ByteString) -> Bool
+sameTaxIdAlignmentResult (_,taxId1,_) (_,taxId2,_) = taxId1 == taxId2
+
+buildTaxRecord :: Int -> [(Fasta () (),Int,B.ByteString)] -> TaxonomyRecord
+buildTaxRecord currentIterationNumber entries = taxRecord
+ where recordTaxId = (\(_,currentTaxonomyId,_) -> currentTaxonomyId) (head entries)
+ seqRecords = map (buildSeqRecord currentIterationNumber) entries
+ taxRecord = TaxonomyRecord recordTaxId seqRecords
+
+buildSeqRecord :: Int -> (Fasta () (),Int,B.ByteString) -> SequenceRecord
+buildSeqRecord currentIterationNumber (parsedFasta,_,seqSubject) = SequenceRecord parsedFasta currentIterationNumber seqSubject
+
+-- | Partitions sequences by containing a cmsearch hit and extracts the hit region as new sequence
+evaluePartitionTrimCMsearchHits :: Double -> [(CMsearch,(Fasta () (), Int, B.ByteString))] -> ([(CMsearch,(Fasta () (), Int, B.ByteString))],[(CMsearch,(Fasta () (), Int, B.ByteString))],[(CMsearch,(Fasta () (), Int, B.ByteString))])
+evaluePartitionTrimCMsearchHits eValueThreshold cmSearchCandidatesWithSequences = (trimmedSelectedCandidates,potentialCandidates,rejectedCandidates)
+ where potentialMemberseValueThreshold = eValueThreshold * 1000
+ (prefilteredCandidates,rejectedCandidates) = partition (\(cmSearchResult,_) -> any (\hitScore' -> potentialMemberseValueThreshold >= hitEvalue hitScore') (cmsearchHits cmSearchResult)) cmSearchCandidatesWithSequences
+ (selectedCandidates,potentialCandidates) = partition (\(cmSearchResult,_) -> any (\hitScore' -> eValueThreshold >= hitEvalue hitScore') (cmsearchHits cmSearchResult)) prefilteredCandidates
+ trimmedSelectedCandidates = map (\(cmSearchResult,inputSequence) -> (cmSearchResult,trimCMsearchHit cmSearchResult inputSequence)) selectedCandidates
+
+
+trimCMsearchHit :: CMsearch -> (Fasta () (), Int, B.ByteString) -> (Fasta () (), Int, B.ByteString)
+trimCMsearchHit cmSearchResult (inputSequence,b,c) = (subSequence,b,c)
+ where hitScoreEntry = head (cmsearchHits cmSearchResult)
+ sequenceString = B.unpack . _bioSequence . _fasta $ inputSequence
+ sequenceSubstring = cmSearchsubString (hitStart hitScoreEntry) (hitEnd hitScoreEntry) sequenceString
+ --extend original seqheader
+ newSequenceHeader = SequenceIdentifier (B.pack (B.unpack (fastaHeader inputSequence) ++ "cmS_" ++ show (hitStart hitScoreEntry) ++ "_" ++ show (hitEnd hitScoreEntry) ++ "_" ++ show (hitStrand hitScoreEntry)))
+ subSequence = Fasta newSequenceHeader (BioSequence (B.pack sequenceSubstring))
+
+-- | Extract a substring with coordinates from cmsearch, first nucleotide has index 1
+cmSearchsubString :: Int -> Int -> String -> String
+cmSearchsubString startSubString endSubString inputString
+ | startSubString < endSubString = take (endSubString - (startSubString -1))(drop (startSubString - 1) inputString)
+ | startSubString > endSubString = take (reverseEnd - (reverseStart - 1))(drop (reverseStart - 1 ) (reverse inputString))
+ | otherwise = take (endSubString - (startSubString -1))(drop (startSubString - 1) inputString)
+ where stringLength = length inputString
+ reverseStart = stringLength - (startSubString + 1)
+ reverseEnd = stringLength - (endSubString - 1)
+
+extractQueries :: Int -> ModelConstruction -> [Fasta () ()]
+extractQueries foundSequenceNumber modelconstruction
+ | foundSequenceNumber < 3 = fastaSeqData
+ | otherwise = querySequences'
+ where fastaSeqData = inputFasta modelconstruction
+ querySequences' = selectedQueries modelconstruction
+
+extractQueryCandidates :: [(Fasta () (),Int,B.ByteString)] -> V.Vector (Int,Fasta () ())
+extractQueryCandidates querycandidates = indexedSeqences
+ where sequences = map (\(candidateSequence,_,_) -> candidateSequence) querycandidates
+ indexedSeqences = V.map (\(number,candidateSequence) -> (number + 1,candidateSequence))(V.indexed (V.fromList sequences))
+
+buildTaxFilterQuery :: Maybe Int -> Maybe Int -> String
+buildTaxFilterQuery upperTaxLimit lowerTaxLimit
+ | isNothing upperTaxLimit = ""
+ | isNothing lowerTaxLimit = "&ENTREZ_QUERY=" ++ encodedTaxIDQuery (fromJust upperTaxLimit)
+ | otherwise = "&ENTREZ_QUERY=" ++ "%28txid" ++ show (fromJust upperTaxLimit) ++ "%5BORGN%5D%29" ++ "NOT" ++ "%28txid" ++ show (fromJust lowerTaxLimit) ++ "%5BORGN%5D&EQ_OP%29"
+
+buildHitNumberQuery :: String -> String
+buildHitNumberQuery hitNumber
+ | hitNumber == "" = ""
+ | otherwise = "&ALIGNMENTS=" ++ hitNumber
+
+encodedTaxIDQuery :: Int -> String
+encodedTaxIDQuery taxID = "txid" ++ show taxID ++ "%20%5BORGN%5D&EQ_OP"
+
+-- | Adds cm prefix to pseudo random number
+randomid :: Int16 -> String
+randomid number = "cm" ++ show number
+
+-- | Create session id for RNAlien
+createSessionID :: Maybe String -> IO String
+createSessionID sessionIdentificator =
+ if isJust sessionIdentificator
+ then return (fromJust sessionIdentificator)
+ else do
+ randomNumber <- randomIO :: IO Int16
+ let sessionId = randomid (abs (randomNumber))
+ return sessionId
+
+-- | Run external locarna command and read the output into the corresponding datatype
+systemlocarna :: String -> (String,String,String,String) -> IO ExitCode
+systemlocarna options (inputFilePath1, inputFilePath2, clustalformatoutputFilePath, outputFilePath) = system ("locarna " ++ options ++ " --clustal=" ++ clustalformatoutputFilePath ++ " " ++ inputFilePath1 ++ " " ++ inputFilePath2 ++ " > " ++ outputFilePath)
+
+-- | Run external mlocarna command and read the output into the corresponding datatype, there is also a folder created at the location of the input fasta file
+systemMlocarna :: String -> (String,String) -> IO ExitCode
+systemMlocarna options (inputFilePath, outputFilePath) = system ("mlocarna " ++ options ++ " " ++ inputFilePath ++ " > " ++ outputFilePath)
+
+-- | Run external mlocarna command and read the output into the corresponding datatype, there is also a folder created at the location of the input fasta file, the job is terminated after the timeout provided in seconds
+systemMlocarnaWithTimeout :: String -> String -> (String,String) -> IO ExitCode
+systemMlocarnaWithTimeout timeout options (inputFilePath, outputFilePath) = system ("timeout " ++ timeout ++"s "++ "mlocarna " ++ options ++ " " ++ inputFilePath ++ " > " ++ outputFilePath)
+
+-- | Run external clustalo command and return the Exitcode
+systemClustalw2 :: String -> (String,String,String) -> IO ExitCode
+systemClustalw2 options (inputFilePath, outputFilePath, summaryFilePath) = system ("clustalw2 " ++ options ++ "-INFILE=" ++ inputFilePath ++ " -OUTFILE=" ++ outputFilePath ++ ">" ++ summaryFilePath)
+
+-- | Run external clustalo command and return the Exitcode
+systemClustalo :: String -> (String,String) -> IO ExitCode
+systemClustalo options (inputFilePath, outputFilePath) = system ("clustalo " ++ options ++ "--infile=" ++ inputFilePath ++ " >" ++ outputFilePath)
+
+-- | Run external CMbuild command and read the output into the corresponding datatype
+systemCMbuild :: String -> String -> String -> String -> IO ExitCode
+systemCMbuild options alignmentFilepath modelFilepath outputFilePath = system ("cmbuild " ++ options ++ " " ++ modelFilepath ++ " " ++ alignmentFilepath ++ " > " ++ outputFilePath)
+
+-- | Run CMCompare and read the output into the corresponding datatype
+systemCMcompare :: String -> String -> String -> IO ExitCode
+systemCMcompare model1path model2path outputFilePath = system ("CMCompare -q " ++ model1path ++ " " ++ model2path ++ " >" ++ outputFilePath)
+
+-- | Run CMsearch
+systemCMsearch :: Int -> String -> String -> String -> String -> IO ExitCode
+systemCMsearch cpus options covarianceModelPath sequenceFilePath outputPath = system ("cmsearch --notrunc --cpu " ++ show cpus ++ " " ++ options ++ " -g " ++ covarianceModelPath ++ " " ++ sequenceFilePath ++ "> " ++ outputPath)
+
+-- | Run CMstat
+systemCMstat :: String -> String -> IO ExitCode
+systemCMstat covarianceModelPath outputPath = system ("cmstat " ++ covarianceModelPath ++ " > " ++ outputPath)
+
+-- | Run CMcalibrate and return exitcode
+systemCMcalibrate :: String -> Int -> String -> String -> IO ExitCode
+systemCMcalibrate mode cpus covarianceModelPath outputPath
+ | mode == "fast" = system ("cmcalibrate --beta 1E-4 --cpu " ++ show cpus ++ " " ++ covarianceModelPath ++ "> " ++ outputPath)
+ | otherwise = system ("cmcalibrate --cpu " ++ show cpus ++ " " ++ covarianceModelPath ++ "> " ++ outputPath)
+
+
+-- | Run CMcalibrate and return exitcode
+systemCMalign :: String -> String -> String -> String -> IO ExitCode
+systemCMalign options filePathCovarianceModel filePathSequence filePathAlignment = system ("cmalign " ++ options ++ " " ++ filePathCovarianceModel ++ " " ++ filePathSequence ++ "> " ++ filePathAlignment)
+
+compareCM :: String -> String -> String -> IO (Either String Double)
+compareCM rfamCMPath resultCMpath outputDirectory = do
+ let myOptions = defaultDecodeOptions {
+ decDelimiter = fromIntegral (ord ' ')
+ }
+ let rfamCMFileName = FP.takeBaseName rfamCMPath
+ let resultCMFileName = FP.takeBaseName resultCMpath
+ let cmcompareResultPath = outputDirectory ++ rfamCMFileName ++ resultCMFileName ++ ".cmcompare"
+ _ <- systemCMcompare rfamCMPath resultCMpath cmcompareResultPath
+ inputCMcompare <- readFile cmcompareResultPath
+ let singlespaceCMcompare = unwords(words inputCMcompare)
+ let decodedCmCompareOutput = head (V.toList (fromRight (decodeWith myOptions NoHeader (L.pack singlespaceCMcompare) :: Either String (V.Vector [String]))))
+ --two.cm three.cm 27.996 19.500 CCCAAAGGGCCCAAAGGG (((...)))(((...))) (((...)))(((...))) [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17] [11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27]
+ let bitscore1 = read (decodedCmCompareOutput !! 2) :: Double
+ let bitscore2 = read (decodedCmCompareOutput !! 3) :: Double
+ let minmax = minimum [bitscore1,bitscore2]
+ return (Right minmax)
+
+readInt :: String -> Int
+readInt = read
+
+readDouble :: String -> Double
+readDouble = read
+
+extractCandidateSequences :: [(Fasta () (),Int,B.ByteString)] -> V.Vector (Int,Fasta () ())
+extractCandidateSequences candidates' = indexedSeqences
+ where sequences = map (\(inputSequence,_,_) -> inputSequence) candidates'
+ indexedSeqences = V.map (\(number,inputSequence) -> (number + 1,inputSequence))(V.indexed (V.fromList sequences))
+
+extractAlignedSequences :: Int -> ModelConstruction -> V.Vector (Int,Fasta () ())
+extractAlignedSequences iterationnumber modelconstruction
+ | iterationnumber == 0 = V.map (\(number,seq') -> (number + 1,seq')) (V.indexed (V.fromList inputSequence))
+ | otherwise = indexedSeqRecords
+ where inputSequence = inputFasta modelconstruction
+ seqRecordsperTaxrecord = map sequenceRecords (taxRecords modelconstruction)
+ seqRecords = concat seqRecordsperTaxrecord
+ --alignedSeqRecords = filter (\seqRec -> (aligned seqRec) > 0) seqRecords
+ indexedSeqRecords = V.map (\(number,seq') -> (number + 1,seq')) (V.indexed (V.fromList (inputSequence ++ map nucleotideSequence seqRecords)))
+
+filterByParentTaxId :: [(J.Hit,Int)] -> Bool -> [(J.Hit,Int)]
+filterByParentTaxId blastHitsWithParentTaxId singleHitPerParentTaxId
+ | singleHitPerParentTaxId = singleBlastHitperParentTaxId
+ | otherwise = blastHitsWithParentTaxId
+ where blastHitsWithParentTaxIdSortedByParentTaxId = sortBy compareTaxId blastHitsWithParentTaxId
+ blastHitsWithParentTaxIdGroupedByParentTaxId = groupBy sameTaxId blastHitsWithParentTaxIdSortedByParentTaxId
+ singleBlastHitperParentTaxId = map (maximumBy compareHitEValue) blastHitsWithParentTaxIdGroupedByParentTaxId
+
+filterByHitLength :: DS.Seq J.Hit -> Int -> Bool -> DS.Seq J.Hit
+filterByHitLength blastHits queryLength filterOn
+ | filterOn = filteredBlastHits
+ | otherwise = blastHits
+ where filteredBlastHits = DS.filter (hitLengthCheck queryLength) blastHits
+
+-- | Hits should have a compareable length to query
+hitLengthCheck :: Int -> J.Hit -> Bool
+hitLengthCheck queryLength blastHit = lengthStatus
+ where hsps = J._hsps blastHit
+ minHfrom = minimum (map J._hit_from hsps)
+ minHfromHSP = fromJust (find (\hsp -> minHfrom == J._hit_from hsp) hsps)
+ maxHto = maximum (map J._hit_to hsps)
+ maxHtoHSP = fromJust (find (\hsp -> maxHto == J._hit_to hsp) hsps)
+ minHonQuery = J._query_from minHfromHSP
+ maxHonQuery = J._query_to maxHtoHSP
+ startCoordinate = minHfrom - minHonQuery
+ endCoordinate = maxHto + (queryLength - maxHonQuery)
+ fullSeqLength = endCoordinate - startCoordinate
+ lengthStatus = fullSeqLength < (queryLength * 3)
+
+filterByCoverage :: DS.Seq J.Hit -> Int -> Bool -> DS.Seq J.Hit
+filterByCoverage blastHits queryLength filterOn
+ | filterOn = filteredBlastHits
+ | otherwise = blastHits
+ where filteredBlastHits = DS.filter (coverageCheck queryLength) blastHits
+
+-- | Hits should have a compareable length to query
+coverageCheck :: Int -> J.Hit -> Bool
+coverageCheck queryLength hit = coverageStatus
+ where hsps = J._hsps hit
+ maxIdentity = fromIntegral (maximum (map J._identity hsps))
+ coverageStatus = (maxIdentity/fromIntegral queryLength)* (100 :: Double) >= (80 :: Double)
+
+-- | Wrapper for retrieveFullSequence that rerequests incomplete return sequees
+retrieveFullSequences :: StaticOptions -> [(String,Int,Int,String,T.Text,Int,B.ByteString)] -> IO [(Fasta () (),Int,B.ByteString)]
+retrieveFullSequences staticOptions requestedSequences = do
+ if offline staticOptions
+ then do
+ fullSequences <- mapM (retrieveFullSequenceBlastDb (fromJust (blastDatabase staticOptions)) (tempDirPath staticOptions)) requestedSequences
+ if any (isNothing . firstOfTriple) fullSequences
+ then do
+ let fullSequencesWithRequestedSequences = zip fullSequences requestedSequences
+ --let (failedRetrievals, successfulRetrievals) = partition (\x -> L.null (unSD (seqdata (firstOfTriple (fst x))))) fullSequencesWithRequestedSequences
+ let (failedRetrievals, successfulRetrievals) = partition (isNothing . firstOfTriple . fst) fullSequencesWithRequestedSequences
+ --we try to reretrieve failed entries once
+ missingSequences <- mapM (retrieveFullSequence (tempDirPath staticOptions) .snd) failedRetrievals
+ let (stillMissingSequences,reRetrievedSequences) = partition (isNothing . firstOfTriple) missingSequences
+ logWarning ("Sequence retrieval failed: \n" ++ concatMap show stillMissingSequences ++ "\n") (tempDirPath staticOptions)
+ let unwrappedRetrievals = map (\(x,y,z) -> (fromJust x,y,z)) (map fst successfulRetrievals ++ reRetrievedSequences)
+ CE.evaluate unwrappedRetrievals
+ else CE.evaluate (map (\(x,y,z) -> (fromJust x,y,z)) fullSequences)
+ else do
+ fullSequences <- mapM (retrieveFullSequence (tempDirPath staticOptions)) requestedSequences
+ if any (isNothing . firstOfTriple) fullSequences
+ then do
+ let fullSequencesWithRequestedSequences = zip fullSequences requestedSequences
+ --let (failedRetrievals, successfulRetrievals) = partition (\x -> L.null (unSD (seqdata (firstOfTriple (fst x))))) fullSequencesWithRequestedSequences
+ let (failedRetrievals, successfulRetrievals) = partition (isNothing . firstOfTriple . fst) fullSequencesWithRequestedSequences
+ --we try to reretrieve failed entries once
+ missingSequences <- mapM (retrieveFullSequence (tempDirPath staticOptions) .snd) failedRetrievals
+ let (stillMissingSequences,reRetrievedSequences) = partition (isNothing . firstOfTriple) missingSequences
+ logWarning ("Sequence retrieval failed: \n" ++ concatMap show stillMissingSequences ++ "\n") (tempDirPath staticOptions)
+ let unwrappedRetrievals = map (\(x,y,z) -> (fromJust x,y,z)) (map fst successfulRetrievals ++ reRetrievedSequences)
+ CE.evaluate unwrappedRetrievals
+ else CE.evaluate (map (\(x,y,z) -> (fromJust x,y,z)) fullSequences)
+
+--retrieveFullSequenceBlastDb = retrieveFullSequence
+retrieveFullSequenceBlastDb :: String -> String -> (String,Int,Int,String,T.Text,Int,B.ByteString) -> IO (Maybe (Fasta () ()),Int,B.ByteString)
+retrieveFullSequenceBlastDb blastDb temporaryDirectoryPath (nucleotideId,seqStart,seqStop,strand,_,taxid,subject') = do
+ let sequencePath = temporaryDirectoryPath ++ "/" ++ nucleotideId ++ ".fa"
+ let cmd = "blastdbcmd -db " ++ blastDb ++ " -range " ++ (show seqStart) ++ "-" ++ (show seqStop) ++ " -strand " ++ (setBlastDbStrand strand) ++ " -entry " ++ nucleotideId ++ " -outfmt %f -target_only -out " ++ sequencePath
+ print cmd
+ system(cmd)
+ retrievedSequence <- readFastaFile sequencePath
+ if null retrievedSequence
+ then return(Nothing,taxid,subject')
+ else do
+ let justSequence = Just . head $ retrievedSequence
+ return(justSequence,taxid,subject')
+
+setBlastDbStrand :: String -> String
+setBlastDbStrand strand
+ | strand == "2" = "minus"
+ | strand == "1" = "plus"
+ | otherwise = "plus"
+
+retrieveFullSequence :: String -> (String,Int,Int,String,T.Text,Int,B.ByteString) -> IO (Maybe (Fasta () ()),Int,B.ByteString)
+retrieveFullSequence temporaryDirectoryPath (nucleotideId,seqStart,seqStop,strand,_,taxid,subject') = do
+ let program' = Just "efetch"
+ let database' = Just "nucleotide"
+ let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
+ let queryString = "id=" ++ nucleotideId ++ "&seq_start=" ++ show seqStart ++ "&seq_stop=" ++ show seqStop ++ "&rettype=fasta" ++ "&strand=" ++ strand ++ registrationInfo
+ let entrezQuery = EntrezHTTPQuery program' database' queryString
+ result <- CE.catch (entrezHTTP entrezQuery)
+ (\e -> do let err = show (e :: CE.IOException)
+ logWarning ("Warning: Full sequence retrieval failed:" ++ " " ++ err) temporaryDirectoryPath
+ return [])
+ if null result
+ then return (Nothing,taxid,subject')
+ else do
+ --let parsedFastas = (BFS.parseFasta (L.pack result))
+ let parsedFastas = byteStringToMultiFasta (L.pack result)
+ if (null parsedFastas)
+ then return (Nothing,taxid,subject')
+ else do
+ let parsedFasta = head parsedFastas
+ if null (B.unpack . _bioSequence . _fasta $ parsedFasta)
+ then return (Nothing,taxid,subject')
+ else CE.evaluate (Just parsedFasta,taxid,subject')
+
+getRequestedSequenceElement :: Int -> (J.Hit,Int) -> (String,Int,Int,String,T.Text,Int,B.ByteString)
+getRequestedSequenceElement queryLength (blastHit,taxid)
+ | blastHitIsReverseComplement (blastHit,taxid) = getReverseRequestedSequenceElement queryLength (blastHit,taxid)
+ | otherwise = getForwardRequestedSequenceElement queryLength (blastHit,taxid)
+
+blastHitIsReverseComplement :: (J.Hit,Int) -> Bool
+blastHitIsReverseComplement (blastHit,_) = isReverse
+ where blastMatch = head (J._hsps blastHit)
+ firstHSPfrom = J._hit_from blastMatch
+ firstHSPto = J._hit_to blastMatch
+ isReverse = firstHSPfrom > firstHSPto
+
+getForwardRequestedSequenceElement :: Int -> (J.Hit,Int) -> (String,Int,Int,String,T.Text,Int,B.ByteString)
+getForwardRequestedSequenceElement queryLength (blastHit,taxid) = (geneIdentifier',startcoordinate,endcoordinate,strand,accession',taxid,subjectBlast)
+ where accession' = J._accession . head . J._description $ blastHit
+ subjectBlast = E.encodeUtf8 . J._title . head . J._description $ blastHit
+ geneIdentifier' = extractGeneId blastHit
+ blastMatch = head (J._hsps blastHit)
+ blastHitOriginSequenceLength = J._len blastHit
+ minHfrom = J._hit_from blastMatch
+ maxHto = J._hit_to blastMatch
+ minHonQuery = J._query_from blastMatch
+ maxHonQuery = J._query_to blastMatch
+ --unsafe coordinates may exceed length of available sequence
+ unsafestartcoordinate = minHfrom - minHonQuery
+ unsafeendcoordinate = maxHto + (queryLength - maxHonQuery)
+ startcoordinate = lowerBoundryCoordinateSetter 0 unsafestartcoordinate
+ endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafeendcoordinate
+ strand = "1"
+ ----
+ --blastMatches = matches blastHit
+ --blastHitOriginSequenceLength = slength blastHit
+ --minHfrom = minimum (map h_from blastMatches)
+ --minHfromHSP = fromJust (find (\hsp -> minHfrom == h_from hsp) blastMatches)
+ --maxHto = maximum (map h_to blastMatches)
+ --maxHtoHSP = fromJust (find (\hsp -> maxHto == h_to hsp) blastMatches)
+ --minHonQuery = q_from minHfromHSP
+ --maxHonQuery = q_to maxHtoHSP
+ --unsafe coordinates may exceed length of available sequence
+ --unsafestartcoordinate = minHfrom - minHonQuery
+ --unsafeendcoordinate = maxHto + (queryLength - maxHonQuery)
+ --startcoordinate = lowerBoundryCoordinateSetter 0 unsafestartcoordinate
+ --endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafeendcoordinate
+ --strand = "1"
+
+lowerBoundryCoordinateSetter :: Int -> Int -> Int
+lowerBoundryCoordinateSetter lowerBoundry currentValue
+ | currentValue < lowerBoundry = lowerBoundry
+ | otherwise = currentValue
+
+upperBoundryCoordinateSetter :: Int -> Int -> Int
+upperBoundryCoordinateSetter upperBoundry currentValue
+ | currentValue > upperBoundry = upperBoundry
+ | otherwise = currentValue
+
+getReverseRequestedSequenceElement :: Int -> (J.Hit,Int) -> (String,Int,Int,String,T.Text,Int,B.ByteString)
+getReverseRequestedSequenceElement queryLength (blastHit,taxid) = (geneIdentifier',startcoordinate,endcoordinate,strand,accession',taxid,subjectBlast)
+ where accession' = J._accession . head . J._description $ blastHit
+ subjectBlast = E.encodeUtf8 . J._title . head . J._description $ blastHit
+ geneIdentifier' = extractGeneId blastHit
+ blastMatch = head (J._hsps blastHit)
+ blastHitOriginSequenceLength = J._len blastHit
+ maxHfrom = J._hit_from blastMatch
+ minHto = J._hit_to blastMatch
+ minHonQuery = J._query_from blastMatch
+ maxHonQuery = J._query_to blastMatch
+ --unsafe coordinates may exceed length of avialable sequence
+ unsafestartcoordinate = maxHfrom + minHonQuery
+ unsafeendcoordinate = minHto - (queryLength - maxHonQuery)
+ startcoordinate = lowerBoundryCoordinateSetter 0 unsafeendcoordinate
+ endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafestartcoordinate
+ strand = "2"
+ --
+ --blastMatches = matches blastHit
+ --blastHitOriginSequenceLength = slength blastHit
+ --maxHfrom = maximum (map h_from blastMatches)
+ --maxHfromHSP = fromJust (find (\hsp -> maxHfrom == h_from hsp) blastMatches)
+ --minHto = minimum (map h_to blastMatches)
+ --minHtoHSP = fromJust (find (\hsp -> minHto == h_to hsp) blastMatches)
+ --minHonQuery = q_from maxHfromHSP
+ --maxHonQuery = q_to minHtoHSP
+ --unsafe coordinates may exeed length of avialable sequence
+ --unsafestartcoordinate = maxHfrom + minHonQuery
+ --unsafeendcoordinate = minHto - (queryLength - maxHonQuery)
+ --startcoordinate = lowerBoundryCoordinateSetter 0 unsafeendcoordinate
+ --endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafestartcoordinate
+ --strand = "2"
+
+--computeAlignmentSCIs :: [String] -> [String] -> IO ()
+--computeAlignmentSCIs alignmentFilepaths rnazOutputFilepaths = do
+-- let zippedFilepaths = zip alignmentFilepaths rnazOutputFilepaths
+-- mapM_ systemRNAz zippedFilepaths
+
+alignSequences :: String -> String -> [String] -> [String] -> [String] -> [String] -> IO ()
+alignSequences program' options fastaFilepaths fastaFilepaths2 alignmentFilepaths summaryFilepaths = do
+ let zipped4Filepaths = zip4 fastaFilepaths fastaFilepaths2 alignmentFilepaths summaryFilepaths
+ let zipped3Filepaths = zip3 fastaFilepaths alignmentFilepaths summaryFilepaths
+ let zippedFilepaths = zip fastaFilepaths alignmentFilepaths
+ let timeout = "3600"
+ case program' of
+ "locarna" -> mapM_ (systemlocarna options) zipped4Filepaths
+ "mlocarna" -> mapM_ (systemMlocarna options) zippedFilepaths
+ "mlocarnatimeout" -> mapM_ (systemMlocarnaWithTimeout timeout options) zippedFilepaths
+ "clustalo" -> mapM_ (systemClustalo options) zippedFilepaths
+ _ -> mapM_ (systemClustalw2 options ) zipped3Filepaths
+
+constructFastaFilePaths :: String -> (Int, Fasta () ()) -> String
+constructFastaFilePaths currentDirectory (fastaIdentifier, _) = currentDirectory ++ show fastaIdentifier ++".fa"
+
+constructCMsearchFilePaths :: String -> (Int, Fasta () ()) -> String
+constructCMsearchFilePaths currentDirectory (fastaIdentifier, _) = currentDirectory ++ show fastaIdentifier ++".cmsearch"
+
+-- Smaller e-Values are greater, the maximum function is applied
+compareHitEValue :: (J.Hit,Int) -> (J.Hit,Int) -> Ordering
+compareHitEValue (hit1,_) (hit2,_)
+ | hitEValue hit1 > hitEValue hit2 = LT
+ | hitEValue hit1 < hitEValue hit2 = GT
+ -- in case of equal evalues the first hit is selected
+ | hitEValue hit1 == hitEValue hit2 = GT
+-- comparing (hitEValue . Down . fst)
+compareHitEValue (_,_) (_,_) = EQ
+
+compareTaxId :: (J.Hit,Int) -> (J.Hit,Int) -> Ordering
+compareTaxId (_,taxId1) (_,taxId2)
+ | taxId1 > taxId2 = LT
+ | taxId1 < taxId2 = GT
+ -- in case of equal evalues the first hit is selected
+ | taxId1 == taxId2 = EQ
+compareTaxId (_,_) (_,_) = EQ
+
+sameTaxId :: (J.Hit,Int) -> (J.Hit,Int) -> Bool
+sameTaxId (_,taxId1) (_,taxId2) = taxId1 == taxId2
+
+-- | NCBI uses the e-Value of the best HSP as the Hits e-Value
+hitEValue :: J.Hit -> Double
+hitEValue currentHit = minimum (map J._evalue (J._hsps currentHit))
+
+convertFastaFoldStockholm :: Fasta () () -> String -> String
+convertFastaFoldStockholm fastasequence foldedStructure = stockholmOutput
+ where alnHeader = "# STOCKHOLM 1.0\n\n"
+ --(L.unpack (fastaHeader inputFasta'))) ++ "\n" ++ (map toUpper (L.unpack (fastaSequence inputFasta'))) ++ "\n"
+ seqIdentifier = B.unpack . _sequenceIdentifier . _header $fastasequence
+ seqSequence = B.unpack . _bioSequence . _fasta $ fastasequence
+ identifierLength = length seqIdentifier
+ spacerLength' = maximum [14,identifierLength + 2]
+ spacer = replicate (spacerLength' - identifierLength) ' '
+ entrystring = seqIdentifier ++ spacer ++ seqSequence ++ "\n"
+ structureString = "#=GC SS_cons" ++ replicate (spacerLength' - 12) ' ' ++ foldedStructure ++ "\n"
+ bottom = "//"
+ stockholmOutput = alnHeader ++ entrystring ++ structureString ++ bottom
+
+convertClustaltoStockholm :: StructuralClustalAlignment -> T.Text
+convertClustaltoStockholm parsedMlocarnaAlignment = stockholmOutput
+ where alnHeader = T.pack "# STOCKHOLM 1.0\n\n"
+ clustalAlignment = structuralAlignmentEntries parsedMlocarnaAlignment
+ uniqueIds = nub (map entrySequenceIdentifier clustalAlignment)
+ mergedEntries = map (mergeEntry clustalAlignment) uniqueIds
+ maxIdentifierLenght = maximum (map (T.length . entrySequenceIdentifier) clustalAlignment)
+ spacerLength' = maxIdentifierLenght + 2
+ stockholmEntries = T.concat (map (buildStockholmAlignmentEntries spacerLength') mergedEntries)
+ structureString = T.pack "#=GC SS_cons" `T.append` T.replicate (spacerLength' - 12) (T.pack " ") `T.append` secondaryStructureTrack parsedMlocarnaAlignment `T.append` T.pack "\n"
+ bottom = T.pack "//"
+ stockholmOutput = alnHeader `T.append` stockholmEntries `T.append` structureString `T.append` bottom
+
+mergeEntry :: [ClustalAlignmentEntry] -> T.Text -> ClustalAlignmentEntry
+mergeEntry clustalAlignment uniqueId = mergedEntry
+ where idEntries = filter (\entry -> entrySequenceIdentifier entry==uniqueId) clustalAlignment
+ mergedSeq = foldr (T.append . entryAlignedSequence) (T.pack "") idEntries
+ mergedEntry = ClustalAlignmentEntry uniqueId mergedSeq
+
+buildStockholmAlignmentEntries :: Int -> ClustalAlignmentEntry -> T.Text
+buildStockholmAlignmentEntries inputSpacerLength entry = entrystring
+ where idLength = T.length (T.filter (/= '\n') (entrySequenceIdentifier entry))
+ spacer = T.replicate (inputSpacerLength - idLength) (T.pack " ")
+ entrystring = entrySequenceIdentifier entry `T.append` spacer `T.append` entryAlignedSequence entry `T.append` T.pack "\n"
+
+retrieveTaxonomicContextEntrez :: Int -> IO (Maybe Taxon)
+retrieveTaxonomicContextEntrez inputTaxId = do
+ let program' = Just "efetch"
+ let database' = Just "taxonomy"
+ let taxIdString = show inputTaxId
+ let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
+ let queryString = "id=" ++ taxIdString ++ registrationInfo
+ let entrezQuery = EntrezHTTPQuery program' database' queryString
+ result <- entrezHTTP entrezQuery
+ if null result
+ then do
+ error "Could not retrieve taxonomic context from NCBI Entrez, cannot proceed."
+ return Nothing
+ else do
+ let taxon = head (readEntrezTaxonSet result)
+ --print taxon
+ if null (lineageEx taxon)
+ then error "Retrieved taxonomic context taxon from NCBI Entrez with empty lineage, cannot proceed."
+ else return (Just taxon)
+
+retrieveParentTaxIdEntrez :: [(J.Hit,Int)] -> IO [(J.Hit,Int)]
+retrieveParentTaxIdEntrez blastHitsWithHitTaxids =
+ if not (null blastHitsWithHitTaxids)
+ then do
+ let program' = Just "efetch"
+ let database' = Just "taxonomy"
+ let extractedBlastHits = map fst blastHitsWithHitTaxids
+ let taxIds = map snd blastHitsWithHitTaxids
+ let taxIdStrings = map show taxIds
+ let taxIdQuery = intercalate "," taxIdStrings
+ let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
+ let queryString = "id=" ++ taxIdQuery ++ registrationInfo
+ let entrezQuery = EntrezHTTPQuery program' database' queryString
+ result <- entrezHTTP entrezQuery
+ let parentTaxIds = readEntrezParentIds result
+ if null parentTaxIds
+ then return []
+ else CE.evaluate (zip extractedBlastHits parentTaxIds)
+ else return []
+
+-- | Wrapper functions that ensures that only 20 queries are sent per request
+retrieveParentTaxIdsEntrez :: [(J.Hit,Int)] -> IO [(J.Hit,Int)]
+retrieveParentTaxIdsEntrez taxIdwithBlastHits = do
+ let splits = portionListElements taxIdwithBlastHits 20
+ taxIdsOutput <- mapM retrieveParentTaxIdEntrez splits
+ return (concat taxIdsOutput)
+
+-- | Extract taxids from JSON2 blasthit
+extractBlastHitsTaxId :: DS.Seq J.Hit -> [(J.Hit,Int)]
+extractBlastHitsTaxId blastHits = do
+ map (\a -> (a,J._taxid . head . J._description $ a)) (Data.Foldable.toList blastHits)
+
+
+-- | Wrapper functions that ensures that only 20 queries are sent per request
+--retrieveBlastHitsTaxIdEntrez :: [J.Hit] -> IO [([J.Hit],String)]
+--retrieveBlastHitsTaxIdEntrez blastHits = do
+-- let splits = portionListElements blastHits 20
+-- mapM retrieveBlastHitTaxIdEntrez splits
+
+
+retrieveBlastHitTaxIdEntrez :: [J.Hit] -> IO ([J.Hit],String)
+retrieveBlastHitTaxIdEntrez blastHits =
+ if not (null blastHits)
+ then do
+ let geneIds = map extractGeneId blastHits
+ let idList = intercalate "," geneIds
+ let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
+ let query' = "id=" ++ idList ++ registrationInfo
+ let entrezQuery = EntrezHTTPQuery (Just "esummary") (Just "nucleotide") query'
+ threadDelay 10000000
+ result <- entrezHTTP entrezQuery
+ CE.evaluate (blastHits,result)
+ else return (blastHits,"")
+
+extractTaxIdFromEntrySummaries :: String -> [Int]
+extractTaxIdFromEntrySummaries input
+ | null input = []
+ | null parsedResultList = []
+ | otherwise = hitTaxIds
+ where parsedResultList = readEntrezSummaries input
+ parsedResult = head parsedResultList
+ blastHitSummaries = documentSummaries parsedResult
+ hitTaxIdStrings = map extractTaxIdfromDocumentSummary blastHitSummaries
+ hitTaxIds = map readInt hitTaxIdStrings
+
+extractGeneId :: J.Hit -> String
+extractGeneId currentBlastHit = nucleotideId
+ where truncatedId = drop 3 (T.unpack (J._id (head (J._description currentBlastHit))))
+ pipeSymbolIndex = fromJust (elemIndex '|' truncatedId)
+ nucleotideId = take pipeSymbolIndex truncatedId
+
+extractTaxIdfromDocumentSummary :: EntrezDocSum -> String
+extractTaxIdfromDocumentSummary documentSummary = itemContent (fromJust (find (\item -> "TaxId" == itemName item) (summaryItems documentSummary)))
+
+getBestHit :: J.BlastJSON2 -> J.Hit
+getBestHit blastJS2
+ | null (J._hits (J._search . J._results . J._report . J._blastoutput2 $ blastJS2)) = error "getBestHit - head: empty list"
+ | otherwise = DS.index (J._hits (J._search . J._results . J._report . J._blastoutput2 $ blastJS2)) 1
+
+-- Blast returns low evalues with zero instead of the exact number
+getHitWithFractionEvalue :: J.BlastJSON2 -> Maybe J.Hsp
+getHitWithFractionEvalue blastJS2
+ | null currentHits = Nothing
+ | otherwise = find (\hsp -> J._evalue hsp /= (0 ::Double)) (concatMap J._hsps currentHits)
+ where currentHits = J._hits . J._search . J._results . J._report . J._blastoutput2 $ blastJS2
+
+showlines :: (Show a, Foldable t) => t a -> String
+showlines = concatMap (\x -> show x ++ "\n")
+
+logMessage :: String -> String -> IO ()
+logMessage logoutput temporaryDirectoryPath = appendFile (temporaryDirectoryPath ++ "Log") logoutput
+
+logWarning :: String -> String -> IO ()
+logWarning logoutput temporaryDirectoryPath = appendFile (temporaryDirectoryPath ++ "log/warnings") logoutput
+
+logVerboseMessage :: Bool -> String -> String -> IO ()
+logVerboseMessage verboseTrue logoutput temporaryDirectoryPath
+ | verboseTrue = appendFile (temporaryDirectoryPath ++ "Log") (show logoutput)
+ | otherwise = return ()
+
+logEither :: (Show a) => Either a b -> String -> IO ()
+logEither (Left logoutput) temporaryDirectoryPath = appendFile (temporaryDirectoryPath ++ "Log") (show logoutput)
+logEither _ _ = return ()
+
+checkTools :: [String] -> String -> String -> IO (Either String String)
+checkTools tools temporaryDirectoryPath selectedQuerySelectionMethod = do
+ -- if queryselectionmethod is set to clustering then also check for clustal omega
+ let additionaltools = if selectedQuerySelectionMethod == "clustering" then tools ++ ["clustalo"] else tools
+ -- check if all tools are available via PATH or Left
+ checks <- mapM checkTool additionaltools
+ if not (null (lefts checks))
+ then return (Left (concat (lefts checks)))
+ else do
+ logMessage ("Tools : " ++ intercalate "," tools ++ "\n") temporaryDirectoryPath
+ return (Right "Tools ok")
+
+logToolVersions :: String -> String -> IO ()
+logToolVersions inputQuerySelectionMethod temporaryDirectoryPath = do
+ let clustaloversionpath = temporaryDirectoryPath ++ "log/clustalo.version"
+ let mlocarnaversionpath = temporaryDirectoryPath ++ "log/mlocarna.version"
+ let rnafoldversionpath = temporaryDirectoryPath ++ "log/RNAfold.version"
+ let infernalversionpath = temporaryDirectoryPath ++ "log/Infernal.version"
+ --_ <- system ("clustalo --version >" ++ clustaloversionpath)
+ _ <- system ("mlocarna --version >" ++ mlocarnaversionpath)
+ _ <- system ("RNAfold --version >" ++ rnafoldversionpath)
+ _ <- system ("cmcalibrate -h >" ++ infernalversionpath)
+ -- _ <- system ("RNAz" ++ rnazversionpath)
+ -- _ <- system ("CMCompare >" ++ infernalversionpath)
+ mlocarnaversion <- readFile mlocarnaversionpath
+ rnafoldversion <- readFile rnafoldversionpath
+ infernalversionOutput <- readFile infernalversionpath
+ let infernalversion = lines infernalversionOutput !! 1
+ if inputQuerySelectionMethod == "clustering"
+ then do
+ _ <- system ("clustalo --version >" ++ clustaloversionpath)
+ clustaloversion <- readFile clustaloversionpath
+ let messageString = "Clustalo version: " ++ clustaloversion ++ "mlocarna version: " ++ mlocarnaversion ++ "RNAfold version: " ++ rnafoldversion ++ "infernalversion: " ++ infernalversion ++ "\n"
+ logMessage messageString temporaryDirectoryPath
+ else do
+ let messageString = "mlocarna version: " ++ mlocarnaversion ++ "RNAfold version: " ++ rnafoldversion ++ "infernalversion: " ++ infernalversion ++ "\n"
+ logMessage messageString temporaryDirectoryPath
+
+
+checkTool :: String -> IO (Either String String)
+checkTool tool = do
+ toolcheck <- findExecutable tool
+ if isJust toolcheck
+ then return (Right (fromJust toolcheck))
+ else return (Left ("RNAlien could not find "++ tool ++ " in your $PATH and has to abort.\n"))
+
+constructTaxonomyRecordsCSVTable :: ModelConstruction -> String
+constructTaxonomyRecordsCSVTable modelconstruction = csvtable
+ where tableheader = "Taxonomy Id;Added in Iteration Step;Entry Header\n"
+ tablebody = concatMap constructTaxonomyRecordCSVEntries (taxRecords modelconstruction)
+ csvtable = tableheader ++ tablebody
+
+constructTaxonomyRecordCSVEntries :: TaxonomyRecord -> String
+constructTaxonomyRecordCSVEntries taxRecord = concatMap (constructTaxonomyRecordCSVEntry taxIdString) (sequenceRecords taxRecord)
+ where taxIdString = show (recordTaxonomyId taxRecord)
+
+constructTaxonomyRecordCSVEntry :: String -> SequenceRecord -> String
+constructTaxonomyRecordCSVEntry taxIdString seqrec = taxIdString ++ ";" ++ show (aligned seqrec) ++ ";" ++ filter checkTaxonomyRecordCSVChar (B.unpack (fastaHeader (nucleotideSequence seqrec))) ++ "\n"
+
+checkTaxonomyRecordCSVChar :: Char -> Bool
+checkTaxonomyRecordCSVChar c
+ | c == '"' = False
+ | c == ';' = False
+ | otherwise = True
+
+setVerbose :: Verbosity -> Bool
+setVerbose verbosityLevel
+ | verbosityLevel == Loud = True
+ | otherwise = False
+
+evaluateConstructionResult :: StaticOptions -> ModelConstruction -> IO String
+evaluateConstructionResult staticOptions mCResult = do
+ let evaluationDirectoryFilepath = tempDirPath staticOptions ++ "evaluation/"
+ createDirectoryIfMissing False evaluationDirectoryFilepath
+ let reformatedClustalPath = evaluationDirectoryFilepath ++ "result.clustal.reformated"
+ let cmFilepath = tempDirPath staticOptions ++ "result.cm"
+ let resultSequences = inputFasta mCResult ++ map nucleotideSequence (concatMap sequenceRecords (taxRecords mCResult))
+ let resultNumber = length resultSequences
+ let rnaCentralQueries = map RCH.buildSequenceViaMD5Query resultSequences
+ rnaCentralEntries <- RCH.getRNACentralEntries rnaCentralQueries
+ let rnaCentralEvaluationResult = RCH.showRNAcentralAlienEvaluation rnaCentralEntries
+ writeFile (tempDirPath staticOptions ++ "result.rnacentral") rnaCentralEvaluationResult
+ let resultModelStatistics = tempDirPath staticOptions ++ "result.cmstat"
+ systemCMstat cmFilepath resultModelStatistics
+ inputcmStat <- readCMstat resultModelStatistics
+ let cmstatString = cmstatEvalOutput inputcmStat
+ if resultNumber > 1
+ then do
+ let resultRNAz = tempDirPath staticOptions ++ "result.rnaz"
+ let resultRNAcode = tempDirPath staticOptions ++ "result.rnacode"
+ let resultClustalFilepath = tempDirPath staticOptions ++ "result.clustal"
+ let seqNumber = 6 :: Int
+ let optimalIdentity = 80 :: Double
+ let maximalIdentity = 99 :: Double
+ let referenceSequence = True
+ preprocessingOutput <- preprocessClustalForRNAz resultClustalFilepath reformatedClustalPath seqNumber optimalIdentity maximalIdentity referenceSequence
+ if isRight preprocessingOutput
+ then do
+ let rightPreprocessingOutput = fromRight preprocessingOutput
+ let rnazClustalpath = snd rightPreprocessingOutput
+ systemRNAz "-l" rnazClustalpath resultRNAz
+ inputRNAz <- readRNAz resultRNAz
+ let rnaZString = rnaZEvalOutput inputRNAz
+ RC.systemRNAcode " -t " rnazClustalpath resultRNAcode
+ inputRNAcode <- RC.readRNAcodeTabular resultRNAcode
+ let rnaCodeString = rnaCodeEvalOutput inputRNAcode
+ return ("\nEvaluation of RNAlien result :\nCMstat statistics for result.cm\n" ++ cmstatString ++ "\nRNAz statistics for result alignment: " ++ rnaZString ++ "\nRNAcode output for result alignment:\n" ++ rnaCodeString ++ "\nSequences found by RNAlien with RNAcentral entry:\n" ++ rnaCentralEvaluationResult)
+ else do
+ logWarning ("Running RNAz for result evalution encountered a problem:" ++ fromLeft preprocessingOutput) (tempDirPath staticOptions)
+ return ("\nEvaluation of RNAlien result :\nCMstat statistics for result.cm\n" ++ cmstatString ++ "\nRNAz statistics for result alignment: Running RNAz for result evalution encountered a problem\n" ++ fromLeft preprocessingOutput ++ "\n" ++ "Sequences found by RNAlien with RNAcentral entry:\n" ++ rnaCentralEvaluationResult)
+ else do
+ logWarning "Message: RNAlien could not find additional covariant sequences\n Could not run RNAz statistics. Could not run RNAz statistics with a single sequence.\n" (tempDirPath staticOptions)
+ return ("\nEvaluation of RNAlien result :\nCMstat statistics for result.cm\n" ++ cmstatString ++ "\nRNAlien could not find additional covariant sequences. Could not run RNAz statistics with a single sequence.\n\nSequences found by RNAlien with RNAcentral entry:\n" ++ rnaCentralEvaluationResult)
+
+
+cmstatEvalOutput :: Either ParseError CMstat -> String
+cmstatEvalOutput inputcmstat
+ | isRight inputcmstat = cmstatString
+ | otherwise = show (fromLeft inputcmstat)
+ where cmStat = fromRight inputcmstat
+ cmstatString = " Sequence Number: " ++ show (statSequenceNumber cmStat)++ "\n" ++ " Effective Sequences: " ++ show (statEffectiveSequences cmStat)++ "\n" ++ " Consensus length: " ++ show (statConsensusLength cmStat) ++ "\n" ++ " Expected maximum hit-length: " ++ show (statW cmStat) ++ "\n" ++ " Basepairs: " ++ show (statBasepairs cmStat)++ "\n" ++ " Bifurcations: " ++ show (statBifurcations cmStat) ++ "\n" ++ " Modeltype: " ++ show (statModel cmStat) ++ "\n" ++ " Relative Entropy CM: " ++ show (relativeEntropyCM cmStat) ++ "\n" ++ " Relative Entropy HMM: " ++ show (relativeEntropyHMM cmStat) ++ "\n"
+
+rnaZEvalOutput :: Either ParseError RNAz -> String
+rnaZEvalOutput inputRNAz
+ | isRight inputRNAz = rnazString
+ | otherwise = show (fromLeft inputRNAz)
+ where rnaZ = fromRight inputRNAz
+ rnazString = " Mean pairwise identity: " ++ show (meanPairwiseIdentity rnaZ) ++ "\n Shannon entropy: " ++ show (shannonEntropy rnaZ) ++ "\n GC content: " ++ show (gcContent rnaZ) ++ "\n Mean single sequence minimum free energy: " ++ show (meanSingleSequenceMinimumFreeEnergy rnaZ) ++ "\n Consensus minimum free energy: " ++ show (consensusMinimumFreeEnergy rnaZ) ++ "\n Energy contribution: " ++ show (energyContribution rnaZ) ++ "\n Covariance contribution: " ++ show (covarianceContribution rnaZ) ++ "\n Combinations pair: " ++ show (combinationsPair rnaZ) ++ "\n Mean z-score: " ++ show (meanZScore rnaZ) ++ "\n Structure conservation index: " ++ show (structureConservationIndex rnaZ) ++ "\n Background model: " ++ backgroundModel rnaZ ++ "\n Decision model: " ++ decisionModel rnaZ ++ "\n SVM decision value: " ++ show (svmDecisionValue rnaZ) ++ "\n SVM class propability: " ++ show (svmRNAClassProbability rnaZ) ++ "\n Prediction: " ++ prediction rnaZ
+
+rnaCodeEvalOutput :: Either ParseError RC.RNAcode -> String
+rnaCodeEvalOutput inputRNAcode
+ | isRight inputRNAcode = rnaCodeString
+ | otherwise = show (fromLeft inputRNAcode)
+ where rnaCode = fromRight inputRNAcode
+ rnaCodeString = "HSS\tFrame\tLength\tFrom\tTo\tName\tStart\tEnd\tScore\tP\n" ++ rnaCodeEntries
+ rnaCodeEntries = concatMap showRNACodeHits (RC.rnacodeHits rnaCode)
+
+showRNACodeHits :: RC.RNAcodeHit -> String
+showRNACodeHits rnacodeHit = show (RC.hss rnacodeHit) ++ "\t" ++ show (RC.frame rnacodeHit) ++ "\t" ++ show (RC.hitLength rnacodeHit) ++ "\t"++ show (RC.from rnacodeHit) ++ "\t" ++ show (RC.to rnacodeHit) ++ "\t" ++ RC.name rnacodeHit ++ "\t" ++ show (RC.start rnacodeHit) ++ "\t" ++ show (RC.end rnacodeHit) ++ "\t" ++ show (RC.score rnacodeHit) ++ show (RC.pvalue rnacodeHit) ++ "\n"
+
+-- | Call for external preprocessClustalForRNAz
+preprocessClustalForRNAzExternal :: String -> String -> Int -> Int -> Int -> Bool -> IO (Either String (String,String))
+preprocessClustalForRNAzExternal clustalFilepath reformatedClustalPath seqenceNumber optimalIdentity maximalIdenity referenceSequence = do
+ clustalText <- TI.readFile clustalFilepath
+ --change clustal format for rnazSelectSeqs.pl
+ let reformatedClustalText = T.map reformatAln clustalText
+ TI.writeFile reformatedClustalPath reformatedClustalText
+ --select representative entries from result.Clustal with select_sequences
+ let selectedClustalpath = clustalFilepath ++ ".selected"
+ let sequenceNumberOption = " -n " ++ show seqenceNumber ++ " "
+ let optimalIdentityOption = " -i " ++ show optimalIdentity ++ " "
+ let maximalIdentityOption = " --max-id=" ++ show maximalIdenity ++ " "
+ let referenceSequenceOption = if referenceSequence then " " else " -x "
+ let syscall = "rnazSelectSeqs.pl " ++ reformatedClustalPath ++ " " ++ sequenceNumberOption ++ optimalIdentityOption ++ maximalIdentityOption ++ referenceSequenceOption ++ " >" ++ selectedClustalpath
+ --putStrLn syscall
+ system syscall
+ selectedClustalText <- readFile selectedClustalpath
+ return (Right ([],selectedClustalText))
+
+-- | Call for external preprocessClustalForRNAcode - RNAcode additionally to RNAz requirements does not accept pipe,underscore, doublepoint symbols
+preprocessClustalForRNAcodeExternal :: String -> String -> Int -> Int -> Int -> Bool -> IO (Either String (String,String))
+preprocessClustalForRNAcodeExternal clustalFilepath reformatedClustalPath seqenceNumber optimalIdentity maximalIdenity referenceSequence = do
+ clustalText <- TI.readFile clustalFilepath
+ --change clustal format for rnazSelectSeqs.pl
+ let clustalTextLines = T.lines clustalText
+ let headerClustalTextLines = T.unlines (take 2 clustalTextLines)
+ let headerlessClustalTextLines = T.unlines (drop 2 clustalTextLines)
+ let reformatedClustalText = T.map reformatRNACodeAln headerlessClustalTextLines
+ TI.writeFile reformatedClustalPath (headerClustalTextLines `T.append` T.singleton '\n' `T.append` reformatedClustalText)
+ --select representative entries from result.Clustal with select_sequences
+ let selectedClustalpath = clustalFilepath ++ ".selected"
+ let sequenceNumberOption = " -n " ++ show seqenceNumber ++ " "
+ let optimalIdentityOption = " -i " ++ show optimalIdentity ++ " "
+ let maximalIdentityOption = " --max-id=" ++ show maximalIdenity ++ " "
+ let referenceSequenceOption = if referenceSequence then " " else " -x "
+ let syscall = "rnazSelectSeqs.pl " ++ reformatedClustalPath ++ " " ++ sequenceNumberOption ++ optimalIdentityOption ++ maximalIdentityOption ++ referenceSequenceOption ++ " >" ++ selectedClustalpath
+ --putStrLn syscall
+ system syscall
+ selectedClustalText <- readFile selectedClustalpath
+ return (Right ([],selectedClustalText))
+
+preprocessClustalForRNAz :: String -> String -> Int -> Double -> Double -> Bool -> IO (Either String (String,String))
+preprocessClustalForRNAz clustalFilepath _ seqenceNumber optimalIdentity maximalIdenity referenceSequence = do
+ clustalText <- TI.readFile clustalFilepath
+ let clustalTextLines = T.lines clustalText
+ parsedClustalInput <- readClustalAlignment clustalFilepath
+ let selectedClustalpath = clustalFilepath ++ ".selected"
+ if length clustalTextLines > 5
+ then
+ if isRight parsedClustalInput
+ then do
+ let (idMatrix,filteredClustalInput) = rnaCodeSelectSeqs2 (fromRight parsedClustalInput) seqenceNumber optimalIdentity maximalIdenity referenceSequence
+ writeFile selectedClustalpath (show filteredClustalInput)
+ let formatedIdMatrix = show (fmap formatIdMatrix idMatrix)
+ return (Right (formatedIdMatrix,selectedClustalpath))
+ else return (Left (show (fromLeft parsedClustalInput)))
+ else do
+ let clustalLines = T.lines clustalText
+ let headerClustalTextLines = T.unlines (take 2 clustalLines)
+ let headerlessClustalTextLines = T.unlines (drop 2 clustalLines)
+ let reformatedClustalText = T.map reformatRNACodeAln headerlessClustalTextLines
+ TI.writeFile selectedClustalpath (headerClustalTextLines `T.append` T.singleton '\n' `T.append` reformatedClustalText)
+ return (Right ([],clustalFilepath))
+
+formatIdMatrix :: Maybe (Int,Int,Double) -> String
+formatIdMatrix (Just (_,_,c)) = printf "%.2f" c
+formatIdMatrix _ = "-"
+
+
+-- | Sequence preselection for RNAz and RNAcode
+rnaCodeSelectSeqs2 :: ClustalAlignment -> Int -> Double -> Double -> Bool -> (Matrix (Maybe (Int,Int,Double)),ClustalAlignment)
+rnaCodeSelectSeqs2 currentClustalAlignment targetSeqNumber optimalIdentity maximalIdentity referenceSequence = (identityMatrix,newClustalAlignment)
+ where entryVector = V.fromList (alignmentEntries currentClustalAlignment)
+ entrySequences = V.map entryAlignedSequence entryVector
+ entryReformatedSequences = V.map (T.map reformatRNACodeAln) entrySequences
+ totalSeqNumber = V.length entryVector
+ identityMatrix = computeSequenceIdentityMatrix entryReformatedSequences
+ entryIdentityVector = V.map fromJust (V.filter isJust (getMatrixAsVector identityMatrix))
+ entryIdentities = V.toList entryIdentityVector
+ --Similarity filter - filter too similar sequences until alive seqs are less then minSeqs
+ entriesToDiscard = preFilterIdentityMatrix maximalIdentity targetSeqNumber totalSeqNumber [] entryIdentities
+ allEntries = [1..totalSeqNumber]
+ prefilteredEntries = allEntries \\ entriesToDiscard
+ --Optimize mean pairwise similarity (greedily) - remove worst sequence until desired number is reached
+ costList = map (computeEntryCost optimalIdentity entryIdentityVector) prefilteredEntries
+ sortedCostList = sortBy compareEntryCost2 costList
+ sortedIndices = map fst sortedCostList
+ --selectedEntryIndices = [1] ++ map fst (take (targetSeqNumber -1) sortedCostList)
+ selectedEntryIndices = selectEntryIndices referenceSequence targetSeqNumber sortedIndices
+ selectedEntries = map (\ind -> entryVector V.! (ind-1)) selectedEntryIndices
+ selectedEntryHeader = map entrySequenceIdentifier selectedEntries
+ reformatedSelectedEntryHeader = map (T.map reformatRNACodeId) selectedEntryHeader
+ selectedEntrySequences = map (\ind -> entryReformatedSequences V.! (ind-1)) selectedEntryIndices
+ --gapfreeEntrySequences = T.transpose (T.filter (\a -> not (T.all isGap a)) (T.transpose selectedEntrySequences))
+ gapfreeEntrySequences = T.transpose (filter (not . T.all isGap) (T.transpose selectedEntrySequences))
+ gapfreeEntries = map (uncurry ClustalAlignmentEntry)(zip reformatedSelectedEntryHeader gapfreeEntrySequences)
+ emptyConservationTrack = setEmptyConservationTrack gapfreeEntries (conservationTrack currentClustalAlignment)
+ newClustalAlignment = currentClustalAlignment {alignmentEntries = gapfreeEntries, conservationTrack = emptyConservationTrack}
+
+selectEntryIndices :: Bool -> Int -> [Int] -> [Int]
+selectEntryIndices referenceSequence targetSeqNumber sortedIndices
+ | referenceSequence = if (1 :: Int) `elem` firstX then firstX else 1:firstXm1
+ | otherwise = firstX
+ where firstXm1 = take (targetSeqNumber - 1) sortedIndices
+ firstX = take targetSeqNumber sortedIndices
+
+setEmptyConservationTrack :: [ClustalAlignmentEntry] -> T.Text -> T.Text
+setEmptyConservationTrack alnentries currentConservationTrack
+ | null alnentries = currentConservationTrack
+ | otherwise = newConservationTrack
+ where trackLength = T.length (entryAlignedSequence (head alnentries))
+ newConservationTrack = T.replicate (trackLength + 0) (T.pack " ")
+
+isGap :: Char -> Bool
+isGap a
+ | a == '-' = True
+ | otherwise = False
+
+computeEntryCost :: Double -> V.Vector (Int,Int,Double) -> Int -> (Int,Double)
+computeEntryCost optimalIdentity allIdentities currentIndex = (currentIndex,entryCost)
+ where entryCost = V.sum (V.map (computeCost optimalIdentity) entryIdentities)
+ entryIdentities = getEntryIdentities currentIndex allIdentities
+
+getEntryIdentities :: Int -> V.Vector (Int,Int,Double) -> V.Vector (Int,Int,Double)
+getEntryIdentities currentIndex allIdentities = V.filter (isIIdx currentIndex) allIdentities V.++ V.filter (isJIdx currentIndex) allIdentities
+
+isIIdx :: Int -> (Int,Int,Double) -> Bool
+isIIdx currentIdx (i,_,_) = currentIdx == i
+isJIdx :: Int -> (Int,Int,Double) -> Bool
+isJIdx currentIdx (_,j,_) = currentIdx == j
+
+computeCost :: Double -> (Int,Int,Double) -> Double
+computeCost optimalIdentity (_,_,c) = (c - optimalIdentity) * (c - optimalIdentity)
+
+compareEntryCost2 :: (Int, Double) -> (Int, Double) -> Ordering
+compareEntryCost2 (_,costA) (_,costB) = compare costA costB
+
+-- TODO change to vector
+preFilterIdentityMatrix :: Double -> Int -> Int-> [Int] -> [(Int,Int,Double)] -> [Int]
+preFilterIdentityMatrix identityCutoff minSeqNumber totalSeqNumber filteredIds entryIdentities
+ | (totalSeqNumber - length filteredIds) <= minSeqNumber = []
+ | identityCutoff == (100 :: Double) = []
+ | Prelude.null entryIdentities = []
+ | otherwise = entryresult ++ preFilterIdentityMatrix identityCutoff minSeqNumber totalSeqNumber (filteredIds ++ entryresult) (tail entryIdentities)
+ where currentEntry = head entryIdentities
+ entryresult = checkIdentityEntry identityCutoff filteredIds currentEntry
+
+checkIdentityEntry :: Double -> [Int] -> (Int,Int,Double) -> [Int]
+checkIdentityEntry identityCutoff filteredIds (i,j,ident)
+ | i `elem` filteredIds = []
+ | j `elem` filteredIds = []
+ | ident > identityCutoff = [j]
+ | otherwise = []
+
+computeSequenceIdentityMatrix :: V.Vector T.Text -> Matrix (Maybe (Int,Int,Double))
+computeSequenceIdentityMatrix entryVector = matrix (V.length entryVector) (V.length entryVector) (computeSequenceIdentityEntry entryVector)
+
+-- Computes Sequence identity once for each pair and not vs itself
+computeSequenceIdentityEntry :: V.Vector T.Text -> (Int,Int) -> Maybe (Int,Int,Double)
+computeSequenceIdentityEntry entryVector (row,col)
+ | i < j = Just (row,col,ident)
+ | otherwise = Nothing
+ where i=row-1
+ j=col-1
+ --gaps in both sequences need to be removed, because they count as match
+ ientry = entryVector V.! i
+ jentry = entryVector V.! j
+ (gfi,gfj) = unzip (filter notDoubleGap (T.zip ientry jentry))
+ gfitext = T.pack gfi
+ gfjtext = T.pack gfj
+ --ident=stringIdentity gfi gfj
+ ident=textIdentity gfitext gfjtext
+
+notDoubleGap :: (Char,Char) -> Bool
+notDoubleGap (a,b)
+ | a == '-' && b == '-' = False
+ | otherwise = True
+
+reformatRNACodeId :: Char -> Char
+reformatRNACodeId c
+ | c == ':' = '-'
+ | c == '|' = '-'
+ | c == '.' = '-'
+ | c == '~' = '-'
+ | c == '_' = '-'
+ | c == '/' = '-'
+ | otherwise = c
+
+reformatRNACodeAln :: Char -> Char
+reformatRNACodeAln c
+ | c == ':' = '-'
+ | c == '|' = '-'
+ | c == '.' = '-'
+ | c == '~' = '-'
+ | c == '_' = '-'
+ | c == 'u' = 'U'
+ | c == 't' = 'T'
+ | c == 'g' = 'G'
+ | c == 'c' = 'C'
+ | c == 'a' = 'A'
+ | otherwise = c
+
+reformatAln :: Char -> Char
+reformatAln c
+ | c == '.' = '-'
+ | c == '~' = '-'
+ | c == '_' = '-'
+ | c == 'u' = 'U'
+ | c == 't' = 'T'
+ | c == 'g' = 'G'
+ | c == 'c' = 'C'
+ | c == 'a' = 'A'
+ | otherwise = c
+
+-- | Check if alien can connect to NCBI
+checkNCBIConnection :: IO (Either String String)
+checkNCBIConnection = do
+ req <- N.parseRequest "https://www.ncbi.nlm.nih.gov"
+ manager <- N.newManager N.tlsManagerSettings
+ response <- N.httpLbs req manager
+ let sta = N.responseStatus response
+ if statusIsSuccessful sta
+ then return (Right "Network connection with NCBI server was successful")
+ else return (Left ("Could not connect to NCBI server \"https://www.ncbi.nlm.nih.gov\". Response Code: " ++ show (statusCode sta) ++ " \n" ++ B.unpack (statusMessage sta)))
+
+-- | Blast evalue is set stricter in inital alignment mode
+setBlastExpectThreshold :: ModelConstruction -> Double
+setBlastExpectThreshold modelConstruction
+ | alignmentModeInfernal modelConstruction = 1 :: Double
+ | otherwise = 0.1 :: Double
+
+reformatFasta :: Fasta () () -> Fasta () ()
+reformatFasta input = Fasta (_header input) updatedSequence
+ where updatedSequence = BioSequence (B.pack (map reformatFastaSequence (B.unpack . _bioSequence . _fasta $ input)))
+
+reformatFastaSequence :: Char -> Char
+reformatFastaSequence c
+ | c == '.' = '-'
+ | c == '~' = '-'
+ | c == '_' = '-'
+ | c == 'u' = 'T'
+ | c == 't' = 'T'
+ | c == 'g' = 'G'
+ | c == 'c' = 'C'
+ | c == 'a' = 'A'
+ | c == 'U' = 'T'
+ | otherwise = c
+
+setRestrictedTaxonomyLimits :: String -> (Maybe Int,Maybe Int)
+setRestrictedTaxonomyLimits trestriction
+ | trestriction == "bacteria" = (Just (2 :: Int), Nothing)
+ | trestriction == "archea" = (Just (2157 :: Int), Nothing)
+ | trestriction == "eukaryia" = (Just (2759 :: Int), Nothing)
+ | otherwise = (Nothing, Nothing)
+
+checkTaxonomyRestriction :: Maybe String -> Maybe String
+checkTaxonomyRestriction taxonomyRestriction
+ | isJust taxonomyRestriction = checkTaxonomyRestrictionString (fromJust taxonomyRestriction)
+ | otherwise = Nothing
+
+checkTaxonomyRestrictionString :: String -> Maybe String
+checkTaxonomyRestrictionString restrictionString
+ | restrictionString == "archea" = Just "archea"
+ | restrictionString == "bacteria" = Just "bacteria"
+ | restrictionString == "eukaryia" = Just "eukaryia"
+ | otherwise = Nothing
+
+extractAlignmentSequencesByIds :: String -> [B.ByteString] -> IO [Fasta () ()]
+extractAlignmentSequencesByIds stockholmFilePath sequenceIds = do
+ inputSeedAln <- TIO.readFile stockholmFilePath
+ let alnEntries = extractAlignmentSequences inputSeedAln
+ --let splitIds = map E.encodeUtf8 (TL.splitOn (TL.pack ",") (TL.pack sequenceIds))
+ let filteredEntries = concatMap (filterSequencesById alnEntries) sequenceIds
+ return filteredEntries
+
+extractAlignmentSequences :: TL.Text -> [Fasta () ()]
+extractAlignmentSequences seedFamilyAln = rfamIDAndseedFamilySequences
+ where seedFamilyAlnLines = TL.lines seedFamilyAln
+ -- remove empty lines from splitting
+ seedFamilyNonEmpty = filter (\alnline -> TL.empty /= alnline) seedFamilyAlnLines
+ -- remove annotation and spacer lines
+ seedFamilyIdSeqLines = filter (\alnline -> not ((TL.head alnline) == '#') && not ((TL.head alnline) == ' ') && not ((TL.head alnline) == '/')) seedFamilyNonEmpty
+ -- put id and corresponding seq of each line into a list and remove whitspaces
+ seedFamilyIdandSeqLines = map TL.words seedFamilyIdSeqLines
+ -- linewise tuples with id and seq without alinment characters - .
+ seedFamilyIdandSeqLineTuples = map (\alnline -> (head alnline,filterAlnChars (last alnline))) seedFamilyIdandSeqLines
+ -- line tuples sorted by id
+ seedFamilyIdandSeqTupleSorted = sortBy (\tuple1 tuple2 -> compare (fst tuple1) (fst tuple2)) seedFamilyIdandSeqLineTuples
+ -- line tuples grouped by id
+ seedFamilyIdandSeqTupleGroups = groupBy (\tuple1 tuple2 -> fst tuple1 == fst tuple2) seedFamilyIdandSeqTupleSorted
+ seedFamilySequences = map mergeIdSeqTuplestoSequence seedFamilyIdandSeqTupleGroups
+ rfamIDAndseedFamilySequences = seedFamilySequences
+
+filterSequencesById :: [Fasta () ()] -> B.ByteString -> [Fasta () ()]
+filterSequencesById alignmentSequences sequenceId = filter (sequenceHasId sequenceId) alignmentSequences
+
+sequenceHasId :: B.ByteString -> Fasta () () -> Bool
+sequenceHasId sequenceId currentSequence = sequenceId == fastaHeader currentSequence
+
+filterAlnChars :: TL.Text -> TL.Text
+filterAlnChars cs = TL.filter (\c -> not (c == '-') && not (c == '.')) cs
+
+mergeIdSeqTuplestoSequence :: [(TL.Text,TL.Text)] -> Fasta () ()
+mergeIdSeqTuplestoSequence tuplelist = currentSequence
+ where seqId = TL.toStrict (fst (head tuplelist))
+ seqData = TL.toStrict (TL.concat (map snd tuplelist))
+ currentSequence = Fasta (SequenceIdentifier (E.encodeUtf8 seqId)) (BioSequence (E.encodeUtf8 seqData))
+
+readFastaFile :: String -> IO [Fasta () ()]
+readFastaFile fastaFilePath = do
+ inputFastaFile <- L.readFile fastaFilePath
+ let inputFastas = byteStringToMultiFasta inputFastaFile
+ return inputFastas
+
+blast :: String -> Int -> Maybe Int -> Maybe Int -> Maybe Double -> Bool -> BlastHTTPQuery -> IO (Either String J.BlastJSON2)
+blast _tempDirPath threads upperTaxIdLimit lowerTaxIdLimit expectThreshold _blastSoftmaskingToggle blastHTTPQuery = do
+ --buildTaxonomyContext
+ let upperTaxIdLimitPath = if isJust upperTaxIdLimit then _tempDirPath ++ "/upper.txids" else ""
+ let lowerTaxIdLimitPath = if isJust lowerTaxIdLimit then _tempDirPath ++ "/lower.txids" else ""
+ when (isJust upperTaxIdLimit) $ systemGetSpeciesTaxId (fromJust upperTaxIdLimit) upperTaxIdLimitPath
+ when (isJust lowerTaxIdLimit) $ systemGetSpeciesTaxId (fromJust lowerTaxIdLimit) lowerTaxIdLimitPath
+ let positiveSetTaxIdLimitPath = _tempDirPath ++ "/postitiveset.txids"
+ if isJust lowerTaxIdLimit && isJust upperTaxIdLimit
+ then do
+ upperTaxIdsFile <- readFile upperTaxIdLimitPath
+ let upperTaxIds = lines upperTaxIdsFile
+ lowerTaxIdsFile <- readFile lowerTaxIdLimitPath
+ let lowerTaxIds = lines lowerTaxIdsFile
+ let positiveSetTaxIds = upperTaxIds \\ lowerTaxIds
+ let positiveSetTaxIdsFile = unlines positiveSetTaxIds
+ writeFile positiveSetTaxIdLimitPath positiveSetTaxIdsFile
+ else return ()
+ --sequenceSearch
+ let fastaFilePath = _tempDirPath ++ "/blastQuery.fa"
+ let blastResultFilePath = _tempDirPath ++ "/blastResult.json2"
+ let selectedBlastDatabase = fromMaybe "" (Biobase.BLAST.HTTP.database blastHTTPQuery)
+ writeFastaFile fastaFilePath (querySequences blastHTTPQuery)
+ systemBlast threads selectedBlastDatabase upperTaxIdLimitPath lowerTaxIdLimitPath positiveSetTaxIdLimitPath expectThreshold _blastSoftmaskingToggle fastaFilePath blastResultFilePath
+ blastCmdResult <- BBI.blastCmdJSON2FromFile blastResultFilePath
+ --if isLeft blastResult then print (fromLeft blastResult) else print ""
+ if isRight blastCmdResult
+ then do
+ let blastCmdOutput = J._blastcmdoutput2 (fromRight blastCmdResult)
+ when ((length blastCmdOutput) > 1) $ print "Blast output list with multiple elements"
+ if (not (null blastCmdOutput))
+ then (return (Right (J.BlastJSON2 (head blastCmdOutput)):: Either String J.BlastJSON2))
+ else (return (Left "Empty BlastOutput List" :: Either String J.BlastJSON2))
+ else (return (Left (fromLeft blastCmdResult) :: Either String J.BlastJSON2))
+
+-- | Run external blast command
+systemBlast :: Int -> String -> String -> String -> String -> Maybe Double -> Bool -> String -> String -> IO ExitCode
+systemBlast threads _blastDatabase upperTaxLimitPath lowerTaxLimitPath positiveSetTaxIdLimitPath _evalueThreshold _blastSoftmaskingToggle queryFilepath outputFilePath = do
+ let cmd = ("blastn " ++ threadedOption ++ expectThresholdOption ++ taxonomyOption ++ " " ++ softmaskOption ++ dbOption ++ " -query " ++ queryFilepath ++ " -outfmt 15 -out " ++ outputFilePath)
+ putStrLn cmd
+ system cmd
+ where threadedOption = " -num_threads " ++ show threads
+ expectThresholdOption = if isJust _evalueThreshold then " -evalue " ++ show (fromJust _evalueThreshold) else ""
+ dbOption = if null _blastDatabase then "" else " -db " ++ _blastDatabase ++ " "
+ softmaskOption = if _blastSoftmaskingToggle then " -soft_masking " else ""
+ taxonomyOption = setBlastCallTaxonomyOptions upperTaxLimitPath lowerTaxLimitPath positiveSetTaxIdLimitPath
+
+setBlastCallTaxonomyOptions :: String -> String -> String -> String
+setBlastCallTaxonomyOptions upperTaxLimitPath lowerTaxLimitPath positiveSetTaxIdLimitPath
+ | and [(not (null upperTaxLimitPath)),(not (null lowerTaxLimitPath))] = " -taxidlist " ++ positiveSetTaxIdLimitPath ++ " "
+ | not (null upperTaxLimitPath) = " -taxidlist " ++ upperTaxLimitPath ++ " "
+ | not (null lowerTaxLimitPath) = " -negative_taxidlist " ++ lowerTaxLimitPath ++ " "
+ | otherwise = ""
+
+-- | Retrieve taxids for blast
+systemGetSpeciesTaxId :: Int -> String -> IO ()
+systemGetSpeciesTaxId requestedTaxId outputFilePath = do
+ system ("get_species_taxids.sh " ++ " -t " ++ show requestedTaxId ++ " > " ++ outputFilePath)
+ return ()
+
+
+
diff --git a/Biobase/RNAlien/RNAcentralHTTP.hs b/Biobase/RNAlien/RNAcentralHTTP.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAlien/RNAcentralHTTP.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{-# LANGUAGE DeriveGeneric #-}
+
+-- | Interface for the RNAcentral REST webservice.
+--
+module Biobase.RNAlien.RNAcentralHTTP (rnaCentralHTTP,
+ buildSequenceViaMD5Query,
+ buildStringViaMD5Query,
+ getRNACentralEntries,
+ showRNAcentralAlienEvaluation,
+ RNAcentralEntryResponse(..),
+ RNAcentralEntry(..)
+ ) where
+
+import Network.HTTP.Conduit
+import qualified Data.ByteString.Lazy.Char8 as L8
+--import qualified Data.ByteString.Char8 as BS8
+import Network.Socket
+import Control.Concurrent
+import Data.Text
+import Data.Aeson
+import GHC.Generics
+import qualified Data.Digest.Pure.MD5 as M
+import Data.Either
+import Biobase.Fasta.Strict
+import Biobase.Types.BioSequence
+
+--Datatypes
+-- | Data structure for RNAcentral entry response
+data RNAcentralEntryResponse = RNAcentralEntryResponse
+ {
+ count :: Int,
+ next :: Maybe Text,
+ previous :: Maybe Text,
+ results :: [RNAcentralEntry]
+ }
+ deriving (Show, Eq, Generic)
+
+instance ToJSON RNAcentralEntryResponse where
+ toJSON = genericToJSON defaultOptions
+ --toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON RNAcentralEntryResponse
+
+data RNAcentralEntry = RNAcentralEntry
+ {
+ url :: Text,
+ rnacentral_id :: Text,
+ md5 :: Text,
+ sequence :: Text,
+ length :: Int,
+ xrefs :: Text,
+ publications :: Text
+ }
+ deriving (Show, Eq, Generic)
+
+instance ToJSON RNAcentralEntry where
+ toJSON = genericToJSON defaultOptions
+ --toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON RNAcentralEntry
+
+-- | Send query and parse return XML
+startSession :: String -> IO (Either String RNAcentralEntryResponse)
+startSession query' = do
+ requestXml <- withSocketsDo
+ $ sendQuery query'
+ --putStr (L8.unpack requestXml)
+ let eitherErrorResponse = eitherDecode requestXml :: Either String RNAcentralEntryResponse
+ return eitherErrorResponse
+
+-- | Send query and return response XML
+sendQuery :: String -> IO L8.ByteString
+sendQuery query' = do
+ let address = "http://rnacentral.org/api/v1/rna/"
+ let request = address ++ query'
+ --putStrLn request
+ simpleHttp request
+
+-- | Function for querying the RNAcentral REST interface.
+rnaCentralHTTP :: String -> IO (Either String RNAcentralEntryResponse)
+rnaCentralHTTP query' =
+ startSession query'
+
+-- | Function for delayed queries to the RNAcentral REST interface. Enforces the maximum 20 requests per second policy.
+delayedRNACentralHTTP :: String -> IO (Either String RNAcentralEntryResponse)
+delayedRNACentralHTTP query' = do
+ threadDelay 55000
+ startSession query'
+
+getRNACentralEntries :: [String] -> IO [Either String RNAcentralEntryResponse]
+getRNACentralEntries queries = do
+ mapM delayedRNACentralHTTP queries
+
+-- | Build a query from a input sequence
+--
+-- TODO [chzs] consider using strict bytestring as long as possible.
+--
+-- TODO [chzs] consider giving useful typelevel names to the types in @Fasta@.
+-- One may give a type-level name to the sequence identifier, and an identifier
+-- (like @DNA@) to the biosequence type.
+
+buildSequenceViaMD5Query :: Fasta () () -> String
+buildSequenceViaMD5Query s = qString
+ where querySequence = L8.fromStrict . _bioSequence $ _fasta s
+ querySequenceUreplacedwithT = L8.map bsreplaceUT querySequence
+ querySequenceU2Twolb = L8.filter ((/= '\n')) querySequenceUreplacedwithT
+ md5Sequence = M.md5 querySequenceU2Twolb
+ qString = "?md5=" ++ show md5Sequence
+
+--Build a query from a input string
+buildStringViaMD5Query :: String -> String
+buildStringViaMD5Query s = qString
+ where querySequenceUreplacedwithT = L8.map bsreplaceUT (L8.pack s)
+ querySequenceU2Twolb = L8.filter ((/= '\n')) querySequenceUreplacedwithT
+ md5Sequence = M.md5 querySequenceU2Twolb
+ qString = "?md5=" ++ show md5Sequence
+
+showRNAcentralAlienEvaluation :: [Either String RNAcentralEntryResponse] -> String
+showRNAcentralAlienEvaluation responses = output
+ where resultEntries = Prelude.concatMap results (rights responses)
+ resulthead = "rnacentral_id\tmd5\tlength\n"
+ resultentries = Prelude.concatMap showRNAcentralAlienEvaluationLine resultEntries
+ output = if Prelude.null resultentries then "No matching sequences found in RNAcentral\n" else resulthead ++ resultentries
+
+showRNAcentralAlienEvaluationLine :: RNAcentralEntry -> String
+showRNAcentralAlienEvaluationLine entry = unpack (rnacentral_id entry) ++ "\t" ++ unpack (md5 entry) ++ "\t" ++ show (Biobase.RNAlien.RNAcentralHTTP.length entry) ++"\n"
+
+bsreplaceUT :: Char -> Char
+bsreplaceUT a
+ | a == 'U' = 'T'
+ | otherwise = a
+
diff --git a/Biobase/RNAlien/Types.hs b/Biobase/RNAlien/Types.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAlien/Types.hs
@@ -0,0 +1,145 @@
+-- | This module contains data structures for RNAlien
+
+module Biobase.RNAlien.Types where
+
+import Biobase.Fasta.Strict
+import Bio.Taxonomy
+--import Biobase.Types.BioSequence
+import qualified Data.ByteString.Char8 as B
+
+-- | Static construction options
+data StaticOptions = StaticOptions
+ { tempDirPath :: String,
+ sessionID :: String,
+ nSCICutoff :: Double,
+ userTaxId :: Maybe Int,
+ singleHitperTaxToggle :: Bool,
+ querySelectionMethod :: String,
+ queryNumber :: Int,
+ lengthFilterToggle :: Bool,
+ coverageFilterToggle :: Bool,
+ blastSoftmaskingToggle :: Bool,
+ cpuThreads :: Int,
+ blastDatabase :: Maybe String,
+ taxRestriction :: Maybe String,
+ verbositySwitch :: Bool,
+ offline :: Bool
+ } deriving (Show)
+
+-- | Keeps track of model construction
+data ModelConstruction = ModelConstruction
+ { iterationNumber :: Int,
+ inputFasta :: [Fasta () ()],
+ taxRecords :: [TaxonomyRecord],
+ --Taxonomy ID of the highest node in taxonomic subtree used in search
+ upperTaxonomyLimit :: Maybe Int,
+ taxonomicContext :: Maybe Taxon,
+ evalueThreshold :: Double,
+ alignmentModeInfernal :: Bool,
+ selectedQueries :: [Fasta () ()],
+ potentialMembers :: [SearchResult]
+ }
+
+instance Show ModelConstruction where
+ show (ModelConstruction _iterationNumber _inputFasta _taxRecords _upperTaxonomyLimit _taxonomicContext _evalueThreshold _alignmentModeInfernal _selectedQueries _potentialMembers) = a ++ b ++ c ++ d ++ e ++ g ++ h ++ i
+ where a = "Modelconstruction iteration: " ++ show _iterationNumber ++ "\n"
+ -- b = "Input fasta:\n" ++ concatMap (prettyPrintFasta 80) _inputFasta -- L.unpack (fastaHeader _inputFasta) ++ "\n" ++ L.unpack (fastaSequence _inputFasta) ++ "\n"
+ b = "Input fasta:\n" ++ concatMap (convertString . fastaToByteString 80) _inputFasta
+ c = show _taxRecords
+ d = "Upper taxonomy limit: " ++ maybe "not set" show _upperTaxonomyLimit ++ "\n"
+ e = "Taxonomic Context: " ++ maybe "not set" show _taxonomicContext ++ "\n"
+ g = "Evalue cutoff: " ++ show _evalueThreshold ++ "\n"
+ h = "Selected queries: \n" ++ concatMap show _selectedQueries
+ i = "Potential Members: \n" ++ concatMap show _potentialMembers
+
+data TaxonomyRecord = TaxonomyRecord
+ { recordTaxonomyId :: Int,
+ sequenceRecords :: [SequenceRecord]
+ }
+
+instance Show TaxonomyRecord where
+ show (TaxonomyRecord _recordTaxonomyId _sequenceRecords) = a ++ b
+ where a = "TaxonomyRecord TaxonomyId: " ++ show _recordTaxonomyId ++ "\n"
+ b = show _sequenceRecords
+
+data SequenceRecord = SequenceRecord
+ { --Sequence consisting of SeqLabel, and SeqData
+ nucleotideSequence :: Fasta () (),
+ -- 0 is unaligned, number is the iteration the sequence has been included into the alignment
+ aligned :: Int,
+ recordDescription :: B.ByteString
+ }
+
+instance Show SequenceRecord where
+ show (SequenceRecord _nucleotideSequence _aligned _recordDescription) = a ++ b ++ c
+ where a = "Record Description: " ++ B.unpack _recordDescription ++ "\n"
+ b = "Aligned in iteration: " ++ show _aligned ++ "\n"
+ c = "Sequence:" ++ show _nucleotideSequence ++ "\n"
+-- |
+data CMsearch = CMsearch
+ { queryCMfile :: String,
+ targetSequenceDatabase :: String,
+ numberOfWorkerThreads :: String,
+ cmsearchHits :: [CMsearchHit]
+-- hitAlignments :: [CMsearchHitAlignment]
+-- internalCMPipelineStatisticsSummary
+ } deriving (Show, Eq, Read)
+
+-- |
+data CMsearchHit = CMsearchHit
+ { hitRank :: Int,
+ hitSignificance :: Char,
+ hitEvalue :: Double,
+ hitScore :: Double,
+ hitBias :: Double,
+ hitSequenceHeader :: B.ByteString,
+ hitStart :: Int,
+ hitEnd :: Int,
+ hitStrand :: Char,
+ hitModel :: B.ByteString,
+ hitTruncation :: B.ByteString,
+ hitGCContent :: Double,
+ hitDescription :: B.ByteString
+ } deriving (Show, Eq, Read)
+
+data SearchResult = SearchResult
+ { candidates :: [(Fasta () (),Int,B.ByteString)],
+ blastDatabaseSize :: Maybe Double
+ }
+
+instance Show SearchResult where
+ show (SearchResult _candidates _blastDatabaseSize) = a ++ b
+ where a = "SearchResults :\n " ++ concatMap show _candidates ++ "\n"
+ b = "BlastDb Size: " ++ show _blastDatabaseSize ++ "\n"
+
+-- |
+data CMstat = CMstat
+ { statIndex :: Int,
+ statName :: String,
+ statAccession :: String,
+ statSequenceNumber :: Int,
+ statEffectiveSequences :: Double,
+ statConsensusLength :: Int,
+ -- W The expected maximum length of a hit to the model.
+ statW :: Int,
+ statBasepairs :: Int,
+ statBifurcations :: Int,
+ statModel :: String,
+ relativeEntropyCM :: Double,
+ relativeEntropyHMM :: Double
+ } deriving (Eq, Read)
+
+instance Show CMstat where
+ show (CMstat _statIndex _statName _statAccession _statSequenceNumber _statEffectiveSequences _statConsensusLength _statW _statBasepairs _statBifurcations _statModel _relativeEntropyCM _relativeEntropyHMM) = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h ++ i ++ j ++ k ++ l
+ where a = "CMstat - covariance model statistics:\nIndex: " ++ show _statIndex ++ "\n"
+ b = "Name: " ++ show _statName ++ "\n"
+ c = "Accession: " ++ show _statAccession ++ "\n"
+ d = "Sequence Number: " ++ show _statSequenceNumber ++ "\n"
+ e = "Effective Sequences: " ++ show _statEffectiveSequences ++ "\n"
+ f = "Consensus length: " ++ show _statConsensusLength ++ "\n"
+ g = "Expected maximum hit-length: " ++ show _statW ++ "\n"
+ h = "Basepairs: " ++ show _statBasepairs ++ "\n"
+ i = "Bifurcations: " ++ show _statBifurcations ++ "\n"
+ j = "Modeltype: " ++ show _statModel ++ "\n"
+ k = "Relative Entropy CM: " ++ show _relativeEntropyCM ++ "\n"
+ l = "Relative Entropy HMM: " ++ show _relativeEntropyHMM ++ "\n"
diff --git a/Biobase/RNAlienStatistics.hs b/Biobase/RNAlienStatistics.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/RNAlienStatistics.hs
@@ -0,0 +1,331 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Statistics for RNAlien Results
+-- dist/build/RNAlienStatistics/RNAlienStatistics -s bitscore -i /scratch/egg/temp/cm13676/1/model.cm -r /home/mescalin/egg/current/Data/AlienTest/cms/BsrG.cm -g /scratch/egg/temp/AlienSearch/genomes/ -o /scratch/egg/temp/AlienStatistics
+module Main where
+
+import System.Console.CmdArgs
+import Data.Either.Unwrap
+import System.Process
+import qualified Data.ByteString.Char8 as B
+import Biobase.RNAlien.Library
+import System.Directory
+import Biobase.Fasta.Strict
+import Data.List
+import qualified System.FilePath as FP
+import qualified Data.List.Split as DS
+import Text.Printf
+import Bio.RNAzParser
+import qualified Bio.RNAcodeParser as RC
+import Biobase.Types.BioSequence
+
+data Options = Options
+ { alienCovarianceModelPath :: String,
+ alienrnazPath :: String,
+ alienrnacodePath :: String,
+ aliencmstatPath :: String,
+ rfamCovarianceModelPath :: String,
+ rfamFastaFilePath :: String,
+ alienFastaFilePath :: String,
+ rfamModelName :: String,
+ rfamModelId :: String,
+ rfamThreshold :: Double,
+ alienThreshold :: Double,
+ databaseSize :: Maybe Double,
+ outputDirectoryPath :: String,
+ benchmarkIndex :: Int,
+ thresholdSelection :: String,
+ linkScores :: Bool,
+ threads :: Int
+ } deriving (Show,Data,Typeable)
+
+options :: Options
+options = Options
+ { alienCovarianceModelPath = def &= name "i" &= help "Path to alienCovarianceModelPath",
+ alienrnazPath = def &= name "z" &= help "Path to alienRNAzResult",
+ alienrnacodePath = def &= name "w" &= help "Path to alienRNAcodeResult",
+ aliencmstatPath = def &= name "m" &= help "Path to aliencmstatResult",
+ rfamCovarianceModelPath = def &= name "r" &= help "Path to rfamCovarianceModelPath",
+ rfamFastaFilePath = def &= name "g" &= help "Path to rfamFastaFile",
+ rfamModelName = def &= name "n" &= help "Rfam model name",
+ rfamModelId = def &= name "d" &= help "Rfam model id",
+ alienFastaFilePath = def &= name "a" &= help "Path to alienFastaFile",
+ outputDirectoryPath = def &= name "o" &= help "Path to output directory",
+ alienThreshold = 20 &= name "t" &= help "Bitscore threshold for RNAlien model hits on Rfam fasta, default 20",
+ rfamThreshold = 20 &= name "x" &= help "Bitscore threshold for Rfam model hits on Alien fasta, default 20",
+ databaseSize = Nothing &= name "k" &= help "Cmsearch database size in mega bases. default not set",
+ benchmarkIndex = 1 &= name "b" &= help "Index used to identify sRNA tagged RNA families",
+ thresholdSelection = "bitscore" &= name "s" &= help "Selection method, (bitscore, evalue), default bitscore",
+ linkScores = False &= name "l" &= help "Triggers computation of linkscores via CMCompare",
+ threads = 1 &= name "c" &= help "Number of available cpu slots/cores, default 1"
+ } &= summary "RNAlienStatistics" &= help "Florian Eggenhofer - >2013" &= verbosity
+
+--cmSearchFasta threads rfamCovarianceModelPath outputDirectoryPath "Rfam" False genomesDirectoryPath
+cmSearchFasta :: Int -> String -> Double -> Maybe Double -> Int -> String -> String -> String -> String -> IO [CMsearchHit]
+cmSearchFasta benchmarkIndex thresholdSelection thresholdScore databaseSize cpuThreads covarianceModelPath outputDirectory modelType fastapath = do
+ createDirectoryIfMissing False (outputDirectory ++ "/" ++ modelType)
+ _ <- systemCMsearch cpuThreads (maybe "" (\dbs -> " -Z " ++ show dbs ++ " ") databaseSize) covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
+ --_ <- systemCMsearch cpuThreads " " covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ (show benchmarkIndex) ++ ".cmsearch")
+ result <- readCMSearch (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
+ if isLeft result
+ then do
+ print (fromLeft result)
+ return []
+ else do
+ let rightResults = fromRight result
+ let significantHits = filterCMsearchHits thresholdSelection thresholdScore rightResults
+ let uniquesignificantHits = nubBy cmSearchSameHit significantHits
+ return uniquesignificantHits
+
+--cmSearchFasta threads rfamCovarianceModelPath outputDirectoryPath "Rfam" False genomesDirectoryPath
+cmSearchesFasta :: Int -> String -> Double -> Maybe Double -> Int -> String -> String -> String -> String -> IO [CMsearchHit]
+cmSearchesFasta benchmarkIndex thresholdSelection thresholdScore databaseSize cpuThreads covarianceModelPath outputDirectory modelType fastapath = do
+ createDirectoryIfMissing False (outputDirectory ++ "/" ++ modelType)
+ _ <- systemCMsearch cpuThreads (maybe "" (\dbs -> " -Z " ++ show dbs ++ " ") databaseSize) covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
+ --_ <- systemCMsearch cpuThreads " " covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ (show benchmarkIndex) ++ ".cmsearch")
+ result <- readCMSearches (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
+ if isLeft result
+ then do
+ print (fromLeft result)
+ return []
+ else do
+ let rightResults = fromRight result
+ let significantHits = filterCMsearchHits thresholdSelection thresholdScore rightResults
+ --putStrLn ("significant Hits " ++ show (length significantHits))
+ let uniquesignificantHits = nubBy cmSearchSameHit significantHits
+ --putStrLn ("unique significant Hits " ++ show (length uniquesignificantHits))
+ --let organismUniquesignificantHits = nubBy cmSearchSameOrganism significantHits
+ return uniquesignificantHits
+
+filterCMsearchHits :: String -> Double -> CMsearch -> [CMsearchHit]
+filterCMsearchHits thresholdSelection thresholdScore cmSearchResult
+ | thresholdSelection == "bitscore" = bitscorefiltered
+ | otherwise = evaluefiltered
+ where bitscorefiltered = filter (\hit -> hitScore hit >= thresholdScore) (cmsearchHits cmSearchResult)
+ evaluefiltered = filter (\hit -> hitEvalue hit <= thresholdScore) (cmsearchHits cmSearchResult)
+
+partitionCMsearchHits :: String -> Double -> CMsearch -> ([CMsearchHit],[CMsearchHit])
+partitionCMsearchHits thresholdSelection thresholdScore cmSearchResult
+ | thresholdSelection == "bitscore" = (bitscoreselected,bitscorerejected)
+ | otherwise = (evalueselected,evaluerejected)
+ where (bitscoreselected,bitscorerejected) = partition (\hit -> hitScore hit >= thresholdScore) (cmsearchHits cmSearchResult)
+ (evalueselected,evaluerejected) = partition (\hit -> hitEvalue hit <= thresholdScore) (cmsearchHits cmSearchResult)
+
+trimCMsearchFastaFile :: String -> String -> String -> CMsearch -> String -> IO ()
+trimCMsearchFastaFile genomesDirectory outputFolder modelType cmsearch fastafile = do
+ let fastaInputPath = genomesDirectory ++ "/" ++ fastafile
+ let fastaOutputPath = outputFolder ++ "/" ++ modelType ++ "/" ++ fastafile
+ fastaSequences <- readFastaFile fastaInputPath
+ let trimmedSequence = trimCMsearchSequence cmsearch (head fastaSequences)
+ writeFastaFile fastaOutputPath [trimmedSequence]
+
+trimCMsearchSequence :: CMsearch -> Fasta () () -> Fasta () ()
+trimCMsearchSequence cmSearchResult inputSequence = subSequence
+ where hitScoreEntry = head (cmsearchHits cmSearchResult)
+ sequenceString = show (_fasta inputSequence)
+ sequenceSubstring = cmSearchsubString (hitStart hitScoreEntry) (hitEnd hitScoreEntry) sequenceString
+ newSequenceHeader = SequenceIdentifier (B.pack (show (_header inputSequence) ++ "cmS_" ++ show (hitStart hitScoreEntry) ++ "_" ++ show (hitEnd hitScoreEntry) ++ "_" ++ show (hitStrand hitScoreEntry)))
+ subSequence = Fasta newSequenceHeader (BioSequence (B.pack sequenceSubstring))
+
+--With paralogs allowed
+cmSearchSameHit :: CMsearchHit -> CMsearchHit -> Bool
+cmSearchSameHit hitscore1 hitscore2
+ | unpackedSeqHeader1 == unpackedSeqHeader2 = True
+ | otherwise = False
+ where unpackedSeqHeader1 = B.unpack (hitSequenceHeader hitscore1)
+ unpackedSeqHeader2 = B.unpack (hitSequenceHeader hitscore2)
+
+cmSearchSameOrganism :: CMsearchHit -> CMsearchHit -> Bool
+cmSearchSameOrganism hitscore1 hitscore2
+ | hitOrganism1 == hitOrganism2 = True
+ | otherwise = False
+ where unpackedSeqHeader1 = B.unpack (hitSequenceHeader hitscore1)
+ unpackedSeqHeader2 = B.unpack (hitSequenceHeader hitscore2)
+ separationcharacter1 = selectSeparationChar unpackedSeqHeader1
+ separationcharacter2 = selectSeparationChar unpackedSeqHeader2
+ hitOrganism1 = head (DS.splitOn separationcharacter1 unpackedSeqHeader1)
+ hitOrganism2 = head (DS.splitOn separationcharacter2 unpackedSeqHeader2)
+
+selectSeparationChar :: String -> String
+selectSeparationChar inputString
+ | any ((== ':')) inputString = ":"
+ | otherwise = "/"
+
+main :: IO ()
+main = do
+ Options{..} <- cmdArgs options
+ rfamModelExists <- doesFileExist rfamCovarianceModelPath
+ verbose <- getVerbosity
+ rnazString <- rnazOutput verbose alienrnazPath
+ rnacodeString <- rnaCodeOutput verbose alienrnacodePath
+ cmStatString <- cmStatOutput verbose aliencmstatPath
+ if rfamModelExists
+ then do
+ --compute linkscore
+ linkscore <- if linkScores
+ then compareCM rfamCovarianceModelPath alienCovarianceModelPath outputDirectoryPath
+ else return (Left "-")
+ rfamMaxLinkScore <- if linkScores then compareCM rfamCovarianceModelPath rfamCovarianceModelPath outputDirectoryPath else return (Left "-")
+ alienMaxLinkscore <- if linkScores then compareCM alienCovarianceModelPath alienCovarianceModelPath outputDirectoryPath else return (Left "-")
+ _ <- system ("cat " ++ rfamFastaFilePath ++ " | grep '>' | wc -l >" ++ outputDirectoryPath ++ FP.takeFileName rfamFastaFilePath ++ ".entries")
+ _ <- system ("cat " ++ alienFastaFilePath ++ " | grep '>' | wc -l >" ++ outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
+ rfamFastaEntries <- readFile (outputDirectoryPath ++ FP.takeFileName rfamFastaFilePath ++ ".entries")
+ alienFastaEntries <- readFile (outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
+ let rfamFastaEntriesNumber = read rfamFastaEntries :: Int
+ let alienFastaEntriesNumber = read alienFastaEntries :: Int
+ rfamonAlienResults <- cmSearchesFasta benchmarkIndex thresholdSelection rfamThreshold databaseSize threads rfamCovarianceModelPath outputDirectoryPath "rfamOnAlien" alienFastaFilePath
+ alienonRfamResults <- cmSearchFasta benchmarkIndex thresholdSelection alienThreshold databaseSize threads alienCovarianceModelPath outputDirectoryPath "alienOnRfam" rfamFastaFilePath
+ let rfamonAlienResultsNumber = length rfamonAlienResults
+ let alienonRfamResultsNumber = length alienonRfamResults
+ let rfamonAlienRecovery = (fromIntegral rfamonAlienResultsNumber :: Double) / (fromIntegral alienFastaEntriesNumber :: Double)
+ let alienonRfamRecovery = (fromIntegral alienonRfamResultsNumber :: Double) / (fromIntegral rfamFastaEntriesNumber :: Double)
+ if verbose == Loud
+ then do
+ putStrLn ("BenchmarkIndex: " ++ show benchmarkIndex)
+ putStrLn ("RfamModelName: " ++ rfamModelName)
+ putStrLn ("RfamModelId: " ++ rfamModelId)
+ putStrLn ("Linkscore: " ++ either id show linkscore)
+ putStrLn ("rfamMaxLinkScore: " ++ either id show rfamMaxLinkScore)
+ putStrLn ("alienMaxLinkscore: " ++ either id show alienMaxLinkscore)
+ putStrLn ("rfamGatheringThreshold: " ++ show rfamThreshold)
+ putStrLn ("alienGatheringThreshold: " ++ show alienThreshold)
+ putStrLn ("rfamFastaEntriesNumber: " ++ show rfamFastaEntriesNumber)
+ putStrLn ("alienFastaEntriesNumber: " ++ show alienFastaEntriesNumber)
+ putStrLn ("rfamonAlienResultsNumber: " ++ show rfamonAlienResultsNumber)
+ putStrLn ("alienonRfamResultsNumber: " ++ show alienonRfamResultsNumber)
+ putStrLn ("RfamonAlienRecovery: " ++ show rfamonAlienRecovery)
+ putStrLn ("AlienonRfamRecovery: " ++ show alienonRfamRecovery)
+ print rnazString
+ print rnacodeString
+ print cmStatString
+ else
+ putStrLn (show benchmarkIndex ++ "\t" ++ rfamModelName ++ "\t" ++ rfamModelId ++ "\t" ++ (either id show linkscore) ++ "\t" ++ (either id show rfamMaxLinkScore) ++ "\t" ++ (either id show alienMaxLinkscore) ++ "\t" ++ show rfamThreshold ++ "\t" ++ show alienThreshold ++ "\t" ++ show rfamFastaEntriesNumber ++ "\t" ++ show alienFastaEntriesNumber ++ "\t" ++ show rfamonAlienResultsNumber ++ "\t" ++ show alienonRfamResultsNumber ++ "\t" ++ printf "%.2f" rfamonAlienRecovery ++ "\t" ++ printf "%.2f" alienonRfamRecovery ++ "\t" ++ rnazString ++ "\t" ++ rnacodeString ++ "\t" ++ cmStatString)
+ else do
+ --compute linkscore
+ alienMaxLinkscore <- if linkScores then compareCM alienCovarianceModelPath alienCovarianceModelPath outputDirectoryPath else return ( Left "-")
+ _ <- system ("cat " ++ alienFastaFilePath ++ " | grep '>' | wc -l >" ++ outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
+ alienFastaEntries <- readFile (outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
+ let alienFastaEntriesNumber = read alienFastaEntries :: Int
+ if verbose == Loud
+ then do
+ putStrLn "BenchmarkIndex:"
+ putStrLn "RfamModelName: -"
+ putStrLn "RfamModelId: -"
+ putStrLn "Linkscore: -"
+ putStrLn "rfamMaxLinkScore: -"
+ putStrLn ("alienMaxLinkscore: " ++ either id show alienMaxLinkscore)
+ putStrLn "rfamGatheringThreshold: -"
+ putStrLn "alienGatheringThreshold: -"
+ putStrLn "rfamFastaEntriesNumber: -"
+ putStrLn ("alienFastaEntriesNumber: " ++ show alienFastaEntriesNumber)
+ putStrLn "rfamonAlienResultsNumber: -"
+ putStrLn "alienonRfamResultsNumber: -"
+ putStrLn "RfamonAlienRecovery: -"
+ putStrLn "AlienonRfamRecovery: -"
+ print rnazString
+ print cmStatString
+ else
+ putStrLn (show benchmarkIndex ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ (either id show alienMaxLinkscore) ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ show alienFastaEntriesNumber ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ rnazString ++ "\t" ++ rnacodeString ++ "\t" ++ cmStatString)
+
+rnazOutput :: Verbosity -> String -> IO String
+rnazOutput verbose rnazPath = do
+ rnazPresent <- doesFileExist rnazPath
+ if rnazPresent
+ then do
+ inputRNAz <- readRNAz rnazPath
+ if isRight inputRNAz
+ then do
+ let rnaZ = fromRight inputRNAz
+ if verbose == Loud
+ then do
+ let output = "Mean pairwise identity: " ++ show (meanPairwiseIdentity rnaZ) ++ "\n Shannon entropy: " ++ show (shannonEntropy rnaZ) ++ "\n GC content: " ++ show (gcContent rnaZ) ++ "\n Mean single sequence minimum free energy: " ++ show (meanSingleSequenceMinimumFreeEnergy rnaZ) ++ "\n Consensus minimum free energy: " ++ show (consensusMinimumFreeEnergy rnaZ) ++ "\n Energy contribution: " ++ show (energyContribution rnaZ) ++ "\n Covariance contribution: " ++ show (covarianceContribution rnaZ) ++ "\n Combinations pair: " ++ show (combinationsPair rnaZ) ++ "\n Mean z-score: " ++ show (meanZScore rnaZ) ++ "\n Structure conservation index: " ++ show (structureConservationIndex rnaZ) ++ "\n Background model: " ++ backgroundModel rnaZ ++ "\n Decision model: " ++ decisionModel rnaZ ++ "\n SVM decision value: " ++ show (svmDecisionValue rnaZ) ++ "\n SVM class propability: " ++ show (svmRNAClassProbability rnaZ) ++ "\n Prediction: " ++ prediction rnaZ
+ return output
+ else do
+ let output = show (meanPairwiseIdentity rnaZ) ++ "\t" ++ show (shannonEntropy rnaZ) ++ "\t" ++ show (gcContent rnaZ) ++ "\t" ++ show (meanSingleSequenceMinimumFreeEnergy rnaZ) ++ "\t" ++ show (consensusMinimumFreeEnergy rnaZ) ++ "\t" ++ show (energyContribution rnaZ) ++ "\t" ++ show (covarianceContribution rnaZ) ++ "\t" ++ show (combinationsPair rnaZ) ++ "\t" ++ show (meanZScore rnaZ) ++ "\t" ++ show (structureConservationIndex rnaZ) ++ "\t" ++ show (svmDecisionValue rnaZ) ++ "\t" ++ show (svmRNAClassProbability rnaZ) ++ "\t" ++ prediction rnaZ
+ return output
+ else
+ if (verbose == Loud)
+ then do
+ let output = "Mean pairwise identity: " ++ " - \n Shannon entropy: " ++ " - \n GC content: " ++ " - \n Mean single sequence minimum free energy: " ++ " - \n Consensus minimum free energy: " ++ " - \n Energy contribution: " ++ " - \n Covariance contribution: " ++ " - \n Combinations pair: " ++ " - \n Mean z-score: " ++ " - \n Structure conservation index: " ++ " - \n Background model: " ++ " - \n Decision model: " ++ " - \n SVM decision value: " ++ " - \n SVM class propability: " ++ " - \n Prediction: " ++ " - \n"
+ return output
+ else do
+ let output = "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-"
+ return output
+ else
+ if (verbose == Loud)
+ then do
+ let output = "Mean pairwise identity: " ++ " - \n Shannon entropy: " ++ " - \n GC content: " ++ " - \n Mean single sequence minimum free energy: " ++ " - \n Consensus minimum free energy: " ++ " - \n Energy contribution: " ++ " - \n Covariance contribution: " ++ " - \n Combinations pair: " ++ " - \n Mean z-score: " ++ " - \n Structure conservation index: " ++ " - \n Background model: " ++ " - \n Decision model: " ++ " - \n SVM decision value: " ++ " - \n SVM class propability: " ++ " - \n Prediction: " ++ " - \n"
+ return output
+ else do
+ let output = "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-"
+ return output
+
+cmStatOutput :: Verbosity -> String -> IO String
+cmStatOutput verbose cmstatPath = do
+ cmstatPresent <- doesFileExist cmstatPath
+ if cmstatPresent
+ then do
+ inputCMstat <- readCMstat cmstatPath
+ if isRight inputCMstat
+ then do
+ let cmStat = fromRight inputCMstat
+ if verbose == Loud
+ then do
+ let output = "statSequenceNumber: " ++ show (statSequenceNumber cmStat) ++ "\nstatEffectiveSequences: " ++ show (statEffectiveSequences cmStat) ++ "\nstatConsensusLength: " ++ show (statConsensusLength cmStat) ++ "\nstatW: " ++ show (statW cmStat) ++ "\nstatBasepairs: " ++ show (statBasepairs cmStat) ++ "\nstatBifurcations: " ++ show (statBifurcations cmStat) ++ "\nstatModel: " ++ statModel cmStat ++ "\nrelativeEntropyCM: " ++ show (relativeEntropyCM cmStat) ++ "\nrelativeEntropyHMM: " ++ show (relativeEntropyHMM cmStat)
+ return output
+ else do
+ let output = show (statSequenceNumber cmStat) ++ "\t" ++ show (statEffectiveSequences cmStat) ++ "\t" ++ show (statConsensusLength cmStat) ++ "\t" ++ show (statW cmStat) ++ "\t" ++ show (statBasepairs cmStat) ++ "\t" ++ show (statBifurcations cmStat) ++ "\t" ++ statModel cmStat ++ "\t" ++ show (relativeEntropyCM cmStat) ++ "\t" ++ show (relativeEntropyHMM cmStat)
+ return output
+ else
+ if (verbose == Loud)
+ then do
+ let output = "statSequenceNumber: -" ++ "\nstatEffectiveSequences: -" ++ "\nstatConsensusLength: -" ++ "\nstatW: -" ++ "\nstatBasepairs: -" ++ "\nstatBifurcations: -" ++ "\nstatModel: -" ++ "\nrelativeEntropyCM: -" ++ "\nrelativeEntropyHMM: -"
+ return output
+ else do
+ let output = "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-"
+ return output
+ else
+ if (verbose == Loud)
+ then do
+ let output = "statSequenceNumber: -" ++ "\nstatEffectiveSequences: -" ++ "\nstatConsensusLength: -" ++ "\nstatW: -" ++ "\nstatBasepairs: -" ++ "\nstatBifurcations: -" ++ "\nstatModel: -" ++ "\nrelativeEntropyCM: -" ++ "\nrelativeEntropyHMM: -"
+ return output
+ else do
+ let output = "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-"
+ return output
+
+rnaCodeOutput :: Verbosity -> String -> IO String
+rnaCodeOutput verbose rnaCodePath = do
+ rnacodePresent <- doesFileExist rnaCodePath
+ if rnacodePresent
+ then do
+ inputRNACode <- RC.readRNAcodeTabular rnaCodePath
+ if isRight inputRNACode
+ then do
+ let rnaCode = fromRight inputRNACode
+ let lowestPvalue = minimum (map RC.pvalue (RC.rnacodeHits rnaCode))
+ let rnaCodeClassification = if lowestPvalue < 0.05 then "PROTEIN" else "OTHER"
+ if verbose == Loud
+ then do
+ let output = "RNAcode lowest p-value: " ++ show lowestPvalue ++ "\nrnaCodeClassification: " ++ rnaCodeClassification
+ return output
+ else do
+ let output = show lowestPvalue ++ "\t" ++ rnaCodeClassification
+ return output
+ else
+ if (verbose == Loud)
+ then do
+ let output = "RNAcode lowest p-value: " ++ "-" ++ "\nrnaCodeClassification: " ++ "-"
+ return output
+ else do
+ let output = "-\t" ++ "-"
+ --let output = show (fromLeft inputRNACode)
+ return output
+ else
+ if (verbose == Loud)
+ then do
+ let output = "RNAcode lowest p-value: " ++ "-" ++ "\nrnaCodeClassification: " ++ "-"
+ return output
+ else do
+ let output = "-\t" ++ "-"
+ return output
diff --git a/Biobase/cmsearchToBED.hs b/Biobase/cmsearchToBED.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/cmsearchToBED.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Convert cmsearch output to Browser Extensible Data (BED) format
+-- Testcommand: cmsearchToBED -i /path/to/test.clustal
+module Main where
+import Prelude
+import System.Console.CmdArgs
+import Biobase.RNAlien.Library
+import Data.Either.Unwrap
+import qualified Data.ByteString.Char8 as B
+import qualified Data.Text as T
+import Data.List
+
+data Bed = Bed
+ { browserPostition :: T.Text,
+ browserSettings :: T.Text,
+ bedName :: T.Text,
+ bedDescription :: T.Text,
+ bedVisibility :: Int,
+ bedItemRgb :: Bool,
+ bedEntries :: [BedEntry]
+ } deriving (Eq, Read)
+
+instance Show Bed where
+ show (Bed _browserPostition _browserSettings _bedName _bedDescription _bedVisibility _bedItemRgb _bedEntries) = a ++ b ++ c ++ d ++ e ++ f ++ g
+ where a = "browser position " ++ T.unpack _browserPostition ++ "\n"
+ b = T.unpack _browserSettings ++ "\n"
+ c = "track name=\"" ++ T.unpack _bedName ++ "\" "
+ d = "description=\"" ++ T.unpack _bedDescription ++ "\" "
+ e = "visibility=" ++ show _bedVisibility ++ " "
+ f = "itemRgb=\"" ++ itemRbg ++ "\"\n"
+ itemRbg = if _bedItemRgb then "On" else "Off"
+ g = concatMap show _bedEntries
+
+
+data BedEntry = BedEntry
+ { chrom :: T.Text,
+ chromStart :: Int,
+ chromEnd :: Int,
+ chromName :: Maybe T.Text,
+ score :: Maybe Int,
+ strand :: Maybe Char,
+ thickStart :: Maybe Int,
+ thickEnd :: Maybe Int,
+ color :: Maybe T.Text,
+ blockCount :: Maybe Int,
+ blockSizes :: Maybe [Int],
+ blockStarts :: Maybe [Int]
+ } deriving (Eq, Read)
+
+instance Show BedEntry where
+ show (BedEntry _chrom _chromStart _chromEnd _chromName _score _strand _thickStart _thickEnd _color _blockCount _blockSizes _blockStarts) = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h ++ i ++ j ++ k ++ l
+ where a = T.unpack _chrom ++ "\t"
+ b = show _chromStart ++ "\t"
+ c = show _chromEnd ++ "\t"
+ d = maybe "" T.unpack _chromName ++ "\t"
+ e = maybe "" show _score ++ "\t"
+ f = maybe "" ((: [])) _strand ++ "\t"
+ g = maybe "" show _thickStart ++ "\t"
+ h = maybe "" show _thickEnd ++ "\t"
+ i = maybe "" T.unpack _color ++ "\t"
+ j = maybe "" show _blockCount ++ "\t"
+ k = maybe "" (intercalate "," . map show) _blockSizes ++ "\t"
+ l = maybe "" (intercalate "," . map show) _blockStarts ++ "\n"
+
+data Options = Options
+ { cmsearchPath :: String,
+ inputBrowserSettings :: String,
+ inputBedVisibility :: Int,
+ inputTrackName :: String,
+ inputTrackDescription :: String,
+ inputItemRgb :: Bool,
+ inputTrackColor :: String,
+ sortBed :: Bool,
+ withHeader :: Bool
+ } deriving (Show,Data,Typeable)
+
+options :: Options
+options = Options
+ { cmsearchPath = def &= name "i" &= help "Path to input cmsearch file",
+ inputBrowserSettings = "browser hide all" &= name "b" &= help "Browser settings. Default: browser hide all",
+ inputBedVisibility = (2 :: Int) &= name "y" &= help "Visibility setting of track. Default: 2",
+ inputTrackName = "PredictedRNA" &= name "n" &= help "Name of the track Default: PredictedRNA",
+ inputTrackDescription = "RNA loci predicted by cmsearch" &= name "d" &= help "Description of the track. Default: RNA loci predicted by cmsearch",
+ inputItemRgb = True &= name "r" &= help "RGB Color of the track. Default: True",
+ inputTrackColor = "255,0,0" &= name "c" &= help "RGB Color of the track. Default: 255,0,0",
+ sortBed = True &= name "s" &= help "Sort entries of Bed file by start end end cooridinates. Default: True",
+ withHeader = True &= name "w" &= help "Output contains bed header. Default: True"
+ } &= summary "cmsearchToBED - Converts cmsearch file hits to BED file entries" &= help "Florian Eggenhofer 2016" &= verbosity
+
+main :: IO ()
+main = do
+ Options{..} <- cmdArgs options
+ parsedCmsearch <- readCMSearch cmsearchPath
+ if isRight parsedCmsearch
+ then do
+ let outputBED = convertcmSearchToBED (fromRight parsedCmsearch) inputBrowserSettings inputTrackName inputTrackDescription inputTrackColor inputBedVisibility inputItemRgb sortBed
+ if isRight outputBED
+ then
+ if withHeader
+ then print (fromRight outputBED)
+ else do
+ let output = concatMap show (bedEntries (fromRight outputBED))
+ putStr output
+ else putStr (fromLeft outputBED)
+ else putStr ("A problem occured converting from cmsearch to BED format:\n " ++ show (fromLeft parsedCmsearch))
+
+--convertcmSearchToBED :: CMsearch -> String -> String -> Either String String
+--convertcmSearchToBED inputcmsearch trackName trackColor
+-- | null cmHits = Left "cmsearch file contains no hits"
+-- | otherwise = Right (bedHeader ++ bedEntries)
+-- where cmHits = cmsearchHits inputcmsearch
+-- bedHeader = "browser position " ++ browserPosition ++ "\nbrowser hide all\ntrack name=\"cmsearch hits\" description=\"cmsearch hits\" visibility=2 itemRgb=\"On\"\n"
+-- bedEntries = concatMap (cmsearchHitToBEDentry trackName trackColor) cmHits
+-- browserPosition = L.unpack (hitSequenceHeader firstHit) ++ ":" ++ entryStart firstHit ++ "-" ++ entryEnd firstHit
+-- firstHit = (head cmHits)
+
+convertcmSearchToBED :: CMsearch -> String -> String -> String -> String -> Int -> Bool -> Bool -> Either String Bed
+convertcmSearchToBED inputcmsearch inputBrowserSettings trackName trackDescription trackColor inputBedVisibility inputItemRgb sortBed
+ | null cmHits = Left "cmsearch file contains no hits"
+ | otherwise = Right bed
+ where cmHits = cmsearchHits inputcmsearch
+ --bedHeader = "browser position " ++ browserPosition ++ "\nbrowser hide all\ntrack name=\"cmsearch hits\" description=\"cmsearch hits\" visibility=2 itemRgb=\"On\"\n"
+ bedEntries = map (cmsearchHitToBEDentry trackName trackColor) cmHits
+ sortedBedEntries = if sortBed then sortBy orderBedEntry bedEntries else bedEntries
+ currentBrowserPosition = T.unpack (chrom firstEntry) ++ ":" ++ show (chromStart firstEntry) ++ "-" ++ show (chromEnd firstEntry)
+ firstEntry = head sortedBedEntries
+ bed = Bed (T.pack currentBrowserPosition) (T.pack inputBrowserSettings) (T.pack trackName) (T.pack trackDescription) inputBedVisibility inputItemRgb sortedBedEntries
+
+cmsearchHitToBEDentry :: String -> String -> CMsearchHit -> BedEntry
+cmsearchHitToBEDentry hitName hitColor cmHit = entry
+ where entry = BedEntry chromosome entrystart entryend (Just (T.pack hitName)) entryscore entrystrand thickstart thickend entrycolor blocks blockSize blockStart
+ chromosome = T.pack (B.unpack (hitSequenceHeader cmHit))
+ --entryline = L.unpack (hitSequenceHeader cmHit) ++ "\t" ++ entryStart cmHit ++ "\t" ++ entryEnd cmHit++ "\t" ++ (hitName) ++ "\t" ++ "0" ++ "\t" ++ [(hitStrand cmHit)] ++ "\t" ++ show (hitStart cmHit) ++ "\t" ++ show (hitEnd cmHit) ++ "\t" ++ hitColor ++ "\n"
+ entrystart = if hitStrand cmHit == '+' then hitStart cmHit else hitEnd cmHit
+ entryend = if hitStrand cmHit == '+' then hitEnd cmHit else hitStart cmHit
+ entryscore = Just (0 :: Int)
+ entrystrand = Just (hitStrand cmHit)
+ thickstart = Just entrystart
+ thickend = Just entryend
+ entrycolor = Just (T.pack hitColor)
+ blocks = Just (1 :: Int)
+ blockSize = Just [entryend - entrystart]
+ blockStart = Just [0 :: Int]
+
+
+--cmsearchHitToBEDentry :: String -> String -> CMsearchHit -> String
+--cmsearchHitToBEDentry hitName hitColor cmHit = entryline
+-- where entryline = L.unpack (hitSequenceHeader cmHit) ++ "\t" ++ entryStart cmHit ++ "\t" ++ entryEnd cmHit++ "\t" ++ (hitName) ++ "\t" ++ "0" ++ "\t" ++ [(hitStrand cmHit)] ++ "\t" ++ show (hitStart cmHit) ++ "\t" ++ show (hitEnd cmHit) ++ "\t" ++ hitColor ++ "\n"
+ --entrystart = if (hitStrand cmHit) == '+' then show (hitStart cmHit) else show (hitEnd cmHit)
+ --entryend = if (hitStrand cmHit) == '+' then show (hitEnd cmHit) else show (hitStart cmHit)
+
+entryStart :: CMsearchHit -> String
+entryStart cmHit
+ | hitStrand cmHit == '+' = show (hitStart cmHit)
+ | otherwise = show (hitEnd cmHit)
+
+entryEnd :: CMsearchHit -> String
+entryEnd cmHit
+ | hitStrand cmHit == '+' = show (hitEnd cmHit)
+ | otherwise = show (hitStart cmHit)
+
+orderBedEntry :: BedEntry -> BedEntry -> Ordering
+orderBedEntry firstHit secondHit
+ | start1 > start2 = GT
+ | start1 < start2 = LT
+ | otherwise = orderBedEntryEnd firstHit secondHit
+ where start1 = chromStart firstHit
+ start2 = chromStart secondHit
+
+orderBedEntryEnd :: BedEntry -> BedEntry -> Ordering
+orderBedEntryEnd firstHit secondHit
+ | end1 > end2 = GT
+ | end1 < end2 = LT
+ | otherwise = EQ
+ where end1 = chromEnd firstHit
+ end2 = chromEnd secondHit
diff --git a/RNAlien.cabal b/RNAlien.cabal
--- a/RNAlien.cabal
+++ b/RNAlien.cabal
@@ -1,48 +1,49 @@
name: RNAlien
-version: 1.3.7
+version: 1.6.0
synopsis: Unsupervized construction of RNA family models
description: RNAlien is a tool for automatic construction of RNAfamily models from a single sequence.
.
It is available as a commandline tool, for testing or construction of few sequences the webservice can be used.
.
The source code of RNAlien, as well as the webserver is open source and available via GitHub (License GPL-3):
- .
- *
- .
- *
.
+ *
+ .
+ *
+ .
TaxonomyTools which can be used to visualise the organisms included in a RNAlien result can be found here (License GPL-3):
- .
- *
- .
- *
.
+ *
+ .
+ *
+ .
For instruction how to use RNAlien please see the .
.
Dependencies:
- .
+ .
*
- .
- *
- .
- *
.
- *
- .
- *
+ *
.
+ *
+ .
+ *
+ .
+ *
+ .
Installation via cabal-install:
.
> cabal install RNAlien
-
+
license: GPL-3
license-file: LICENSE
author: Florian Eggenhofer
-maintainer: egg@tbi.univie.ac.at
--- copyright:
+maintainer: egg@informatik.uni-freiburg.de
+copyright: Florian Eggenhofer
category: Bioinformatics
build-type: Simple
-cabal-version: >=1.8
+cabal-version: >= 1.10.0
+tested-with: GHC == 8.4.4
source-repository head
type: git
@@ -50,40 +51,51 @@
source-repository this
type: git
- location: https://github.com/eggzilla/RNAlien/tree/1.3.7
- tag: 1.3.7
-
+ location: https://github.com/eggzilla/RNAlien/tree/1.6.0
+ tag: 1.6.0
+
executable RNAlien
- Hs-Source-Dirs: ./src/Bio/
- main-is: RNAlien.hs
- ghc-options: -Wall
- build-depends: base >=4.5 && <5, cmdargs, directory, biofasta, random, biocore, containers, RNAlien, time, either-unwrap, filepath
+ Hs-Source-Dirs: ./Biobase/
+ main-is: RNAlien.hs
+ ghc-options: -Wall
+ default-language: Haskell2010
+ other-modules: Paths_RNAlien
+ build-depends: base >=4.5 && <5, cmdargs, directory,
+ random, containers, RNAlien, time, either-unwrap, filepath,
+ BiobaseFasta == 0.3.0.*
executable RNAlienStatistics
- Hs-Source-Dirs: ./src/Bio/
+ Hs-Source-Dirs: ./Biobase/
main-is: RNAlienStatistics.hs
- ghc-options: -Wall
- build-depends: base >=4.5 && <5, cmdargs, cassava, vector, process, bytestring, either-unwrap, RNAlien, directory, biofasta, biocore, split, filepath, ViennaRNAParser>=1.3.2
+ ghc-options: -Wall
+ default-language: Haskell2010
+ other-modules: Paths_RNAlien
+ build-depends: base >=4.5 && <5, cmdargs, cassava, vector, process, bytestring, either-unwrap, RNAlien, directory, split, filepath, ViennaRNAParser>=1.3.2, BiobaseFasta == 0.3.0.*, BiobaseTypes == 0.2.0.*
executable cmsearchToBed
- Hs-Source-Dirs: ./src/Bio/
+ Hs-Source-Dirs: ./Biobase/
main-is: cmsearchToBED.hs
- ghc-options: -Wall
+ ghc-options: -Wall
+ default-language: Haskell2010
+ other-modules: Paths_RNAlien
build-depends: base >=4.5 && <5, cmdargs, either-unwrap, RNAlien, bytestring, text
executable RNAcentralHTTPRequest
- Hs-Source-Dirs: ./src/Bio/
+ Hs-Source-Dirs: ./Biobase/
main-is: RNAcentralHTTPRequest.hs
- ghc-options: -Wall
+ ghc-options: -Wall
+ default-language: Haskell2010
+ other-modules: Paths_RNAlien
build-depends: base >=4.5 && <5, cmdargs, either-unwrap, RNAlien
-
+
Library
- Hs-Source-Dirs: ./src/
+ Hs-Source-Dirs: .
ghc-options: -Wall -fno-warn-unused-do-bind
- build-depends: base >=4.5 && <5, cmdargs, ViennaRNAParser>=1.3.2, process, directory, blastxml>=0.3.2, biofasta, parsec, random, BlastHTTP>=1.2.1, biocore, bytestring, Taxonomy >= 1.0.2, either-unwrap, containers, ClustalParser>=1.2.1, EntrezHTTP>=1.0.3, vector, edit-distance, cassava, matrix, hierarchical-clustering, filepath, HTTP, http-conduit, hxt, network, aeson, text, transformers, pureMD5, http-types, text-metrics
- Exposed-Modules: Bio.RNAlienData
- Bio.RNAlienLibrary
- Bio.RNAcentralHTTP
- Bio.InfernalParser
-
-
+ default-language: Haskell2010
+ build-depends: base >=4.5 && <5, cmdargs, ViennaRNAParser>=1.3.2, process, directory,
+ parsec, random, bytestring, Taxonomy >= 1.0.3, either-unwrap, containers, ClustalParser>=1.2.1, vector, edit-distance, cassava, matrix, hierarchical-clustering, filepath, HTTP, http-conduit, hxt, network<=2.8.0.0, aeson, text, transformers, pureMD5, http-types, text-metrics,
+ BiobaseTypes == 0.2.0.*, BiobaseFasta == 0.3.0.* , BiobaseBlast == 0.3.0.*, BlastHTTP >= 1.4.0, BiobaseHTTP == 1.1.0
+ Exposed-Modules: Biobase.RNAlien.Types
+ Biobase.RNAlien.Library
+ Biobase.RNAlien.RNAcentralHTTP
+ Biobase.RNAlien.InfernalParser
diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/src/Bio/InfernalParser.hs b/src/Bio/InfernalParser.hs
deleted file mode 100644
--- a/src/Bio/InfernalParser.hs
+++ /dev/null
@@ -1,340 +0,0 @@
--- | This module contains parsing functions for Infernal programs
-
-module Bio.InfernalParser (
- module Bio.RNAlienData,
- readCMSearch,
- readCMSearches,
- parseCMSearch,
- parseCMSearches,
- parseCMstat,
- readCMstat
- )
-where
-
-import Text.ParserCombinators.Parsec
-import Bio.RNAlienData
-import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Control.Exception.Base as CE
-
--- | parse from input filePath
-parseCMSearch :: String -> Either ParseError CMsearch
-parseCMSearch = parse genParserCMSearch "parseCMsearch"
-
--- | parse from input filePath
-parseCMSearches :: String -> Either ParseError CMsearch
-parseCMSearches = parse genParserCMSearches "parseCMsearch"
-
--- | parse from input filePath
-readCMSearch :: String -> IO (Either ParseError CMsearch)
-readCMSearch filePath = do
- parsedFile <- parseFromFile genParserCMSearch filePath
- CE.evaluate parsedFile
-
--- | parse from input filePath
-readCMSearches :: String -> IO (Either ParseError CMsearch)
-readCMSearches filePath = do
- parsedFile <- parseFromFile genParserCMSearches filePath
- CE.evaluate parsedFile
-
-genParserCMSearches :: GenParser Char st CMsearch
-genParserCMSearches = do
- string "# cmsearch :: search CM(s) against a sequence database"
- newline
- string "# INFERNAL "
- many1 (noneOf "\n")
- newline
- string "# Copyright (C) 201"
- many1 (noneOf "\n")
- newline
- string "# Freely distributed under the GNU General Public License (GPLv3)."
- newline
- string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
- newline
- string "# query CM file:"
- many1 space
- queryCMfile' <- many1 (noneOf "\n")
- newline
- string "# target sequence database:"
- many1 space
- targetSequenceDatabase' <- many1 (noneOf "\n")
- newline
- optional (try (genParserCMsearchHeaderField "# CM configuration"))
- optional (try (genParserCMsearchHeaderField "# database size is set to"))
- optional (try (genParserCMsearchHeaderField "# truncated sequence detection"))
- string "# number of worker threads:"
- many1 space
- numberOfWorkerThreads' <- many1 (noneOf "\n")
- newline
- string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
- newline
- optional newline
- cmSearchesHits <- many1 (try genParserMultipleCMSearch)
- optional (string "[ok]\n")
- eof
- return $ CMsearch queryCMfile' targetSequenceDatabase' numberOfWorkerThreads' (concat cmSearchesHits)
-
-genParserCMSearch :: GenParser Char st CMsearch
-genParserCMSearch = do
- string "# cmsearch :: search CM(s) against a sequence database"
- newline
- string "# INFERNAL "
- many1 (noneOf "\n")
- newline
- string "# Copyright (C) 201"
- many1 (noneOf "\n")
- newline
- string "# Freely distributed under the GNU General Public License (GPLv3)."
- newline
- string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
- newline
- string "# query CM file:"
- many1 space
- queryCMfile' <- many1 (noneOf "\n")
- newline
- string "# target sequence database:"
- many1 space
- targetSequenceDatabase' <- many1 (noneOf "\n")
- newline
- optional (try (genParserCMsearchHeaderField "# CM configuration"))
- optional (try (genParserCMsearchHeaderField "# database size is set to"))
- optional (try (genParserCMsearchHeaderField "# truncated sequence detection"))
- string "# number of worker threads:"
- many1 space
- numberOfWorkerThreads' <- many1 (noneOf "\n")
- newline
- string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
- newline
- optional newline
- string "Query:"
- many1 (noneOf "\n")
- newline
- optional (try (genParserCMsearchHeaderField "Accession"))
- optional (try (genParserCMsearchHeaderField "Description"))
- string "Hit scores:"
- newline
- choice [try (string " rank"), try (string " rank") , try (string " rank"), try (string " rank"),try (string " rank"),try (string " rank")]
- many1 space
- string "E-value"
- many1 space
- string "score"
- many1 space
- string "bias"
- many1 space
- string "sequence"
- many1 space
- string "start"
- many1 space
- string "end"
- many1 space
- string "mdl"
- many1 space
- string "trunc"
- many1 space
- string "gc"
- many1 space
- string "description"
- newline
- string " -"
- many1 (try (oneOf " -"))
- newline
- optional (try (string " ------ inclusion threshold ------"))
- many newline
- hitScores' <- many (try genParserCMsearchHit) --`endBy` (try (string "Hit alignments:"))
- optional (try genParserCMsearchEmptyHit)
- -- this is followed by hit alignments and internal cmsearch statistics which are not parsed
- many anyChar
- eof
- return $ CMsearch queryCMfile' targetSequenceDatabase' numberOfWorkerThreads' hitScores'
-
--- | Parsing function for CMSearches with multiple querymodels in one modelfile, e.g. clans
-genParserMultipleCMSearch :: GenParser Char st [CMsearchHit]
-genParserMultipleCMSearch = do
- --optional newline
- --optional string "//"
- string "Query:"
- many1 (noneOf "\n")
- newline
- optional (try (genParserCMsearchHeaderField "Accession"))
- optional (try (genParserCMsearchHeaderField "Description"))
- string "Hit scores:"
- newline
- choice [try (string " rank"), try (string " rank") , try (string " rank"), try (string " rank"),try (string " rank"),try (string " rank")]
- many1 space
- string "E-value"
- many1 space
- string "score"
- many1 space
- string "bias"
- many1 space
- string "sequence"
- many1 space
- string "start"
- many1 space
- string "end"
- many1 space
- string "mdl"
- many1 space
- string "trunc"
- many1 space
- string "gc"
- many1 space
- string "description"
- newline
- string " -"
- many1 (try (oneOf " -"))
- newline
- optional (try (string " ------ inclusion threshold ------"))
- many newline
- hitScores' <- many (try genParserCMsearchHit) --`endBy` (try (string "Hit alignments:"))
- optional (try genParserCMsearchEmptyHit)
- -- this is followed by hit alignments and internal cmsearch statistics which are not parsed
- --many anyChar
- manyTill anyChar (try (string "//\n"))
- return hitScores'
-
-genParserCMsearchHeaderField :: String -> GenParser Char st String
-genParserCMsearchHeaderField fieldname = do
- string (fieldname ++ ":")
- many1 space
- many1 (noneOf "\n")
- newline
- return []
-
-genParserCMsearchEmptyHit :: GenParser Char st [CMsearchHit]
-genParserCMsearchEmptyHit = do
- string " [No hits detected that satisfy reporting thresholds]"
- newline
- optional (try newline)
- return []
-
-genParserCMsearchHit :: GenParser Char st CMsearchHit
-genParserCMsearchHit = do
- many1 space
- string "("
- hitRank' <- many1 digit
- string ")"
- many1 space
- hitSignificant' <- choice [char '!', char '?']
- many1 space
- hitEValue' <- many1 (oneOf "0123456789.e-")
- many1 space
- hitScore' <- many1 (oneOf "0123456789.e-")
- many1 space
- hitBias' <- many1 (oneOf "0123456789.e-")
- many1 space
- hitSequenceHeader' <- many1 (noneOf " ")
- many1 space
- hitStart' <- many1 digit
- many1 space
- hitEnd' <- many1 digit
- many1 space
- hitStrand' <- choice [char '+', char '-', char '.']
- many1 space
- hitModel' <- many1 letter
- many1 space
- hitTruncation' <- many1 (choice [alphaNum, char '\''])
- many1 space
- hitGCcontent' <- many1 (oneOf "0123456789.e-")
- many1 space
- hitDescription' <- many1 (noneOf "\n")
- newline
- optional (try (string " ------ inclusion threshold ------"))
- optional (try newline)
- return $ CMsearchHit (readInt hitRank') hitSignificant' (readDouble hitEValue') (readDouble hitScore') (readDouble hitBias') (L.pack hitSequenceHeader') (readInt hitStart') (readInt hitEnd') hitStrand' (L.pack hitModel') (L.pack hitTruncation') (readDouble hitGCcontent') (L.pack hitDescription')
-
--- | parse from input filePath
-parseCMstat :: String -> Either ParseError CMstat
-parseCMstat = parse genParserCMstat "parseCMstat"
-
--- | parse from input filePath
-readCMstat :: String -> IO (Either ParseError CMstat)
-readCMstat filePath = do
- parsedFile <- parseFromFile genParserCMstat filePath
- CE.evaluate parsedFile
-
-genParserCMstat :: GenParser Char st CMstat
-genParserCMstat = do
- string "# cmstat :: display summary statistics for CMs"
- newline
- string "# INFERNAL "
- many1 (noneOf "\n")
- newline
- string "# Copyright (C) 201"
- many1 (noneOf "\n")
- newline
- string "# Freely distributed under the GNU General Public License (GPLv3)."
- newline
- string "# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
- newline
- char '#'
- many1 (char ' ')
- string "rel entropy"
- newline
- char '#'
- many1 (char ' ')
- many1 (char '-')
- newline
- char '#'
- many1 space
- string "idx"
- many1 space
- string "name"
- many1 space
- string "accession"
- many1 space
- string "nseq"
- many1 space
- string "eff_nseq"
- many1 space
- string "clen"
- many1 space
- string "W"
- many1 space
- string "bps"
- many1 space
- string "bifs"
- many1 space
- string "model"
- many1 space
- string "cm"
- many1 space
- string "hmm"
- newline
- string "#"
- many1 (try (oneOf " -"))
- newline
- many1 space
- _statIndex <- many1 digit
- many1 space
- _statName <- many1 letter
- many1 space
- _statAccession <- many1 (noneOf " ")
- many1 space
- _statSequenceNumber <- many1 digit
- many1 space
- _statEffectiveSequences <- many1 (oneOf "0123456789.e-")
- many1 space
- _statConsensusLength <- many digit
- many1 space
- _statW <- many1 digit
- many1 space
- _statBasepaires <- many1 digit
- many1 space
- _statBifurcations <- many1 digit
- many1 space
- _statModel <- many1 letter
- many1 space
- _relativeEntropyCM <- many1 (oneOf "0123456789.e-")
- many1 space
- _relativeEntropyHMM <- many1 (oneOf "0123456789.e-")
- newline
- char '#'
- newline
- eof
- return $ CMstat (readInt _statIndex) _statName _statAccession (readInt _statSequenceNumber) (readDouble _statEffectiveSequences) (readInt _statConsensusLength) (readInt _statW) (readInt _statBasepaires) (readInt _statBifurcations) _statModel (readDouble _relativeEntropyCM) (readDouble _relativeEntropyHMM)
---
-readInt :: String -> Int
-readInt = read
-
-readDouble :: String -> Double
-readDouble = read
diff --git a/src/Bio/RNAcentralHTTP.hs b/src/Bio/RNAcentralHTTP.hs
deleted file mode 100644
--- a/src/Bio/RNAcentralHTTP.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-{-# LANGUAGE DeriveGeneric #-}
-
--- | Interface for the RNAcentral REST webservice.
---
-module Bio.RNAcentralHTTP (rnaCentralHTTP,
- buildSequenceViaMD5Query,
- buildStringViaMD5Query,
- getRNACentralEntries,
- showRNAcentralAlienEvaluation,
- RNAcentralEntryResponse(..),
- RNAcentralEntry(..)
- ) where
-
-import Network.HTTP.Conduit
-import qualified Data.ByteString.Lazy.Char8 as L8
-import Network
-import Control.Concurrent
-import Data.Text
-import Data.Aeson
-import GHC.Generics
-import qualified Data.Digest.Pure.MD5 as M
-import Bio.Core.Sequence
-import Bio.Sequence.Fasta
-import Data.Either
-
---Datatypes
--- | Data structure for RNAcentral entry response
-data RNAcentralEntryResponse = RNAcentralEntryResponse
- {
- count :: Int,
- next :: Maybe Text,
- previous :: Maybe Text,
- results :: [RNAcentralEntry]
- }
- deriving (Show, Eq, Generic)
-
-instance ToJSON RNAcentralEntryResponse where
- toJSON = genericToJSON defaultOptions
- --toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON RNAcentralEntryResponse
-
-data RNAcentralEntry = RNAcentralEntry
- {
- url :: Text,
- rnacentral_id :: Text,
- md5 :: Text,
- sequence :: Text,
- length :: Int,
- xrefs :: Text,
- publications :: Text
- }
- deriving (Show, Eq, Generic)
-
-instance ToJSON RNAcentralEntry where
- toJSON = genericToJSON defaultOptions
- --toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON RNAcentralEntry
-
--- | Send query and parse return XML
-startSession :: String -> IO (Either String RNAcentralEntryResponse)
-startSession query' = do
- requestXml <- withSocketsDo
- $ sendQuery query'
- --putStr (L8.unpack requestXml)
- let eitherErrorResponse = eitherDecode requestXml :: Either String RNAcentralEntryResponse
- return eitherErrorResponse
-
--- | Send query and return response XML
-sendQuery :: String -> IO L8.ByteString
-sendQuery query' = do
- let address = "http://rnacentral.org/api/v1/rna/"
- let request = address ++ query'
- --putStrLn request
- simpleHttp request
-
--- | Function for querying the RNAcentral REST interface.
-rnaCentralHTTP :: String -> IO (Either String RNAcentralEntryResponse)
-rnaCentralHTTP query' =
- startSession query'
-
--- | Function for delayed queries to the RNAcentral REST interface. Enforces the maximum 20 requests per second policy.
-delayedRNACentralHTTP :: String -> IO (Either String RNAcentralEntryResponse)
-delayedRNACentralHTTP query' = do
- threadDelay 55000
- startSession query'
-
-getRNACentralEntries :: [String] -> IO [Either String RNAcentralEntryResponse]
-getRNACentralEntries queries = do
- mapM delayedRNACentralHTTP queries
-
---Build a query from a input sequence
-buildSequenceViaMD5Query :: Sequence -> String
-buildSequenceViaMD5Query s = qString
- where querySequence = unSD (seqdata s)
- querySequenceUreplacedwithT = L8.map bsreplaceUT querySequence
- querySequenceU2Twolb = L8.filter ((/= '\n')) querySequenceUreplacedwithT
- md5Sequence = M.md5 querySequenceU2Twolb
- qString = "?md5=" ++ show md5Sequence
-
---Build a query from a input string
-buildStringViaMD5Query :: String -> String
-buildStringViaMD5Query s = qString
- where querySequenceUreplacedwithT = L8.map bsreplaceUT (L8.pack s)
- querySequenceU2Twolb = L8.filter ((/= '\n')) querySequenceUreplacedwithT
- md5Sequence = M.md5 querySequenceU2Twolb
- qString = "?md5=" ++ show md5Sequence
-
-showRNAcentralAlienEvaluation :: [Either String RNAcentralEntryResponse] -> String
-showRNAcentralAlienEvaluation responses = output
- where resultEntries = Prelude.concatMap results (rights responses)
- resulthead = "rnacentral_id\tmd5\tlength\n"
- resultentries = Prelude.concatMap showRNAcentralAlienEvaluationLine resultEntries
- output = if Prelude.null resultentries then "No matching sequences found in RNAcentral\n" else resulthead ++ resultentries
-
-showRNAcentralAlienEvaluationLine :: RNAcentralEntry -> String
-showRNAcentralAlienEvaluationLine entry = unpack (rnacentral_id entry) ++ "\t" ++ unpack (md5 entry) ++ "\t" ++ show (Bio.RNAcentralHTTP.length entry) ++"\n"
-
-bsreplaceUT :: Char -> Char
-bsreplaceUT a
- | a == 'U' = 'T'
- | otherwise = a
-
diff --git a/src/Bio/RNAcentralHTTPRequest.hs b/src/Bio/RNAcentralHTTPRequest.hs
deleted file mode 100644
--- a/src/Bio/RNAcentralHTTPRequest.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | RNAcentralHTTPRequest
--- Testcommand: dist/build/RNAcentralHTTPRequest/RNAcentralHTTPRequest -i ATACTTACCTGGCACAGGGGATACCACGATCACCAAGGTGGTTCCCCCAAGACGAGGCTCACCATTGCACTCCGGTGGCGCTGACCCTTGCAATGACCCCAAATGTGGGTTACTCGGGTGTGTAATTTCTGTTAGCTGGGGACTGCGTTCGCGCTTTCCCCTT
-module Main where
-
-import System.Console.CmdArgs
-import Bio.RNAcentralHTTP
-
-data Options = Options
- { inputSequence :: String
- } deriving (Show,Data,Typeable)
-
-options :: Options
-options = Options
- { inputSequence = def &= name "i" &= help "input sequence"
- } &= summary "RNAcentralHTTPRequest" &= help "Florian Eggenhofer 2016" &= verbosity
-
-main :: IO ()
-main = do
- Options{..} <- cmdArgs options
- let query = buildStringViaMD5Query inputSequence
- rnacentralentries <- getRNACentralEntries [query]
- print rnacentralentries
-
diff --git a/src/Bio/RNAlien.hs b/src/Bio/RNAlien.hs
deleted file mode 100644
--- a/src/Bio/RNAlien.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | Unsupervized construction of RNA family models
--- For more information on RNA family models consult
--- Testcommand: dist/build/RNAlien/RNAlien -i ~egg/initialfasta/RybB.fa -c 3 -o /scr/kronos/egg/temp/ > ~egg/Desktop/alieninitialtest
-module Main where
-
-import System.Console.CmdArgs
-import System.Directory
-import Bio.Sequence.Fasta
-import Bio.RNAlienData
-import Bio.RNAlienLibrary
-import Data.Maybe
-import Data.Either.Unwrap
-import Data.Time
-import qualified System.FilePath as FP
-import Paths_RNAlien (version)
-import Data.Version (showVersion)
-
-data Options = Options
- { inputFastaFilePath :: String,
- outputPath :: String,
- inputTaxId :: Maybe Int,
- inputnSCICutoff :: Maybe Double,
- inputEvalueCutoff :: Maybe Double,
- inputBlastDatabase :: Maybe String,
- lengthFilter :: Bool,
- coverageFilter :: Bool,
- singleHitperTax :: Bool,
- blastSoftmasking :: Bool,
- inputQuerySelectionMethod :: String,
- inputQueryNumber :: Int,
- threads :: Int,
- taxonomyRestriction :: Maybe String,
- sessionIdentificator :: Maybe String,
- performEvaluation :: Bool,
- checkSetup :: Bool
- } deriving (Show,Data,Typeable)
-
-options :: Options
-options = Options
- { inputFastaFilePath = def &= name "i" &= help "Path to input fasta file",
- outputPath = def &= name "o" &= help "Path to output directory. Default: current working directory",
- inputTaxId = Nothing &= name "t" &= help "NCBI taxonomy ID number of input RNA organism",
- inputnSCICutoff = Just (1 :: Double) &= name "z" &= help "Only candidate sequences with a normalized structure conservation index (nSCI) higher than this value are accepted. Default: 1",
- inputEvalueCutoff = Just (0.001 :: Double) &= name "e" &= help "Evalue cutoff for cmsearch filtering. Default: 0.001",
- inputBlastDatabase = Just "nt" &= name "b" &= help "Specify name of blast database to use. Default: nt",
- lengthFilter = True &= name "l" &= help "Filter blast hits per genomic length. Default: True",
- coverageFilter = True &= name "a" &= help "Filter blast hits by coverage of at least 80%. Default: True",
- singleHitperTax = False &= name "s" &= help "Only the best blast hit per taxonomic entry is considered. Default: False",
- blastSoftmasking = False &= name "f" &= help "Toggles blast query softmasking, meaning masking of non-conserved regions on the query. Default: False",
- inputQuerySelectionMethod = "filtering" &= name "m" &= help "Method for selection of queries (filtering,clustering). Default: filtering",
- inputQueryNumber = (5 :: Int) &= name "n" &= help "Number of queries used for candidate search. Default: 5",
- threads = 1 &= name "c" &= help "Number of available cpu slots/cores. Default: 1",
- taxonomyRestriction = Nothing &= name "r" &= help "Restrict search space to taxonomic kingdom (bacteria,archea,eukaryia). Default: not set",
- sessionIdentificator = Nothing &= name "d" &= help "Optional session id that is used instead of automatically generated one.",
- performEvaluation = True &= name "x" &= help "Perform evaluation step. Default: True",
- checkSetup = False &= name "g" &= help "Just prints installed tool versions and performs connection check. Default: False"
- } &= summary ("RNAlien " ++ alienVersion) &= help "Florian Eggenhofer, Ivo L. Hofacker, Christian Hoener zu Siederdissen - 2013 - 2017" &= verbosity
-
-main :: IO ()
-main = do
- Options{..} <- cmdArgs options
- verboseLevel <- getVerbosity
- let tools = if inputQuerySelectionMethod == "clustering" then ["clustalo","mlocarna","RNAfold","RNAalifold","cmcalibrate","cmstat","cmbuild","RNAz","RNAcode"] else ["mlocarna","RNAfold","RNAalifold","cmcalibrate","cmstat","cmbuild","RNAz","RNAcode"]
- -- Generate SessionID
- sessionId <- createSessionID sessionIdentificator
- timestamp <- getCurrentTime
- currentWorkDirectory <- getCurrentDirectory
- let selectedOutputPath = if null outputPath then currentWorkDirectory else outputPath
- let temporaryDirectoryPath = FP.addTrailingPathSeparator selectedOutputPath ++ sessionId ++ "/"
- createDirectoryIfMissing False temporaryDirectoryPath
- networkCheck <- checkNCBIConnection
- if checkSetup
- then do
- toolsCheck <- checkTools tools inputQuerySelectionMethod temporaryDirectoryPath
- let setupCheckPath = temporaryDirectoryPath ++ "setupCheck"
- let toolCheckResult = either id id toolsCheck
- let networkCheckResult = either id id networkCheck
- writeFile setupCheckPath (toolCheckResult ++ "\n" ++ networkCheckResult ++ "\n")
- else
- if isLeft networkCheck
- then do
- putStrLn ("Error - Could not contact NCBI server: " ++ fromLeft networkCheck ++ "\n")
- logMessage ("Error - Could not contact NCBI server: " ++ fromLeft networkCheck ++ "\n") temporaryDirectoryPath
- else do
- createDirectoryIfMissing False (temporaryDirectoryPath ++ "log")
- -- Create Log files
- writeFile (temporaryDirectoryPath ++ "Log") ("RNAlien " ++ alienVersion ++ "\n")
- writeFile (temporaryDirectoryPath ++ "log/warnings") ("")
- logMessage ("Timestamp: " ++ (show timestamp) ++ "\n") temporaryDirectoryPath
- logMessage ("Temporary Directory: " ++ temporaryDirectoryPath ++ "\n") temporaryDirectoryPath
- inputFasta <- readFasta inputFastaFilePath
- if null inputFasta
- then do
- putStrLn "Error: Input fasta file is empty."
- logMessage "Error: Input fasta file is empty.\n" temporaryDirectoryPath
- else do
- let iterationNumber = 0
- toolsCheck <- checkTools tools inputQuerySelectionMethod temporaryDirectoryPath
- if isLeft toolsCheck
- then do
- putStrLn ("Error - Not all required tools could be found in $PATH: " ++ fromLeft toolsCheck ++ "\n")
- logMessage ("Error - Not all required tools could be found in $PATH: " ++ fromLeft toolsCheck ++ "\n") temporaryDirectoryPath
- else do
- logToolVersions inputQuerySelectionMethod temporaryDirectoryPath
- let inputSequence = reformatFasta (head inputFasta)
- initialTaxId <- setInitialTaxId inputBlastDatabase temporaryDirectoryPath inputTaxId inputSequence
- let checkedTaxonomyRestriction = checkTaxonomyRestriction taxonomyRestriction
- let staticOptions = StaticOptions temporaryDirectoryPath sessionId (fromJust inputnSCICutoff) inputTaxId singleHitperTax inputQuerySelectionMethod inputQueryNumber lengthFilter coverageFilter blastSoftmasking threads inputBlastDatabase checkedTaxonomyRestriction (setVerbose verboseLevel)
- let initialization = ModelConstruction iterationNumber inputSequence [] initialTaxId Nothing (fromJust inputEvalueCutoff) False [] []
- logMessage (show initialization) temporaryDirectoryPath
- modelConstructionResults <- modelConstructer staticOptions initialization
- let resultTaxonomyRecordsCSVTable = constructTaxonomyRecordsCSVTable modelConstructionResults
- writeFile (temporaryDirectoryPath ++ "result.csv") resultTaxonomyRecordsCSVTable
- if performEvaluation
- then do
- resultEvaluation <- evaluateConstructionResult staticOptions modelConstructionResults
- appendFile (temporaryDirectoryPath ++ "Log") resultEvaluation
- resultSummary modelConstructionResults staticOptions
- writeFile (temporaryDirectoryPath ++ "done") ""
- else do
- resultSummary modelConstructionResults staticOptions
- writeFile (temporaryDirectoryPath ++ "done") ""
-
-alienVersion :: String
-alienVersion = showVersion version
diff --git a/src/Bio/RNAlienData.hs b/src/Bio/RNAlienData.hs
deleted file mode 100644
--- a/src/Bio/RNAlienData.hs
+++ /dev/null
@@ -1,144 +0,0 @@
--- | This module contains data structures for RNAlien
-
-module Bio.RNAlienData where
-
-import qualified Data.ByteString.Lazy.Char8 as L
-import Bio.Core.Sequence
-import Bio.Sequence.Fasta
-import Bio.Taxonomy
-
--- | Static construction options
-data StaticOptions = StaticOptions
- { tempDirPath :: String,
- sessionID :: String,
- nSCICutoff :: Double,
- userTaxId :: Maybe Int,
- singleHitperTaxToggle :: Bool,
- querySelectionMethod :: String,
- queryNumber :: Int,
- lengthFilterToggle :: Bool,
- coverageFilterToggle :: Bool,
- blastSoftmaskingToggle :: Bool,
- cpuThreads :: Int,
- blastDatabase :: Maybe String,
- taxRestriction :: Maybe String,
- verbositySwitch :: Bool
- } deriving (Show)
-
--- | Keeps track of model construction
-data ModelConstruction = ModelConstruction
- { iterationNumber :: Int,
- inputFasta :: Sequence,
- taxRecords :: [TaxonomyRecord],
- --Taxonomy ID of the highest node in taxonomic subtree used in search
- upperTaxonomyLimit :: Maybe Int,
- taxonomicContext :: Maybe Taxon,
- evalueThreshold :: Double,
- alignmentModeInfernal :: Bool,
- selectedQueries :: [Sequence],
- potentialMembers :: [SearchResult]
- }
-
-instance Show ModelConstruction where
- show (ModelConstruction _iterationNumber _inputFasta _taxRecords _upperTaxonomyLimit _taxonomicContext _evalueThreshold _alignmentModeInfernal _selectedQueries _potentialMembers) = a ++ b ++ c ++ d ++ e ++ g ++ h ++ i
- where a = "Modelconstruction iteration: " ++ show _iterationNumber ++ "\n"
- b = "Input fasta:\n" ++ L.unpack (unSL (seqheader _inputFasta)) ++ "\n" ++ L.unpack (unSD (seqdata _inputFasta)) ++ "\n"
- c = show _taxRecords
- d = "Upper taxonomy limit: " ++ maybe "not set" show _upperTaxonomyLimit ++ "\n"
- e = "Taxonomic Context: " ++ maybe "not set" show _taxonomicContext ++ "\n"
- g = "Evalue cutoff: " ++ show _evalueThreshold ++ "\n"
- h = "Selected queries: \n" ++ concatMap show _selectedQueries
- i = "Potential Members: \n" ++ concatMap show _potentialMembers
-
-data TaxonomyRecord = TaxonomyRecord
- { recordTaxonomyId :: Int,
- sequenceRecords :: [SequenceRecord]
- }
-
-instance Show TaxonomyRecord where
- show (TaxonomyRecord _recordTaxonomyId _sequenceRecords) = a ++ b
- where a = "TaxonomyRecord TaxonomyId: " ++ show _recordTaxonomyId ++ "\n"
- b = show _sequenceRecords
-
-data SequenceRecord = SequenceRecord
- { --Sequence consisting of SeqLabel, and SeqData
- nucleotideSequence :: Sequence,
- -- 0 is unaligned, number is the iteration the sequence has been included into the alignment
- aligned :: Int,
- recordDescription :: L.ByteString
- }
-
-instance Show SequenceRecord where
- show (SequenceRecord _nucleotideSequence _aligned _recordDescription) = a ++ b ++ c
- where a = "Record Description: " ++ L.unpack _recordDescription ++ "\n"
- b = "Aligned in iteration: " ++ show _aligned ++ "\n"
- c = "Sequence:" ++ show _nucleotideSequence ++ "\n"
--- |
-data CMsearch = CMsearch
- { queryCMfile :: String,
- targetSequenceDatabase :: String,
- numberOfWorkerThreads :: String,
- cmsearchHits :: [CMsearchHit]
--- hitAlignments :: [CMsearchHitAlignment]
--- internalCMPipelineStatisticsSummary
- } deriving (Show, Eq, Read)
-
--- |
-data CMsearchHit = CMsearchHit
- { hitRank :: Int,
- hitSignificance :: Char,
- hitEvalue :: Double,
- hitScore :: Double,
- hitBias :: Double,
- hitSequenceHeader :: L.ByteString,
- hitStart :: Int,
- hitEnd :: Int,
- hitStrand :: Char,
- hitModel :: L.ByteString,
- hitTruncation :: L.ByteString,
- hitGCContent :: Double,
- hitDescription :: L.ByteString
- } deriving (Show, Eq, Read)
-
-data SearchResult = SearchResult
- { candidates :: [(Sequence,Int,L.ByteString)],
- blastDatabaseSize :: Maybe Double
- }
-
-instance Show SearchResult where
- show (SearchResult _candidates _blastDatabaseSize) = a ++ b
- where a = "SearchResults :\n " ++ concatMap show _candidates ++ "\n"
- b = "BlastDb Size: " ++ show _blastDatabaseSize ++ "\n"
-
--- |
-data CMstat = CMstat
- { statIndex :: Int,
- statName :: String,
- statAccession :: String,
- statSequenceNumber :: Int,
- statEffectiveSequences :: Double,
- statConsensusLength :: Int,
- -- W The expected maximum length of a hit to the model.
- statW :: Int,
- statBasepairs :: Int,
- statBifurcations :: Int,
- statModel :: String,
- relativeEntropyCM :: Double,
- relativeEntropyHMM :: Double
- } deriving (Eq, Read)
-
-instance Show CMstat where
- show (CMstat _statIndex _statName _statAccession _statSequenceNumber _statEffectiveSequences _statConsensusLength _statW _statBasepairs _statBifurcations _statModel _relativeEntropyCM _relativeEntropyHMM) = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h ++ i ++ j ++ k ++ l
- where a = "CMstat - covariance model statistics:\nIndex: " ++ show _statIndex ++ "\n"
- b = "Name: " ++ show _statName ++ "\n"
- c = "Accession: " ++ show _statAccession ++ "\n"
- d = "Sequence Number: " ++ show _statSequenceNumber ++ "\n"
- e = "Effective Sequences: " ++ show _statEffectiveSequences ++ "\n"
- f = "Consensus length: " ++ show _statConsensusLength ++ "\n"
- g = "Expected maximum hit-length: " ++ show _statW ++ "\n"
- h = "Basepairs: " ++ show _statBasepairs ++ "\n"
- i = "Bifurcations: " ++ show _statBifurcations ++ "\n"
- j = "Modeltype: " ++ show _statModel ++ "\n"
- k = "Relative Entropy CM: " ++ show _relativeEntropyCM ++ "\n"
- l = "Relative Entropy HMM: " ++ show _relativeEntropyHMM ++ "\n"
-
diff --git a/src/Bio/RNAlienLibrary.hs b/src/Bio/RNAlienLibrary.hs
deleted file mode 100644
--- a/src/Bio/RNAlienLibrary.hs
+++ /dev/null
@@ -1,1904 +0,0 @@
--- | This module contains functions for RNAlien
-{-# LANGUAGE RankNTypes #-}
-module Bio.RNAlienLibrary (
- module Bio.RNAlienData,
- createSessionID,
- logMessage,
- logEither,
- modelConstructer,
- constructTaxonomyRecordsCSVTable,
- resultSummary,
- setVerbose,
- logToolVersions,
- checkTools,
- systemCMsearch,
- readCMSearch,
- readCMSearches,
- compareCM,
- parseCMSearch,
- cmSearchsubString,
- setInitialTaxId,
- evaluateConstructionResult,
- readCMstat,
- parseCMstat,
- checkNCBIConnection,
- preprocessClustalForRNAz,
- preprocessClustalForRNAzExternal,
- preprocessClustalForRNAcodeExternal,
- rnaZEvalOutput,
- reformatFasta,
- checkTaxonomyRestriction,
- evaluePartitionTrimCMsearchHits
- )
-where
-
-import System.Process
-import qualified System.FilePath as FP
-import Text.ParserCombinators.Parsec
-import Data.List
-import Data.Char
-import Bio.Core.Sequence
-import Bio.Sequence.Fasta
-import Bio.BlastXML
-import Bio.ClustalParser
-import Data.Int (Int16)
-import Bio.RNAlienData
-import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.ByteString.Char8 as B
-import Bio.Taxonomy
-import Data.Either.Unwrap
-import Data.Maybe
-import Bio.EntrezHTTP
-import System.Exit
-import Data.Either (lefts,rights,Either)
-import qualified Text.EditDistance as ED
-import qualified Data.Vector as V
-import Control.Concurrent
-import System.Random
-import Data.Csv
-import Data.Matrix
-import Bio.BlastHTTP
-import Data.Clustering.Hierarchical
-import System.Directory
-import System.Console.CmdArgs
-import qualified Control.Exception.Base as CE
-import Bio.RNAfoldParser
-import Bio.RNAalifoldParser
-import Bio.RNAzParser
-import qualified Network.HTTP.Conduit as N
-import Network.HTTP.Types.Status
-import qualified Bio.RNAcodeParser as RC
-import qualified Bio.RNAcentralHTTP as RCH
-import Bio.InfernalParser
-import qualified Data.Text as T
-import qualified Data.Text.IO as TI
-import qualified Data.Text.Encoding as DTE
-import qualified Data.Text.Lazy.Encoding as E
-import qualified Data.Text.Lazy as TL
-import qualified Data.Text.Lazy.IO as TIO
-import Text.Printf
-import qualified Data.Text.Metrics as TM
-import Control.Monad
-import Control.Arrow
-
--- | Initial RNA family model construction - generates iteration number, seed alignment and model
-modelConstructer :: StaticOptions -> ModelConstruction -> IO ModelConstruction
-modelConstructer staticOptions modelConstruction = do
- logMessage ("Iteration: " ++ show (iterationNumber modelConstruction) ++ "\n") (tempDirPath staticOptions)
- iterationSummary modelConstruction staticOptions
- let currentIterationNumber = iterationNumber modelConstruction
- let foundSequenceNumber = length (concatMap sequenceRecords (taxRecords modelConstruction))
- --extract queries
- let queries = extractQueries foundSequenceNumber modelConstruction
- logVerboseMessage (verbositySwitch staticOptions) ("Queries:" ++ show queries ++ "\n") (tempDirPath staticOptions)
- let iterationDirectory = tempDirPath staticOptions ++ show currentIterationNumber ++ "/"
- let maybeLastTaxId = extractLastTaxId (taxonomicContext modelConstruction)
- Control.Monad.when (isNothing maybeLastTaxId) $ logMessage ("Lineage: Could not extract last tax id \n") (tempDirPath staticOptions)
- --If highest node in linage was used as upper taxonomy limit, taxonomic tree is exhausted
- if maybe True (\uppertaxlimit -> maybe True (\lastTaxId -> uppertaxlimit /= lastTaxId) maybeLastTaxId) (upperTaxonomyLimit modelConstruction)
- then do
- createDirectory iterationDirectory
- let (upperTaxLimit,lowerTaxLimit) = setTaxonomicContextEntrez currentIterationNumber (taxonomicContext modelConstruction) (upperTaxonomyLimit modelConstruction)
- logVerboseMessage (verbositySwitch staticOptions) ("Upper taxonomy limit: " ++ show upperTaxLimit ++ "\n " ++ "Lower taxonomy limit: "++ show lowerTaxLimit ++ "\n") (tempDirPath staticOptions)
- --search queries
- let expectThreshold = setBlastExpectThreshold modelConstruction
- searchResults <- catchAll (searchCandidates staticOptions Nothing currentIterationNumber upperTaxLimit lowerTaxLimit expectThreshold queries)
- (\e -> do logWarning ("Warning: Search results iteration" ++ show (iterationNumber modelConstruction) ++ " - exception: " ++ show e) (tempDirPath staticOptions)
- return (SearchResult [] Nothing))
- currentTaxonomicContext <- getTaxonomicContextEntrez upperTaxLimit (taxonomicContext modelConstruction)
- if null (candidates searchResults)
- then
- alignmentConstructionWithoutCandidates currentTaxonomicContext upperTaxLimit staticOptions modelConstruction
- else
- alignmentConstructionWithCandidates currentTaxonomicContext upperTaxLimit searchResults staticOptions modelConstruction
- else do
- logMessage "Message: Modelconstruction complete: Out of queries or taxonomic tree exhausted\n" (tempDirPath staticOptions)
- modelConstructionResult staticOptions modelConstruction
-
-catchAll :: IO a -> (CE.SomeException -> IO a) -> IO a
-catchAll = CE.catch
-
-setInitialTaxId :: Maybe String -> String -> Maybe Int -> Sequence -> IO (Maybe Int)
-setInitialTaxId inputBlastDatabase tempdir inputTaxId inputSequence =
- if (isNothing inputTaxId)
- then do
- initialTaxId <- findTaxonomyStart inputBlastDatabase tempdir inputSequence
- return (Just initialTaxId)
- else do
- return inputTaxId
-
-extractLastTaxId :: Maybe Taxon -> Maybe Int
-extractLastTaxId taxon
- | isNothing taxon = Nothing
- | V.null lineageExVector = Nothing
- | otherwise = Just (lineageTaxId (V.head lineageExVector))
- where lineageExVector = V.fromList (lineageEx (fromJust taxon))
-
-modelConstructionResult :: StaticOptions -> ModelConstruction -> IO ModelConstruction
-modelConstructionResult staticOptions modelConstruction = do
- let currentIterationNumber = iterationNumber modelConstruction
- let outputDirectory = tempDirPath staticOptions
- logMessage ("Global search iteration: " ++ show currentIterationNumber ++ "\n") outputDirectory
- iterationSummary modelConstruction staticOptions
- let foundSequenceNumber = length (concatMap sequenceRecords (taxRecords modelConstruction))
- --extract queries
- --let querySeqIds = selectedQueries modelConstruction ---
- let queries = extractQueries foundSequenceNumber modelConstruction ---
- --let alignedSequences' = map nucleotideSequence (concatMap sequenceRecords (taxRecords modelConstruction)) ---
- logVerboseMessage (verbositySwitch staticOptions) ("Queries:" ++ show queries ++ "\n") outputDirectory
- let iterationDirectory = outputDirectory ++ show currentIterationNumber ++ "/"
- createDirectory iterationDirectory
- let logFileDirectoryPath = iterationDirectory ++ "log"
- createDirectoryIfMissing False logFileDirectoryPath
- let expectThreshold = setBlastExpectThreshold modelConstruction
- (alignmentResults,currentPotentialMembers) <- if isJust (taxRestriction staticOptions)
- then do
- --taxonomic restriction
- let (upperTaxLimit,lowerTaxLimit) = setRestrictedTaxonomyLimits (fromJust (taxRestriction staticOptions))
- restrictedCandidates <- catchAll (searchCandidates staticOptions (taxRestriction staticOptions) currentIterationNumber upperTaxLimit lowerTaxLimit expectThreshold queries)
- (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return (SearchResult [] Nothing))
- let uniqueCandidates = filterDuplicates modelConstruction restrictedCandidates
- (restrictedAlignmentResults,restrictedPotentialMembers) <- catchAll (alignCandidates staticOptions modelConstruction (fromJust (taxRestriction staticOptions)) uniqueCandidates)
- (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return ([],[]))
- let currentPotentialMembers = [SearchResult restrictedPotentialMembers (blastDatabaseSize restrictedCandidates)]
- return (restrictedAlignmentResults,currentPotentialMembers)
- else do
- --taxonomic context archea
- let (upperTaxLimit1,lowerTaxLimit1) = (Just (2157 :: Int), Nothing)
- candidates1 <- catchAll (searchCandidates staticOptions (Just "archea") currentIterationNumber upperTaxLimit1 lowerTaxLimit1 expectThreshold queries)
- (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return (SearchResult [] Nothing))
- let uniqueCandidates1 = filterDuplicates modelConstruction candidates1
- (alignmentResults1,potentialMembers1) <- catchAll (alignCandidates staticOptions modelConstruction "archea" uniqueCandidates1)
- (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return ([],[]))
- --taxonomic context bacteria
- let (upperTaxLimit2,lowerTaxLimit2) = (Just (2 :: Int), Nothing)
- candidates2 <- catchAll (searchCandidates staticOptions (Just "bacteria") currentIterationNumber upperTaxLimit2 lowerTaxLimit2 expectThreshold queries)
- (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return (SearchResult [] Nothing))
- let uniqueCandidates2 = filterDuplicates modelConstruction candidates2
- (alignmentResults2,potentialMembers2) <- catchAll (alignCandidates staticOptions modelConstruction "bacteria" uniqueCandidates2)
- (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return ([],[]))
- --taxonomic context eukaryia
- let (upperTaxLimit3,lowerTaxLimit3) = (Just (2759 :: Int), Nothing)
- candidates3 <- catchAll (searchCandidates staticOptions (Just "eukaryia") currentIterationNumber upperTaxLimit3 lowerTaxLimit3 expectThreshold queries)
- (\e -> do logWarning ("Warning: Search results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return (SearchResult [] Nothing))
- let uniqueCandidates3 = filterDuplicates modelConstruction candidates3
- (alignmentResults3,potentialMembers3) <- catchAll (alignCandidates staticOptions modelConstruction "eukaryia" uniqueCandidates3)
- (\e -> do logWarning ("Warning: Alignment results iteration" ++ show currentIterationNumber ++ " - exception: " ++ show e) outputDirectory
- return ([],[]))
- let alignmentResults = alignmentResults1 ++ alignmentResults2 ++ alignmentResults3
- let currentPotentialMembers = [SearchResult potentialMembers1 (blastDatabaseSize candidates1), SearchResult potentialMembers2 (blastDatabaseSize candidates2), SearchResult potentialMembers3 (blastDatabaseSize candidates3)]
- return (alignmentResults,currentPotentialMembers)
- let preliminaryFastaPath = iterationDirectory ++ "model.fa"
- let preliminaryCMPath = iterationDirectory ++ "model.cm"
- let preliminaryAlignmentPath = iterationDirectory ++ "model.stockholm"
- let preliminaryCMLogPath = iterationDirectory ++ "model.cm.log"
- let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults Nothing Nothing [] currentPotentialMembers (alignmentModeInfernal modelConstruction)
- if (null alignmentResults) && not (alignmentModeInfernal modelConstruction)
- then do
- logVerboseMessage (verbositySwitch staticOptions) "Alignment result initial mode\n" outputDirectory
- logMessage "Message: No sequences found that statisfy filters. Try to reconstruct model with less strict cutoff parameters." outputDirectory
- let alignedSequences = extractAlignedSequences (iterationNumber modelConstruction) modelConstruction
- let alignmentSequences = map snd (V.toList (V.concat [alignedSequences]))
- writeFasta preliminaryFastaPath alignmentSequences
- let cmBuildFilepath = iterationDirectory ++ "model" ++ ".cmbuild"
- let refinedAlignmentFilepath = iterationDirectory ++ "modelrefined" ++ ".stockholm"
- let cmBuildOptions ="--refine " ++ refinedAlignmentFilepath
- let foldFilepath = iterationDirectory ++ "model" ++ ".fold"
- _ <- systemRNAfold preliminaryFastaPath foldFilepath
- foldoutput <- readRNAfold foldFilepath
- let seqStructure = foldSecondaryStructure (fromRight foldoutput)
- let stockholAlignment = convertFastaFoldStockholm (head alignmentSequences) seqStructure
- writeFile preliminaryAlignmentPath stockholAlignment
- _ <- systemCMbuild cmBuildOptions preliminaryAlignmentPath preliminaryCMPath cmBuildFilepath
- _ <- systemCMcalibrate "fast" (cpuThreads staticOptions) preliminaryCMPath preliminaryCMLogPath
- reevaluatePotentialMembers staticOptions nextModelConstructionInput
- else
- if (alignmentModeInfernal modelConstruction)
- then do
- logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - infernal mode\n") outputDirectory
- constructModel nextModelConstructionInput staticOptions
- writeFile (iterationDirectory ++ "done") ""
- logMessage (iterationSummaryLog nextModelConstructionInput) outputDirectory
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInput) outputDirectory
- resultModelConstruction <- reevaluatePotentialMembers staticOptions nextModelConstructionInput
- return resultModelConstruction
- else do
- logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - initial mode\n") outputDirectory
- constructModel nextModelConstructionInput staticOptions
- let nextModelConstructionInputInfernalMode = nextModelConstructionInput {alignmentModeInfernal = True}
- logMessage (iterationSummaryLog nextModelConstructionInputInfernalMode) outputDirectory
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputInfernalMode) outputDirectory
- writeFile (iterationDirectory ++ "done") ""
- resultModelConstruction <- reevaluatePotentialMembers staticOptions nextModelConstructionInputInfernalMode
- return resultModelConstruction
-
--- | Reevaluate collected potential members for inclusion in the result model
-reevaluatePotentialMembers :: StaticOptions -> ModelConstruction -> IO ModelConstruction
-reevaluatePotentialMembers staticOptions modelConstruction = do
- let currentIterationNumber = iterationNumber modelConstruction
- let outputDirectory = tempDirPath staticOptions
- iterationSummary modelConstruction staticOptions
- logMessage ("Reevaluation of potential members iteration: " ++ show currentIterationNumber ++ "\n") outputDirectory
- let iterationDirectory = outputDirectory ++ show currentIterationNumber ++ "/"
- createDirectory iterationDirectory
- let indexedPotentialMembers = V.indexed (V.fromList (potentialMembers modelConstruction))
- potentialMembersAlignmentResultVector <- V.mapM (\(i,searchresult) -> (alignCandidates staticOptions modelConstruction (show i ++ "_") searchresult)) indexedPotentialMembers
- let potentialMembersAlignmentResults = V.toList potentialMembersAlignmentResultVector
- let alignmentResults = concatMap fst potentialMembersAlignmentResults
- let discardedMembers = concatMap snd potentialMembersAlignmentResults
- writeFile (outputDirectory ++ "log/discarded") (concatMap show discardedMembers)
- let resultFastaPath = outputDirectory ++ "result.fa"
- let resultCMPath = outputDirectory ++ "result.cm"
- let resultAlignmentPath = outputDirectory ++ "result.stockholm"
- let resultClustalFilepath = outputDirectory ++ "result.clustal"
- let resultCMLogPath = outputDirectory ++ "log/result.cm.log"
- if null alignmentResults
- then do
- let lastIterationFastaPath = outputDirectory ++ show (currentIterationNumber - 1)++ "/model.fa"
- let lastIterationAlignmentPath = outputDirectory ++ show (currentIterationNumber - 1) ++ "/model.stockholm"
- let lastIterationCMPath = outputDirectory ++ show (currentIterationNumber - 1)++ "/model.cm"
- copyFile lastIterationCMPath resultCMPath
- --copyFile lastIterationCMPath (resultCMPath ++ ".bak1")
- copyFile lastIterationFastaPath resultFastaPath
- copyFile lastIterationAlignmentPath resultAlignmentPath
- _ <- systemCMcalibrate "standard" (cpuThreads staticOptions) resultCMPath resultCMLogPath
- systemCMalign ("--outformat=Clustal --cpu " ++ show (cpuThreads staticOptions)) resultCMPath resultFastaPath resultClustalFilepath
- writeFile (iterationDirectory ++ "done") ""
- return modelConstruction
- else do
- let lastIterationFastaPath = outputDirectory ++ show currentIterationNumber ++ "/model.fa"
- let lastIterationAlignmentPath = outputDirectory ++ show currentIterationNumber ++ "/model.stockholm"
- let lastIterationCMPath = outputDirectory ++ show currentIterationNumber ++ "/model.cm"
- logVerboseMessage (verbositySwitch staticOptions) "Alignment construction with candidates - infernal mode\n" outputDirectory
- let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults Nothing Nothing [] [] (alignmentModeInfernal modelConstruction)
- constructModel nextModelConstructionInput staticOptions
- copyFile lastIterationCMPath resultCMPath
- --debug
- --copyFile lastIterationCMPath (resultCMPath ++ ".bak2")
- copyFile lastIterationFastaPath resultFastaPath
- copyFile lastIterationAlignmentPath resultAlignmentPath
- logMessage (iterationSummaryLog nextModelConstructionInput) outputDirectory
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInput) outputDirectory
- _ <- systemCMcalibrate "standard" (cpuThreads staticOptions) resultCMPath resultCMLogPath
- systemCMalign ("--outformat=Clustal --cpu " ++ show (cpuThreads staticOptions)) resultCMPath resultFastaPath resultClustalFilepath
- writeFile (iterationDirectory ++ "done") ""
- return nextModelConstructionInput
-
----------------------------------------------------------
-
-alignmentConstructionWithCandidates :: Maybe Taxon -> Maybe Int -> SearchResult -> StaticOptions -> ModelConstruction -> IO ModelConstruction
-alignmentConstructionWithCandidates currentTaxonomicContext currentUpperTaxonomyLimit searchResults staticOptions modelConstruction = do
- --candidates usedUpperTaxonomyLimit blastDatabaseSize
- let currentIterationNumber = iterationNumber modelConstruction
- let iterationDirectory = tempDirPath staticOptions ++ show currentIterationNumber ++ "/"
- --let usedUpperTaxonomyLimit = (snd (head candidates))
- --align search result
- (alignmentResults,potentialMemberEntries) <- catchAll (alignCandidates staticOptions modelConstruction "" searchResults)
- (\e -> do logWarning ("Warning: Alignment results iteration" ++ show (iterationNumber modelConstruction) ++ " - exception: " ++ show e) (tempDirPath staticOptions)
- return ([],[]))
- let currentPotentialMembers = [SearchResult potentialMemberEntries (blastDatabaseSize searchResults)]
- if (null alignmentResults) && not (alignmentModeInfernal modelConstruction)
- then do
- logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - length 1 - inital mode" ++ "\n") (tempDirPath staticOptions)
- --too few sequences for alignment. because of lack in sequences no cm was constructed before
- --reusing previous modelconstruction with increased upperTaxonomyLimit but include found sequence
- --prepare next iteration
- let newTaxEntries = taxRecords modelConstruction ++ buildTaxRecords alignmentResults currentIterationNumber
- let nextModelConstructionInputWithThreshold = modelConstruction {iterationNumber = currentIterationNumber + 1,upperTaxonomyLimit = currentUpperTaxonomyLimit, taxRecords = newTaxEntries,taxonomicContext = currentTaxonomicContext}
- logMessage (iterationSummaryLog nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithThreshold) (tempDirPath staticOptions) ----
- writeFile (iterationDirectory ++ "done") ""
- modelConstructer staticOptions nextModelConstructionInputWithThreshold
- else
- if (alignmentModeInfernal modelConstruction)
- then do
- logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - infernal mode\n") (tempDirPath staticOptions)
- --prepare next iteration
- let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults currentUpperTaxonomyLimit currentTaxonomicContext [] currentPotentialMembers True
- constructModel nextModelConstructionInput staticOptions
- writeFile (iterationDirectory ++ "done") ""
- logMessage (iterationSummaryLog nextModelConstructionInput) (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInput) (tempDirPath staticOptions)
- --select queries
- currentSelectedQueries <- selectQueries staticOptions modelConstruction alignmentResults
- let nextModelConstructionInputWithQueries = nextModelConstructionInput {selectedQueries = currentSelectedQueries}
- nextModelConstruction <- modelConstructer staticOptions nextModelConstructionInputWithQueries
- return nextModelConstruction
- else do
- logVerboseMessage (verbositySwitch staticOptions) ("Alignment construction with candidates - initial mode\n") (tempDirPath staticOptions)
- --First round enough candidates are available for modelconstruction, alignmentModeInfernal is set to true after this iteration
- --prepare next iteration
- let nextModelConstructionInput = constructNext currentIterationNumber modelConstruction alignmentResults currentUpperTaxonomyLimit currentTaxonomicContext [] currentPotentialMembers False
- constructModel nextModelConstructionInput staticOptions
- currentSelectedQueries <- selectQueries staticOptions modelConstruction alignmentResults
- --select queries
- let nextModelConstructionInputWithInfernalMode = nextModelConstructionInput {alignmentModeInfernal = True, selectedQueries = currentSelectedQueries}
- logMessage (iterationSummaryLog nextModelConstructionInputWithInfernalMode) (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithInfernalMode) (tempDirPath staticOptions)
- writeFile (iterationDirectory ++ "done") ""
- nextModelConstruction <- modelConstructer staticOptions nextModelConstructionInputWithInfernalMode
- return nextModelConstruction
-
-alignmentConstructionWithoutCandidates :: Maybe Taxon -> Maybe Int -> StaticOptions -> ModelConstruction -> IO ModelConstruction
-alignmentConstructionWithoutCandidates currentTaxonomicContext upperTaxLimit staticOptions modelConstruction = do
- let currentIterationNumber = iterationNumber modelConstruction
- let iterationDirectory = tempDirPath staticOptions ++ show currentIterationNumber ++ "/"
- --Found no new candidates in this iteration, reusing previous modelconstruction with increased upperTaxonomyLimit
- let nextModelConstructionInputWithThreshold = modelConstruction {iterationNumber = currentIterationNumber + 1,upperTaxonomyLimit = upperTaxLimit,taxonomicContext = currentTaxonomicContext}
- --copy model and alignment from last iteration in place if present
- let previousIterationCMPath = tempDirPath staticOptions ++ show (currentIterationNumber - 1) ++ "/model.cm"
- previousIterationCMexists <- doesFileExist previousIterationCMPath
- if previousIterationCMexists
- then do
- logVerboseMessage (verbositySwitch staticOptions) "Alignment construction no candidates - previous cm\n" (tempDirPath staticOptions)
- let previousIterationFastaPath = tempDirPath staticOptions ++ show (currentIterationNumber - 1) ++ "/model.fa"
- let previousIterationAlignmentPath = tempDirPath staticOptions ++ show (currentIterationNumber - 1) ++ "/model.stockholm"
- let thisIterationFastaPath = tempDirPath staticOptions ++ show (currentIterationNumber) ++ "/model.fa"
- let thisIterationAlignmentPath = tempDirPath staticOptions ++ show (currentIterationNumber) ++ "/model.stockholm"
- let thisIterationCMPath = tempDirPath staticOptions ++ show (currentIterationNumber) ++ "/model.cm"
- copyFile previousIterationFastaPath thisIterationFastaPath
- copyFile previousIterationAlignmentPath thisIterationAlignmentPath
- copyFile previousIterationCMPath thisIterationCMPath
- logMessage (iterationSummaryLog nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
- writeFile (iterationDirectory ++ "done") ""
- modelConstructer staticOptions nextModelConstructionInputWithThreshold
- else do
- logVerboseMessage (verbositySwitch staticOptions) "Alignment construction no candidates - no previous iteration cm\n" (tempDirPath staticOptions)
- logMessage (iterationSummaryLog nextModelConstructionInputWithThreshold) (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) (show nextModelConstructionInputWithThreshold) (tempDirPath staticOptions) ----
- writeFile (iterationDirectory ++ "done") ""
- modelConstructer staticOptions nextModelConstructionInputWithThreshold
-
-findTaxonomyStart :: Maybe String -> String -> Sequence -> IO Int
-findTaxonomyStart inputBlastDatabase temporaryDirectory querySequence = do
- let queryIndexString = "1"
- let hitNumberQuery = buildHitNumberQuery "&HITLIST_SIZE=10"
- let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
- let blastQuery = BlastHTTPQuery (Just "ncbi") (Just "blastn") inputBlastDatabase [querySequence] (Just (hitNumberQuery ++ registrationInfo)) (Just (5400000000 :: Int))
- logMessage "No tax id provided - Sending find taxonomy start blast query \n" temporaryDirectory
- blastOutput <- CE.catch (blastHTTP blastQuery)
- (\e -> do let err = show (e :: CE.IOException)
- logWarning ("Warning: Blast attempt failed:" ++ " " ++ err) temporaryDirectory
- error "findTaxonomyStart: Blast attempt failed"
- return (Left ""))
- let logFileDirectoryPath = temporaryDirectory ++ "taxonomystart" ++ "/"
- createDirectory logFileDirectoryPath
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_1blastOutput") (show blastOutput)
- logEither blastOutput temporaryDirectory
- let blastHitsArePresent = either (const False) blastMatchesPresent blastOutput
- if blastHitsArePresent
- then do
- let rightBlast = fromRight blastOutput
- let bestHit = getBestHit rightBlast
- bestBlastHitTaxIdOutput <- retrieveBlastHitTaxIdEntrez [bestHit]
- let taxIdFromEntrySummaries = extractTaxIdFromEntrySummaries (snd bestBlastHitTaxIdOutput)
- Control.Monad.when (null taxIdFromEntrySummaries) (error "findTaxonomyStart: - head: empty list of taxonomy entry summary for best hit")
- let rightBestTaxIdResult = head taxIdFromEntrySummaries
- logMessage ("Initial TaxId: " ++ show rightBestTaxIdResult ++ "\n") temporaryDirectory
- CE.evaluate rightBestTaxIdResult
- else error "Find taxonomy start: Could not find blast hits to use as a taxonomic starting point"
-
-searchCandidates :: StaticOptions -> Maybe String -> Int -> Maybe Int -> Maybe Int -> Double -> [Sequence] -> IO SearchResult
-searchCandidates staticOptions finaliterationprefix iterationnumber upperTaxLimit lowerTaxLimit expectThreshold inputQuerySequences = do
- --let fastaSeqData = seqdata _querySequence
- Control.Monad.when (null inputQuerySequences) $ error "searchCandidates: - head: empty list of query sequences"
- let queryLength = fromIntegral (seqlength (head inputQuerySequences))
- let queryIndexString = "1"
- let entrezTaxFilter = buildTaxFilterQuery upperTaxLimit lowerTaxLimit
- logVerboseMessage (verbositySwitch staticOptions) ("entrezTaxFilter" ++ show entrezTaxFilter ++ "\n") (tempDirPath staticOptions)
- let hitNumberQuery = buildHitNumberQuery "&HITLIST_SIZE=5000&EXPECT=" ++ show expectThreshold
- let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
- let softmaskFilter = if blastSoftmaskingToggle staticOptions then "&FILTER=True&FILTER=m" else ""
- let blastQuery = BlastHTTPQuery (Just "ncbi") (Just "blastn") (blastDatabase staticOptions) inputQuerySequences (Just (hitNumberQuery ++ entrezTaxFilter ++ softmaskFilter ++ registrationInfo)) (Just (5400000000 :: Int))
- --appendFile "/scratch/egg/blasttest/queries" ("\nBlast query:\n" ++ show blastQuery ++ "\n")
- logVerboseMessage (verbositySwitch staticOptions) ("Sending blast query " ++ show iterationnumber ++ "\n") (tempDirPath staticOptions)
- blastOutput <- CE.catch (blastHTTP blastQuery)
- (\e -> do let err = show (e :: CE.IOException)
- logWarning ("Warning: Blast attempt failed:" ++ " " ++ err) (tempDirPath staticOptions)
- return (Left ""))
- let logFileDirectoryPath = tempDirPath staticOptions ++ show iterationnumber ++ "/" ++ fromMaybe "" finaliterationprefix ++ "log"
- logDirectoryPresent <- doesDirectoryExist logFileDirectoryPath
- Control.Monad.when (not logDirectoryPresent) $ createDirectory (logFileDirectoryPath)
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_1blastOutput") (show blastOutput)
- logEither blastOutput (tempDirPath staticOptions)
- let blastHitsArePresent = either (const False) blastMatchesPresent blastOutput
- if blastHitsArePresent
- then do
- let rightBlast = fromRight blastOutput
- -- bestBlastHitTaxIdOutput <- retrieveBlastHitTaxIdEntrez [bestHit]
- -- let taxIdFromEntrySummaries = extractTaxIdFromEntrySummaries bestBlastHitTaxIdOutput
- -- if (null taxIdFromEntrySummaries) then (error "searchCandidates: - head: empty list of taxonomy entry summary for best hit") else return ()
- -- let rightBestTaxIdResult = head taxIdFromEntrySummaries
- -- logVerboseMessage (verbositySwitch staticOptions) ("rightbestTaxIdResult: " ++ (show rightBestTaxIdResult) ++ "\n") (tempDirPath staticOptions)
- let blastHits = concatMap hits (results rightBlast)
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_2blastHits") (showlines blastHits)
- --filter by length
- let blastHitsFilteredByLength = filterByHitLength blastHits queryLength (lengthFilterToggle staticOptions)
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_3blastHitsFilteredByLength") (showlines blastHitsFilteredByLength)
- let blastHitsFilteredByCoverage = filterByCoverage blastHitsFilteredByLength queryLength (coverageFilterToggle staticOptions)
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_3ablastHitsFilteredByLength") (showlines blastHitsFilteredByCoverage)
- --tag BlastHits with TaxId
- blastHitsWithTaxIdOutput <- retrieveBlastHitsTaxIdEntrez blastHitsFilteredByCoverage
- let uncheckedBlastHitsWithTaxIdList = map (Control.Arrow.second extractTaxIdFromEntrySummaries) blastHitsWithTaxIdOutput
- let checkedBlastHitsWithTaxId = filter (\(_,taxids) -> not (null taxids)) uncheckedBlastHitsWithTaxIdList
- --todo checked blasthittaxidswithblasthits need to be merged as taxid blasthit pairs
- let blastHitsWithTaxId = zip (concatMap fst checkedBlastHitsWithTaxId) (concatMap snd checkedBlastHitsWithTaxId)
- blastHitsWithParentTaxIdOutput <- retrieveParentTaxIdsEntrez blastHitsWithTaxId
- --let blastHitsWithParentTaxId = concat blastHitsWithParentTaxIdOutput
- -- filter by ParentTaxId (only one hit per TaxId)
- let blastHitsFilteredByParentTaxIdWithParentTaxId = filterByParentTaxId blastHitsWithParentTaxIdOutput True
- --let blastHitsFilteredByParentTaxId = map fst blastHitsFilteredByParentTaxIdWithParentTaxId
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_4blastHitsFilteredByParentTaxId") (showlines blastHitsFilteredByParentTaxIdWithParentTaxId)
- -- Filtering with TaxTree (only hits from the same subtree as besthit)
- --let blastHitsWithTaxId = zip blastHitsFilteredByParentTaxId blastHittaxIdList
- --let (_, filteredBlastResults) = filterByNeighborhoodTreeConditional alignndmentModeInfernalToggle upperTaxLimit blastHitsWithTaxId (inputTaxNodes staticOptions) (fromJust upperTaxLimit) (singleHitperTaxToggle staticOptions)
- --writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_5filteredBlastResults") (showlines filteredBlastResults)
- -- Coordinate generation
- let nonEmptyfilteredBlastResults = filter (\(blasthit,_) -> not (null (matches blasthit))) blastHitsFilteredByParentTaxIdWithParentTaxId
- let requestedSequenceElements = map (getRequestedSequenceElement queryLength) nonEmptyfilteredBlastResults
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_6requestedSequenceElements") (showlines requestedSequenceElements)
- -- Retrieval of full sequences from entrez
- --fullSequencesWithSimilars <- retrieveFullSequences requestedSequenceElements
- fullSequencesWithSimilars <- retrieveFullSequences staticOptions requestedSequenceElements
- if null fullSequencesWithSimilars
- then do
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_10afullSequencesWithSimilars") "No sequences retrieved"
- CE.evaluate (SearchResult [] Nothing)
- else do
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_10afullSequencesWithSimilars") (showlines fullSequencesWithSimilars)
- let fullSequences = filterIdenticalSequences fullSequencesWithSimilars 100
- --let fullSequencesWithOrigin = map (\(parsedFasta,taxid,seqSubject) -> (parsedFasta,taxid,seqSubject,'B')) fullSequences
- writeFile (logFileDirectoryPath ++ "/" ++ queryIndexString ++ "_10fullSequences") (showlines fullSequences)
- let maybeFractionEvalueMatch = getHitWithFractionEvalue rightBlast
- if isNothing maybeFractionEvalueMatch
- then CE.evaluate (SearchResult [] Nothing)
- else do
- let fractionEvalueMatch = fromJust maybeFractionEvalueMatch
- let dbSize = computeDataBaseSize (e_val fractionEvalueMatch) (bits fractionEvalueMatch) (fromIntegral queryLength ::Double)
- CE.evaluate (SearchResult fullSequences (Just dbSize))
- else CE.evaluate (SearchResult [] Nothing)
-
--- |Computes size of blast db in Mb
-computeDataBaseSize :: Double -> Double -> Double -> Double
-computeDataBaseSize evalue bitscore querylength = ((evalue * 2 ** bitscore) / querylength)/10^(6 :: Integer)
-
-alignCandidates :: StaticOptions -> ModelConstruction -> String -> SearchResult -> IO ([(Sequence,Int,L.ByteString)],[(Sequence,Int,L.ByteString)])
-alignCandidates staticOptions modelConstruction multipleSearchResultPrefix searchResults = do
- let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/" ++ multipleSearchResultPrefix
- createDirectoryIfMissing False (iterationDirectory ++ "log")
- if null (candidates searchResults)
- then do
- writeFile (iterationDirectory ++ "log" ++ "/11candidates") "No candidates to align"
- return ([],[])
- else do
- --refilter for similarity
- writeFile (iterationDirectory ++ "log" ++ "/11candidates") (showlines (candidates searchResults))
- let alignedSequences = map snd (V.toList (extractAlignedSequences (iterationNumber modelConstruction) modelConstruction))
- let filteredCandidates = filterWithCollectedSequences (candidates searchResults) alignedSequences 99
- writeFile (iterationDirectory ++ "log" ++ "/12candidatesFilteredByCollected") (showlines filteredCandidates)
- if alignmentModeInfernal modelConstruction
- then alignCandidatesInfernalMode staticOptions modelConstruction multipleSearchResultPrefix (blastDatabaseSize searchResults) filteredCandidates
- else alignCandidatesInitialMode staticOptions modelConstruction multipleSearchResultPrefix filteredCandidates
-
-alignCandidatesInfernalMode :: StaticOptions -> ModelConstruction -> String -> Maybe Double -> [(Sequence,Int,L.ByteString)] -> IO ([(Sequence,Int,L.ByteString)],[(Sequence,Int,L.ByteString)])
-alignCandidatesInfernalMode staticOptions modelConstruction multipleSearchResultPrefix blastDbSize filteredCandidates = do
- let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/" ++ multipleSearchResultPrefix
- let candidateSequences = extractCandidateSequences filteredCandidates
- logVerboseMessage (verbositySwitch staticOptions) "Alignment Mode Infernal\n" (tempDirPath staticOptions)
- let indexedCandidateSequenceList = V.toList candidateSequences
- let cmSearchFastaFilePaths = map (constructFastaFilePaths iterationDirectory) indexedCandidateSequenceList
- let cmSearchFilePaths = map (constructCMsearchFilePaths iterationDirectory) indexedCandidateSequenceList
- let covarianceModelPath = tempDirPath staticOptions ++ show (iterationNumber modelConstruction - 1) ++ "/" ++ "model.cm"
- mapM_ (\(number,_nucleotideSequence) -> writeFasta (iterationDirectory ++ show number ++ ".fa") [_nucleotideSequence]) indexedCandidateSequenceList
- let zippedFastaCMSearchResultPaths = zip cmSearchFastaFilePaths cmSearchFilePaths
- --check with cmSearch
- mapM_ (uncurry (systemCMsearch (cpuThreads staticOptions) ("-Z " ++ show (fromJust blastDbSize)) covarianceModelPath)) zippedFastaCMSearchResultPaths
- cmSearchResults <- mapM readCMSearch cmSearchFilePaths
- writeFile (iterationDirectory ++ "cm_error") (concatMap show (lefts cmSearchResults))
- let rightCMSearchResults = rights cmSearchResults
- let cmSearchCandidatesWithSequences = zip rightCMSearchResults filteredCandidates
- let (trimmedSelectedCandidates,potentialCandidates,rejectedCandidates) = evaluePartitionTrimCMsearchHits (evalueThreshold modelConstruction) cmSearchCandidatesWithSequences
- createDirectoryIfMissing False (iterationDirectory ++ "log")
- writeFile (iterationDirectory ++ "log" ++ "/13selectedCandidates'") (showlines trimmedSelectedCandidates)
- writeFile (iterationDirectory ++ "log" ++ "/14rejectedCandidates'") (showlines rejectedCandidates)
- writeFile (iterationDirectory ++ "log" ++ "/15potentialCandidates'") (showlines potentialCandidates)
- return (map snd trimmedSelectedCandidates,map snd potentialCandidates)
-
-alignCandidatesInitialMode :: StaticOptions -> ModelConstruction -> String -> [(Sequence,Int,L.ByteString)] -> IO ([(Sequence,Int,L.ByteString)],[(Sequence,Int,L.ByteString)])
-alignCandidatesInitialMode staticOptions modelConstruction multipleSearchResultPrefix filteredCandidates = do
- let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/" ++ multipleSearchResultPrefix
- --writeFile (iterationDirectory ++ "log" ++ "/11bcandidates") (showlines filteredCandidates)
- createDirectoryIfMissing False (iterationDirectory ++ "log")
- let candidateSequences = extractCandidateSequences filteredCandidates
- --writeFile (iterationDirectory ++ "log" ++ "/11ccandidates") (showlines (V.toList candidateSequences))
- logVerboseMessage (verbositySwitch staticOptions) "Alignment Mode Initial\n" (tempDirPath staticOptions)
- --write Fasta sequences
- let inputFastaFilepath = iterationDirectory ++ "input.fa"
- let inputFoldFilepath = iterationDirectory ++ "input.fold"
- writeFasta (iterationDirectory ++ "input.fa") [inputFasta modelConstruction]
- logMessage (showlines (V.toList candidateSequences)) (tempDirPath staticOptions)
- V.mapM_ (\(number,nucleotideSequence') -> writeFasta (iterationDirectory ++ show number ++ ".fa") [nucleotideSequence']) candidateSequences
- let candidateFastaFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ ".fa") candidateSequences)
- let candidateFoldFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ ".fold") candidateSequences)
- let locarnainClustalw2FormatFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ "." ++ "clustalmlocarna") candidateSequences)
- let candidateAliFoldFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ ".alifold") candidateSequences)
- let locarnaFilepath = V.toList (V.map (\(number,_) -> iterationDirectory ++ show number ++ "." ++ "mlocarna") candidateSequences)
- alignSequences "locarna" " --write-structure --free-endgaps=++-- " (replicate (V.length candidateSequences) inputFastaFilepath) candidateFastaFilepath locarnainClustalw2FormatFilepath locarnaFilepath
- --compute SequenceIdentities
- let sequenceIdentities = V.map (\(_,s) -> sequenceIdentity (inputFasta modelConstruction) s/(100 :: Double)) candidateSequences
- --compute SCI
- systemRNAfold inputFastaFilepath inputFoldFilepath
- inputfoldResult <- readRNAfold inputFoldFilepath
- let inputFoldMFE = foldingEnergy (fromRight inputfoldResult)
- mapM_ (uncurry systemRNAfold) (zip candidateFastaFilepath candidateFoldFilepath)
- foldResults <- mapM readRNAfold candidateFoldFilepath
- let candidateMFEs = map (foldingEnergy . fromRight) foldResults
- let averageMFEs = map (\candidateMFE -> (candidateMFE + inputFoldMFE)/2) candidateMFEs
- mapM_ (uncurry (systemRNAalifold "")) (zip locarnainClustalw2FormatFilepath candidateAliFoldFilepath)
- alifoldResults <- mapM readRNAalifold candidateAliFoldFilepath
- let consensusMFE = map (alignmentConsensusMinimumFreeEnergy . fromRight) alifoldResults
- let sciidfraction = map (\(consMFE,averMFE,seqId) -> (consMFE/averMFE)/seqId) (zip3 consensusMFE averageMFEs (V.toList sequenceIdentities))
- let idlog = concatMap (\(sciidfraction',consMFE,averMFE,seqId) -> show sciidfraction' ++ "," ++ show consMFE ++ "," ++ show averMFE ++ "," ++ show seqId ++ "\n")(zip4 sciidfraction consensusMFE averageMFEs (V.toList sequenceIdentities))
- writeFile (iterationDirectory ++ "log" ++ "/idlog") idlog
- let alignedCandidates = zip sciidfraction filteredCandidates
- writeFile (iterationDirectory ++ "log" ++ "/zscores") (showlines alignedCandidates)
- let (selectedCandidates,rejectedCandidates) = partition (\(sciidfraction',_) -> sciidfraction' > nSCICutoff staticOptions) alignedCandidates
- mapM_ print (zip3 consensusMFE averageMFEs (V.toList sequenceIdentities))
- writeFile (iterationDirectory ++ "log" ++ "/13selectedCandidates") (showlines selectedCandidates)
- writeFile (iterationDirectory ++ "log" ++ "/14rejectedCandidates") (showlines rejectedCandidates)
- return (map snd selectedCandidates,[])
-
-setClusterNumber :: Int -> Int
-setClusterNumber x
- | x <= 5 = x
- | otherwise = 5
-
-findCutoffforClusterNumber :: Dendrogram a -> Int -> Distance -> Distance
-findCutoffforClusterNumber clustaloDendrogram numberOfClusters currentCutoff
- | currentClusterNumber >= numberOfClusters = currentCutoff
- | otherwise = findCutoffforClusterNumber clustaloDendrogram numberOfClusters (currentCutoff-0.01)
- where currentClusterNumber = length (cutAt clustaloDendrogram currentCutoff)
-
--- Selects Query sequence ids from all collected seqeuences. Queries are then fetched by extractQueries function.
-selectQueries :: StaticOptions -> ModelConstruction -> [(Sequence,Int,L.ByteString)] -> IO [Sequence]
-selectQueries staticOptions modelConstruction selectedCandidates = do
- logVerboseMessage (verbositySwitch staticOptions) "SelectQueries\n" (tempDirPath staticOptions)
- --Extract sequences from modelconstruction
- let alignedSequences = extractAlignedSequences (iterationNumber modelConstruction) modelConstruction
- let candidateSequences = extractQueryCandidates selectedCandidates
- let iterationDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/"
- let stockholmFilepath = iterationDirectory ++ "model" ++ ".stockholm"
- let alignmentSequences = map snd (V.toList (V.concat [candidateSequences,alignedSequences]))
- if length alignmentSequences > 3
- then
- if (querySelectionMethod staticOptions) == "clustering"
- then do
- --write Fasta sequences
- writeFasta (iterationDirectory ++ "query" ++ ".fa") alignmentSequences
- let fastaFilepath = iterationDirectory ++ "query" ++ ".fa"
- let clustaloFilepath = iterationDirectory ++ "query" ++ ".clustalo"
- let clustaloDistMatrixPath = iterationDirectory ++ "query" ++ ".matrix"
- alignSequences "clustalo" ("--full --distmat-out=" ++ clustaloDistMatrixPath ++ " ") [fastaFilepath] [] [clustaloFilepath] []
- idsDistancematrix <- readClustaloDistMatrix clustaloDistMatrixPath
- logEither idsDistancematrix (tempDirPath staticOptions)
- let (clustaloIds,clustaloDistMatrix) = fromRight idsDistancematrix
- logVerboseMessage (verbositySwitch staticOptions) ("Clustalid: " ++ intercalate "," clustaloIds ++ "\n") (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) ("Distmatrix: " ++ show clustaloDistMatrix ++ "\n") (tempDirPath staticOptions)
- let clustaloDendrogram = dendrogram UPGMA clustaloIds (getDistanceMatrixElements clustaloIds clustaloDistMatrix)
- logVerboseMessage (verbositySwitch staticOptions) ("ClustaloDendrogram: " ++ show clustaloDendrogram ++ "\n") (tempDirPath staticOptions)
- logVerboseMessage (verbositySwitch staticOptions) ("ClustaloDendrogram: " ++ show clustaloDistMatrix ++ "\n") (tempDirPath staticOptions)
- let numberOfClusters = setClusterNumber (length alignmentSequences)
- logVerboseMessage (verbositySwitch staticOptions) ("numberOfClusters: " ++ show numberOfClusters ++ "\n") (tempDirPath staticOptions)
- let dendrogramStartCutDistance = 1 :: Double
- let dendrogramCutDistance' = findCutoffforClusterNumber clustaloDendrogram numberOfClusters dendrogramStartCutDistance
- logVerboseMessage (verbositySwitch staticOptions) ("dendrogramCutDistance': " ++ show dendrogramCutDistance' ++ "\n") (tempDirPath staticOptions)
- let cutDendrogram = cutAt clustaloDendrogram dendrogramCutDistance'
- --putStrLn "cutDendrogram: "
- --print cutDendrogram
- let currentSelectedSequenceIds = map L.pack (take (queryNumber staticOptions) (concatMap (take 1 . elements) cutDendrogram))
- --let alignedSequences = fastaSeqData:map nucleotideSequence (concatMap sequenceRecords (taxRecords modelconstruction))
- let fastaSelectedSequences = concatMap (filterSequenceById alignmentSequences) currentSelectedSequenceIds
- stockholmSelectedSequences <- extractAlignmentSequencesByIds stockholmFilepath currentSelectedSequenceIds
- --Stockholm sequnces contain conservation annotation from cmalign in infernal mode
- let currentSelectedSequences = if (blastSoftmaskingToggle staticOptions) then stockholmSelectedSequences else fastaSelectedSequences
- --let currentSelectedQueries = concatMap (\querySeqId -> filter (\alignedSeq -> L.unpack (unSL (seqid alignedSeq)) == querySeqId) alignmentSequences) querySeqIds
- logVerboseMessage (verbositySwitch staticOptions) ("SelectedQueries: " ++ show currentSelectedSequences ++ "\n") (tempDirPath staticOptions)
- writeFile (tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/log" ++ "/13selectedQueries") (showlines currentSelectedSequences)
- CE.evaluate currentSelectedSequences
- else do
- let fastaSelectedSequences = filterIdenticalSequences' alignmentSequences (95 :: Double)
- let currentSelectedSequenceIds = map (unSL . seqid) (take (queryNumber staticOptions) fastaSelectedSequences)
- stockholmSelectedSequences <- extractAlignmentSequencesByIds stockholmFilepath currentSelectedSequenceIds
- let currentSelectedSequences = if (blastSoftmaskingToggle staticOptions) then stockholmSelectedSequences else fastaSelectedSequences
- writeFile (tempDirPath staticOptions ++ show (iterationNumber modelConstruction) ++ "/log" ++ "/13selectedQueries") (showlines currentSelectedSequences)
- CE.evaluate currentSelectedSequences
- else return []
-
-
-filterSequenceById :: [Sequence] -> L.ByteString-> [Sequence]
-filterSequenceById alignmentSequences querySequenceId = filter (seqenceHasId querySequenceId) alignmentSequences
-
-seqenceHasId :: L.ByteString -> Sequence -> Bool
-seqenceHasId querySequenceId alignmentSequence = unSL (seqid alignmentSequence) == querySequenceId
-
-constructModel :: ModelConstruction -> StaticOptions -> IO String
-constructModel modelConstruction staticOptions = do
- --Extract sequences from modelconstruction
- let alignedSequences = extractAlignedSequences (iterationNumber modelConstruction) modelConstruction
- --The CM resides in the iteration directory where its input alignment originates from
- let outputDirectory = tempDirPath staticOptions ++ show (iterationNumber modelConstruction - 1) ++ "/"
- let alignmentSequences = map snd (V.toList (V.concat [alignedSequences]))
- --write Fasta sequences
- writeFasta (outputDirectory ++ "model" ++ ".fa") alignmentSequences
- let fastaFilepath = outputDirectory ++ "model" ++ ".fa"
- let locarnaFilepath = outputDirectory ++ "model" ++ ".mlocarna"
- let stockholmFilepath = outputDirectory ++ "model" ++ ".stockholm"
- --- let reformatedClustalFilepath = outputDirectory ++ "model" ++ ".clustal.reformated"
- let updatedStructureStockholmFilepath = outputDirectory ++ "newstructuremodel" ++ ".stockholm"
- let cmalignCMFilepath = tempDirPath staticOptions ++ show (iterationNumber modelConstruction - 2) ++ "/" ++ "model" ++ ".cm"
- let cmFilepath = outputDirectory ++ "model" ++ ".cm"
- let cmCalibrateFilepath = outputDirectory ++ "model" ++ ".cmcalibrate"
- let cmBuildFilepath = outputDirectory ++ "model" ++ ".cmbuild"
- let alifoldFilepath = outputDirectory ++ "model" ++ ".alifold"
- let refinedAlignmentFilepath = outputDirectory ++ "modelrefined" ++ ".stockholm"
- let cmBuildOptions ="--refine " ++ refinedAlignmentFilepath
- if alignmentModeInfernal modelConstruction
- then do
- logVerboseMessage (verbositySwitch staticOptions) "Construct Model - infernal mode\n" (tempDirPath staticOptions)
- systemCMalign ("--cpu " ++ show (cpuThreads staticOptions)) cmalignCMFilepath fastaFilepath stockholmFilepath
- systemRNAalifold "-r --cfactor 0.6 --nfactor 0.5" stockholmFilepath alifoldFilepath
- replaceStatus <- replaceStockholmStructure stockholmFilepath alifoldFilepath updatedStructureStockholmFilepath
- if null replaceStatus
- then do
- systemCMbuild cmBuildOptions updatedStructureStockholmFilepath cmFilepath cmBuildFilepath
- systemCMcalibrate "fast" (cpuThreads staticOptions) cmFilepath cmCalibrateFilepath
- return cmFilepath
- else do
- logWarning ("Warning: A problem occured updating the secondary structure of iteration " ++ show (iterationNumber modelConstruction) ++ " stockholm alignment: " ++ replaceStatus) (tempDirPath staticOptions)
- systemCMbuild cmBuildOptions stockholmFilepath cmFilepath cmBuildFilepath
- systemCMcalibrate "fast" (cpuThreads staticOptions) cmFilepath cmCalibrateFilepath
- return cmFilepath
- else do
- logVerboseMessage (verbositySwitch staticOptions) "Construct Model - initial mode\n" (tempDirPath staticOptions)
- alignSequences "mlocarna" ("--threads=" ++ show (cpuThreads staticOptions) ++ " ") [fastaFilepath] [] [locarnaFilepath] []
- mlocarnaAlignment <- readStructuralClustalAlignment locarnaFilepath
- logEither mlocarnaAlignment (tempDirPath staticOptions)
- let stockholAlignment = convertClustaltoStockholm (fromRight mlocarnaAlignment)
- TI.writeFile stockholmFilepath stockholAlignment
- _ <- systemCMbuild cmBuildOptions stockholmFilepath cmFilepath cmBuildFilepath
- _ <- systemCMcalibrate "fast" (cpuThreads staticOptions) cmFilepath cmCalibrateFilepath
- return cmFilepath
-
--- | Replaces structure of input stockholm file with the consensus structure of alifoldFilepath and outputs updated stockholmfile
-replaceStockholmStructure :: String -> String -> String -> IO String
-replaceStockholmStructure stockholmFilepath alifoldFilepath updatedStructureStockholmFilepath = do
- inputAln <- readFile stockholmFilepath
- inputRNAalifold <- readRNAalifold alifoldFilepath
- if isLeft inputRNAalifold
- then
- return (show (fromLeft inputRNAalifold))
- else do
- let alifoldstructure = alignmentConsensusDotBracket (fromRight inputRNAalifold)
- let seedLinesVector = V.fromList (lines inputAln)
- let structureIndices = V.toList (V.findIndices isStructureLine seedLinesVector)
- let updatedStructureElements = updateStructureElements seedLinesVector alifoldstructure structureIndices
- let newVector = seedLinesVector V.// updatedStructureElements
- let newVectorString = unlines (V.toList newVector)
- writeFile updatedStructureStockholmFilepath newVectorString
- return []
-
-updateStructureElements :: V.Vector String -> String -> [Int] -> [(Int,String)]
-updateStructureElements inputVector structureString indices
- | null indices = []
- | otherwise = newElement ++ updateStructureElements inputVector (drop structureLength structureString) (tail indices)
- where currentIndex = head indices
- currentElement = inputVector V.! currentIndex
- elementLength = length currentElement
- structureStartIndex = maximum (elemIndices ' ' currentElement) + 1
- structureLength = elementLength - structureStartIndex
- newElementHeader = take structureStartIndex currentElement
- newElementStructure = take structureLength structureString
- newElement = [(currentIndex,newElementHeader ++ newElementStructure)]
-
-isStructureLine :: String -> Bool
-isStructureLine input = "#=GC SS_cons" `isInfixOf` input
-
--- Generates iteration string for Log
-iterationSummaryLog :: ModelConstruction -> String
-iterationSummaryLog mC = output
- where upperTaxonomyLimitOutput = maybe "not set" show (upperTaxonomyLimit mC)
- output = "Upper taxonomy id limit: " ++ upperTaxonomyLimitOutput ++ ", Collected members: " ++ show (length (concatMap sequenceRecords (taxRecords mC))) ++ "\n"
-
--- | Used for passing progress to Alien server
-iterationSummary :: ModelConstruction -> StaticOptions -> IO()
-iterationSummary mC sO = do
- --iteration -- tax limit -- bitscore cutoff -- blastresult -- aligned seqs --queries --fa link --aln link --cm link
- let upperTaxonomyLimitOutput = maybe "not set" show (upperTaxonomyLimit mC)
- let output = show (iterationNumber mC) ++ "," ++ upperTaxonomyLimitOutput ++ "," ++ show (length (concatMap sequenceRecords (taxRecords mC)))
- writeFile (tempDirPath sO ++ "/log/" ++ show (iterationNumber mC) ++ ".log") output
-
--- | Used for passing progress to Alien server
-resultSummary :: ModelConstruction -> StaticOptions -> IO()
-resultSummary mC sO = do
- --iteration -- tax limit -- bitscore cutoff -- blastresult -- aligned seqs --queries --fa link --aln link --cm link
- let upperTaxonomyLimitOutput = maybe "not set" show (upperTaxonomyLimit mC)
- let output = show (iterationNumber mC) ++ "," ++ upperTaxonomyLimitOutput ++ "," ++ show (length (concatMap sequenceRecords (taxRecords mC)))
- writeFile (tempDirPath sO ++ "/log/result" ++ ".log") output
-
-readClustaloDistMatrix :: String -> IO (Either ParseError ([String],Matrix Double))
-readClustaloDistMatrix = parseFromFile genParserClustaloDistMatrix
-
-genParserClustaloDistMatrix :: GenParser Char st ([String],Matrix Double)
-genParserClustaloDistMatrix = do
- _ <- many1 digit
- newline
- clustaloDistRow <- many1 (try genParserClustaloDistRow)
- eof
- return (map fst clustaloDistRow,fromLists (map snd clustaloDistRow))
-
-genParserClustaloDistRow :: GenParser Char st (String,[Double])
-genParserClustaloDistRow = do
- entryId <- many1 (noneOf " ")
- many1 space
- distances <- many1 (try genParserClustaloDistance)
- newline
- return (entryId,distances)
-
-genParserClustaloDistance :: GenParser Char st Double
-genParserClustaloDistance = do
- distance <- many1 (oneOf "1234567890.")
- optional (try (char ' ' ))
- return (readDouble distance)
-
-getDistanceMatrixElements :: [String] -> Matrix Double -> String -> String -> Double
-getDistanceMatrixElements ids distMatrix id1 id2 = distance
- -- Data.Matrix is indexed starting with 1
- where indexid1 = fromJust (elemIndex id1 ids) + 1
- indexid2 = fromJust (elemIndex id2 ids) + 1
- distance = getElem indexid1 indexid2 distMatrix
-
--- | Filter duplicates removes hits in sequences that were already collected. This happens during revisiting the starting subtree.
-filterDuplicates :: ModelConstruction -> SearchResult -> SearchResult
-filterDuplicates modelConstruction inputSearchResult = uniqueSearchResult
- where alignedSequences = map snd (V.toList (extractAlignedSequences (iterationNumber modelConstruction) modelConstruction))
- collectedIdentifiers = map seqid alignedSequences
- uniques = filter (\(s,_,_) -> notElem (seqid s) collectedIdentifiers) (candidates inputSearchResult)
- uniqueSearchResult = SearchResult uniques (blastDatabaseSize inputSearchResult)
-
--- | Filter a list of similar extended blast hits
---filterIdenticalSequencesWithOrigin :: [(Sequence,Int,String,Char)] -> Double -> [(Sequence,Int,String,Char)]
---filterIdenticalSequencesWithOrigin (headSequence:rest) identitycutoff = result
--- where filteredSequences = filter (\x -> (sequenceIdentity (firstOfQuadruple headSequence) (firstOfQuadruple x)) < identitycutoff) rest
--- result = headSequence:(filterIdenticalSequencesWithOrigin filteredSequences identitycutoff)
---filterIdenticalSequencesWithOrigin [] _ = []
-
--- | Filter a list of similar extended blast hits
-filterIdenticalSequences :: [(Sequence,Int,L.ByteString)] -> Double -> [(Sequence,Int,L.ByteString)]
-filterIdenticalSequences (headSequence:rest) identitycutoff = result
- where filteredSequences = filter (\x -> sequenceIdentity (firstOfTriple headSequence) (firstOfTriple x) < identitycutoff) rest
- result = headSequence:filterIdenticalSequences filteredSequences identitycutoff
-filterIdenticalSequences [] _ = []
-
--- | Filter sequences too similar to already aligned sequences
-filterWithCollectedSequences :: [(Sequence,Int,L.ByteString)] -> [Sequence] -> Double -> [(Sequence,Int,L.ByteString)]
-filterWithCollectedSequences inputCandidates collectedSequences identitycutoff = filter (isUnSimilarSequence collectedSequences identitycutoff . firstOfTriple) inputCandidates
---filterWithCollectedSequences [] [] _ = []
-
--- | Filter alignment entries by similiarity
-filterIdenticalSequences' :: [Sequence] -> Double -> [Sequence]
-filterIdenticalSequences' (headEntry:rest) identitycutoff = result
- where filteredEntries = filter (\ x -> sequenceIdentity headEntry x < identitycutoff) rest
- result = headEntry:filterIdenticalSequences' filteredEntries identitycutoff
-filterIdenticalSequences' [] _ = []
-
----- | Filter alignment entries by similiarity
---filterIdenticalAlignmentEntry :: [ClustalAlignmentEntry] -> Double -> [ClustalAlignmentEntry]
---filterIdenticalAlignmentEntry (headEntry:rest) identitycutoff = result
--- where filteredEntries = filter (\x -> (stringIdentity (entryAlignedSequence headEntry) (entryAlignedSequence x)) < identitycutoff) rest
--- result = headEntry:filterIdenticalAlignmentEntry filteredEntries identitycutoff
---filterIdenticalAlignmentEntry [] _ = []
-
-isUnSimilarSequence :: [Sequence] -> Double -> Sequence -> Bool
-isUnSimilarSequence collectedSequences identitycutoff checkSequence = any (\ x -> sequenceIdentity checkSequence x < identitycutoff) collectedSequences
-
-firstOfTriple :: (t, t1, t2) -> t
-firstOfTriple (a,_,_) = a
-
--- | Check if the result field of BlastResult is filled and if hits are present
-blastMatchesPresent :: BlastResult -> Bool
-blastMatchesPresent blastResult
- | null resultList = False
- | otherwise = True
- where resultList = concatMap matches (concatMap hits (results blastResult))
-
--- | Compute identity of sequences
-textIdentity :: T.Text -> T.Text -> Double
-textIdentity text1 text2 = identityPercent
- where distance = TM.hamming text1 text2
- --Replication of RNAz select sequences requires only allowing substitutions
- --costs = ED.defaultEditCosts {ED.deletionCosts = ED.ConstantCost 100,ED.insertionCosts = ED.ConstantCost 100,ED.transpositionCosts = ED.ConstantCost 100}
- maximumDistance = maximum [T.length text1, T.length text2]
- distanceDouble = toInteger ( fromJust distance )
- identityPercent = 1 - (fromIntegral distanceDouble/fromIntegral maximumDistance)
-
-
--- | Compute identity of sequences
--- stringIdentity :: String -> String -> Double
--- stringIdentity string1 string2 = identityPercent
--- where distance = ED.levenshteinDistance costs string1 string2
--- --Replication of RNAz select sequences requires only allowing substitutions
--- costs = ED.defaultEditCosts {ED.deletionCosts = ED.ConstantCost 100,ED.insertionCosts = ED.ConstantCost 100,ED.transpositionCosts = ED.ConstantCost 100}
--- maximumDistance = maximum [length string1,length string2]
--- identityPercent = 1 - (fromIntegral distance/fromIntegral maximumDistance)
-
--- | Compute identity of sequences
-sequenceIdentity :: Sequence -> Sequence -> Double
-sequenceIdentity sequence1 sequence2 = identityPercent
- where distance = ED.levenshteinDistance ED.defaultEditCosts sequence1string sequence2string
- sequence1string = L.unpack (unSD (seqdata sequence1))
- sequence2string = L.unpack (unSD (seqdata sequence2))
- maximumDistance = maximum [length sequence1string,length sequence2string]
- identityPercent = 100 - ((fromIntegral distance/fromIntegral maximumDistance) * (read "100" ::Double))
-
-getTaxonomicContextEntrez :: Maybe Int -> Maybe Taxon -> IO (Maybe Taxon)
-getTaxonomicContextEntrez upperTaxLimit currentTaxonomicContext =
- if isJust upperTaxLimit
- then if isJust currentTaxonomicContext
- then return currentTaxonomicContext
- else retrieveTaxonomicContextEntrez (fromJust upperTaxLimit)
- --return retrievedTaxonomicContext
- else return Nothing
-
-setTaxonomicContextEntrez :: Int -> Maybe Taxon -> Maybe Int -> (Maybe Int, Maybe Int)
-setTaxonomicContextEntrez currentIterationNumber currentTaxonomicContext subTreeTaxId
- | currentIterationNumber == 0 = (subTreeTaxId, Nothing)
- | otherwise = setUpperLowerTaxLimitEntrez (fromJust subTreeTaxId) (fromJust currentTaxonomicContext)
-
--- setTaxonomic Context for next candidate search, the upper bound of the last search become the lower bound of the next
-setUpperLowerTaxLimitEntrez :: Int -> Taxon -> (Maybe Int, Maybe Int)
-setUpperLowerTaxLimitEntrez subTreeTaxId currentTaxonomicContext = (upperLimit,lowerLimit)
- where upperLimit = raiseTaxIdLimitEntrez subTreeTaxId currentTaxonomicContext
- lowerLimit = Just subTreeTaxId
-
-raiseTaxIdLimitEntrez :: Int -> Taxon -> Maybe Int
-raiseTaxIdLimitEntrez subTreeTaxId taxon = parentNodeTaxId
- where lastUpperBoundNodeIndex = fromJust (V.findIndex (\node -> lineageTaxId node == subTreeTaxId) lineageExVector)
- linageNodeTaxId = Just (lineageTaxId (lineageExVector V.! (lastUpperBoundNodeIndex -1)))
- lineageExVector = V.fromList (lineageEx taxon)
- --the input taxid is not part of the lineage, therefor we look for further taxids in the lineage after we used the parent tax id of the input node
- parentNodeTaxId = if subTreeTaxId == taxonTaxId taxon then Just (taxonParentTaxId taxon) else linageNodeTaxId
-
-constructNext :: Int -> ModelConstruction -> [(Sequence,Int,L.ByteString)] -> Maybe Int -> Maybe Taxon -> [Sequence] -> [SearchResult] -> Bool -> ModelConstruction
-constructNext currentIterationNumber modelconstruction alignmentResults upperTaxLimit inputTaxonomicContext inputSelectedQueries inputPotentialMembers toggleInfernalAlignmentModeTrue = nextModelConstruction
- where newIterationNumber = currentIterationNumber + 1
- taxEntries = taxRecords modelconstruction ++ buildTaxRecords alignmentResults currentIterationNumber
- potMembers = potentialMembers modelconstruction ++ inputPotentialMembers
- currentAlignmentMode = toggleInfernalAlignmentModeTrue || alignmentModeInfernal modelconstruction
- nextModelConstruction = ModelConstruction newIterationNumber (inputFasta modelconstruction) taxEntries upperTaxLimit inputTaxonomicContext (evalueThreshold modelconstruction) currentAlignmentMode inputSelectedQueries potMembers
-
-buildTaxRecords :: [(Sequence,Int,L.ByteString)] -> Int -> [TaxonomyRecord]
-buildTaxRecords alignmentResults currentIterationNumber = taxonomyRecords
- where taxIdGroups = groupBy sameTaxIdAlignmentResult alignmentResults
- taxonomyRecords = map (buildTaxRecord currentIterationNumber) taxIdGroups
-
-sameTaxIdAlignmentResult :: (Sequence,Int,L.ByteString) -> (Sequence,Int,L.ByteString) -> Bool
-sameTaxIdAlignmentResult (_,taxId1,_) (_,taxId2,_) = taxId1 == taxId2
-
-buildTaxRecord :: Int -> [(Sequence,Int,L.ByteString)] -> TaxonomyRecord
-buildTaxRecord currentIterationNumber entries = taxRecord
- where recordTaxId = (\(_,currentTaxonomyId,_) -> currentTaxonomyId) (head entries)
- seqRecords = map (buildSeqRecord currentIterationNumber) entries
- taxRecord = TaxonomyRecord recordTaxId seqRecords
-
-buildSeqRecord :: Int -> (Sequence,Int,L.ByteString) -> SequenceRecord
-buildSeqRecord currentIterationNumber (parsedFasta,_,seqSubject) = SequenceRecord parsedFasta currentIterationNumber seqSubject
-
--- | Partitions sequences by containing a cmsearch hit and extracts the hit region as new sequence
-evaluePartitionTrimCMsearchHits :: Double -> [(CMsearch,(Sequence, Int, L.ByteString))] -> ([(CMsearch,(Sequence, Int, L.ByteString))],[(CMsearch,(Sequence, Int, L.ByteString))],[(CMsearch,(Sequence, Int, L.ByteString))])
-evaluePartitionTrimCMsearchHits eValueThreshold cmSearchCandidatesWithSequences = (trimmedSelectedCandidates,potentialCandidates,rejectedCandidates)
- where potentialMemberseValueThreshold = eValueThreshold * 1000
- (prefilteredCandidates,rejectedCandidates) = partition (\(cmSearchResult,_) -> any (\hitScore' -> potentialMemberseValueThreshold >= hitEvalue hitScore') (cmsearchHits cmSearchResult)) cmSearchCandidatesWithSequences
- (selectedCandidates,potentialCandidates) = partition (\(cmSearchResult,_) -> any (\hitScore' -> eValueThreshold >= hitEvalue hitScore') (cmsearchHits cmSearchResult)) prefilteredCandidates
- trimmedSelectedCandidates = map (\(cmSearchResult,inputSequence) -> (cmSearchResult,trimCMsearchHit cmSearchResult inputSequence)) selectedCandidates
-
-
-trimCMsearchHit :: CMsearch -> (Sequence, Int, L.ByteString) -> (Sequence, Int, L.ByteString)
-trimCMsearchHit cmSearchResult (inputSequence,b,c) = (subSequence,b,c)
- where hitScoreEntry = head (cmsearchHits cmSearchResult)
- sequenceString = L.unpack (unSD (seqdata inputSequence))
- sequenceSubstring = cmSearchsubString (hitStart hitScoreEntry) (hitEnd hitScoreEntry) sequenceString
- --extend original seqheader
- newSequenceHeader = L.pack (L.unpack (unSL (seqheader inputSequence)) ++ "cmS_" ++ show (hitStart hitScoreEntry) ++ "_" ++ show (hitEnd hitScoreEntry) ++ "_" ++ show (hitStrand hitScoreEntry))
- subSequence = Seq (SeqLabel newSequenceHeader) (SeqData (L.pack sequenceSubstring)) Nothing
-
--- | Extract a substring with coordinates from cmsearch, first nucleotide has index 1
-cmSearchsubString :: Int -> Int -> String -> String
-cmSearchsubString startSubString endSubString inputString
- | startSubString < endSubString = take (endSubString - (startSubString -1))(drop (startSubString - 1) inputString)
- | startSubString > endSubString = take (reverseEnd - (reverseStart - 1))(drop (reverseStart - 1 ) (reverse inputString))
- | otherwise = take (endSubString - (startSubString -1))(drop (startSubString - 1) inputString)
- where stringLength = length inputString
- reverseStart = stringLength - (startSubString + 1)
- reverseEnd = stringLength - (endSubString - 1)
-
-extractQueries :: Int -> ModelConstruction -> [Sequence]
-extractQueries foundSequenceNumber modelconstruction
- | foundSequenceNumber < 3 = [fastaSeqData]
- | otherwise = querySequences'
- where fastaSeqData = inputFasta modelconstruction
- querySequences' = selectedQueries modelconstruction
-
-extractQueryCandidates :: [(Sequence,Int,L.ByteString)] -> V.Vector (Int,Sequence)
-extractQueryCandidates querycandidates = indexedSeqences
- where sequences = map (\(candidateSequence,_,_) -> candidateSequence) querycandidates
- indexedSeqences = V.map (\(number,candidateSequence) -> (number + 1,candidateSequence))(V.indexed (V.fromList sequences))
-
-buildTaxFilterQuery :: Maybe Int -> Maybe Int -> String
-buildTaxFilterQuery upperTaxLimit lowerTaxLimit
- | isNothing upperTaxLimit = ""
- | isNothing lowerTaxLimit = "&ENTREZ_QUERY=" ++ encodedTaxIDQuery (fromJust upperTaxLimit)
- | otherwise = "&ENTREZ_QUERY=" ++ "%28txid" ++ show (fromJust upperTaxLimit) ++ "%5BORGN%5D%29" ++ "NOT" ++ "%28txid" ++ show (fromJust lowerTaxLimit) ++ "%5BORGN%5D&EQ_OP%29"
-
-buildHitNumberQuery :: String -> String
-buildHitNumberQuery hitNumber
- | hitNumber == "" = ""
- | otherwise = "&ALIGNMENTS=" ++ hitNumber
-
-encodedTaxIDQuery :: Int -> String
-encodedTaxIDQuery taxID = "txid" ++ show taxID ++ "%20%5BORGN%5D&EQ_OP"
-
--- | Adds cm prefix to pseudo random number
-randomid :: Int16 -> String
-randomid number = "cm" ++ show number
-
--- | Create session id for RNAlien
-createSessionID :: Maybe String -> IO String
-createSessionID sessionIdentificator =
- if isJust sessionIdentificator
- then return (fromJust sessionIdentificator)
- else do
- randomNumber <- randomIO :: IO Int16
- let sessionId = randomid (abs (randomNumber))
- return sessionId
-
--- | Run external locarna command and read the output into the corresponding datatype
-systemlocarna :: String -> (String,String,String,String) -> IO ExitCode
-systemlocarna options (inputFilePath1, inputFilePath2, clustalformatoutputFilePath, outputFilePath) = system ("locarna " ++ options ++ " --clustal=" ++ clustalformatoutputFilePath ++ " " ++ inputFilePath1 ++ " " ++ inputFilePath2 ++ " > " ++ outputFilePath)
-
--- | Run external mlocarna command and read the output into the corresponding datatype, there is also a folder created at the location of the input fasta file
-systemMlocarna :: String -> (String,String) -> IO ExitCode
-systemMlocarna options (inputFilePath, outputFilePath) = system ("mlocarna " ++ options ++ " " ++ inputFilePath ++ " > " ++ outputFilePath)
-
--- | Run external mlocarna command and read the output into the corresponding datatype, there is also a folder created at the location of the input fasta file, the job is terminated after the timeout provided in seconds
-systemMlocarnaWithTimeout :: String -> String -> (String,String) -> IO ExitCode
-systemMlocarnaWithTimeout timeout options (inputFilePath, outputFilePath) = system ("timeout " ++ timeout ++"s "++ "mlocarna " ++ options ++ " " ++ inputFilePath ++ " > " ++ outputFilePath)
-
--- | Run external clustalo command and return the Exitcode
-systemClustalw2 :: String -> (String,String,String) -> IO ExitCode
-systemClustalw2 options (inputFilePath, outputFilePath, summaryFilePath) = system ("clustalw2 " ++ options ++ "-INFILE=" ++ inputFilePath ++ " -OUTFILE=" ++ outputFilePath ++ ">" ++ summaryFilePath)
-
--- | Run external clustalo command and return the Exitcode
-systemClustalo :: String -> (String,String) -> IO ExitCode
-systemClustalo options (inputFilePath, outputFilePath) = system ("clustalo " ++ options ++ "--infile=" ++ inputFilePath ++ " >" ++ outputFilePath)
-
--- | Run external CMbuild command and read the output into the corresponding datatype
-systemCMbuild :: String -> String -> String -> String -> IO ExitCode
-systemCMbuild options alignmentFilepath modelFilepath outputFilePath = system ("cmbuild " ++ options ++ " " ++ modelFilepath ++ " " ++ alignmentFilepath ++ " > " ++ outputFilePath)
-
--- | Run CMCompare and read the output into the corresponding datatype
-systemCMcompare :: String -> String -> String -> IO ExitCode
-systemCMcompare model1path model2path outputFilePath = system ("CMCompare -q " ++ model1path ++ " " ++ model2path ++ " >" ++ outputFilePath)
-
--- | Run CMsearch
-systemCMsearch :: Int -> String -> String -> String -> String -> IO ExitCode
-systemCMsearch cpus options covarianceModelPath sequenceFilePath outputPath = system ("cmsearch --notrunc --cpu " ++ show cpus ++ " " ++ options ++ " -g " ++ covarianceModelPath ++ " " ++ sequenceFilePath ++ "> " ++ outputPath)
-
--- | Run CMstat
-systemCMstat :: String -> String -> IO ExitCode
-systemCMstat covarianceModelPath outputPath = system ("cmstat " ++ covarianceModelPath ++ " > " ++ outputPath)
-
--- | Run CMcalibrate and return exitcode
-systemCMcalibrate :: String -> Int -> String -> String -> IO ExitCode
-systemCMcalibrate mode cpus covarianceModelPath outputPath
- | mode == "fast" = system ("cmcalibrate --beta 1E-4 --cpu " ++ show cpus ++ " " ++ covarianceModelPath ++ "> " ++ outputPath)
- | otherwise = system ("cmcalibrate --cpu " ++ show cpus ++ " " ++ covarianceModelPath ++ "> " ++ outputPath)
-
-
--- | Run CMcalibrate and return exitcode
-systemCMalign :: String -> String -> String -> String -> IO ExitCode
-systemCMalign options filePathCovarianceModel filePathSequence filePathAlignment = system ("cmalign " ++ options ++ " " ++ filePathCovarianceModel ++ " " ++ filePathSequence ++ "> " ++ filePathAlignment)
-
-compareCM :: String -> String -> String -> IO (Either String Double)
-compareCM rfamCMPath resultCMpath outputDirectory = do
- let myOptions = defaultDecodeOptions {
- decDelimiter = fromIntegral (ord ' ')
- }
- let rfamCMFileName = FP.takeBaseName rfamCMPath
- let resultCMFileName = FP.takeBaseName resultCMpath
- let cmcompareResultPath = outputDirectory ++ rfamCMFileName ++ resultCMFileName ++ ".cmcompare"
- _ <- systemCMcompare rfamCMPath resultCMpath cmcompareResultPath
- inputCMcompare <- readFile cmcompareResultPath
- let singlespaceCMcompare = unwords(words inputCMcompare)
- let decodedCmCompareOutput = head (V.toList (fromRight (decodeWith myOptions NoHeader (L.pack singlespaceCMcompare) :: Either String (V.Vector [String]))))
- --two.cm three.cm 27.996 19.500 CCCAAAGGGCCCAAAGGG (((...)))(((...))) (((...)))(((...))) [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17] [11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27]
- let bitscore1 = read (decodedCmCompareOutput !! 2) :: Double
- let bitscore2 = read (decodedCmCompareOutput !! 3) :: Double
- let minmax = minimum [bitscore1,bitscore2]
- return (Right minmax)
-
-readInt :: String -> Int
-readInt = read
-
-readDouble :: String -> Double
-readDouble = read
-
-extractCandidateSequences :: [(Sequence,Int,L.ByteString)] -> V.Vector (Int,Sequence)
-extractCandidateSequences candidates' = indexedSeqences
- where sequences = map (\(inputSequence,_,_) -> inputSequence) candidates'
- indexedSeqences = V.map (\(number,inputSequence) -> (number + 1,inputSequence))(V.indexed (V.fromList sequences))
-
-extractAlignedSequences :: Int -> ModelConstruction -> V.Vector (Int,Sequence)
-extractAlignedSequences iterationnumber modelconstruction
- | iterationnumber == 0 = V.map (\(number,seq') -> (number + 1,seq')) (V.indexed (V.fromList [inputSequence]))
- | otherwise = indexedSeqRecords
- where inputSequence = inputFasta modelconstruction
- seqRecordsperTaxrecord = map sequenceRecords (taxRecords modelconstruction)
- seqRecords = concat seqRecordsperTaxrecord
- --alignedSeqRecords = filter (\seqRec -> (aligned seqRec) > 0) seqRecords
- indexedSeqRecords = V.map (\(number,seq') -> (number + 1,seq')) (V.indexed (V.fromList (inputSequence : map nucleotideSequence seqRecords)))
-
-filterByParentTaxId :: [(BlastHit,Int)] -> Bool -> [(BlastHit,Int)]
-filterByParentTaxId blastHitsWithParentTaxId singleHitPerParentTaxId
- | singleHitPerParentTaxId = singleBlastHitperParentTaxId
- | otherwise = blastHitsWithParentTaxId
- where blastHitsWithParentTaxIdSortedByParentTaxId = sortBy compareTaxId blastHitsWithParentTaxId
- blastHitsWithParentTaxIdGroupedByParentTaxId = groupBy sameTaxId blastHitsWithParentTaxIdSortedByParentTaxId
- singleBlastHitperParentTaxId = map (maximumBy compareHitEValue) blastHitsWithParentTaxIdGroupedByParentTaxId
-
-filterByHitLength :: [BlastHit] -> Int -> Bool -> [BlastHit]
-filterByHitLength blastHits queryLength filterOn
- | filterOn = filteredBlastHits
- | otherwise = blastHits
- where filteredBlastHits = filter (hitLengthCheck queryLength) blastHits
-
--- | Hits should have a compareable length to query
-hitLengthCheck :: Int -> BlastHit -> Bool
-hitLengthCheck queryLength blastHit = lengthStatus
- where blastMatches = matches blastHit
- minHfrom = minimum (map h_from blastMatches)
- minHfromHSP = fromJust (find (\hsp -> minHfrom == h_from hsp) blastMatches)
- maxHto = maximum (map h_to blastMatches)
- maxHtoHSP = fromJust (find (\hsp -> maxHto == h_to hsp) blastMatches)
- minHonQuery = q_from minHfromHSP
- maxHonQuery = q_to maxHtoHSP
- startCoordinate = minHfrom - minHonQuery
- endCoordinate = maxHto + (queryLength - maxHonQuery)
- fullSeqLength = endCoordinate - startCoordinate
- lengthStatus = fullSeqLength < (queryLength * 3)
-
-filterByCoverage :: [BlastHit] -> Int -> Bool -> [BlastHit]
-filterByCoverage blastHits queryLength filterOn
- | filterOn = filteredBlastHits
- | otherwise = blastHits
- where filteredBlastHits = filter (coverageCheck queryLength) blastHits
-
--- | Hits should have a compareable length to query
-coverageCheck :: Int -> BlastHit -> Bool
-coverageCheck queryLength blastHit = coverageStatus
- where blastMatches = matches blastHit
- maxIdentity = fromIntegral (maximum (map (snd . Bio.BlastXML.identity) blastMatches))
- coverageStatus = (maxIdentity/fromIntegral queryLength)* (100 :: Double) >= (80 :: Double)
-
--- | Wrapper for retrieveFullSequence that rerequests incomplete return sequees
-retrieveFullSequences :: StaticOptions -> [(String,Int,Int,String,T.Text,Int,L.ByteString)] -> IO [(Sequence,Int,L.ByteString)]
-retrieveFullSequences staticOptions requestedSequences = do
- fullSequences <- mapM (retrieveFullSequence (tempDirPath staticOptions)) requestedSequences
- if any (isNothing . firstOfTriple) fullSequences
- then do
- let fullSequencesWithRequestedSequences = zip fullSequences requestedSequences
- --let (failedRetrievals, successfulRetrievals) = partition (\x -> L.null (unSD (seqdata (firstOfTriple (fst x))))) fullSequencesWithRequestedSequences
- let (failedRetrievals, successfulRetrievals) = partition (isNothing . firstOfTriple . fst) fullSequencesWithRequestedSequences
- --we try to reretrieve failed entries once
- missingSequences <- mapM (retrieveFullSequence (tempDirPath staticOptions) .snd) failedRetrievals
- let (stillMissingSequences,reRetrievedSequences) = partition (isNothing . firstOfTriple) missingSequences
- logWarning ("Sequence retrieval failed: \n" ++ concatMap show stillMissingSequences ++ "\n") (tempDirPath staticOptions)
- let unwrappedRetrievals = map (\(x,y,z) -> (fromJust x,y,z)) (map fst successfulRetrievals ++ reRetrievedSequences)
- CE.evaluate unwrappedRetrievals
- else CE.evaluate (map (\(x,y,z) -> (fromJust x,y,z)) fullSequences)
-
-retrieveFullSequence :: String -> (String,Int,Int,String,T.Text,Int,L.ByteString) -> IO (Maybe Sequence,Int,L.ByteString)
-retrieveFullSequence temporaryDirectoryPath (nucleotideId,seqStart,seqStop,strand,_,taxid,subject') = do
- let program' = Just "efetch"
- let database' = Just "nucleotide"
- let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
- let queryString = "id=" ++ nucleotideId ++ "&seq_start=" ++ show seqStart ++ "&seq_stop=" ++ show seqStop ++ "&rettype=fasta" ++ "&strand=" ++ strand ++ registrationInfo
- let entrezQuery = EntrezHTTPQuery program' database' queryString
- result <- CE.catch (entrezHTTP entrezQuery)
- (\e -> do let err = show (e :: CE.IOException)
- logWarning ("Warning: Full sequence retrieval failed:" ++ " " ++ err) temporaryDirectoryPath
- return [])
- if null result
- then return (Nothing,taxid,subject')
- else
- if null ((mkSeqs . L.lines) (L.pack result))
- then return (Nothing,taxid,subject')
- else do
- let parsedFasta = head ((mkSeqs . L.lines) (L.pack result))
- if L.null (unSD (seqdata parsedFasta))
- then return (Nothing,taxid,subject')
- else CE.evaluate (Just parsedFasta,taxid,subject')
-
-getRequestedSequenceElement :: Int -> (BlastHit,Int) -> (String,Int,Int,String,T.Text,Int,L.ByteString)
-getRequestedSequenceElement queryLength (blastHit,taxid)
- | blastHitIsReverseComplement (blastHit,taxid) = getReverseRequestedSequenceElement queryLength (blastHit,taxid)
- | otherwise = getForwardRequestedSequenceElement queryLength (blastHit,taxid)
-
-blastHitIsReverseComplement :: (BlastHit,Int) -> Bool
-blastHitIsReverseComplement (blastHit,_) = isReverse
- where blastMatch = head (matches blastHit)
- firstHSPfrom = h_from blastMatch
- firstHSPto = h_to blastMatch
- isReverse = firstHSPfrom > firstHSPto
-
-getForwardRequestedSequenceElement :: Int -> (BlastHit,Int) -> (String,Int,Int,String,T.Text,Int,L.ByteString)
-getForwardRequestedSequenceElement queryLength (blastHit,taxid) = (geneIdentifier',startcoordinate,endcoordinate,strand,accession',taxid,subjectBlast)
- where accession' = extractAccession blastHit
- subjectBlast = unSL (subject blastHit)
- geneIdentifier' = extractGeneId blastHit
- blastMatch = head (matches blastHit)
- blastHitOriginSequenceLength = slength blastHit
- minHfrom = h_from blastMatch
- maxHto = h_to blastMatch
- minHonQuery = q_from blastMatch
- maxHonQuery = q_to blastMatch
- --unsafe coordinates may exceed length of available sequence
- unsafestartcoordinate = minHfrom - minHonQuery
- unsafeendcoordinate = maxHto + (queryLength - maxHonQuery)
- startcoordinate = lowerBoundryCoordinateSetter 0 unsafestartcoordinate
- endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafeendcoordinate
- strand = "1"
- ----
- --blastMatches = matches blastHit
- --blastHitOriginSequenceLength = slength blastHit
- --minHfrom = minimum (map h_from blastMatches)
- --minHfromHSP = fromJust (find (\hsp -> minHfrom == h_from hsp) blastMatches)
- --maxHto = maximum (map h_to blastMatches)
- --maxHtoHSP = fromJust (find (\hsp -> maxHto == h_to hsp) blastMatches)
- --minHonQuery = q_from minHfromHSP
- --maxHonQuery = q_to maxHtoHSP
- --unsafe coordinates may exceed length of available sequence
- --unsafestartcoordinate = minHfrom - minHonQuery
- --unsafeendcoordinate = maxHto + (queryLength - maxHonQuery)
- --startcoordinate = lowerBoundryCoordinateSetter 0 unsafestartcoordinate
- --endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafeendcoordinate
- --strand = "1"
-
-lowerBoundryCoordinateSetter :: Int -> Int -> Int
-lowerBoundryCoordinateSetter lowerBoundry currentValue
- | currentValue < lowerBoundry = lowerBoundry
- | otherwise = currentValue
-
-upperBoundryCoordinateSetter :: Int -> Int -> Int
-upperBoundryCoordinateSetter upperBoundry currentValue
- | currentValue > upperBoundry = upperBoundry
- | otherwise = currentValue
-
-getReverseRequestedSequenceElement :: Int -> (BlastHit,Int) -> (String,Int,Int,String,T.Text,Int,L.ByteString)
-getReverseRequestedSequenceElement queryLength (blastHit,taxid) = (geneIdentifier',startcoordinate,endcoordinate,strand,accession',taxid,subjectBlast)
- where accession' = extractAccession blastHit
- subjectBlast = unSL (subject blastHit)
- geneIdentifier' = extractGeneId blastHit
- blastMatch = head (matches blastHit)
- blastHitOriginSequenceLength = slength blastHit
- maxHfrom = h_from blastMatch
- minHto = h_to blastMatch
- minHonQuery = q_from blastMatch
- maxHonQuery = q_to blastMatch
- --unsafe coordinates may exceed length of avialable sequence
- unsafestartcoordinate = maxHfrom + minHonQuery
- unsafeendcoordinate = minHto - (queryLength - maxHonQuery)
- startcoordinate = lowerBoundryCoordinateSetter 0 unsafeendcoordinate
- endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafestartcoordinate
- strand = "2"
- --
- --blastMatches = matches blastHit
- --blastHitOriginSequenceLength = slength blastHit
- --maxHfrom = maximum (map h_from blastMatches)
- --maxHfromHSP = fromJust (find (\hsp -> maxHfrom == h_from hsp) blastMatches)
- --minHto = minimum (map h_to blastMatches)
- --minHtoHSP = fromJust (find (\hsp -> minHto == h_to hsp) blastMatches)
- --minHonQuery = q_from maxHfromHSP
- --maxHonQuery = q_to minHtoHSP
- --unsafe coordinates may exeed length of avialable sequence
- --unsafestartcoordinate = maxHfrom + minHonQuery
- --unsafeendcoordinate = minHto - (queryLength - maxHonQuery)
- --startcoordinate = lowerBoundryCoordinateSetter 0 unsafeendcoordinate
- --endcoordinate = upperBoundryCoordinateSetter blastHitOriginSequenceLength unsafestartcoordinate
- --strand = "2"
-
---computeAlignmentSCIs :: [String] -> [String] -> IO ()
---computeAlignmentSCIs alignmentFilepaths rnazOutputFilepaths = do
--- let zippedFilepaths = zip alignmentFilepaths rnazOutputFilepaths
--- mapM_ systemRNAz zippedFilepaths
-
-alignSequences :: String -> String -> [String] -> [String] -> [String] -> [String] -> IO ()
-alignSequences program' options fastaFilepaths fastaFilepaths2 alignmentFilepaths summaryFilepaths = do
- let zipped4Filepaths = zip4 fastaFilepaths fastaFilepaths2 alignmentFilepaths summaryFilepaths
- let zipped3Filepaths = zip3 fastaFilepaths alignmentFilepaths summaryFilepaths
- let zippedFilepaths = zip fastaFilepaths alignmentFilepaths
- let timeout = "3600"
- case program' of
- "locarna" -> mapM_ (systemlocarna options) zipped4Filepaths
- "mlocarna" -> mapM_ (systemMlocarna options) zippedFilepaths
- "mlocarnatimeout" -> mapM_ (systemMlocarnaWithTimeout timeout options) zippedFilepaths
- "clustalo" -> mapM_ (systemClustalo options) zippedFilepaths
- _ -> mapM_ (systemClustalw2 options ) zipped3Filepaths
-
-constructFastaFilePaths :: String -> (Int, Sequence) -> String
-constructFastaFilePaths currentDirectory (fastaIdentifier, _) = currentDirectory ++ show fastaIdentifier ++".fa"
-
-constructCMsearchFilePaths :: String -> (Int, Sequence) -> String
-constructCMsearchFilePaths currentDirectory (fastaIdentifier, _) = currentDirectory ++ show fastaIdentifier ++".cmsearch"
-
--- Smaller e-Values are greater, the maximum function is applied
-compareHitEValue :: (BlastHit,Int) -> (BlastHit,Int) -> Ordering
-compareHitEValue (hit1,_) (hit2,_)
- | hitEValue hit1 > hitEValue hit2 = LT
- | hitEValue hit1 < hitEValue hit2 = GT
- -- in case of equal evalues the first hit is selected
- | hitEValue hit1 == hitEValue hit2 = GT
--- comparing (hitEValue . Down . fst)
-compareHitEValue (_,_) (_,_) = EQ
-
-compareTaxId :: (BlastHit,Int) -> (BlastHit,Int) -> Ordering
-compareTaxId (_,taxId1) (_,taxId2)
- | taxId1 > taxId2 = LT
- | taxId1 < taxId2 = GT
- -- in case of equal evalues the first hit is selected
- | taxId1 == taxId2 = EQ
-compareTaxId (_,_) (_,_) = EQ
-
-sameTaxId :: (BlastHit,Int) -> (BlastHit,Int) -> Bool
-sameTaxId (_,taxId1) (_,taxId2) = taxId1 == taxId2
-
--- | NCBI uses the e-Value of the best HSP as the Hits e-Value
-hitEValue :: BlastHit -> Double
-hitEValue hit = minimum (map e_val (matches hit))
-
-convertFastaFoldStockholm :: Sequence -> String -> String
-convertFastaFoldStockholm fastasequence foldedStructure = stockholmOutput
- where alnHeader = "# STOCKHOLM 1.0\n\n"
- --(L.unpack (unSL (seqheader inputFasta')))) ++ "\n" ++ (map toUpper (L.unpack (unSD (seqdata inputFasta')))) ++ "\n"
- seqIdentifier = L.unpack (unSL (seqheader fastasequence))
- seqSequence = L.unpack (unSD (seqdata fastasequence))
- identifierLength = length seqIdentifier
- spacerLength' = maximum [14,identifierLength + 2]
- spacer = replicate (spacerLength' - identifierLength) ' '
- entrystring = seqIdentifier ++ spacer ++ seqSequence ++ "\n"
- structureString = "#=GC SS_cons" ++ replicate (spacerLength' - 12) ' ' ++ foldedStructure ++ "\n"
- bottom = "//"
- stockholmOutput = alnHeader ++ entrystring ++ structureString ++ bottom
-
-convertClustaltoStockholm :: StructuralClustalAlignment -> T.Text
-convertClustaltoStockholm parsedMlocarnaAlignment = stockholmOutput
- where alnHeader = T.pack "# STOCKHOLM 1.0\n\n"
- clustalAlignment = structuralAlignmentEntries parsedMlocarnaAlignment
- uniqueIds = nub (map entrySequenceIdentifier clustalAlignment)
- mergedEntries = map (mergeEntry clustalAlignment) uniqueIds
- maxIdentifierLenght = maximum (map (T.length . entrySequenceIdentifier) clustalAlignment)
- spacerLength' = maxIdentifierLenght + 2
- stockholmEntries = T.concat (map (buildStockholmAlignmentEntries spacerLength') mergedEntries)
- structureString = T.pack "#=GC SS_cons" `T.append` T.replicate (spacerLength' - 12) (T.pack " ") `T.append` secondaryStructureTrack parsedMlocarnaAlignment `T.append` T.pack "\n"
- bottom = T.pack "//"
- stockholmOutput = alnHeader `T.append` stockholmEntries `T.append` structureString `T.append` bottom
-
-mergeEntry :: [ClustalAlignmentEntry] -> T.Text -> ClustalAlignmentEntry
-mergeEntry clustalAlignment uniqueId = mergedEntry
- where idEntries = filter (\entry -> entrySequenceIdentifier entry==uniqueId) clustalAlignment
- mergedSeq = foldr (T.append . entryAlignedSequence) (T.pack "") idEntries
- mergedEntry = ClustalAlignmentEntry uniqueId mergedSeq
-
-buildStockholmAlignmentEntries :: Int -> ClustalAlignmentEntry -> T.Text
-buildStockholmAlignmentEntries inputSpacerLength entry = entrystring
- where idLength = T.length (T.filter (/= '\n') (entrySequenceIdentifier entry))
- spacer = T.replicate (inputSpacerLength - idLength) (T.pack " ")
- entrystring = entrySequenceIdentifier entry `T.append` spacer `T.append` entryAlignedSequence entry `T.append` T.pack "\n"
-
-retrieveTaxonomicContextEntrez :: Int -> IO (Maybe Taxon)
-retrieveTaxonomicContextEntrez inputTaxId = do
- let program' = Just "efetch"
- let database' = Just "taxonomy"
- let taxIdString = show inputTaxId
- let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
- let queryString = "id=" ++ taxIdString ++ registrationInfo
- let entrezQuery = EntrezHTTPQuery program' database' queryString
- result <- entrezHTTP entrezQuery
- if null result
- then do
- error "Could not retrieve taxonomic context from NCBI Entrez, cannot proceed."
- return Nothing
- else do
- let taxon = head (readEntrezTaxonSet result)
- --print taxon
- if null (lineageEx taxon)
- then error "Retrieved taxonomic context taxon from NCBI Entrez with empty lineage, cannot proceed."
- else return (Just taxon)
-
-retrieveParentTaxIdEntrez :: [(BlastHit,Int)] -> IO [(BlastHit,Int)]
-retrieveParentTaxIdEntrez blastHitsWithHitTaxids =
- if not (null blastHitsWithHitTaxids)
- then do
- let program' = Just "efetch"
- let database' = Just "taxonomy"
- let extractedBlastHits = map fst blastHitsWithHitTaxids
- let taxIds = map snd blastHitsWithHitTaxids
- let taxIdStrings = map show taxIds
- let taxIdQuery = intercalate "," taxIdStrings
- let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
- let queryString = "id=" ++ taxIdQuery ++ registrationInfo
- let entrezQuery = EntrezHTTPQuery program' database' queryString
- result <- entrezHTTP entrezQuery
- let parentTaxIds = readEntrezParentIds result
- if null parentTaxIds
- then return []
- else CE.evaluate (zip extractedBlastHits parentTaxIds)
- else return []
-
--- | Wrapper functions that ensures that only 20 queries are sent per request
-retrieveParentTaxIdsEntrez :: [(BlastHit,Int)] -> IO [(BlastHit,Int)]
-retrieveParentTaxIdsEntrez taxIdwithBlastHits = do
- let splits = portionListElements taxIdwithBlastHits 20
- taxIdsOutput <- mapM retrieveParentTaxIdEntrez splits
- return (concat taxIdsOutput)
-
--- | Wrapper functions that ensures that only 20 queries are sent per request
-retrieveBlastHitsTaxIdEntrez :: [BlastHit] -> IO [([BlastHit],String)]
-retrieveBlastHitsTaxIdEntrez blastHits = do
- let splits = portionListElements blastHits 20
- mapM retrieveBlastHitTaxIdEntrez splits
-
-
-retrieveBlastHitTaxIdEntrez :: [BlastHit] -> IO ([BlastHit],String)
-retrieveBlastHitTaxIdEntrez blastHits =
- if not (null blastHits)
- then do
- let geneIds = map extractGeneId blastHits
- let idList = intercalate "," geneIds
- let registrationInfo = buildRegistration "RNAlien" "florian.eggenhofer@univie.ac.at"
- let query' = "id=" ++ idList ++ registrationInfo
- let entrezQuery = EntrezHTTPQuery (Just "esummary") (Just "nucleotide") query'
- threadDelay 10000000
- result <- entrezHTTP entrezQuery
- CE.evaluate (blastHits,result)
- else return (blastHits,"")
-
-extractTaxIdFromEntrySummaries :: String -> [Int]
-extractTaxIdFromEntrySummaries input
- | null input = []
- | null parsedResultList = []
- | otherwise = hitTaxIds
- where parsedResultList = readEntrezSummaries input
- parsedResult = head parsedResultList
- blastHitSummaries = documentSummaries parsedResult
- hitTaxIdStrings = map extractTaxIdfromDocumentSummary blastHitSummaries
- hitTaxIds = map readInt hitTaxIdStrings
-
-extractAccession :: BlastHit -> T.Text
-extractAccession currentBlastHit = accession'
- where splitedFields = T.splitOn (T.pack "|") (DTE.decodeUtf8 (L.toStrict (hitId currentBlastHit)))
- accession' = splitedFields !! 3
-
-extractGeneId :: BlastHit -> String
-extractGeneId currentBlastHit = nucleotideId
- where truncatedId = drop 3 (L.unpack (hitId currentBlastHit))
- pipeSymbolIndex = fromJust (elemIndex '|' truncatedId)
- nucleotideId = take pipeSymbolIndex truncatedId
-
-extractTaxIdfromDocumentSummary :: EntrezDocSum -> String
-extractTaxIdfromDocumentSummary documentSummary = itemContent (fromJust (find (\item -> "TaxId" == itemName item) (summaryItems documentSummary)))
-
-getBestHit :: BlastResult -> BlastHit
-getBestHit blastResult
- | null (concatMap hits (results blastResult)) = error "getBestHit - head: empty list"
- | otherwise = head (hits (head (results blastResult)))
-
--- Blast returns low evalues with zero instead of the exact number
-getHitWithFractionEvalue :: BlastResult -> Maybe BlastMatch
-getHitWithFractionEvalue blastResult
- | null (concatMap hits (results blastResult)) = Nothing
- | otherwise = find (\match -> e_val match /= (0 ::Double)) (concatMap matches (concatMap hits (results blastResult)))
-
-showlines :: Show a => [a] -> String
-showlines = concatMap (\x -> show x ++ "\n")
-
-logMessage :: String -> String -> IO ()
-logMessage logoutput temporaryDirectoryPath = appendFile (temporaryDirectoryPath ++ "Log") logoutput
-
-logWarning :: String -> String -> IO ()
-logWarning logoutput temporaryDirectoryPath = appendFile (temporaryDirectoryPath ++ "log/warnings") logoutput
-
-logVerboseMessage :: Bool -> String -> String -> IO ()
-logVerboseMessage verboseTrue logoutput temporaryDirectoryPath
- | verboseTrue = appendFile (temporaryDirectoryPath ++ "Log") (show logoutput)
- | otherwise = return ()
-
-logEither :: (Show a) => Either a b -> String -> IO ()
-logEither (Left logoutput) temporaryDirectoryPath = appendFile (temporaryDirectoryPath ++ "Log") (show logoutput)
-logEither _ _ = return ()
-
-checkTools :: [String] -> String -> String -> IO (Either String String)
-checkTools tools temporaryDirectoryPath selectedQuerySelectionMethod = do
- -- if queryselectionmethod is set to clustering then also check for clustal omega
- let additionaltools = if selectedQuerySelectionMethod == "clustering" then tools ++ ["clustalo"] else tools
- -- check if all tools are available via PATH or Left
- checks <- mapM checkTool additionaltools
- if not (null (lefts checks))
- then return (Left (concat (lefts checks)))
- else do
- logMessage ("Tools : " ++ intercalate "," tools ++ "\n") temporaryDirectoryPath
- return (Right "Tools ok")
-
-logToolVersions :: String -> String -> IO ()
-logToolVersions inputQuerySelectionMethod temporaryDirectoryPath = do
- let clustaloversionpath = temporaryDirectoryPath ++ "log/clustalo.version"
- let mlocarnaversionpath = temporaryDirectoryPath ++ "log/mlocarna.version"
- let rnafoldversionpath = temporaryDirectoryPath ++ "log/RNAfold.version"
- let infernalversionpath = temporaryDirectoryPath ++ "log/Infernal.version"
- --_ <- system ("clustalo --version >" ++ clustaloversionpath)
- _ <- system ("mlocarna --version >" ++ mlocarnaversionpath)
- _ <- system ("RNAfold --version >" ++ rnafoldversionpath)
- _ <- system ("cmcalibrate -h >" ++ infernalversionpath)
- -- _ <- system ("RNAz" ++ rnazversionpath)
- -- _ <- system ("CMCompare >" ++ infernalversionpath)
- mlocarnaversion <- readFile mlocarnaversionpath
- rnafoldversion <- readFile rnafoldversionpath
- infernalversionOutput <- readFile infernalversionpath
- let infernalversion = lines infernalversionOutput !! 1
- if inputQuerySelectionMethod == "clustering"
- then do
- _ <- system ("clustalo --version >" ++ clustaloversionpath)
- clustaloversion <- readFile clustaloversionpath
- let messageString = "Clustalo version: " ++ clustaloversion ++ "mlocarna version: " ++ mlocarnaversion ++ "RNAfold version: " ++ rnafoldversion ++ "infernalversion: " ++ infernalversion ++ "\n"
- logMessage messageString temporaryDirectoryPath
- else do
- let messageString = "mlocarna version: " ++ mlocarnaversion ++ "RNAfold version: " ++ rnafoldversion ++ "infernalversion: " ++ infernalversion ++ "\n"
- logMessage messageString temporaryDirectoryPath
-
-
-checkTool :: String -> IO (Either String String)
-checkTool tool = do
- toolcheck <- findExecutable tool
- if isJust toolcheck
- then return (Right (fromJust toolcheck))
- else return (Left ("RNAlien could not find "++ tool ++ " in your $PATH and has to abort.\n"))
-
-constructTaxonomyRecordsCSVTable :: ModelConstruction -> String
-constructTaxonomyRecordsCSVTable modelconstruction = csvtable
- where tableheader = "Taxonomy Id;Added in Iteration Step;Entry Header\n"
- tablebody = concatMap constructTaxonomyRecordCSVEntries (taxRecords modelconstruction)
- csvtable = tableheader ++ tablebody
-
-constructTaxonomyRecordCSVEntries :: TaxonomyRecord -> String
-constructTaxonomyRecordCSVEntries taxRecord = concatMap (constructTaxonomyRecordCSVEntry taxIdString) (sequenceRecords taxRecord)
- where taxIdString = show (recordTaxonomyId taxRecord)
-
-constructTaxonomyRecordCSVEntry :: String -> SequenceRecord -> String
-constructTaxonomyRecordCSVEntry taxIdString seqrec = taxIdString ++ ";" ++ show (aligned seqrec) ++ ";" ++ filter checkTaxonomyRecordCSVChar (L.unpack (unSL (seqheader (nucleotideSequence seqrec)))) ++ "\n"
-
-checkTaxonomyRecordCSVChar :: Char -> Bool
-checkTaxonomyRecordCSVChar c
- | c == '"' = False
- | c == ';' = False
- | otherwise = True
-
-setVerbose :: Verbosity -> Bool
-setVerbose verbosityLevel
- | verbosityLevel == Loud = True
- | otherwise = False
-
-evaluateConstructionResult :: StaticOptions -> ModelConstruction -> IO String
-evaluateConstructionResult staticOptions mCResult = do
- let evaluationDirectoryFilepath = tempDirPath staticOptions ++ "evaluation/"
- createDirectoryIfMissing False evaluationDirectoryFilepath
- let reformatedClustalPath = evaluationDirectoryFilepath ++ "result.clustal.reformated"
- let cmFilepath = tempDirPath staticOptions ++ "result.cm"
- let resultSequences = inputFasta mCResult:map nucleotideSequence (concatMap sequenceRecords (taxRecords mCResult))
- let resultNumber = length resultSequences
- let rnaCentralQueries = map RCH.buildSequenceViaMD5Query resultSequences
- rnaCentralEntries <- RCH.getRNACentralEntries rnaCentralQueries
- let rnaCentralEvaluationResult = RCH.showRNAcentralAlienEvaluation rnaCentralEntries
- writeFile (tempDirPath staticOptions ++ "result.rnacentral") rnaCentralEvaluationResult
- let resultModelStatistics = tempDirPath staticOptions ++ "result.cmstat"
- systemCMstat cmFilepath resultModelStatistics
- inputcmStat <- readCMstat resultModelStatistics
- let cmstatString = cmstatEvalOutput inputcmStat
- if resultNumber > 1
- then do
- let resultRNAz = tempDirPath staticOptions ++ "result.rnaz"
- let resultRNAcode = tempDirPath staticOptions ++ "result.rnacode"
- let resultClustalFilepath = tempDirPath staticOptions ++ "result.clustal"
- let seqNumber = 6 :: Int
- let optimalIdentity = 80 :: Double
- let maximalIdentity = 99 :: Double
- let referenceSequence = True
- preprocessingOutput <- preprocessClustalForRNAz resultClustalFilepath reformatedClustalPath seqNumber optimalIdentity maximalIdentity referenceSequence
- if isRight preprocessingOutput
- then do
- let rightPreprocessingOutput = fromRight preprocessingOutput
- let rnazClustalpath = snd rightPreprocessingOutput
- systemRNAz "-l" rnazClustalpath resultRNAz
- inputRNAz <- readRNAz resultRNAz
- let rnaZString = rnaZEvalOutput inputRNAz
- RC.systemRNAcode " -t " rnazClustalpath resultRNAcode
- inputRNAcode <- RC.readRNAcodeTabular resultRNAcode
- let rnaCodeString = rnaCodeEvalOutput inputRNAcode
- return ("\nEvaluation of RNAlien result :\nCMstat statistics for result.cm\n" ++ cmstatString ++ "\nRNAz statistics for result alignment: " ++ rnaZString ++ "\nRNAcode output for result alignment:\n" ++ rnaCodeString ++ "\nSequences found by RNAlien with RNAcentral entry:\n" ++ rnaCentralEvaluationResult)
- else do
- logWarning ("Running RNAz for result evalution encountered a problem:" ++ fromLeft preprocessingOutput) (tempDirPath staticOptions)
- return ("\nEvaluation of RNAlien result :\nCMstat statistics for result.cm\n" ++ cmstatString ++ "\nRNAz statistics for result alignment: Running RNAz for result evalution encountered a problem\n" ++ fromLeft preprocessingOutput ++ "\n" ++ "Sequences found by RNAlien with RNAcentral entry:\n" ++ rnaCentralEvaluationResult)
- else do
- logWarning "Message: RNAlien could not find additional covariant sequences\n Could not run RNAz statistics. Could not run RNAz statistics with a single sequence.\n" (tempDirPath staticOptions)
- return ("\nEvaluation of RNAlien result :\nCMstat statistics for result.cm\n" ++ cmstatString ++ "\nRNAlien could not find additional covariant sequences. Could not run RNAz statistics with a single sequence.\n\nSequences found by RNAlien with RNAcentral entry:\n" ++ rnaCentralEvaluationResult)
-
-
-cmstatEvalOutput :: Either ParseError CMstat -> String
-cmstatEvalOutput inputcmstat
- | isRight inputcmstat = cmstatString
- | otherwise = show (fromLeft inputcmstat)
- where cmStat = fromRight inputcmstat
- cmstatString = " Sequence Number: " ++ show (statSequenceNumber cmStat)++ "\n" ++ " Effective Sequences: " ++ show (statEffectiveSequences cmStat)++ "\n" ++ " Consensus length: " ++ show (statConsensusLength cmStat) ++ "\n" ++ " Expected maximum hit-length: " ++ show (statW cmStat) ++ "\n" ++ " Basepairs: " ++ show (statBasepairs cmStat)++ "\n" ++ " Bifurcations: " ++ show (statBifurcations cmStat) ++ "\n" ++ " Modeltype: " ++ show (statModel cmStat) ++ "\n" ++ " Relative Entropy CM: " ++ show (relativeEntropyCM cmStat) ++ "\n" ++ " Relative Entropy HMM: " ++ show (relativeEntropyHMM cmStat) ++ "\n"
-
-rnaZEvalOutput :: Either ParseError RNAz -> String
-rnaZEvalOutput inputRNAz
- | isRight inputRNAz = rnazString
- | otherwise = show (fromLeft inputRNAz)
- where rnaZ = fromRight inputRNAz
- rnazString = " Mean pairwise identity: " ++ show (meanPairwiseIdentity rnaZ) ++ "\n Shannon entropy: " ++ show (shannonEntropy rnaZ) ++ "\n GC content: " ++ show (gcContent rnaZ) ++ "\n Mean single sequence minimum free energy: " ++ show (meanSingleSequenceMinimumFreeEnergy rnaZ) ++ "\n Consensus minimum free energy: " ++ show (consensusMinimumFreeEnergy rnaZ) ++ "\n Energy contribution: " ++ show (energyContribution rnaZ) ++ "\n Covariance contribution: " ++ show (covarianceContribution rnaZ) ++ "\n Combinations pair: " ++ show (combinationsPair rnaZ) ++ "\n Mean z-score: " ++ show (meanZScore rnaZ) ++ "\n Structure conservation index: " ++ show (structureConservationIndex rnaZ) ++ "\n Background model: " ++ backgroundModel rnaZ ++ "\n Decision model: " ++ decisionModel rnaZ ++ "\n SVM decision value: " ++ show (svmDecisionValue rnaZ) ++ "\n SVM class propability: " ++ show (svmRNAClassProbability rnaZ) ++ "\n Prediction: " ++ prediction rnaZ
-
-rnaCodeEvalOutput :: Either ParseError RC.RNAcode -> String
-rnaCodeEvalOutput inputRNAcode
- | isRight inputRNAcode = rnaCodeString
- | otherwise = show (fromLeft inputRNAcode)
- where rnaCode = fromRight inputRNAcode
- rnaCodeString = "HSS\tFrame\tLength\tFrom\tTo\tName\tStart\tEnd\tScore\tP\n" ++ rnaCodeEntries
- rnaCodeEntries = concatMap showRNACodeHits (RC.rnacodeHits rnaCode)
-
-showRNACodeHits :: RC.RNAcodeHit -> String
-showRNACodeHits rnacodeHit = show (RC.hss rnacodeHit) ++ "\t" ++ show (RC.frame rnacodeHit) ++ "\t" ++ show (RC.hitLength rnacodeHit) ++ "\t"++ show (RC.from rnacodeHit) ++ "\t" ++ show (RC.to rnacodeHit) ++ "\t" ++ RC.name rnacodeHit ++ "\t" ++ show (RC.start rnacodeHit) ++ "\t" ++ show (RC.end rnacodeHit) ++ "\t" ++ show (RC.score rnacodeHit) ++ show (RC.pvalue rnacodeHit) ++ "\n"
-
--- | Call for external preprocessClustalForRNAz
-preprocessClustalForRNAzExternal :: String -> String -> Int -> Int -> Int -> Bool -> IO (Either String (String,String))
-preprocessClustalForRNAzExternal clustalFilepath reformatedClustalPath seqenceNumber optimalIdentity maximalIdenity referenceSequence = do
- clustalText <- TI.readFile clustalFilepath
- --change clustal format for rnazSelectSeqs.pl
- let reformatedClustalText = T.map reformatAln clustalText
- TI.writeFile reformatedClustalPath reformatedClustalText
- --select representative entries from result.Clustal with select_sequences
- let selectedClustalpath = clustalFilepath ++ ".selected"
- let sequenceNumberOption = " -n " ++ show seqenceNumber ++ " "
- let optimalIdentityOption = " -i " ++ show optimalIdentity ++ " "
- let maximalIdentityOption = " --max-id=" ++ show maximalIdenity ++ " "
- let referenceSequenceOption = if referenceSequence then " " else " -x "
- let syscall = "rnazSelectSeqs.pl " ++ reformatedClustalPath ++ " " ++ sequenceNumberOption ++ optimalIdentityOption ++ maximalIdentityOption ++ referenceSequenceOption ++ " >" ++ selectedClustalpath
- --putStrLn syscall
- system syscall
- selectedClustalText <- readFile selectedClustalpath
- return (Right ([],selectedClustalText))
-
--- | Call for external preprocessClustalForRNAcode - RNAcode additionally to RNAz requirements does not accept pipe,underscore, doublepoint symbols
-preprocessClustalForRNAcodeExternal :: String -> String -> Int -> Int -> Int -> Bool -> IO (Either String (String,String))
-preprocessClustalForRNAcodeExternal clustalFilepath reformatedClustalPath seqenceNumber optimalIdentity maximalIdenity referenceSequence = do
- clustalText <- TI.readFile clustalFilepath
- --change clustal format for rnazSelectSeqs.pl
- let clustalTextLines = T.lines clustalText
- let headerClustalTextLines = T.unlines (take 2 clustalTextLines)
- let headerlessClustalTextLines = T.unlines (drop 2 clustalTextLines)
- let reformatedClustalText = T.map reformatRNACodeAln headerlessClustalTextLines
- TI.writeFile reformatedClustalPath (headerClustalTextLines `T.append` T.singleton '\n' `T.append` reformatedClustalText)
- --select representative entries from result.Clustal with select_sequences
- let selectedClustalpath = clustalFilepath ++ ".selected"
- let sequenceNumberOption = " -n " ++ show seqenceNumber ++ " "
- let optimalIdentityOption = " -i " ++ show optimalIdentity ++ " "
- let maximalIdentityOption = " --max-id=" ++ show maximalIdenity ++ " "
- let referenceSequenceOption = if referenceSequence then " " else " -x "
- let syscall = "rnazSelectSeqs.pl " ++ reformatedClustalPath ++ " " ++ sequenceNumberOption ++ optimalIdentityOption ++ maximalIdentityOption ++ referenceSequenceOption ++ " >" ++ selectedClustalpath
- --putStrLn syscall
- system syscall
- selectedClustalText <- readFile selectedClustalpath
- return (Right ([],selectedClustalText))
-
-preprocessClustalForRNAz :: String -> String -> Int -> Double -> Double -> Bool -> IO (Either String (String,String))
-preprocessClustalForRNAz clustalFilepath _ seqenceNumber optimalIdentity maximalIdenity referenceSequence = do
- clustalText <- TI.readFile clustalFilepath
- let clustalTextLines = T.lines clustalText
- parsedClustalInput <- readClustalAlignment clustalFilepath
- let selectedClustalpath = clustalFilepath ++ ".selected"
- if length clustalTextLines > 5
- then
- if isRight parsedClustalInput
- then do
- let (idMatrix,filteredClustalInput) = rnaCodeSelectSeqs2 (fromRight parsedClustalInput) seqenceNumber optimalIdentity maximalIdenity referenceSequence
- writeFile selectedClustalpath (show filteredClustalInput)
- let formatedIdMatrix = show (fmap formatIdMatrix idMatrix)
- return (Right (formatedIdMatrix,selectedClustalpath))
- else return (Left (show (fromLeft parsedClustalInput)))
- else do
- let clustalLines = T.lines clustalText
- let headerClustalTextLines = T.unlines (take 2 clustalLines)
- let headerlessClustalTextLines = T.unlines (drop 2 clustalLines)
- let reformatedClustalText = T.map reformatRNACodeAln headerlessClustalTextLines
- TI.writeFile selectedClustalpath (headerClustalTextLines `T.append` T.singleton '\n' `T.append` reformatedClustalText)
- return (Right ([],clustalFilepath))
-
-formatIdMatrix :: Maybe (Int,Int,Double) -> String
-formatIdMatrix (Just (_,_,c)) = printf "%.2f" c
-formatIdMatrix _ = "-"
-
-
--- | Sequence preselection for RNAz and RNAcode
-rnaCodeSelectSeqs2 :: ClustalAlignment -> Int -> Double -> Double -> Bool -> (Matrix (Maybe (Int,Int,Double)),ClustalAlignment)
-rnaCodeSelectSeqs2 currentClustalAlignment targetSeqNumber optimalIdentity maximalIdentity referenceSequence = (identityMatrix,newClustalAlignment)
- where entryVector = V.fromList (alignmentEntries currentClustalAlignment)
- entrySequences = V.map entryAlignedSequence entryVector
- entryReformatedSequences = V.map (T.map reformatRNACodeAln) entrySequences
- totalSeqNumber = V.length entryVector
- identityMatrix = computeSequenceIdentityMatrix entryReformatedSequences
- entryIdentityVector = V.map fromJust (V.filter isJust (getMatrixAsVector identityMatrix))
- entryIdentities = V.toList entryIdentityVector
- --Similarity filter - filter too similar sequences until alive seqs are less then minSeqs
- entriesToDiscard = preFilterIdentityMatrix maximalIdentity targetSeqNumber totalSeqNumber [] entryIdentities
- allEntries = [1..totalSeqNumber]
- prefilteredEntries = allEntries \\ entriesToDiscard
- --Optimize mean pairwise similarity (greedily) - remove worst sequence until desired number is reached
- costList = map (computeEntryCost optimalIdentity entryIdentityVector) prefilteredEntries
- sortedCostList = sortBy compareEntryCost2 costList
- sortedIndices = map fst sortedCostList
- --selectedEntryIndices = [1] ++ map fst (take (targetSeqNumber -1) sortedCostList)
- selectedEntryIndices = selectEntryIndices referenceSequence targetSeqNumber sortedIndices
- selectedEntries = map (\ind -> entryVector V.! (ind-1)) selectedEntryIndices
- selectedEntryHeader = map entrySequenceIdentifier selectedEntries
- reformatedSelectedEntryHeader = map (T.map reformatRNACodeId) selectedEntryHeader
- selectedEntrySequences = map (\ind -> entryReformatedSequences V.! (ind-1)) selectedEntryIndices
- --gapfreeEntrySequences = T.transpose (T.filter (\a -> not (T.all isGap a)) (T.transpose selectedEntrySequences))
- gapfreeEntrySequences = T.transpose (filter (not . T.all isGap) (T.transpose selectedEntrySequences))
- gapfreeEntries = map (uncurry ClustalAlignmentEntry)(zip reformatedSelectedEntryHeader gapfreeEntrySequences)
- emptyConservationTrack = setEmptyConservationTrack gapfreeEntries (conservationTrack currentClustalAlignment)
- newClustalAlignment = currentClustalAlignment {alignmentEntries = gapfreeEntries, conservationTrack = emptyConservationTrack}
-
-selectEntryIndices :: Bool -> Int -> [Int] -> [Int]
-selectEntryIndices referenceSequence targetSeqNumber sortedIndices
- | referenceSequence = if (1 :: Int) `elem` firstX then firstX else 1:firstXm1
- | otherwise = firstX
- where firstXm1 = take (targetSeqNumber - 1) sortedIndices
- firstX = take targetSeqNumber sortedIndices
-
-setEmptyConservationTrack :: [ClustalAlignmentEntry] -> T.Text -> T.Text
-setEmptyConservationTrack alnentries currentConservationTrack
- | null alnentries = currentConservationTrack
- | otherwise = newConservationTrack
- where trackLength = T.length (entryAlignedSequence (head alnentries))
- newConservationTrack = T.replicate (trackLength + 0) (T.pack " ")
-
-isGap :: Char -> Bool
-isGap a
- | a == '-' = True
- | otherwise = False
-
-computeEntryCost :: Double -> V.Vector (Int,Int,Double) -> Int -> (Int,Double)
-computeEntryCost optimalIdentity allIdentities currentIndex = (currentIndex,entryCost)
- where entryCost = V.sum (V.map (computeCost optimalIdentity) entryIdentities)
- entryIdentities = getEntryIdentities currentIndex allIdentities
-
-getEntryIdentities :: Int -> V.Vector (Int,Int,Double) -> V.Vector (Int,Int,Double)
-getEntryIdentities currentIndex allIdentities = V.filter (isIIdx currentIndex) allIdentities V.++ V.filter (isJIdx currentIndex) allIdentities
-
-isIIdx :: Int -> (Int,Int,Double) -> Bool
-isIIdx currentIdx (i,_,_) = currentIdx == i
-isJIdx :: Int -> (Int,Int,Double) -> Bool
-isJIdx currentIdx (_,j,_) = currentIdx == j
-
-computeCost :: Double -> (Int,Int,Double) -> Double
-computeCost optimalIdentity (_,_,c) = (c - optimalIdentity) * (c - optimalIdentity)
-
-compareEntryCost2 :: (Int, Double) -> (Int, Double) -> Ordering
-compareEntryCost2 (_,costA) (_,costB) = compare costA costB
-
--- TODO change to vector
-preFilterIdentityMatrix :: Double -> Int -> Int-> [Int] -> [(Int,Int,Double)] -> [Int]
-preFilterIdentityMatrix identityCutoff minSeqNumber totalSeqNumber filteredIds entryIdentities
- | (totalSeqNumber - length filteredIds) <= minSeqNumber = []
- | identityCutoff == (100 :: Double) = []
- | Prelude.null entryIdentities = []
- | otherwise = entryresult ++ preFilterIdentityMatrix identityCutoff minSeqNumber totalSeqNumber (filteredIds ++ entryresult) (tail entryIdentities)
- where currentEntry = head entryIdentities
- entryresult = checkIdentityEntry identityCutoff filteredIds currentEntry
-
-checkIdentityEntry :: Double -> [Int] -> (Int,Int,Double) -> [Int]
-checkIdentityEntry identityCutoff filteredIds (i,j,ident)
- | i `elem` filteredIds = []
- | j `elem` filteredIds = []
- | ident > identityCutoff = [j]
- | otherwise = []
-
-computeSequenceIdentityMatrix :: V.Vector T.Text -> Matrix (Maybe (Int,Int,Double))
-computeSequenceIdentityMatrix entryVector = matrix (V.length entryVector) (V.length entryVector) (computeSequenceIdentityEntry entryVector)
-
--- Computes Sequence identity once for each pair and not vs itself
-computeSequenceIdentityEntry :: V.Vector T.Text -> (Int,Int) -> Maybe (Int,Int,Double)
-computeSequenceIdentityEntry entryVector (row,col)
- | i < j = Just (row,col,ident)
- | otherwise = Nothing
- where i=row-1
- j=col-1
- --gaps in both sequences need to be removed, because they count as match
- ientry = entryVector V.! i
- jentry = entryVector V.! j
- (gfi,gfj) = unzip (filter notDoubleGap (T.zip ientry jentry))
- gfitext = T.pack gfi
- gfjtext = T.pack gfj
- --ident=stringIdentity gfi gfj
- ident=textIdentity gfitext gfjtext
-
-notDoubleGap :: (Char,Char) -> Bool
-notDoubleGap (a,b)
- | a == '-' && b == '-' = False
- | otherwise = True
-
-reformatRNACodeId :: Char -> Char
-reformatRNACodeId c
- | c == ':' = '-'
- | c == '|' = '-'
- | c == '.' = '-'
- | c == '~' = '-'
- | c == '_' = '-'
- | c == '/' = '-'
- | otherwise = c
-
-reformatRNACodeAln :: Char -> Char
-reformatRNACodeAln c
- | c == ':' = '-'
- | c == '|' = '-'
- | c == '.' = '-'
- | c == '~' = '-'
- | c == '_' = '-'
- | c == 'u' = 'U'
- | c == 't' = 'T'
- | c == 'g' = 'G'
- | c == 'c' = 'C'
- | c == 'a' = 'A'
- | otherwise = c
-
-reformatAln :: Char -> Char
-reformatAln c
- | c == '.' = '-'
- | c == '~' = '-'
- | c == '_' = '-'
- | c == 'u' = 'U'
- | c == 't' = 'T'
- | c == 'g' = 'G'
- | c == 'c' = 'C'
- | c == 'a' = 'A'
- | otherwise = c
-
--- | Check if alien can connect to NCBI
-checkNCBIConnection :: IO (Either String String)
-checkNCBIConnection = do
- req <- N.parseRequest "https://www.ncbi.nlm.nih.gov"
- manager <- N.newManager N.tlsManagerSettings
- response <- N.httpLbs req manager
- let sta = N.responseStatus response
- if statusIsSuccessful sta
- then return (Right "Network connection with NCBI server was successful")
- else return (Left ("Could not connect to NCBI server \"https://www.ncbi.nlm.nih.gov\". Response Code: " ++ show (statusCode sta) ++ " \n" ++ B.unpack (statusMessage sta)))
-
--- | Blast evalue is set stricter in inital alignment mode
-setBlastExpectThreshold :: ModelConstruction -> Double
-setBlastExpectThreshold modelConstruction
- | alignmentModeInfernal modelConstruction = 1 :: Double
- | otherwise = 0.1 :: Double
-
-reformatFasta :: Sequence -> Sequence
-reformatFasta input = Seq (seqheader input) updatedSequence Nothing
- where updatedSequence = SeqData (L.pack (map reformatFastaSequence (L.unpack (unSD (seqdata input)))))
-
-reformatFastaSequence :: Char -> Char
-reformatFastaSequence c
- | c == '.' = '-'
- | c == '~' = '-'
- | c == '_' = '-'
- | c == 'u' = 'T'
- | c == 't' = 'T'
- | c == 'g' = 'G'
- | c == 'c' = 'C'
- | c == 'a' = 'A'
- | c == 'U' = 'T'
- | otherwise = c
-
-setRestrictedTaxonomyLimits :: String -> (Maybe Int,Maybe Int)
-setRestrictedTaxonomyLimits trestriction
- | trestriction == "bacteria" = (Just (2 :: Int), Nothing)
- | trestriction == "archea" = (Just (2157 :: Int), Nothing)
- | trestriction == "eukaryia" = (Just (2759 :: Int), Nothing)
- | otherwise = (Nothing, Nothing)
-
-checkTaxonomyRestriction :: Maybe String -> Maybe String
-checkTaxonomyRestriction taxonomyRestriction
- | isJust taxonomyRestriction = checkTaxonomyRestrictionString (fromJust taxonomyRestriction)
- | otherwise = Nothing
-
-checkTaxonomyRestrictionString :: String -> Maybe String
-checkTaxonomyRestrictionString restrictionString
- | restrictionString == "archea" = Just "archea"
- | restrictionString == "bacteria" = Just "bacteria"
- | restrictionString == "eukaryia" = Just "eukaryia"
- | otherwise = Nothing
-
-extractAlignmentSequencesByIds :: String -> [L.ByteString] -> IO [Sequence]
-extractAlignmentSequencesByIds stockholmFilePath sequenceIds = do
- inputSeedAln <- TIO.readFile stockholmFilePath
- let alnEntries = extractAlignmentSequences inputSeedAln
- --let splitIds = map E.encodeUtf8 (TL.splitOn (TL.pack ",") (TL.pack sequenceIds))
- let filteredEntries = concatMap (filterSequencesById alnEntries) sequenceIds
- return filteredEntries
-
-extractAlignmentSequences :: TL.Text -> [Sequence]
-extractAlignmentSequences seedFamilyAln = rfamIDAndseedFamilySequences
- where seedFamilyAlnLines = TL.lines seedFamilyAln
- -- remove empty lines from splitting
- seedFamilyNonEmpty = filter (\alnline -> TL.empty /= alnline) seedFamilyAlnLines
- -- remove annotation and spacer lines
- seedFamilyIdSeqLines = filter (\alnline -> not ((TL.head alnline) == '#') && not ((TL.head alnline) == ' ') && not ((TL.head alnline) == '/')) seedFamilyNonEmpty
- -- put id and corresponding seq of each line into a list and remove whitspaces
- seedFamilyIdandSeqLines = map TL.words seedFamilyIdSeqLines
- -- linewise tuples with id and seq without alinment characters - .
- seedFamilyIdandSeqLineTuples = map (\alnline -> (head alnline,filterAlnChars (last alnline))) seedFamilyIdandSeqLines
- -- line tuples sorted by id
- seedFamilyIdandSeqTupleSorted = sortBy (\tuple1 tuple2 -> compare (fst tuple1) (fst tuple2)) seedFamilyIdandSeqLineTuples
- -- line tuples grouped by id
- seedFamilyIdandSeqTupleGroups = groupBy (\tuple1 tuple2 -> fst tuple1 == fst tuple2) seedFamilyIdandSeqTupleSorted
- seedFamilySequences = map mergeIdSeqTuplestoSequence seedFamilyIdandSeqTupleGroups
- rfamIDAndseedFamilySequences = seedFamilySequences
-
-filterSequencesById :: [Sequence] -> L.ByteString -> [Sequence]
-filterSequencesById alignmentSequences sequenceId = filter (sequenceHasId sequenceId) alignmentSequences
-
-sequenceHasId :: L.ByteString -> Sequence -> Bool
-sequenceHasId sequenceId currentSequence = sequenceId == unSL (seqid currentSequence)
-
-filterAlnChars :: TL.Text -> TL.Text
-filterAlnChars cs = TL.filter (\c -> not (c == '-') && not (c == '.')) cs
-
-mergeIdSeqTuplestoSequence :: [(TL.Text,TL.Text)] -> Sequence
-mergeIdSeqTuplestoSequence tuplelist = currentSequence
- where seqId = fst (head tuplelist)
- seqData = TL.concat (map snd tuplelist)
- currentSequence = Seq (SeqLabel (E.encodeUtf8 seqId)) (SeqData (E.encodeUtf8 seqData)) Nothing
-
diff --git a/src/Bio/RNAlienStatistics.hs b/src/Bio/RNAlienStatistics.hs
deleted file mode 100644
--- a/src/Bio/RNAlienStatistics.hs
+++ /dev/null
@@ -1,331 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | Statistics for RNAlien Results
--- dist/build/RNAlienStatistics/RNAlienStatistics -s bitscore -i /scratch/egg/temp/cm13676/1/model.cm -r /home/mescalin/egg/current/Data/AlienTest/cms/BsrG.cm -g /scratch/egg/temp/AlienSearch/genomes/ -o /scratch/egg/temp/AlienStatistics
-module Main where
-
-import System.Console.CmdArgs
-import Data.Either.Unwrap
-import System.Process
-import qualified Data.ByteString.Lazy.Char8 as L
-import Bio.RNAlienLibrary
-import System.Directory
-import Bio.Core.Sequence
-import Bio.Sequence.Fasta
-import Data.List
-import qualified System.FilePath as FP
-import qualified Data.List.Split as DS
-import Text.Printf
-import Bio.RNAzParser
-import qualified Bio.RNAcodeParser as RC
-
-data Options = Options
- { alienCovarianceModelPath :: String,
- alienrnazPath :: String,
- alienrnacodePath :: String,
- aliencmstatPath :: String,
- rfamCovarianceModelPath :: String,
- rfamFastaFilePath :: String,
- alienFastaFilePath :: String,
- rfamModelName :: String,
- rfamModelId :: String,
- rfamThreshold :: Double,
- alienThreshold :: Double,
- databaseSize :: Maybe Double,
- outputDirectoryPath :: String,
- benchmarkIndex :: Int,
- thresholdSelection :: String,
- linkScores :: Bool,
- threads :: Int
- } deriving (Show,Data,Typeable)
-
-options :: Options
-options = Options
- { alienCovarianceModelPath = def &= name "i" &= help "Path to alienCovarianceModelPath",
- alienrnazPath = def &= name "z" &= help "Path to alienRNAzResult",
- alienrnacodePath = def &= name "w" &= help "Path to alienRNAcodeResult",
- aliencmstatPath = def &= name "m" &= help "Path to aliencmstatResult",
- rfamCovarianceModelPath = def &= name "r" &= help "Path to rfamCovarianceModelPath",
- rfamFastaFilePath = def &= name "g" &= help "Path to rfamFastaFile",
- rfamModelName = def &= name "n" &= help "Rfam model name",
- rfamModelId = def &= name "d" &= help "Rfam model id",
- alienFastaFilePath = def &= name "a" &= help "Path to alienFastaFile",
- outputDirectoryPath = def &= name "o" &= help "Path to output directory",
- alienThreshold = 20 &= name "t" &= help "Bitscore threshold for RNAlien model hits on Rfam fasta, default 20",
- rfamThreshold = 20 &= name "x" &= help "Bitscore threshold for Rfam model hits on Alien fasta, default 20",
- databaseSize = Nothing &= name "k" &= help "Cmsearch database size in mega bases. default not set",
- benchmarkIndex = 1 &= name "b" &= help "Index used to identify sRNA tagged RNA families",
- thresholdSelection = "bitscore" &= name "s" &= help "Selection method, (bitscore, evalue), default bitscore",
- linkScores = False &= name "l" &= help "Triggers computation of linkscores via CMCompare",
- threads = 1 &= name "c" &= help "Number of available cpu slots/cores, default 1"
- } &= summary "RNAlienStatistics" &= help "Florian Eggenhofer - >2013" &= verbosity
-
---cmSearchFasta threads rfamCovarianceModelPath outputDirectoryPath "Rfam" False genomesDirectoryPath
-cmSearchFasta :: Int -> String -> Double -> Maybe Double -> Int -> String -> String -> String -> String -> IO [CMsearchHit]
-cmSearchFasta benchmarkIndex thresholdSelection thresholdScore databaseSize cpuThreads covarianceModelPath outputDirectory modelType fastapath = do
- createDirectoryIfMissing False (outputDirectory ++ "/" ++ modelType)
- _ <- systemCMsearch cpuThreads (maybe "" (\dbs -> " -Z " ++ show dbs ++ " ") databaseSize) covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
- --_ <- systemCMsearch cpuThreads " " covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ (show benchmarkIndex) ++ ".cmsearch")
- result <- readCMSearch (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
- if isLeft result
- then do
- print (fromLeft result)
- return []
- else do
- let rightResults = fromRight result
- let significantHits = filterCMsearchHits thresholdSelection thresholdScore rightResults
- let uniquesignificantHits = nubBy cmSearchSameHit significantHits
- return uniquesignificantHits
-
---cmSearchFasta threads rfamCovarianceModelPath outputDirectoryPath "Rfam" False genomesDirectoryPath
-cmSearchesFasta :: Int -> String -> Double -> Maybe Double -> Int -> String -> String -> String -> String -> IO [CMsearchHit]
-cmSearchesFasta benchmarkIndex thresholdSelection thresholdScore databaseSize cpuThreads covarianceModelPath outputDirectory modelType fastapath = do
- createDirectoryIfMissing False (outputDirectory ++ "/" ++ modelType)
- _ <- systemCMsearch cpuThreads (maybe "" (\dbs -> " -Z " ++ show dbs ++ " ") databaseSize) covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
- --_ <- systemCMsearch cpuThreads " " covarianceModelPath fastapath (outputDirectory ++ "/" ++ modelType ++ "/" ++ (show benchmarkIndex) ++ ".cmsearch")
- result <- readCMSearches (outputDirectory ++ "/" ++ modelType ++ "/" ++ show benchmarkIndex ++ ".cmsearch")
- if isLeft result
- then do
- print (fromLeft result)
- return []
- else do
- let rightResults = fromRight result
- let significantHits = filterCMsearchHits thresholdSelection thresholdScore rightResults
- --putStrLn ("significant Hits " ++ show (length significantHits))
- let uniquesignificantHits = nubBy cmSearchSameHit significantHits
- --putStrLn ("unique significant Hits " ++ show (length uniquesignificantHits))
- --let organismUniquesignificantHits = nubBy cmSearchSameOrganism significantHits
- return uniquesignificantHits
-
-filterCMsearchHits :: String -> Double -> CMsearch -> [CMsearchHit]
-filterCMsearchHits thresholdSelection thresholdScore cmSearchResult
- | thresholdSelection == "bitscore" = bitscorefiltered
- | otherwise = evaluefiltered
- where bitscorefiltered = filter (\hit -> hitScore hit >= thresholdScore) (cmsearchHits cmSearchResult)
- evaluefiltered = filter (\hit -> hitEvalue hit <= thresholdScore) (cmsearchHits cmSearchResult)
-
-partitionCMsearchHits :: String -> Double -> CMsearch -> ([CMsearchHit],[CMsearchHit])
-partitionCMsearchHits thresholdSelection thresholdScore cmSearchResult
- | thresholdSelection == "bitscore" = (bitscoreselected,bitscorerejected)
- | otherwise = (evalueselected,evaluerejected)
- where (bitscoreselected,bitscorerejected) = partition (\hit -> hitScore hit >= thresholdScore) (cmsearchHits cmSearchResult)
- (evalueselected,evaluerejected) = partition (\hit -> hitEvalue hit <= thresholdScore) (cmsearchHits cmSearchResult)
-
-trimCMsearchFastaFile :: String -> String -> String -> CMsearch -> String -> IO ()
-trimCMsearchFastaFile genomesDirectory outputFolder modelType cmsearch fastafile = do
- let fastaInputPath = genomesDirectory ++ "/" ++ fastafile
- let fastaOutputPath = outputFolder ++ "/" ++ modelType ++ "/" ++ fastafile
- fastaSequences <- readFasta fastaInputPath
- let trimmedSequence = trimCMsearchSequence cmsearch (head fastaSequences)
- writeFasta fastaOutputPath [trimmedSequence]
-
-trimCMsearchSequence :: CMsearch -> Sequence -> Sequence
-trimCMsearchSequence cmSearchResult inputSequence = subSequence
- where hitScoreEntry = head (cmsearchHits cmSearchResult)
- sequenceString = L.unpack (unSD (seqdata inputSequence))
- sequenceSubstring = cmSearchsubString (hitStart hitScoreEntry) (hitEnd hitScoreEntry) sequenceString
- newSequenceHeader = L.pack (L.unpack (unSL (seqheader inputSequence)) ++ "cmS_" ++ show (hitStart hitScoreEntry) ++ "_" ++ show (hitEnd hitScoreEntry) ++ "_" ++ show (hitStrand hitScoreEntry))
- subSequence = Seq (SeqLabel newSequenceHeader) (SeqData (L.pack sequenceSubstring)) Nothing
-
---With paralogs allowed
-cmSearchSameHit :: CMsearchHit -> CMsearchHit -> Bool
-cmSearchSameHit hitscore1 hitscore2
- | unpackedSeqHeader1 == unpackedSeqHeader2 = True
- | otherwise = False
- where unpackedSeqHeader1 = L.unpack (hitSequenceHeader hitscore1)
- unpackedSeqHeader2 = L.unpack (hitSequenceHeader hitscore2)
-
-cmSearchSameOrganism :: CMsearchHit -> CMsearchHit -> Bool
-cmSearchSameOrganism hitscore1 hitscore2
- | hitOrganism1 == hitOrganism2 = True
- | otherwise = False
- where unpackedSeqHeader1 = L.unpack (hitSequenceHeader hitscore1)
- unpackedSeqHeader2 = L.unpack (hitSequenceHeader hitscore2)
- separationcharacter1 = selectSeparationChar unpackedSeqHeader1
- separationcharacter2 = selectSeparationChar unpackedSeqHeader2
- hitOrganism1 = head (DS.splitOn separationcharacter1 unpackedSeqHeader1)
- hitOrganism2 = head (DS.splitOn separationcharacter2 unpackedSeqHeader2)
-
-selectSeparationChar :: String -> String
-selectSeparationChar inputString
- | any ((== ':')) inputString = ":"
- | otherwise = "/"
-
-main :: IO ()
-main = do
- Options{..} <- cmdArgs options
- rfamModelExists <- doesFileExist rfamCovarianceModelPath
- verbose <- getVerbosity
- rnazString <- rnazOutput verbose alienrnazPath
- rnacodeString <- rnaCodeOutput verbose alienrnacodePath
- cmStatString <- cmStatOutput verbose aliencmstatPath
- if rfamModelExists
- then do
- --compute linkscore
- linkscore <- if linkScores
- then compareCM rfamCovarianceModelPath alienCovarianceModelPath outputDirectoryPath
- else return (Left "-")
- rfamMaxLinkScore <- if linkScores then compareCM rfamCovarianceModelPath rfamCovarianceModelPath outputDirectoryPath else return (Left "-")
- alienMaxLinkscore <- if linkScores then compareCM alienCovarianceModelPath alienCovarianceModelPath outputDirectoryPath else return (Left "-")
- _ <- system ("cat " ++ rfamFastaFilePath ++ " | grep '>' | wc -l >" ++ outputDirectoryPath ++ FP.takeFileName rfamFastaFilePath ++ ".entries")
- _ <- system ("cat " ++ alienFastaFilePath ++ " | grep '>' | wc -l >" ++ outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
- rfamFastaEntries <- readFile (outputDirectoryPath ++ FP.takeFileName rfamFastaFilePath ++ ".entries")
- alienFastaEntries <- readFile (outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
- let rfamFastaEntriesNumber = read rfamFastaEntries :: Int
- let alienFastaEntriesNumber = read alienFastaEntries :: Int
- rfamonAlienResults <- cmSearchesFasta benchmarkIndex thresholdSelection rfamThreshold databaseSize threads rfamCovarianceModelPath outputDirectoryPath "rfamOnAlien" alienFastaFilePath
- alienonRfamResults <- cmSearchFasta benchmarkIndex thresholdSelection alienThreshold databaseSize threads alienCovarianceModelPath outputDirectoryPath "alienOnRfam" rfamFastaFilePath
- let rfamonAlienResultsNumber = length rfamonAlienResults
- let alienonRfamResultsNumber = length alienonRfamResults
- let rfamonAlienRecovery = (fromIntegral rfamonAlienResultsNumber :: Double) / (fromIntegral alienFastaEntriesNumber :: Double)
- let alienonRfamRecovery = (fromIntegral alienonRfamResultsNumber :: Double) / (fromIntegral rfamFastaEntriesNumber :: Double)
- if verbose == Loud
- then do
- putStrLn ("BenchmarkIndex: " ++ show benchmarkIndex)
- putStrLn ("RfamModelName: " ++ rfamModelName)
- putStrLn ("RfamModelId: " ++ rfamModelId)
- putStrLn ("Linkscore: " ++ either id show linkscore)
- putStrLn ("rfamMaxLinkScore: " ++ either id show rfamMaxLinkScore)
- putStrLn ("alienMaxLinkscore: " ++ either id show alienMaxLinkscore)
- putStrLn ("rfamGatheringThreshold: " ++ show rfamThreshold)
- putStrLn ("alienGatheringThreshold: " ++ show alienThreshold)
- putStrLn ("rfamFastaEntriesNumber: " ++ show rfamFastaEntriesNumber)
- putStrLn ("alienFastaEntriesNumber: " ++ show alienFastaEntriesNumber)
- putStrLn ("rfamonAlienResultsNumber: " ++ show rfamonAlienResultsNumber)
- putStrLn ("alienonRfamResultsNumber: " ++ show alienonRfamResultsNumber)
- putStrLn ("RfamonAlienRecovery: " ++ show rfamonAlienRecovery)
- putStrLn ("AlienonRfamRecovery: " ++ show alienonRfamRecovery)
- print rnazString
- print rnacodeString
- print cmStatString
- else
- putStrLn (show benchmarkIndex ++ "\t" ++ rfamModelName ++ "\t" ++ rfamModelId ++ "\t" ++ (either id show linkscore) ++ "\t" ++ (either id show rfamMaxLinkScore) ++ "\t" ++ (either id show alienMaxLinkscore) ++ "\t" ++ show rfamThreshold ++ "\t" ++ show alienThreshold ++ "\t" ++ show rfamFastaEntriesNumber ++ "\t" ++ show alienFastaEntriesNumber ++ "\t" ++ show rfamonAlienResultsNumber ++ "\t" ++ show alienonRfamResultsNumber ++ "\t" ++ printf "%.2f" rfamonAlienRecovery ++ "\t" ++ printf "%.2f" alienonRfamRecovery ++ "\t" ++ rnazString ++ "\t" ++ rnacodeString ++ "\t" ++ cmStatString)
- else do
- --compute linkscore
- alienMaxLinkscore <- if linkScores then compareCM alienCovarianceModelPath alienCovarianceModelPath outputDirectoryPath else return ( Left "-")
- _ <- system ("cat " ++ alienFastaFilePath ++ " | grep '>' | wc -l >" ++ outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
- alienFastaEntries <- readFile (outputDirectoryPath ++ FP.takeFileName alienFastaFilePath ++ ".entries")
- let alienFastaEntriesNumber = read alienFastaEntries :: Int
- if verbose == Loud
- then do
- putStrLn "BenchmarkIndex:"
- putStrLn "RfamModelName: -"
- putStrLn "RfamModelId: -"
- putStrLn "Linkscore: -"
- putStrLn "rfamMaxLinkScore: -"
- putStrLn ("alienMaxLinkscore: " ++ either id show alienMaxLinkscore)
- putStrLn "rfamGatheringThreshold: -"
- putStrLn "alienGatheringThreshold: -"
- putStrLn "rfamFastaEntriesNumber: -"
- putStrLn ("alienFastaEntriesNumber: " ++ show alienFastaEntriesNumber)
- putStrLn "rfamonAlienResultsNumber: -"
- putStrLn "alienonRfamResultsNumber: -"
- putStrLn "RfamonAlienRecovery: -"
- putStrLn "AlienonRfamRecovery: -"
- print rnazString
- print cmStatString
- else
- putStrLn (show benchmarkIndex ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ (either id show alienMaxLinkscore) ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ show alienFastaEntriesNumber ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ rnazString ++ "\t" ++ rnacodeString ++ "\t" ++ cmStatString)
-
-rnazOutput :: Verbosity -> String -> IO String
-rnazOutput verbose rnazPath = do
- rnazPresent <- doesFileExist rnazPath
- if rnazPresent
- then do
- inputRNAz <- readRNAz rnazPath
- if isRight inputRNAz
- then do
- let rnaZ = fromRight inputRNAz
- if verbose == Loud
- then do
- let output = "Mean pairwise identity: " ++ show (meanPairwiseIdentity rnaZ) ++ "\n Shannon entropy: " ++ show (shannonEntropy rnaZ) ++ "\n GC content: " ++ show (gcContent rnaZ) ++ "\n Mean single sequence minimum free energy: " ++ show (meanSingleSequenceMinimumFreeEnergy rnaZ) ++ "\n Consensus minimum free energy: " ++ show (consensusMinimumFreeEnergy rnaZ) ++ "\n Energy contribution: " ++ show (energyContribution rnaZ) ++ "\n Covariance contribution: " ++ show (covarianceContribution rnaZ) ++ "\n Combinations pair: " ++ show (combinationsPair rnaZ) ++ "\n Mean z-score: " ++ show (meanZScore rnaZ) ++ "\n Structure conservation index: " ++ show (structureConservationIndex rnaZ) ++ "\n Background model: " ++ backgroundModel rnaZ ++ "\n Decision model: " ++ decisionModel rnaZ ++ "\n SVM decision value: " ++ show (svmDecisionValue rnaZ) ++ "\n SVM class propability: " ++ show (svmRNAClassProbability rnaZ) ++ "\n Prediction: " ++ prediction rnaZ
- return output
- else do
- let output = show (meanPairwiseIdentity rnaZ) ++ "\t" ++ show (shannonEntropy rnaZ) ++ "\t" ++ show (gcContent rnaZ) ++ "\t" ++ show (meanSingleSequenceMinimumFreeEnergy rnaZ) ++ "\t" ++ show (consensusMinimumFreeEnergy rnaZ) ++ "\t" ++ show (energyContribution rnaZ) ++ "\t" ++ show (covarianceContribution rnaZ) ++ "\t" ++ show (combinationsPair rnaZ) ++ "\t" ++ show (meanZScore rnaZ) ++ "\t" ++ show (structureConservationIndex rnaZ) ++ "\t" ++ show (svmDecisionValue rnaZ) ++ "\t" ++ show (svmRNAClassProbability rnaZ) ++ "\t" ++ prediction rnaZ
- return output
- else
- if (verbose == Loud)
- then do
- let output = "Mean pairwise identity: " ++ " - \n Shannon entropy: " ++ " - \n GC content: " ++ " - \n Mean single sequence minimum free energy: " ++ " - \n Consensus minimum free energy: " ++ " - \n Energy contribution: " ++ " - \n Covariance contribution: " ++ " - \n Combinations pair: " ++ " - \n Mean z-score: " ++ " - \n Structure conservation index: " ++ " - \n Background model: " ++ " - \n Decision model: " ++ " - \n SVM decision value: " ++ " - \n SVM class propability: " ++ " - \n Prediction: " ++ " - \n"
- return output
- else do
- let output = "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-"
- return output
- else
- if (verbose == Loud)
- then do
- let output = "Mean pairwise identity: " ++ " - \n Shannon entropy: " ++ " - \n GC content: " ++ " - \n Mean single sequence minimum free energy: " ++ " - \n Consensus minimum free energy: " ++ " - \n Energy contribution: " ++ " - \n Covariance contribution: " ++ " - \n Combinations pair: " ++ " - \n Mean z-score: " ++ " - \n Structure conservation index: " ++ " - \n Background model: " ++ " - \n Decision model: " ++ " - \n SVM decision value: " ++ " - \n SVM class propability: " ++ " - \n Prediction: " ++ " - \n"
- return output
- else do
- let output = "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-" ++ "\t" ++ "-"
- return output
-
-cmStatOutput :: Verbosity -> String -> IO String
-cmStatOutput verbose cmstatPath = do
- cmstatPresent <- doesFileExist cmstatPath
- if cmstatPresent
- then do
- inputCMstat <- readCMstat cmstatPath
- if isRight inputCMstat
- then do
- let cmStat = fromRight inputCMstat
- if verbose == Loud
- then do
- let output = "statSequenceNumber: " ++ show (statSequenceNumber cmStat) ++ "\nstatEffectiveSequences: " ++ show (statEffectiveSequences cmStat) ++ "\nstatConsensusLength: " ++ show (statConsensusLength cmStat) ++ "\nstatW: " ++ show (statW cmStat) ++ "\nstatBasepairs: " ++ show (statBasepairs cmStat) ++ "\nstatBifurcations: " ++ show (statBifurcations cmStat) ++ "\nstatModel: " ++ statModel cmStat ++ "\nrelativeEntropyCM: " ++ show (relativeEntropyCM cmStat) ++ "\nrelativeEntropyHMM: " ++ show (relativeEntropyHMM cmStat)
- return output
- else do
- let output = show (statSequenceNumber cmStat) ++ "\t" ++ show (statEffectiveSequences cmStat) ++ "\t" ++ show (statConsensusLength cmStat) ++ "\t" ++ show (statW cmStat) ++ "\t" ++ show (statBasepairs cmStat) ++ "\t" ++ show (statBifurcations cmStat) ++ "\t" ++ statModel cmStat ++ "\t" ++ show (relativeEntropyCM cmStat) ++ "\t" ++ show (relativeEntropyHMM cmStat)
- return output
- else
- if (verbose == Loud)
- then do
- let output = "statSequenceNumber: -" ++ "\nstatEffectiveSequences: -" ++ "\nstatConsensusLength: -" ++ "\nstatW: -" ++ "\nstatBasepairs: -" ++ "\nstatBifurcations: -" ++ "\nstatModel: -" ++ "\nrelativeEntropyCM: -" ++ "\nrelativeEntropyHMM: -"
- return output
- else do
- let output = "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-"
- return output
- else
- if (verbose == Loud)
- then do
- let output = "statSequenceNumber: -" ++ "\nstatEffectiveSequences: -" ++ "\nstatConsensusLength: -" ++ "\nstatW: -" ++ "\nstatBasepairs: -" ++ "\nstatBifurcations: -" ++ "\nstatModel: -" ++ "\nrelativeEntropyCM: -" ++ "\nrelativeEntropyHMM: -"
- return output
- else do
- let output = "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-\t" ++ "-"
- return output
-
-rnaCodeOutput :: Verbosity -> String -> IO String
-rnaCodeOutput verbose rnaCodePath = do
- rnacodePresent <- doesFileExist rnaCodePath
- if rnacodePresent
- then do
- inputRNACode <- RC.readRNAcodeTabular rnaCodePath
- if isRight inputRNACode
- then do
- let rnaCode = fromRight inputRNACode
- let lowestPvalue = minimum (map RC.pvalue (RC.rnacodeHits rnaCode))
- let rnaCodeClassification = if lowestPvalue < 0.05 then "PROTEIN" else "OTHER"
- if verbose == Loud
- then do
- let output = "RNAcode lowest p-value: " ++ show lowestPvalue ++ "\nrnaCodeClassification: " ++ rnaCodeClassification
- return output
- else do
- let output = show lowestPvalue ++ "\t" ++ rnaCodeClassification
- return output
- else
- if (verbose == Loud)
- then do
- let output = "RNAcode lowest p-value: " ++ "-" ++ "\nrnaCodeClassification: " ++ "-"
- return output
- else do
- let output = "-\t" ++ "-"
- --let output = show (fromLeft inputRNACode)
- return output
- else
- if (verbose == Loud)
- then do
- let output = "RNAcode lowest p-value: " ++ "-" ++ "\nrnaCodeClassification: " ++ "-"
- return output
- else do
- let output = "-\t" ++ "-"
- return output
diff --git a/src/Bio/cmsearchToBED.hs b/src/Bio/cmsearchToBED.hs
deleted file mode 100644
--- a/src/Bio/cmsearchToBED.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | Convert cmsearch output to Browser Extensible Data (BED) format
--- Testcommand: cmsearchToBED -i /path/to/test.clustal
-module Main where
-import Prelude
-import System.Console.CmdArgs
-import Bio.RNAlienLibrary
-import Data.Either.Unwrap
-import qualified Data.ByteString.Lazy.Char8 as L
-import qualified Data.Text as T
-import Data.List
-
-data Bed = Bed
- { browserPostition :: T.Text,
- browserSettings :: T.Text,
- bedName :: T.Text,
- bedDescription :: T.Text,
- bedVisibility :: Int,
- bedItemRgb :: Bool,
- bedEntries :: [BedEntry]
- } deriving (Eq, Read)
-
-instance Show Bed where
- show (Bed _browserPostition _browserSettings _bedName _bedDescription _bedVisibility _bedItemRgb _bedEntries) = a ++ b ++ c ++ d ++ e ++ f ++ g
- where a = "browser position " ++ T.unpack _browserPostition ++ "\n"
- b = T.unpack _browserSettings ++ "\n"
- c = "track name=\"" ++ T.unpack _bedName ++ "\" "
- d = "description=\"" ++ T.unpack _bedDescription ++ "\" "
- e = "visibility=" ++ show _bedVisibility ++ " "
- f = "itemRgb=\"" ++ itemRbg ++ "\"\n"
- itemRbg = if _bedItemRgb then "On" else "Off"
- g = concatMap show _bedEntries
-
-
-data BedEntry = BedEntry
- { chrom :: T.Text,
- chromStart :: Int,
- chromEnd :: Int,
- chromName :: Maybe T.Text,
- score :: Maybe Int,
- strand :: Maybe Char,
- thickStart :: Maybe Int,
- thickEnd :: Maybe Int,
- color :: Maybe T.Text,
- blockCount :: Maybe Int,
- blockSizes :: Maybe [Int],
- blockStarts :: Maybe [Int]
- } deriving (Eq, Read)
-
-instance Show BedEntry where
- show (BedEntry _chrom _chromStart _chromEnd _chromName _score _strand _thickStart _thickEnd _color _blockCount _blockSizes _blockStarts) = a ++ b ++ c ++ d ++ e ++ f ++ g ++ h ++ i ++ j ++ k ++ l
- where a = T.unpack _chrom ++ "\t"
- b = show _chromStart ++ "\t"
- c = show _chromEnd ++ "\t"
- d = maybe "" T.unpack _chromName ++ "\t"
- e = maybe "" show _score ++ "\t"
- f = maybe "" ((: [])) _strand ++ "\t"
- g = maybe "" show _thickStart ++ "\t"
- h = maybe "" show _thickEnd ++ "\t"
- i = maybe "" T.unpack _color ++ "\t"
- j = maybe "" show _blockCount ++ "\t"
- k = maybe "" (intercalate "," . map show) _blockSizes ++ "\t"
- l = maybe "" (intercalate "," . map show) _blockStarts ++ "\n"
-
-data Options = Options
- { cmsearchPath :: String,
- inputBrowserSettings :: String,
- inputBedVisibility :: Int,
- inputTrackName :: String,
- inputTrackDescription :: String,
- inputItemRgb :: Bool,
- inputTrackColor :: String,
- sortBed :: Bool,
- withHeader :: Bool
- } deriving (Show,Data,Typeable)
-
-options :: Options
-options = Options
- { cmsearchPath = def &= name "i" &= help "Path to input cmsearch file",
- inputBrowserSettings = "browser hide all" &= name "b" &= help "Browser settings. Default: browser hide all",
- inputBedVisibility = (2 :: Int) &= name "y" &= help "Visibility setting of track. Default: 2",
- inputTrackName = "PredictedRNA" &= name "n" &= help "Name of the track Default: PredictedRNA",
- inputTrackDescription = "RNA loci predicted by cmsearch" &= name "d" &= help "Description of the track. Default: RNA loci predicted by cmsearch",
- inputItemRgb = True &= name "r" &= help "RGB Color of the track. Default: True",
- inputTrackColor = "255,0,0" &= name "c" &= help "RGB Color of the track. Default: 255,0,0",
- sortBed = True &= name "s" &= help "Sort entries of Bed file by start end end cooridinates. Default: True",
- withHeader = True &= name "w" &= help "Output contains bed header. Default: True"
- } &= summary "cmsearchToBED - Converts cmsearch file hits to BED file entries" &= help "Florian Eggenhofer 2016" &= verbosity
-
-main :: IO ()
-main = do
- Options{..} <- cmdArgs options
- parsedCmsearch <- readCMSearch cmsearchPath
- if isRight parsedCmsearch
- then do
- let outputBED = convertcmSearchToBED (fromRight parsedCmsearch) inputBrowserSettings inputTrackName inputTrackDescription inputTrackColor inputBedVisibility inputItemRgb sortBed
- if isRight outputBED
- then
- if withHeader
- then print (fromRight outputBED)
- else do
- let output = concatMap show (bedEntries (fromRight outputBED))
- putStr output
- else putStr (fromLeft outputBED)
- else putStr ("A problem occured converting from cmsearch to BED format:\n " ++ show (fromLeft parsedCmsearch))
-
---convertcmSearchToBED :: CMsearch -> String -> String -> Either String String
---convertcmSearchToBED inputcmsearch trackName trackColor
--- | null cmHits = Left "cmsearch file contains no hits"
--- | otherwise = Right (bedHeader ++ bedEntries)
--- where cmHits = cmsearchHits inputcmsearch
--- bedHeader = "browser position " ++ browserPosition ++ "\nbrowser hide all\ntrack name=\"cmsearch hits\" description=\"cmsearch hits\" visibility=2 itemRgb=\"On\"\n"
--- bedEntries = concatMap (cmsearchHitToBEDentry trackName trackColor) cmHits
--- browserPosition = L.unpack (hitSequenceHeader firstHit) ++ ":" ++ entryStart firstHit ++ "-" ++ entryEnd firstHit
--- firstHit = (head cmHits)
-
-convertcmSearchToBED :: CMsearch -> String -> String -> String -> String -> Int -> Bool -> Bool -> Either String Bed
-convertcmSearchToBED inputcmsearch inputBrowserSettings trackName trackDescription trackColor inputBedVisibility inputItemRgb sortBed
- | null cmHits = Left "cmsearch file contains no hits"
- | otherwise = Right bed
- where cmHits = cmsearchHits inputcmsearch
- --bedHeader = "browser position " ++ browserPosition ++ "\nbrowser hide all\ntrack name=\"cmsearch hits\" description=\"cmsearch hits\" visibility=2 itemRgb=\"On\"\n"
- bedEntries = map (cmsearchHitToBEDentry trackName trackColor) cmHits
- sortedBedEntries = if sortBed then sortBy orderBedEntry bedEntries else bedEntries
- currentBrowserPosition = T.unpack (chrom firstEntry) ++ ":" ++ show (chromStart firstEntry) ++ "-" ++ show (chromEnd firstEntry)
- firstEntry = head sortedBedEntries
- bed = Bed (T.pack currentBrowserPosition) (T.pack inputBrowserSettings) (T.pack trackName) (T.pack trackDescription) inputBedVisibility inputItemRgb sortedBedEntries
-
-cmsearchHitToBEDentry :: String -> String -> CMsearchHit -> BedEntry
-cmsearchHitToBEDentry hitName hitColor cmHit = entry
- where entry = BedEntry chromosome entrystart entryend (Just (T.pack hitName)) entryscore entrystrand thickstart thickend entrycolor blocks blockSize blockStart
- chromosome = T.pack (L.unpack (hitSequenceHeader cmHit))
- --entryline = L.unpack (hitSequenceHeader cmHit) ++ "\t" ++ entryStart cmHit ++ "\t" ++ entryEnd cmHit++ "\t" ++ (hitName) ++ "\t" ++ "0" ++ "\t" ++ [(hitStrand cmHit)] ++ "\t" ++ show (hitStart cmHit) ++ "\t" ++ show (hitEnd cmHit) ++ "\t" ++ hitColor ++ "\n"
- entrystart = if hitStrand cmHit == '+' then hitStart cmHit else hitEnd cmHit
- entryend = if hitStrand cmHit == '+' then hitEnd cmHit else hitStart cmHit
- entryscore = Just (0 :: Int)
- entrystrand = Just (hitStrand cmHit)
- thickstart = Just entrystart
- thickend = Just entryend
- entrycolor = Just (T.pack hitColor)
- blocks = Just (1 :: Int)
- blockSize = Just [entryend - entrystart]
- blockStart = Just [0 :: Int]
-
-
---cmsearchHitToBEDentry :: String -> String -> CMsearchHit -> String
---cmsearchHitToBEDentry hitName hitColor cmHit = entryline
--- where entryline = L.unpack (hitSequenceHeader cmHit) ++ "\t" ++ entryStart cmHit ++ "\t" ++ entryEnd cmHit++ "\t" ++ (hitName) ++ "\t" ++ "0" ++ "\t" ++ [(hitStrand cmHit)] ++ "\t" ++ show (hitStart cmHit) ++ "\t" ++ show (hitEnd cmHit) ++ "\t" ++ hitColor ++ "\n"
- --entrystart = if (hitStrand cmHit) == '+' then show (hitStart cmHit) else show (hitEnd cmHit)
- --entryend = if (hitStrand cmHit) == '+' then show (hitEnd cmHit) else show (hitStart cmHit)
-
-entryStart :: CMsearchHit -> String
-entryStart cmHit
- | hitStrand cmHit == '+' = show (hitStart cmHit)
- | otherwise = show (hitEnd cmHit)
-
-entryEnd :: CMsearchHit -> String
-entryEnd cmHit
- | hitStrand cmHit == '+' = show (hitEnd cmHit)
- | otherwise = show (hitStart cmHit)
-
-orderBedEntry :: BedEntry -> BedEntry -> Ordering
-orderBedEntry firstHit secondHit
- | start1 > start2 = GT
- | start1 < start2 = LT
- | otherwise = orderBedEntryEnd firstHit secondHit
- where start1 = chromStart firstHit
- start2 = chromStart secondHit
-
-orderBedEntryEnd :: BedEntry -> BedEntry -> Ordering
-orderBedEntryEnd firstHit secondHit
- | end1 > end2 = GT
- | end1 < end2 = LT
- | otherwise = EQ
- where end1 = chromEnd firstHit
- end2 = chromEnd secondHit