diff --git a/.travis.yml b/.travis.yml index 963d138..44a6360 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,40 +1,34 @@ -# NB: don't set `language: haskell` here - -# explicitly request legacy non-sudo based build environment sudo: required -# The following enables several GHC versions to be tested; often it's enough to test only against the last release in a major GHC version. Feel free to omit lines listings versions you don't need/want testing for. -env: - - CABALVER=1.24 GHCVER=8.0.2 - - CABALVER=2.0 GHCVER=8.2.2 - -# Note: the distinction between `before_install` and `install` is not important. -before_install: - - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - - travis_retry sudo apt-get update - - travis_retry sudo apt-get install libcairo2 libpango1.0-0 libpangomm-1.4-dev - - travis_retry sudo apt-get install happy-1.19.4 alex-3.1.3 - - export PATH=/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:$PATH - - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER # see note about happy/alex - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH +language: c + +services: + - docker -install: - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - travis_retry cabal update - - cabal install --only-dependencies --enable-tests --enable-benchmarks +before_script: + - docker build --tag devel -f Dockerfile.dev . -# Here starts the actual work to be performed for the package under test; any command which exits with a non-zero exit code causes the build to fail. script: - - if [ -f configure.ac ]; then autoreconf -i; fi - - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - - cabal build # this builds all libraries and executables (including tests/benchmarks) - - cabal test - - cabal check - - cabal sdist # tests that a source-distribution can be generated + - docker create --name develcontainer devel + - mkdir cmv + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/CMCV/build/CMCV/CMCV CMCV + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/CMV/build/CMV/CMV CMV + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/HMMCV/build/HMMCV/HMMCV HMMCV + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/HMMV/build/HMMV/HMMV HMMV + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/CMCWStoCMCV/build/CMCWStoCMCV/CMCWStoCMCV CMCWStoCMCV + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/CMCtoHMMC/build/CMCtoHMMC/CMCtoHMMC CMCtoHMMC + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/CMCtoHMMC/build/CMCtoHMMC/CMCtoHMMC CMCtoHMMC + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/HMMCtoCMC/build/HMMCtoCMC/HMMCtoCMC HMMCtoCMC + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/StockholmV/build/StockholmV/StockholmV StockholmV + - docker cp develcontainer:/source/dist-newstyle/build/x86_64-linux/ghc-8.4.3/cmv-1.1.0/x/CMVJson/build/CMVJson/CMVJson CMVJson + - cp LICENSE cmv + - tar -cvzf cmv.tar.gz cmv + -# Check that the resulting source distribution can be built & installed. -# If there are no other `.tar.gz` files in `dist`, this can be even simpler: -# `cabal install --force-reinstalls dist/*-*.tar.gz` - - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && - (cd dist && cabal install --force-reinstalls "$SRC_TGZ") +deploy: + provider: releases + skip_cleanup: true + api_key: $GITHUB_TOKEN + file: "cmv.tar.gz" + on: + tags: true diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..d482326 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,43 @@ +-*-change-log-*- +### 1.1.0 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 12. July 2019 + + * Added StockholmV + * Added statically compiled executables via CI + +### 1.0.8 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 27. January 2018 + + * Fixed secondary structure visualisation for missing consensus + secondary structure + +### 1.0.7 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 15. January 2018 + * Improved placment of index labels + * Prepared for layout direction extension + +### 1.0.6 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 26. September 2017 + + * Fixed a missing output bug in HMMCV + +### 1.0.5 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 18. September 2017 + + * Changed used stack lts due to problems with build tool dependencies + +### 1.0.4 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 14. September 2017 + * Initial compatiblity with GHC 8.2.1 + +### 1.0.3 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 12. September 2017 + + * Added missing README instructions + * Added link to biocontainer + * Fixed changed dependency in travis file, updated stack file + +### 1.0.2 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 22. June 2017 + + * Added package meta files for stack and cabal-new + +### 1.0.1 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 16. June 2017 + + * Additions to documentation + +### 1.0.0 [Florian Eggenhofer](mailto:egg@informatik.uni-freiburg.de) 16. June 2017 + + * Initial release diff --git a/Dockerfile.dev b/Dockerfile.dev new file mode 100644 index 0000000..1d76e69 --- /dev/null +++ b/Dockerfile.dev @@ -0,0 +1,8 @@ +FROM alpine:latest + +RUN apk update +RUN apk add --no-cache musl musl-dev musl-utils musl-dbg ghc ghc-dev ghc-doc cabal zlib-dev zlib tar gzip wget + +ADD . source +WORKDIR source +RUN cabal new-update && cabal new-build --ghc-options="-optl-static -optl-pthread -fPIC" diff --git a/changelog b/changelog deleted file mode 100644 index 4438be9..0000000 --- a/changelog +++ /dev/null @@ -1,23 +0,0 @@ --*-change-log-*- -1.0.8 Florian Eggenhofer 27. January 2018 - * Fixed secondary structure visualisation for missing consensus - secondary structure -1.0.7 Florian Eggenhofer 15. January 2018 - * Improved placment of index labels - * Prepared for layout direction extension -1.0.6 Florian Eggenhofer 26. September 2017 - * Fixed a missing output bug in HMMCV -1.0.5 Florian Eggenhofer 18. September 2017 - * Changed used stack lts due to problems with build tool dependencies -1.0.4 Florian Eggenhofer 14. September 2017 - * Initial compatiblity with GHC 8.2.1 -1.0.3 Florian Eggenhofer 12. September 2017 - * Added missing README instructions - * Added link to biocontainer - * Fixed changed dependency in travis file, updated stack file -1.0.2 Florian Eggenhofer 22. June 2017 - * Added package meta files for stack and cabal-new -1.0.1 Florian Eggenhofer 16. June 2017 - * Additions to documentation -1.0.0 Florian Eggenhofer 16. June 2017 - * Initial release diff --git a/cmv.cabal b/cmv.cabal index db3b5ee..d7f4e99 100644 --- a/cmv.cabal +++ b/cmv.cabal @@ -1,12 +1,12 @@ name: cmv -version: 1.0.8 +version: 1.1.0 synopsis: Detailed visualization of CMs, HMMs and their comparisions description: cmv is a collection of tools for the visualisation of Hidden Markov Models (HMMV) and RNA-family models (CMV). Moreover it can visualise comparisons of these models (HMMCV,CMCV), and annotate linked regions in the structural alignments they were constructed from and via, 3rd party tools, in their consensus secondary structure. license: GPL-3 license-file: LICENSE author: Florian Eggenhofer maintainer: egg@informatik.uni-freiburg.de -Tested-With: GHC == 8.0.2, GHC == 8.2.2 +Tested-With: GHC == 8.4.4 category: Bioinformatics build-type: Simple cabal-version: >=1.8 @@ -20,8 +20,8 @@ source-repository head source-repository this type: git - location: https://github.com/eggzilla/cmv/tree/1.0.8 - tag: 1.0.8 + location: https://github.com/eggzilla/cmv/tree/1.1.0 + tag: 1.1.0 library -- Modules exported by the library. @@ -33,7 +33,7 @@ library -- Other library packages from which modules are imported. build-depends: base >=4.5 && <5, parsec>=3.1.9, diagrams-lib, BiobaseInfernal, text, vector, ParsecTools, diagrams-cairo, filepath, colour, PrimitiveArray, BiobaseXNA, mtl, directory, either-unwrap, SVGFonts>=1.6.0.2, BioHMM>=1.2.0, StockholmAlignment>=1.1.2, BiobaseTypes,containers,diagrams-core - + -- Directories containing source files. hs-source-dirs: src @@ -46,26 +46,26 @@ executable CMCV executable CMV Hs-Source-Dirs: ./src/cmv/ main-is: CMVisualisation.hs - ghc-options: -Wall + ghc-options: -Wall build-depends: base >=4.5, cmdargs, BiobaseInfernal==0.8.1.0, BiobaseXNA, diagrams-lib, parsec, colour, containers, bytestring, template-haskell, text, vector, directory, cmv, either-unwrap, filepath, StockholmAlignment>=1.1.2 executable CMCWStoCMCV Hs-Source-Dirs: ./src/cmcv/ main-is: cmcwsvtocmcv.hs - ghc-options: -Wall + ghc-options: -Wall build-depends: base >=4.5, cmdargs, BiobaseInfernal==0.8.1.0, BiobaseXNA, diagrams-lib, parsec, colour, containers, bytestring, template-haskell, text, vector, directory, cmv, either-unwrap, filepath executable CMCtoHMMC Hs-Source-Dirs: ./src/cmcv/ main-is: cmctohmmc.hs - ghc-options: -Wall + ghc-options: -Wall build-depends: base >=4.5, cmdargs, BiobaseInfernal==0.8.1.0, BiobaseXNA, diagrams-lib, parsec, colour, containers, bytestring, template-haskell, text, vector, directory, cmv, either-unwrap, filepath, BioHMM>=1.2.0 executable HMMCtoCMC Hs-Source-Dirs: ./src/cmcv/ main-is: hmmctocmc.hs - ghc-options: -Wall - build-depends: base >=4.5, cmdargs, BiobaseInfernal==0.8.1.0, BiobaseXNA, diagrams-lib, parsec, colour, containers, bytestring, template-haskell, text, vector, directory, cmv, either-unwrap, filepath, BioHMM>=1.2.0 + ghc-options: -Wall + build-depends: base >=4.5, cmdargs, BiobaseInfernal==0.8.1.0, BiobaseXNA, diagrams-lib, parsec, colour, containers, bytestring, template-haskell, text, vector, directory, cmv, either-unwrap, filepath, BioHMM>=1.2.0 executable CMVJson Hs-Source-Dirs: ./src/cmv/ @@ -84,3 +84,9 @@ executable HMMV main-is: HMMVisualisation.hs ghc-options: -Wall build-depends: base >=4.5, cmdargs, diagrams-lib, parsec, colour, containers, bytestring, text, vector, directory, cmv, either-unwrap, filepath, BioHMM>=1.2.0, StockholmAlignment>=1.1.2 + +executable StockholmV + Hs-Source-Dirs: ./src/Stockholm/ + main-is: StockholmVisualisation.hs + ghc-options: -Wall + build-depends: base >=4.5, cmdargs, diagrams-lib, parsec, colour, containers, bytestring, text, vector, directory, cmv, either-unwrap, filepath, StockholmAlignment>=1.1.2 diff --git a/src/Bio/CMDraw.hs b/src/Bio/CMDraw.hs index 1e60d3f..0aea4c6 100755 --- a/src/Bio/CMDraw.hs +++ b/src/Bio/CMDraw.hs @@ -44,7 +44,7 @@ import qualified Biobase.SElab.CM.Types as CM import qualified Biobase.SElab.CM.ModelStructure as CM import Data.Either.Unwrap import qualified Data.Map as M -import Data.Function +import Data.Function -- | Draw one or more CM drawSingleCMComparisons :: String -> String -> Int -> Double -> String -> String -> Double -> Double -> [CM.CM] -> [Maybe StockholmAlignment] -> [CmcompareResult] -> [(QDiagram Cairo V2 Double Any,Maybe (QDiagram Cairo V2 Double Any))] @@ -102,7 +102,7 @@ drawCM layoutDirection modelDetail entryNumberCutoff transitionCutoff modelLayou _ -> [] labelList = case modelDetail of "detailed" -> V.toList (V.map makeLabel connectedStates V.++ V.map makeSelfLabel selfConnectedStates) - _ -> [] + _ -> [] alignmentDiagram = drawStockholmLinesComparisonLabel entryNumberCutoff maxWidth comparisonNodeLabels nodes aln drawStockholmLinesComparisonLabel :: Int -> Double -> V.Vector (Int,V.Vector (Colour Double)) -> V.Vector CM.Node -> Maybe StockholmAlignment -> Maybe (QDiagram Cairo V2 Double Any) @@ -114,12 +114,12 @@ drawStockholmLinesComparisonLabel entryNumberCutoff maxWidth comparisonNodeLabel -- end nodes have no alignment columns associated columnComparisonLabels = getComparisonPerColumnLabels comparisonNodeLabels nodes alignmentVis = drawStockholmLines entryNumberCutoff maxWidth columnComparisonLabels aln - + makeAllConnectedStates :: M.Map (PI.PInt () CM.StateIndex) CM.State -> V.Vector (String,String,Double) makeAllConnectedStates allStates = allConnectedStates where indexStateTuples = M.assocs allStates allConnectedStates = V.fromList (concatMap makeStateConnections indexStateTuples) - + makeStateConnections :: (PI.PInt () CM.StateIndex,CM.State) -> [(String,String,Double)] makeStateConnections (pInt,currentState) = conns where stateId = show (PI.getPInt pInt) @@ -146,11 +146,12 @@ perModelSecondaryStructureVisualisation selectedTool _ structureFilePath cms aln nameColorVector = V.zipWith (\a b -> (a,b)) modelNames colorVector structureComparisonInfo = zip3 cms alns comparisonNodeLabels + getComparisonPerModelNodeLabels :: [CmcompareResult] -> V.Vector (String, Colour Double) -> CM.CM -> V.Vector (String,Colour Double, V.Vector (Int,V.Vector (Colour Double))) getComparisonPerModelNodeLabels comparsionResults colorVector model = modelComparisonLabels where modelName = T.unpack (CM._name model) relevantComparisons1 = filter ((modelName==) . model1Name) comparsionResults - modelNodeInterval1 = map (\a -> (model2Name a,nub (model1matchednodes a))) relevantComparisons1 + modelNodeInterval1 = map (\a -> (model2Name a,nub (model1matchednodes a))) relevantComparisons1 relevantComparisons2 = filter ((modelName==) . model2Name) comparsionResults modelNodeInterval2 = map (\a -> (model1Name a,nub (model2matchednodes a))) relevantComparisons2 modelNodeIntervals = V.fromList (modelNodeInterval1 ++ modelNodeInterval2) @@ -161,16 +162,16 @@ getModelComparisonLabels :: String -> Int -> V.Vector (String, Colour Double) -> getModelComparisonLabels _ nodeNumber colorVector (compModel,matchedNodes) = (compModel,modelColor,comparisonNodeLabels) where (modelColor,modelInterval) = modelToColor colorVector (compModel,matchedNodes) -- cm starts at node index 0 for root node and ends with end node - -- cmcompare does not include root node, but end node + -- cmcompare does not include root node, but end node comparisonNodeLabels = V.generate (nodeNumber) (makeModelComparisonNodeLabel (modelColor,modelInterval)) makeModelComparisonNodeLabel :: (Colour Double,[Int]) -> Int -> (Int,V.Vector (Colour Double)) -makeModelComparisonNodeLabel (modelColor, nodeInterval) nodeNumber +makeModelComparisonNodeLabel (modelColor, nodeInterval) nodeNumber | elem nodeNumber nodeInterval = (nodeNumber,V.singleton modelColor) | otherwise = (nodeNumber,V.singleton white) getComparisonPerColumnLabels :: V.Vector (Int,V.Vector (Colour Double)) -> V.Vector CM.Node -> V.Vector (Int, V.Vector (Colour Double)) -getComparisonPerColumnLabels comparisonNodeLabels nodes = columnComparisonLabels where +getComparisonPerColumnLabels comparisonNodeLabels nodes = columnComparisonLabels where unsortedColumnComparisonLabel = concatMap (nodeToColumnComparisonLabel nodes) (V.toList comparisonNodeLabels) columnComparisonLabels = V.fromList (sortBy (compare `on` fst) unsortedColumnComparisonLabel) @@ -179,7 +180,7 @@ nodeToColumnComparisonLabel nodes (nodeIndex,colors) = colLabels where currentNode = (V.!) nodes (nodeIndex) colIndices = nub [CM._nodeColL currentNode,CM._nodeColR currentNode] colLabels = map (\a->(a,colors)) colIndices - + -- buildR2RperModelInput :: String -> (CM.CM, Maybe StockholmAlignment,V.Vector (String,Colour Double,V.Vector (Int,V.Vector (Colour Double)))) -> [(String,String)] buildR2RperModelInput structureFilePath (inputCM,maybeAln,comparisonNodeLabels) @@ -189,7 +190,7 @@ buildR2RperModelInput structureFilePath (inputCM,maybeAln,comparisonNodeLabels) modelName = T.unpack (CM._name inputCM) nodes = V.fromList (M.elems (CM._fmNodes cm)) aln = fromJust maybeAln - r2rInputPrefix = sHeader ++ sConsensusStructure ++ sConsensusSequence ++ sConsensusSequenceColor ++ sCovarianceAnnotation + r2rInputPrefix = sHeader ++ sConsensusStructure ++ sConsensusSequence ++ sConsensusSequenceColor ++ sCovarianceAnnotation allColumnAnnotations = columnAnnotations aln consensusSequenceList = map annotation (filter (\annotEntry -> tag annotEntry == T.pack "RF") allColumnAnnotations) firstSeq = T.unpack (entrySequence (head (sequenceEntries aln))) @@ -211,7 +212,7 @@ buildR2RperModelInput structureFilePath (inputCM,maybeAln,comparisonNodeLabels) sConsensusSequence = "#=GC cons " ++ gapFreeConsensusSequence ++ "\n" -- ++ show consensusStructureColIndices ++ "\n" ++ show comparisonNodeLabels ++ "\n" sConsensusSequenceColor = "#=GC conss " ++ replicate (length gapFreeConsensusSequence) '2' ++ "\n" sCovarianceAnnotation = "#=GC cov_SS_cons " ++ replicate (length gapFreeConsensusSequence) '.' ++ "\n" - singleFilePath = structureFilePath ++ modelName ++ ".r2r" + singleFilePath = structureFilePath ++ modelName ++ ".r2r" singler2rInput = [(singleFilePath,r2rInputPrefix)] -- for multiple comparisons we need to return different filenames and labels r2rComparisonInputs = V.map (buildR2RperModelComparisonInput modelName structureFilePath r2rInputPrefix) consensusStructureColumnComparisonLabels @@ -249,13 +250,13 @@ buildFornaperModelInput structureFilePath (inputCM,maybeAln,comparisonNodeLabels indexedGapFreeConsensusStructure = extractGapfreeIndexedStructure consensusSequence consensusStructure consensusStructureColIndices = map ((+1) . fst) indexedGapFreeConsensusStructure gapFreeConsensusStructure = map snd indexedGapFreeConsensusStructure - modelName = T.unpack (CM._name inputCM) + modelName = T.unpack (CM._name inputCM) columnComparisonLabels = V.map (\(mname,mcolor,comparisonNodePerModelLabels) -> (mname,mcolor,getComparisonPerColumnLabels comparisonNodePerModelLabels nodes)) comparisonNodeLabelsPerModels --filter for labels that are part of consensus secondary structure by index consensusStructureColumnComparisonLabels = V.map (\(mname,mcolor,colLabels) -> (mname,mcolor,V.filter (\(i,_) -> elem i consensusStructureColIndices) colLabels)) columnComparisonLabels colorSchemes = V.toList (V.map (makeColorScheme modelName structureFilePath) consensusStructureColumnComparisonLabels) - - + + buildFornaLinksInput :: String -> (CM.CM,Maybe StockholmAlignment,V.Vector (String,Colour Double,V.Vector (Int,V.Vector (Colour Double)))) -> [(String, String)] buildFornaLinksInput structureFilePath (inputCM,maybeAln,comparisonNodeLabelsPerModels) | isNothing maybeAln = [] @@ -277,7 +278,7 @@ buildFornaLinksInput structureFilePath (inputCM,maybeAln,comparisonNodeLabelsPer consensusStructure = if null consensusStructureList then "" else T.unpack (head consensusStructureList) indexedGapFreeConsensusStructure = extractGapfreeIndexedStructure consensusSequence consensusStructure consensusStructureColIndices = map ((+1) . fst) indexedGapFreeConsensusStructure - gapFreeConsensusStructure = map snd indexedGapFreeConsensusStructure + gapFreeConsensusStructure = map snd indexedGapFreeConsensusStructure columnComparisonLabels = V.map (\(mname,mcolor,comparisonNodePerModelLabels) -> (mname,mcolor,getComparisonPerColumnLabels comparisonNodePerModelLabels nodes)) comparisonNodeLabelsPerModels --filter for labels that are part of consensus secondary structure by index consensusStructureColumnComparisonLabels = V.map (\(mname,mcolor,colLabels) -> (mname,mcolor,V.filter (\(i,_) -> elem i consensusStructureColIndices) colLabels)) columnComparisonLabels @@ -286,17 +287,17 @@ buildFornaLinksInput structureFilePath (inputCM,maybeAln,comparisonNodeLabelsPer makeFornaComparisonLink :: String -> String -> String -> (String,Colour Double,V.Vector (Int,V.Vector (Colour Double))) -> (String,String) makeFornaComparisonLink modelName structureFilePath fornaURLPrefix (compModelName,_,comparisonColLabelsPerModel) = (comparisonPath,comparisonLink) where comparisonPath = structureFilePath ++ modelName ++ "." ++ compModelName ++ ".fornalink" - comparisonLink = fornaURLPrefix ++ labelPrefix ++ singleColorLabels - labelPrefix = "&colors=%3Eheader\\n" + comparisonLink = fornaURLPrefix ++ labelPrefix ++ singleColorLabels + labelPrefix = "&colors=%3Eheader\\n" --forna only supports a single color per node, which has to be supplied as additional color scheme singleColorLabels = concatMap comparisonColLabelsToFornaLinkLabel (V.toList comparisonColLabelsPerModel) - + comparisonColLabelsToFornaLinkLabel :: (Int, V.Vector (Colour Double)) -> String comparisonColLabelsToFornaLinkLabel (_,colorVector) | V.null colorVector = "" | V.head colorVector /= white = "1\\n" | otherwise = "0\\n" - + makeColorScheme :: String -> String -> (String,Colour Double,V.Vector (Int,V.Vector (Colour Double))) -> (String,String) makeColorScheme modelName structureFilePath (compModelName,_,comparisonColLabelsPerModel) = (schemeFilePath,singleColorLabels) where schemeFilePath = structureFilePath ++ modelName ++ "." ++ compModelName ++ ".fornacolor" @@ -304,7 +305,7 @@ makeColorScheme modelName structureFilePath (compModelName,_,comparisonColLabels --column indexes have to be mapped to gap free consensus sequence structureIndexedLabels = V.map (\(a,(_,c)) -> (a+1,c)) indexedComparisonColLabelsPerModel singleColorLabels = concatMap comparisonColLabelsToFornaLabel (V.toList structureIndexedLabels) - + -- | Extracts consensus secondary structure from alignment and annotates cmcompare nodes for all comparisons in one merged output mergedSecondaryStructureVisualisation :: String -> Double -> [CM.CM] -> [Maybe StockholmAlignment] -> [CmcompareResult] -> [(String,String)] mergedSecondaryStructureVisualisation selectedTool _ cms alns comparisons @@ -319,7 +320,7 @@ mergedSecondaryStructureVisualisation selectedTool _ cms alns comparisons modelNames = V.fromList (map (T.unpack . CM._name) cms) nameColorVector = V.zipWith (\a b -> (a,b)) modelNames colorVector structureComparisonInfo = zip3 cms alns comparisonNodeLabels - + buildMergedFornaInput :: (CM.CM,Maybe StockholmAlignment,V.Vector (Int, V.Vector (Colour Double))) -> (String, String) buildMergedFornaInput (inputCM,maybeAln,comparisonNodeLabels) | isNothing maybeAln = ([],[]) @@ -349,7 +350,7 @@ comparisonColLabelsToFornaLabel (nodeNr,colorVector) | V.null colorVector = "" | V.head colorVector /= white = " " ++ show nodeNr ++ ":blue " | otherwise = "" - + buildMergedR2RInput :: (CM.CM, Maybe StockholmAlignment,V.Vector (Int,V.Vector (Colour Double))) -> (String,String) buildMergedR2RInput (inputCM,maybeAln,comparisonNodeLabels) | isNothing maybeAln = ([],[]) @@ -415,7 +416,7 @@ buildRowIndexStructure row nodes (currentIndex:xs) = do let currentEnd = getIndexEnd nodes (currentIndex:xs) let ntype = CM._nodeType currentNode case ntype of - CM.Root -> put ((row,parentId,"S,",currentIndex,currentEnd):currentInterval,parentId) -- ROOT start tree + CM.Root -> put ((row,parentId,"S,",currentIndex,currentEnd):currentInterval,parentId) -- ROOT start tree CM.BegL -> put ((row,parentId,"L,",currentIndex,currentEnd):currentInterval,parentId) -- BEGL set current label CM.BegR -> put ((row,parentId,"R,",currentIndex,currentEnd):currentInterval,parentId) -- BEGR set current label CM.Bif -> put (currentInterval,parentId+1) @@ -441,7 +442,7 @@ buildTreeIndexStructure intervalId nodes (currentIndex:xs) = do buildTreeIndexStructure _ _ [] = do (a,b) <- get return (a,b) - + setNextId :: CM.NodeType -> Int -> Int -> Int setNextId ntype intervalId newId | ntype == CM.Root = newId @@ -549,7 +550,7 @@ text' t = textSVG_ (TextOpts linLibertineFont INSIDE_H KERN False 3 3) t # fc bl -- | label == "BIF" = sRGB24 255 069 064 -- B -- | label == "ROOT" = sRGB24 245 245 245 -- S -- | label == "BEGL" = sRGB24 211 211 211 -- S --- | label == "BEGR" = sRGB24 211 211 211 -- S +-- | label == "BEGR" = sRGB24 211 211 211 -- S -- | label == "END" = sRGB24 245 245 245 -- E --labelToColor _ = sRGB24 245 245 245 @@ -570,9 +571,9 @@ colorBox singleBoxYLength colColour = rect 5 singleBoxYLength # fc colColour # l drawCMMinimalNodeBox :: String -> String -> String -> Int -> M.Map (PI.PInt () CM.StateIndex) CM.State -> V.Vector (Int, V.Vector (Colour Double)) -> CM.Node -> Int -> QDiagram Cairo V2 Double Any drawCMMinimalNodeBox layoutDirection alphabetSymbols emissiontype boxlength currentStates comparisonNodeLabels node nodeIndex - | ntype == CM.Bif = currentCat minimalNode splitStatesBox -- bifNode - | ntype == CM.BegL = currentCat splitStatesBox minimalNode -- begLNode - | ntype == CM.BegR = currentCat splitStatesBox minimalNode -- begRNode + | ntype == CM.Bif = currentCat minimalNode splitStatesBox -- bifNode + | ntype == CM.BegL = currentCat splitStatesBox minimalNode -- begLNode + | ntype == CM.BegR = currentCat splitStatesBox minimalNode -- begRNode | otherwise = minimalNode where ntype = CM._nodeType node idNumber = nodeIndex @@ -584,18 +585,18 @@ drawCMMinimalNodeBox layoutDirection alphabetSymbols emissiontype boxlength curr --nodeType = getCMNodeType node nodeLabels = V.toList (snd (comparisonNodeLabels V.! idNumber)) --boxNumber = fromIntegral $ length nodeLabels - --totalBoxYlength = 5 + --totalBoxYlength = 5 --singleBoxYLength = totalBoxYlength / boxNumber --colourBoxes = vcat (map (colorBox singleBoxYLength) nodeLabels) drawCMSimpleNodeBox :: String -> String -> String -> Int -> M.Map (PI.PInt () CM.StateIndex) CM.State -> V.Vector (Int, V.Vector (Colour Double)) -> CM.Node -> Int -> QDiagram Cairo V2 Double Any drawCMSimpleNodeBox layoutDirection alphabetSymbols emissiontype boxlength currentStates comparisonNodeLabels node nodeIndex - | ntype == CM.Bif = currentCat simpleNode splitStatesBox -- bifNode - | ntype == CM.BegL = currentCat splitStatesBox simpleNode -- begLNode - | ntype == CM.BegR = currentCat splitStatesBox simpleNode -- begRNode + | ntype == CM.Bif = currentCat simpleNode splitStatesBox -- bifNode + | ntype == CM.BegL = currentCat splitStatesBox simpleNode -- begLNode + | ntype == CM.BegR = currentCat splitStatesBox simpleNode -- begRNode | otherwise = simpleNode where ntype = CM._nodeType node - idNumber = nodeIndex + idNumber = nodeIndex nId = show idNumber currentCat = if layoutDirection == "vertical" then (===) else (|||) stateIndices = V.toList (CM._nodeStates node) @@ -604,7 +605,7 @@ drawCMSimpleNodeBox layoutDirection alphabetSymbols emissiontype boxlength curre nodeType = getCMNodeType node nodeLabels = V.toList (snd (comparisonNodeLabels V.! idNumber)) boxNumber = fromIntegral $ length nodeLabels - totalBoxYlength = 5 + totalBoxYlength = 5 singleBoxYLength = totalBoxYlength / boxNumber -- concatenated colorboxes are placed atop the simplenode box with the first colorbox boxYoffset = totalBoxYlength/2 - singleBoxYLength/2 @@ -612,8 +613,8 @@ drawCMSimpleNodeBox layoutDirection alphabetSymbols emissiontype boxlength curre drawCMSimpleStateBox :: String -> String -> String -> Int -> M.Map (PI.PInt () CM.StateIndex) CM.State -> PI.PInt () CM.StateIndex -> QDiagram Cairo V2 Double Any drawCMSimpleStateBox _ _ _ _ currentStates sIndex - | stype == CM.S = sState - | stype == CM.B = bState + | stype == CM.S = sState + | stype == CM.B = bState | otherwise = mempty where currentState = currentStates M.! sIndex stype = CM._stateType currentState @@ -692,7 +693,7 @@ drawCMSplitStateBox _ _ emissiontype _ currentStates sIndex pairSymbolsAndEmissions = zip ["AA","AU","AG","AC","UU","UA","UG","UC","GG","GA","GU","GC","CC","CA","CU","CG"] (VU.toList pairEmissionEntries) pairSymbolsAndEmissions1 = take 8 pairSymbolsAndEmissions pairSymbolsAndEmissions2 = drop 8 pairSymbolsAndEmissions - dState = setState ("D" ++ stateIndx) (negate 0.5) (negate 1) === strutY 1 + dState = setState ("D" ++ stateIndx) (negate 0.5) (negate 1) === strutY 1 mpState = setState ("MP" ++ stateIndx) (negate 0.5) (negate 1) === strutY 1 === (vcat (map (emissionEntry emissiontype) pairSymbolsAndEmissions1) ||| strutX 0.5 ||| vcat (map (emissionEntry emissiontype) pairSymbolsAndEmissions2)) mlState = setState ("ML" ++ stateIndx) (negate 0.5) (negate 1) === strutY 1 === vcat (map (emissionEntry emissiontype) singleSymbolsAndEmissions) mrState = setState ("MR" ++ stateIndx) (negate 0.5) (negate 1) === strutY 1 === vcat (map (emissionEntry emissiontype) singleSymbolsAndEmissions) @@ -763,14 +764,14 @@ diagramName filename fileformat | fileformat == "png" = Right (filename ++ "." ++ fileformat ) | fileformat == "ps" = Right (filename ++ "." ++ fileformat ) | otherwise = Left "Unsupported output format requested (use svg, pdf, ps, png)" - + printCM :: FilePath -> SizeSpec V2 Double -> QDiagram Cairo V2 Double Any -> IO () printCM outputName = renderCairo outputName getBlankComparisonNodeLabels :: CM.CM -> V.Vector (Int, V.Vector (Colour Double)) getBlankComparisonNodeLabels model = comparisonNodeLabels where comparisonNodeLabels = V.generate (nodeNumber ) makeBlankComparisonNodeLabel - nodeNumber = (CM._nodesInModel model) + nodeNumber = (CM._nodesInModel model) makeBlankComparisonNodeLabel :: Int -> (Int,V.Vector (Colour Double)) makeBlankComparisonNodeLabel nodeNumber = (nodeNumber,V.singleton white) @@ -779,7 +780,7 @@ getComparisonNodeLabels :: [CmcompareResult] -> V.Vector (String, Colour Double) getComparisonNodeLabels comparsionResults colorVector model = comparisonNodeLabels where modelName = T.unpack (CM._name model) relevantComparisons1 = filter ((modelName==) . model1Name) comparsionResults - modelNodeInterval1 = map (\a -> (model2Name a,model1matchednodes a)) relevantComparisons1 + modelNodeInterval1 = map (\a -> (model2Name a,model1matchednodes a)) relevantComparisons1 relevantComparisons2 = filter ((modelName==) . model2Name) comparsionResults modelNodeInterval2 = map (\a -> (model1Name a,model2matchednodes a)) relevantComparisons2 modelNodeIntervals = V.fromList (modelNodeInterval1 ++ modelNodeInterval2) @@ -809,7 +810,7 @@ makeArrow :: ([Char], [Char], Double) -> QDiagram Cairo V2 Double Any -> QDiagra makeArrow (lab1,lab2,weight) = connectOutside' arrowStyle1 ("e" ++ lab1) ("a" ++ lab2) where arrowStyle1 = with & arrowHead .~ spike & shaftStyle %~ lw (local 0.1) & headLength .~ local 0.01 & shaftStyle %~ dashingG [weight, 0.1] 0 & headStyle %~ fc black . opacity (weight * 2) -makeSelfArrow :: ([Char], [Char], Double) -> QDiagram Cairo V2 Double Any -> QDiagram Cairo V2 Double Any +makeSelfArrow :: ([Char], [Char], Double) -> QDiagram Cairo V2 Double Any -> QDiagram Cairo V2 Double Any makeSelfArrow (lab1,_,weight) = connectPerim' arrowStyle ("s" ++ lab1) ("z" ++ lab1) (5/12 @@ turn) (8/12 @@ turn) where arrowStyle = with & arrowHead .~ spike & arrowShaft .~ shaft' & arrowTail .~ lineTail & tailTexture .~ solid black & shaftStyle %~ lw (local 0.1) & headLength .~ local 0.01 & tailLength .~ 0 & shaftStyle %~ dashingG [weight, 0.3] 0 & headStyle %~ fc black . opacity (weight * 2) shaft' = wedge 3 xDir (2/4 @@ turn) @@ -823,18 +824,18 @@ makeLabel (n1,n2,weight) = (xOffset,yOffset) = setLabelOffset (location b1 ^. _x) (location b2 ^. _x) (location b1 ^. _y) (location b2 ^. _y) in Diagrams.Prelude.atop (position [(midpoint # translateX xOffset # translateY yOffset, setTransition ((show (roundPos 3 weight))))]) - --Diagrams.Prelude.atop (position [(midpoint # translateX xOffset # translateY yOffset, setTransition (lclass ++"," ++ (show (roundPos 3 weight))))]) - --Diagrams.Prelude.atop (position [(midpoint # translateX xOffset # translateY yOffset, setTransition (n1 ++"," ++ n2 ++"," ++lclass ++"," ++ (show (roundPos 3 weight))))]) + --Diagrams.Prelude.atop (position [(midpoint # translateX xOffset # translateY yOffset, setTransition (lclass ++"," ++ (show (roundPos 3 weight))))]) + --Diagrams.Prelude.atop (position [(midpoint # translateX xOffset # translateY yOffset, setTransition (n1 ++"," ++ n2 ++"," ++lclass ++"," ++ (show (roundPos 3 weight))))]) setLabelOffset :: Double -> Double -> Double -> Double -> (Double,Double) setLabelOffset x1 x2 y1 y2 - -- + -- | ydiff < 2 = (0,0) | xdiff < 2 = (negate 1,negate 1) - -- + -- | x1 > x2 && (ydiff > 30) = (negate 1,negate 10) - -- - | x1 < x2 && (ydiff > 30) = (1,negate 10) + -- + | x1 < x2 && (ydiff > 30) = (1,negate 10) -- between split and insert state of same node - left upper(A) | x1 > x2 && (ydiff < 30) = (negate 1,negate 12) -- between split and insert state of same node - right upper (B) @@ -843,7 +844,7 @@ setLabelOffset x1 x2 y1 y2 | otherwise = (0,0) where ydiff = abs (abs y1 - abs y2) xdiff = abs (abs x1 - abs x2) - + makeSelfLabel :: (String, String, Double) -> QDiagram Cairo V2 Double Any -> QDiagram Cairo V2 Double Any makeSelfLabel (n1,_,weight) | weight == 0 = mempty diff --git a/src/Stockholm/StockholmVisualisation.hs b/src/Stockholm/StockholmVisualisation.hs new file mode 100644 index 0000000..f6ca16b --- /dev/null +++ b/src/Stockholm/StockholmVisualisation.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleContexts #-} + +-- | Visualize Stockholm models +-- Visualization is accomplished with diagrams-svg + +module Main where + +import System.Console.CmdArgs +import System.Directory +import Data.Either.Unwrap +import qualified Bio.StockholmParser as SP +import qualified Data.Text as T +import Paths_cmv (version) +import Data.Version (showVersion) +--import Data.List (intercalate) +import Control.Monad +--Data.Maybe +import Bio.StockholmDraw +import Bio.CMDraw +import qualified Data.Char as C +import qualified Data.Vector as V + +options :: Options +data Options = Options + { alignmentFile :: String, + alignmentEntries :: Int, + maxWidth :: Double, + scalingFactor :: Double, + outputFormat :: String, + withIndex :: Bool, + outputDirectoryPath :: String, + secondaryStructureVisTool :: String, + labelFilePath :: String + } deriving (Show,Data,Typeable) + +options = Options + { alignmentFile = "" &= name "s" &= help "Path to stockholm alignment file", + alignmentEntries = (50 :: Int) &= name "n" &= help "Set cutoff for included stockholm alignment entries (Default: 50)", + maxWidth = (200 :: Double) &= name "w" &= help "Set maximal width of result figure (Default: 100)", + scalingFactor = (2.0 :: Double) &= name "c" &= help "Set uniform scaling factor for image size (Default: 2)", + outputFormat = "pdf" &= name "f" &= help "Output image format: pdf, svg, png, ps (Default: pdf)", + withIndex = True &= name "i" &= help "Print index line, True or False (Default: True)", + outputDirectoryPath = "" &= name "p" &= help "Output directory path (Default: none)", + secondaryStructureVisTool = "" &= name "x" &= help "Select tool for secondary structure visualisation: forna, r2r (Default: none)", + labelFilePath = "" &= name "s" &= help "Path to label file containing labels (Default:none)" + } &= summary ("StockholmV " ++ toolVersion) &= help "Florian Eggenhofer - 2019-" &= verbosity + +main :: IO () +main = do + Options{..} <- cmdArgs options + alnFileExists <- doesFileExist alignmentFile + if alnFileExists + then do + alnInput <- SP.readExistingStockholm alignmentFile + Control.Monad.when (isLeft alnInput) $ print (fromLeft alnInput) + let alns = fromRight alnInput + currentWD <- getCurrentDirectory + let dirPath = if null outputDirectoryPath then currentWD else outputDirectoryPath + let currentAlnNames = map show [1..(length alns)] + let alignmentFileNames = map (\m -> m ++ ".aln" ++ "." ++ outputFormat) currentAlnNames + setCurrentDirectory dirPath + --V.Vector (Int, V.Vector (Colour Double)) + let alignmentLabels = if null labelFilePath then V.empty else + let alignmentVis = if withIndex then (map (drawStockholmLines alignmentEntries maxWidth V.empty) alns) else (map (drawStockholm alignmentEntries) alns) + mapM_ (\(alnPath,stockholm) -> printCM alnPath svgsize stockholm) (zip alignmentFileNames alignmentVis) + let structureFilePath = dirPath ++ "/" + let structureVisInputs = zip currentAlnNames alns + let structureVisOutputs = perAlignmentSecondaryStructureVisualisation secondaryStructureVisTool maxWidth structureFilePath structureVisInputs + mapM_ (\(structureFileName,structureVis) -> writeFile structureFileName structureVis) structureVisOutputs + setCurrentDirectory currentWD + else + putStrLn "Input alignment file not found" + +toolVersion :: String +toolVersion = showVersion version + +-- | Extracts consensus secondary structure from alignment and annotates cmcompare nodes for each model-model combination separately +perAlignmentSecondaryStructureVisualisation :: String -> Double -> String -> [(String,SP.StockholmAlignment)] -> [(String,String)] +perAlignmentSecondaryStructureVisualisation selectedTool _ structureFilePath alns + | selectedTool == "forna" = fornaVis + | selectedTool == "r2r" = r2rVis + | selectedTool == "fornaLink" = fornaLink + | selectedTool == "r2rfornaLink" = fornaLink ++ r2rVis + | selectedTool == "all" = fornaLink ++ r2rVis ++ fornaVis + | otherwise = [] + where fornaVis = map (buildFornaperAlignment structureFilePath) alns + fornaLink = concatMap (buildFornaLinks structureFilePath) alns + r2rVis = concatMap (buildR2RperAlignment structureFilePath) alns + +buildFornaperAlignment :: String -> (String,SP.StockholmAlignment) -> (String, String) +buildFornaperAlignment structureFilePath (alnName,aln) = fornaInput + where fornaString = ">" ++ alnName ++ "\n" ++ gapfreeConsensusSequence ++ "\n" ++ gapFreeConsensusStructure + fornaFilePath = structureFilePath ++ alnName ++ ".forna" + fornaInput = (fornaFilePath,fornaString) + allColumnAnnotations = SP.columnAnnotations aln + consensusSequenceList = map SP.annotation (filter (\annotEntry -> SP.tag annotEntry == T.pack "RF") allColumnAnnotations) + firstSeq = T.unpack (SP.entrySequence (head (SP.sequenceEntries aln))) + consensusSequence = if null consensusSequenceList then firstSeq else T.unpack (head consensusSequenceList) + gapfreeConsensusSequence = map C.toUpper (filter (not . isGap) consensusSequence) + consensusStructureList = map (convertWUSStoDotBracket . SP.annotation) (filter (\annotEntry -> SP.tag annotEntry == T.pack "SS_cons") allColumnAnnotations) + consensusStructure = if null consensusStructureList then "" else T.unpack (head consensusStructureList) + indexedGapFreeConsensusStructure = extractGapfreeIndexedStructure consensusSequence consensusStructure + --consensusStructureColIndices = map ((+1) . fst) indexedGapFreeConsensusStructure + gapFreeConsensusStructure = map snd indexedGapFreeConsensusStructure + --columnComparisonLabels = V.map (\(mname,mcolor,comparisonNodePerModelLabels) -> (mname,mcolor,getComparisonPerColumnLabels comparisonNodePerModelLabels nodes)) comparisonNodeLabelsPerModels + --filter for labels that are part of consensus secondary structure by index + --consensusStructureColumnComparisonLabels = V.map (\(mname,mcolor,colLabels) -> (mname,mcolor,V.filter (\(i,_) -> elem i consensusStructureColIndices) colLabels)) columnComparisonLabels + --colorSchemes = V.toList (V.map (makeColorScheme modelName structureFilePath) consensusStructureColumnComparisonLabels) + +buildFornaLinks :: String -> (String,SP.StockholmAlignment) -> [(String, String)] +buildFornaLinks structureFilePath (alnName,aln) = singleFornaLink + where fornaURLPrefix = "http://rna.tbi.univie.ac.at/forna/forna.html?id=fasta&file=%3Eheader\\n" ++ gapfreeConsensusSequence ++ "\\n" ++ gapFreeConsensusStructure + singleFornaLink = [(fornaFilePath,fornaURLPrefix)] + fornaFilePath = structureFilePath ++ alnName ++ ".fornalink" + allColumnAnnotations = SP.columnAnnotations aln + consensusSequenceList = map SP.annotation (filter (\annotEntry -> SP.tag annotEntry == T.pack "RF") allColumnAnnotations) + firstSeq = T.unpack (SP.entrySequence (head (SP.sequenceEntries aln))) + consensusSequence = if null consensusSequenceList then firstSeq else T.unpack (head consensusSequenceList) + gapfreeConsensusSequence = map C.toUpper (filter (not . isGap) consensusSequence) + consensusStructureList = map (convertWUSStoDotBracket . SP.annotation) (filter (\annotEntry -> SP.tag annotEntry == T.pack "SS_cons") allColumnAnnotations) + consensusStructure = if null consensusStructureList then "" else T.unpack (head consensusStructureList) + indexedGapFreeConsensusStructure = extractGapfreeIndexedStructure consensusSequence consensusStructure + --consensusStructureColIndices = map ((+1) . fst) indexedGapFreeConsensusStructure + gapFreeConsensusStructure = map snd indexedGapFreeConsensusStructure + + + +buildR2RperAlignment :: String -> (String, SP.StockholmAlignment) -> [(String,String)] +buildR2RperAlignment structureFilePath (alnName,aln) = singler2rInput + where r2rInputPrefix = sHeader ++ sConsensusStructure ++ sConsensusSequence ++ sConsensusSequenceColor ++ sCovarianceAnnotation + allColumnAnnotations = SP.columnAnnotations aln + consensusSequenceList = map SP.annotation (filter (\annotEntry -> SP.tag annotEntry == T.pack "RF") allColumnAnnotations) + firstSeq = T.unpack (SP.entrySequence (head (SP.sequenceEntries aln))) + consensusSequence = if null consensusSequenceList then firstSeq else T.unpack (head consensusSequenceList) + gapFreeConsensusSequence = map C.toUpper (filter (not . isGap) consensusSequence) + consensusStructureList = map (convertWUSStoDotBracket . SP.annotation) (filter (\annotEntry -> SP.tag annotEntry == T.pack "SS_cons") allColumnAnnotations) + consensusStructure = if null consensusStructureList then "" else T.unpack (head consensusStructureList) + indexedGapFreeConsensusStructure = extractGapfreeIndexedStructure consensusSequence consensusStructure + --consensusStructureColIndices = map ((+1) . fst) indexedGapFreeConsensusStructure + gapFreeConsensusStructure = map snd indexedGapFreeConsensusStructure + sHeader = "# STOCKHOLM 1.0\n" + sConsensusStructure = "#=GC SS_cons " ++ gapFreeConsensusStructure ++ "\n" + sConsensusSequence = "#=GC cons " ++ gapFreeConsensusSequence ++ "\n" -- ++ show consensusStructureColIndices ++ "\n" ++ show comparisonNodeLabels ++ "\n" + sConsensusSequenceColor = "#=GC conss " ++ replicate (length gapFreeConsensusSequence) '2' ++ "\n" + sCovarianceAnnotation = "#=GC cov_SS_cons " ++ replicate (length gapFreeConsensusSequence) '.' ++ "\n" + singleFilePath = structureFilePath ++ alnName ++ ".r2r" + singler2rInput = [(singleFilePath,r2rInputPrefix)]