From d98fd9a6c1e1557bc095a540725acb2b6ec25796 Mon Sep 17 00:00:00 2001 From: Florian Eggenhofer Date: Mon, 11 Feb 2019 20:16:55 +0100 Subject: [PATCH 1/5] Added prototype for stockholmv tool --- cmv.cabal | 6 + src/Stockholm/StockholmVisualisation.hs | 145 ++++++++++++++++++++++++ 2 files changed, 151 insertions(+) create mode 100644 src/Stockholm/StockholmVisualisation.hs diff --git a/cmv.cabal b/cmv.cabal index db3b5ee..62f4f18 100644 --- a/cmv.cabal +++ b/cmv.cabal @@ -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/Stockholm/StockholmVisualisation.hs b/src/Stockholm/StockholmVisualisation.hs new file mode 100644 index 0000000..6f352f4 --- /dev/null +++ b/src/Stockholm/StockholmVisualisation.hs @@ -0,0 +1,145 @@ +{-# 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, + outputDirectoryPath :: String, + secondaryStructureVisTool :: 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)", + outputDirectoryPath = "" &= name "p" &= help "Output directory path (Default: none)", + secondaryStructureVisTool = "" &= name "x" &= help "Select tool for secondary structure visualisation: forna, r2r (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 + let alignmentVis = 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)] From 77a3c36650c77e30d0d79b06516c4282beee47d2 Mon Sep 17 00:00:00 2001 From: Florian Eggenhofer Date: Mon, 11 Feb 2019 20:56:45 +0100 Subject: [PATCH 2/5] Updated changelog and travis --- .travis.yml | 133 +++++++++++++++++++++++++++++++++++++++------------- changelog | 3 ++ cmv.cabal | 20 ++++---- 3 files changed, 113 insertions(+), 43 deletions(-) diff --git a/.travis.yml b/.travis.yml index 963d138..88ad0c6 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,40 +1,107 @@ -# NB: don't set `language: haskell` here +# This Travis job script has been generated by a script via +# +# haskell-ci 'cmv.cabal' +# +# For more information, see https://github.com/haskell-CI/haskell-ci +# +language: c +dist: xenial -# explicitly request legacy non-sudo based build environment -sudo: required +git: + submodules: false # whether to recursively clone submodules + +cache: + directories: + - $HOME/.cabal/packages + - $HOME/.cabal/store + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + + - rm -rfv $HOME/.cabal/packages/head.hackage + +matrix: + include: + - compiler: "ghc-8.4.4" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} + - compiler: "ghc-8.0.2" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} -# 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 + - HC=${CC} + - HCPKG=${HC/ghc/ghc-pkg} + - unset CC + - ROOTDIR=$(pwd) + - mkdir -p $HOME/.local/bin + - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" + - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) + - echo $HCNUMVER 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 + - cabal --version + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - UNCONSTRAINED=${UNCONSTRAINED-true} + - GHCHEAD=${GHCHEAD-false} + - travis_retry cabal update -v + - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" + - rm -fv cabal.project cabal.project.local + - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' + - "printf 'packages: \".\"\\n' > cabal.project" + - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" + - touch cabal.project.local + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cmv)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + - if [ -f "./configure.ac" ]; then + (cd "." && autoreconf -i); + fi + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all + - rm -rf .ghc.environment.* "."/dist + - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) -# 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. +# 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 - -# 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") + # test that source-distributions can be generated + - cabal new-sdist all + - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ + - cd ${DISTDIR} || false + - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; + - "printf 'packages: cmv-*/*.cabal\\n' > cabal.project" + - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" + - touch cabal.project.local + - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cmv)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" + - cat cabal.project || true + - cat cabal.project.local || true + # this builds all libraries and executables (without tests/benchmarks) + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + + # build & run tests, build benchmarks + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + + # cabal check + - (cd cmv-* && cabal check) + + # haddock + - cabal new-haddock -w ${HC} ${TEST} ${BENCH} all + + # Build without installed constraints for packages in global-db + - if $UNCONSTRAINED; then rm -f cabal.project.local; cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi + +# REGENDATA ["cmv.cabal"] +# EOF diff --git a/changelog b/changelog index 4438be9..5aec63f 100644 --- a/changelog +++ b/changelog @@ -1,4 +1,7 @@ -*-change-log-*- +1.1.0 Florian Eggenhofer 20. February 2019 + * Fixed secondary structure visualisation for missing consensus + secondary structure 1.0.8 Florian Eggenhofer 27. January 2018 * Fixed secondary structure visualisation for missing consensus secondary structure diff --git a/cmv.cabal b/cmv.cabal index 62f4f18..5bb7a68 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.0.2, GHC == 8.2.2, 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/ From 1991363243c9d5c4b843e4a5341e8f8677d4c977 Mon Sep 17 00:00:00 2001 From: Florian Eggenhofer Date: Tue, 12 Feb 2019 20:37:40 +0100 Subject: [PATCH 3/5] Added switch to control index --- src/Stockholm/StockholmVisualisation.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Stockholm/StockholmVisualisation.hs b/src/Stockholm/StockholmVisualisation.hs index 6f352f4..9d0584a 100644 --- a/src/Stockholm/StockholmVisualisation.hs +++ b/src/Stockholm/StockholmVisualisation.hs @@ -22,7 +22,7 @@ import Control.Monad import Bio.StockholmDraw import Bio.CMDraw import qualified Data.Char as C ---import qualified Data.Vector as V +import qualified Data.Vector as V options :: Options data Options = Options @@ -31,6 +31,7 @@ data Options = Options maxWidth :: Double, scalingFactor :: Double, outputFormat :: String, + withIndex :: Bool, outputDirectoryPath :: String, secondaryStructureVisTool :: String } deriving (Show,Data,Typeable) @@ -41,6 +42,7 @@ options = Options 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)" } &= summary ("StockholmV " ++ toolVersion) &= help "Florian Eggenhofer - 2019-" &= verbosity @@ -59,7 +61,7 @@ main = do let currentAlnNames = map show [1..(length alns)] let alignmentFileNames = map (\m -> m ++ ".aln" ++ "." ++ outputFormat) currentAlnNames setCurrentDirectory dirPath - let alignmentVis = map (drawStockholm alignmentEntries) alns + 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 From f705ad4972e0e068eb7c918c9b31f3597169d6bb Mon Sep 17 00:00:00 2001 From: Florian Eggenhofer Date: Sat, 29 Jun 2019 21:48:02 +0200 Subject: [PATCH 4/5] Updates for stk labels --- src/Bio/CMDraw.hs | 97 +++++++++++++------------ src/Stockholm/StockholmVisualisation.hs | 8 +- 2 files changed, 55 insertions(+), 50 deletions(-) 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 index 9d0584a..f6ca16b 100644 --- a/src/Stockholm/StockholmVisualisation.hs +++ b/src/Stockholm/StockholmVisualisation.hs @@ -33,7 +33,8 @@ data Options = Options outputFormat :: String, withIndex :: Bool, outputDirectoryPath :: String, - secondaryStructureVisTool :: String + secondaryStructureVisTool :: String, + labelFilePath :: String } deriving (Show,Data,Typeable) options = Options @@ -44,7 +45,8 @@ options = Options 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)" + 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 () @@ -61,6 +63,8 @@ main = do 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 ++ "/" From afba45126330b19ebb53508b785ca06cbdcdf4e0 Mon Sep 17 00:00:00 2001 From: Florian Eggenhofer Date: Fri, 12 Jul 2019 17:52:07 +0200 Subject: [PATCH 5/5] Added static executbales via CI --- .travis.yml | 131 +++++++++++-------------------------------------- ChangeLog.md | 43 ++++++++++++++++ Dockerfile.dev | 8 +++ changelog | 26 ---------- cmv.cabal | 2 +- 5 files changed, 81 insertions(+), 129 deletions(-) create mode 100644 ChangeLog.md create mode 100644 Dockerfile.dev delete mode 100644 changelog diff --git a/.travis.yml b/.travis.yml index 88ad0c6..44a6360 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,107 +1,34 @@ -# This Travis job script has been generated by a script via -# -# haskell-ci 'cmv.cabal' -# -# For more information, see https://github.com/haskell-CI/haskell-ci -# -language: c -dist: xenial - -git: - submodules: false # whether to recursively clone submodules - -cache: - directories: - - $HOME/.cabal/packages - - $HOME/.cabal/store +sudo: required -before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - # remove files that are regenerated by 'cabal update' - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx - - - rm -rfv $HOME/.cabal/packages/head.hackage - -matrix: - include: - - compiler: "ghc-8.4.4" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}} - - compiler: "ghc-8.2.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}} - - compiler: "ghc-8.0.2" - # env: TEST=--disable-tests BENCH=--disable-benchmarks - addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}} +language: c -before_install: - - HC=${CC} - - HCPKG=${HC/ghc/ghc-pkg} - - unset CC - - ROOTDIR=$(pwd) - - mkdir -p $HOME/.local/bin - - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH" - - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') )) - - echo $HCNUMVER +services: + - docker -install: - - cabal --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - BENCH=${BENCH---enable-benchmarks} - - TEST=${TEST---enable-tests} - - UNCONSTRAINED=${UNCONSTRAINED-true} - - GHCHEAD=${GHCHEAD-false} - - travis_retry cabal update -v - - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config" - - rm -fv cabal.project cabal.project.local - - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' - - "printf 'packages: \".\"\\n' > cabal.project" - - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" - - touch cabal.project.local - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cmv)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then - (cd "." && autoreconf -i); - fi - - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all - - rm -rf .ghc.environment.* "."/dist - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) +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: - # test that source-distributions can be generated - - cabal new-sdist all - - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} || false - - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - - "printf 'packages: cmv-*/*.cabal\\n' > cabal.project" - - "printf 'write-ghc-environment-files: always\\n' >> cabal.project" - - touch cabal.project.local - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(cmv)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - # this builds all libraries and executables (without tests/benchmarks) - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all - - # build & run tests, build benchmarks - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - # cabal check - - (cd cmv-* && cabal check) - - # haddock - - cabal new-haddock -w ${HC} ${TEST} ${BENCH} all - - # Build without installed constraints for packages in global-db - - if $UNCONSTRAINED; then rm -f cabal.project.local; cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi - -# REGENDATA ["cmv.cabal"] -# EOF + - 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 + + +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 5aec63f..0000000 --- a/changelog +++ /dev/null @@ -1,26 +0,0 @@ --*-change-log-*- -1.1.0 Florian Eggenhofer 20. February 2019 - * Fixed secondary structure visualisation for missing consensus - secondary structure -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 5bb7a68..d7f4e99 100644 --- a/cmv.cabal +++ b/cmv.cabal @@ -6,7 +6,7 @@ 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, GHC == 8.4.4 +Tested-With: GHC == 8.4.4 category: Bioinformatics build-type: Simple cabal-version: >=1.8