elynx-seq 0.6.1.0 → 0.6.1.1

raw patch · 53 files changed

+2900/−2894 lines, 53 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• README.md +14/−12
• elynx-seq.cabal +27/−27
• src/ELynx/Alphabet/Alphabet.hs +307/−0
• src/ELynx/Alphabet/Character.hs +76/−0
• src/ELynx/Alphabet/DistributionDiversity.hs +110/−0
• src/ELynx/Character/AminoAcid.hs +113/−0
• src/ELynx/Character/AminoAcidI.hs +212/−0
• src/ELynx/Character/AminoAcidS.hs +148/−0
• src/ELynx/Character/AminoAcidX.hs +145/−0
• src/ELynx/Character/Character.hs +94/−0
• src/ELynx/Character/Codon.hs +258/−0
• src/ELynx/Character/Nucleotide.hs +67/−0
• src/ELynx/Character/NucleotideI.hs +168/−0
• src/ELynx/Character/NucleotideX.hs +79/−0
• src/ELynx/Data/Alphabet/Alphabet.hs +0/−310
• src/ELynx/Data/Alphabet/Character.hs +0/−76
• src/ELynx/Data/Alphabet/DistributionDiversity.hs +0/−110
• src/ELynx/Data/Character/AminoAcid.hs +0/−113
• src/ELynx/Data/Character/AminoAcidI.hs +0/−212
• src/ELynx/Data/Character/AminoAcidS.hs +0/−148
• src/ELynx/Data/Character/AminoAcidX.hs +0/−145
• src/ELynx/Data/Character/Character.hs +0/−94
• src/ELynx/Data/Character/Codon.hs +0/−258
• src/ELynx/Data/Character/Nucleotide.hs +0/−67
• src/ELynx/Data/Character/NucleotideI.hs +0/−168
• src/ELynx/Data/Character/NucleotideX.hs +0/−79
• src/ELynx/Data/Sequence/Alignment.hs +0/−323
• src/ELynx/Data/Sequence/Defaults.hs +0/−34
• src/ELynx/Data/Sequence/Distance.hs +0/−33
• src/ELynx/Data/Sequence/Sequence.hs +0/−244
• src/ELynx/Data/Sequence/Translate.hs +0/−53
• src/ELynx/Export/Sequence/Fasta.hs +0/−36
• src/ELynx/Import/Sequence/Fasta.hs +0/−70
• src/ELynx/Sequence/Alignment.hs +323/−0
• src/ELynx/Sequence/Defaults.hs +34/−0
• src/ELynx/Sequence/Distance.hs +33/−0
• src/ELynx/Sequence/Export/Fasta.hs +36/−0
• src/ELynx/Sequence/Import/Fasta.hs +70/−0
• src/ELynx/Sequence/Sequence.hs +244/−0
• src/ELynx/Sequence/Translate.hs +53/−0
• test/ELynx/Alphabet/DistributionDiversitySpec.hs +54/−0
• test/ELynx/Data/Alphabet/DistributionDiversitySpec.hs +0/−54
• test/ELynx/Data/Sequence/AlignmentSpec.hs +0/−47
• test/ELynx/Data/Sequence/SequenceSpec.hs +0/−48
• test/ELynx/Data/Sequence/TranslateSpec.hs +0/−35
• test/ELynx/Export/Sequence/FastaSpec.hs +0/−34
• test/ELynx/Import/Sequence/FastaSpec.hs +0/−64
• test/ELynx/Sequence/AlignmentSpec.hs +47/−0
• test/ELynx/Sequence/Export/FastaSpec.hs +34/−0
• test/ELynx/Sequence/Import/FastaSpec.hs +64/−0
• test/ELynx/Sequence/SequenceSpec.hs +48/−0
• test/ELynx/Sequence/TranslateSpec.hs +35/−0

@@ -5,6 +5,13 @@ ## Unreleased changes  +## Version 0.6.1.1++-   Remove plotting functionality (gnuplot incompatible with ghc921).+-   Read files strictly.+-   Refactor; flatten model hierarchy.++ ## Version 0.6.1.0  -   Split `ELynx.Tools` into separate modules because the package will be reduced.

@@ -2,7 +2,7 @@  # The ELynx Suite -Version: 0.6.0.0.+Version: 0.6.1.1. Reproducible evolution made easy.  <p align="center"><img src="https://travis-ci.org/dschrempf/elynx.svg?branch=master"/></p>@@ -69,15 +69,16 @@  # Get help -    cabal exec slynx -- --help+    cabal run slynx -- --help     # OR: stack exec slynx -- --help     # OR: slynx --help -    ELynx Suite version 0.6.0.0.+    Up to date+    ELynx Suite version 0.6.1.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2021, at 12:58 pm, UTC.+    Compiled on February 22, 2022, at 15:10 pm, UTC.     -    Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME] +    Usage: slynx [-v|--verbosity VALUE] [-o|--output-file-basename NAME]                  [-f|--force] [--no-elynx-file] COMMAND       Analyze, and simulate multi sequence alignments.     @@ -138,18 +139,19 @@  The documentation of sub commands can be accessed separately: -    cabal exec slynx -- simulate --help+    cabal run slynx -- simulate --help     # OR: stack exec slynx -- simulate --help     # OR: slynx simulate --help -    ELynx Suite version 0.6.0.0.+    Up to date+    ELynx Suite version 0.6.1.1.     Developed by Dominik Schrempf.-    Compiled on September 4, 2021, at 12:58 pm, UTC.+    Compiled on February 22, 2022, at 15:10 pm, UTC.     -    Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL] -                          [-m|--mixture-model MODEL] [-e|--edm-file NAME] -                          [-p|--siteprofile-files NAMES] -                          [-w|--mixture-model-weights "[DOUBLE,DOUBLE,...]"] +    Usage: slynx simulate (-t|--tree-file Name) [-s|--substitution-model MODEL]+                          [-m|--mixture-model MODEL] [-e|--edm-file NAME]+                          [-p|--siteprofile-files NAMES]+                          [-w|--mixture-model-weights "[DOUBLE,DOUBLE,...]"]                           [-g|--gamma-rate-heterogeneity "(NCAT,SHAPE)"]                           (-l|--length NUMBER) [-S|--seed [INT]]       Simulate multi sequence alignments.

@@ -1,6 +1,6 @@-cabal-version:  2.2+cabal-version:  3.0 name:           elynx-seq-version:        0.6.1.0+version:        0.6.1.1 synopsis:       Handle molecular sequences description:    Examine, modify, and simulate molecular sequences in a reproducible way. Please see the README on GitHub at <https://github.com/dschrempf/elynx>. category:       Bioinformatics@@ -31,25 +31,25 @@  library   exposed-modules:-      ELynx.Data.Alphabet.Alphabet-      ELynx.Data.Alphabet.Character-      ELynx.Data.Alphabet.DistributionDiversity-      ELynx.Data.Character.AminoAcid-      ELynx.Data.Character.AminoAcidI-      ELynx.Data.Character.AminoAcidS-      ELynx.Data.Character.AminoAcidX-      ELynx.Data.Character.Character-      ELynx.Data.Character.Codon-      ELynx.Data.Character.Nucleotide-      ELynx.Data.Character.NucleotideI-      ELynx.Data.Character.NucleotideX-      ELynx.Data.Sequence.Alignment-      ELynx.Data.Sequence.Defaults-      ELynx.Data.Sequence.Distance-      ELynx.Data.Sequence.Sequence-      ELynx.Data.Sequence.Translate-      ELynx.Export.Sequence.Fasta-      ELynx.Import.Sequence.Fasta+      ELynx.Alphabet.Alphabet+      ELynx.Alphabet.Character+      ELynx.Alphabet.DistributionDiversity+      ELynx.Character.AminoAcid+      ELynx.Character.AminoAcidI+      ELynx.Character.AminoAcidS+      ELynx.Character.AminoAcidX+      ELynx.Character.Character+      ELynx.Character.Codon+      ELynx.Character.Nucleotide+      ELynx.Character.NucleotideI+      ELynx.Character.NucleotideX+      ELynx.Sequence.Alignment+      ELynx.Sequence.Defaults+      ELynx.Sequence.Distance+      ELynx.Sequence.Sequence+      ELynx.Sequence.Translate+      ELynx.Sequence.Export.Fasta+      ELynx.Sequence.Import.Fasta   other-modules:       Paths_elynx_seq   autogen-modules:@@ -75,12 +75,12 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      ELynx.Data.Alphabet.DistributionDiversitySpec-      ELynx.Data.Sequence.AlignmentSpec-      ELynx.Data.Sequence.SequenceSpec-      ELynx.Data.Sequence.TranslateSpec-      ELynx.Export.Sequence.FastaSpec-      ELynx.Import.Sequence.FastaSpec+      ELynx.Alphabet.DistributionDiversitySpec+      ELynx.Sequence.AlignmentSpec+      ELynx.Sequence.SequenceSpec+      ELynx.Sequence.TranslateSpec+      ELynx.Sequence.Export.FastaSpec+      ELynx.Sequence.Import.FastaSpec       Paths_elynx_seq   autogen-modules:       Paths_elynx_seq

@@ -0,0 +1,307 @@+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module      :  ELynx.Alphabet.Alphabet+-- Description :  Alphabets store hereditary information+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+--+-- Portability :  portable+--+-- Creation date: Fri May 10 11:10:32 2019.+--+-- Hierarchy:+--+-- 1. 'Character' type.+--+-- 2. Sets of 'Character's form 'Alphabet's; each 'Alphabet' has a specification+-- 'AlphabetSpec'.+--+-- New alphabets have to be added manually to this module.+--+-- This way of handling characters and alphabets IS NOT TYPE SAFE, but much, much+-- faster. A second layer of modules such as 'ELynx.Character.Nucleotide'+-- depend on a 'ELynx.Character.Character.Character' type class. Hence, they+-- provide a type safe way of handling alphabets. Conversion is possible, for+-- instance, with 'ELynx.Alphabet.Character.fromCVec', and+-- 'ELynx.Alphabet.Character.toCVec'.+module ELynx.Alphabet.Alphabet+  ( Alphabet (..),+    AlphabetSpec (..),+    alphabetSpec,+    alphabetDescription,+    isStd,+    isGap,+    isUnknown,+    isIUPAC,+    isMember,+  )+where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import qualified Data.Set as S+import ELynx.Alphabet.Character+import GHC.Generics (Generic)+import Prelude hiding (all)++-- | Available alphabets; for details see 'alphabetSpec'.+data Alphabet+  = DNA+  | DNAX+  | DNAI+  | Protein+  | ProteinX+  | ProteinS+  | ProteinI+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)++instance FromJSON Alphabet++instance ToJSON Alphabet++-- | Verbose alphabet name.+alphabetDescription :: Alphabet -> String+alphabetDescription DNA = "DNA (nucleotides)"+alphabetDescription DNAX = "DNAX (nucleotides; including gaps)"+alphabetDescription DNAI = "DNAI (nucleotides; including gaps, and IUPAC codes)"+alphabetDescription Protein = "Protein (amino acids)"+alphabetDescription ProteinX = "ProteinX (amino acids; including gaps)"+alphabetDescription ProteinS = "ProteinS (amino acids; including gaps, and translation stops)"+alphabetDescription ProteinI = "ProteinI (amino acids; including gaps, translation stops, and IUPAC codes)"++-- | Alphabet specification. 'S.Set' is used because it provides fast lookups.+data AlphabetSpec = AlphabetSpec+  { -- | Standard characters.+    std :: !(S.Set Character),+    -- | Gap characters.+    gap :: !(S.Set Character),+    -- | Unknown characters.+    unknown :: !(S.Set Character),+    -- | Other IUPAC codes.+    iupac :: !(S.Set Character),+    -- | All characters in the alphabet.+    all :: !(S.Set Character),+    -- | Convert from IUPAC to the corresponding standard characters.+    toStd :: Character -> [Character]+  }++-- Create alphabet spec.+fromChars ::+  String -> String -> String -> String -> (Char -> String) -> AlphabetSpec+fromChars st ga un iu to =+  AlphabetSpec+    st'+    ga'+    un'+    iu'+    al+    (fromString . to . toChar)+  where+    st' = S.fromList $ fromString st+    ga' = S.fromList $ fromString ga+    un' = S.fromList $ fromString un+    iu' = S.fromList $ fromString iu+    al = S.unions [st', ga', un', iu']++-- | Get the alphabet specification for a given alphabet.+alphabetSpec :: Alphabet -> AlphabetSpec+alphabetSpec DNA = dna+alphabetSpec DNAX = dnaX+alphabetSpec DNAI = dnaI+alphabetSpec Protein = protein+alphabetSpec ProteinX = proteinX+alphabetSpec ProteinS = proteinS+alphabetSpec ProteinI = proteinI++isWith :: (AlphabetSpec -> S.Set Character) -> Alphabet -> Character -> Bool+isWith set alph char = char `S.member` set (alphabetSpec alph)++-- | Test if standard character.+isStd :: Alphabet -> Character -> Bool+isStd = isWith std++-- | Test if gap.+isGap :: Alphabet -> Character -> Bool+isGap = isWith gap++-- | Test if unknown.+isUnknown :: Alphabet -> Character -> Bool+isUnknown = isWith unknown++-- | Test if extended IUPAC character (excluding gaps and unknowns).+isIUPAC :: Alphabet -> Character -> Bool+isIUPAC = isWith iupac++-- | Test if member of alphabet.+isMember :: Alphabet -> Character -> Bool+isMember = isWith all++dna :: AlphabetSpec+dna = fromChars "ACGT" [] [] [] toStdDNA++toStdDNA :: Char -> String+toStdDNA 'A' = "A"+toStdDNA 'C' = "C"+toStdDNA 'G' = "G"+toStdDNA 'T' = "T"+toStdDNA _ = error "tostdDNA: Cannot convert to standard nucleotide."++dnaX :: AlphabetSpec+dnaX = fromChars "ACGT" "-." [] [] toStdDNAX++toStdDNAX :: Char -> String+toStdDNAX 'A' = "A"+toStdDNAX 'C' = "C"+toStdDNAX 'G' = "G"+toStdDNAX 'T' = "T"+toStdDNAX '-' = []+toStdDNAX '.' = []+toStdDNAX _ = error "toStdDNAX: Cannot convert to standard nucleotide."++dnaI :: AlphabetSpec+dnaI = fromChars "ACGT" "-." "N?" "UWSMKRYBDHV" toStdDNAI++toStdDNAI :: Char -> String+toStdDNAI 'A' = "A"+toStdDNAI 'C' = "C"+toStdDNAI 'G' = "G"+toStdDNAI 'T' = "T"+toStdDNAI 'U' = "T"+toStdDNAI 'W' = "AT"+toStdDNAI 'S' = "GC"+toStdDNAI 'M' = "AC"+toStdDNAI 'K' = "GT"+toStdDNAI 'R' = "AG"+toStdDNAI 'Y' = "CT"+toStdDNAI 'B' = "CGT"+toStdDNAI 'D' = "AGT"+toStdDNAI 'H' = "ACT"+toStdDNAI 'V' = "ACG"+toStdDNAI 'N' = "ACGT"+toStdDNAI '?' = "ACGT"+toStdDNAI '-' = []+toStdDNAI '.' = []+toStdDNAI _ = error "toStdDNAI: Cannot convert to standard nucleotide."++protein :: AlphabetSpec+protein = fromChars "ACDEFGHIKLMNPQRSTVWY" [] [] [] toStdP++toStdP :: Char -> String+toStdP 'A' = "A"+toStdP 'C' = "C"+toStdP 'D' = "D"+toStdP 'E' = "E"+toStdP 'F' = "F"+toStdP 'G' = "G"+toStdP 'H' = "H"+toStdP 'I' = "I"+toStdP 'K' = "K"+toStdP 'L' = "L"+toStdP 'M' = "M"+toStdP 'N' = "N"+toStdP 'P' = "P"+toStdP 'Q' = "Q"+toStdP 'R' = "R"+toStdP 'S' = "S"+toStdP 'T' = "T"+toStdP 'V' = "V"+toStdP 'W' = "W"+toStdP 'Y' = "Y"+toStdP _ = error "toStdP: Cannot convert to standard amino acid."++proteinX :: AlphabetSpec+proteinX = fromChars "ACDEFGHIKLMNPQRSTVWY" "-." [] [] toStdPX++toStdPX :: Char -> String+toStdPX 'A' = "A"+toStdPX 'C' = "C"+toStdPX 'D' = "D"+toStdPX 'E' = "E"+toStdPX 'F' = "F"+toStdPX 'G' = "G"+toStdPX 'H' = "H"+toStdPX 'I' = "I"+toStdPX 'K' = "K"+toStdPX 'L' = "L"+toStdPX 'M' = "M"+toStdPX 'N' = "N"+toStdPX 'P' = "P"+toStdPX 'Q' = "Q"+toStdPX 'R' = "R"+toStdPX 'S' = "S"+toStdPX 'T' = "T"+toStdPX 'V' = "V"+toStdPX 'W' = "W"+toStdPX 'Y' = "Y"+toStdPX '-' = ""+toStdPX '.' = ""+toStdPX _ = error "toStdPX: Cannot convert to standard amino acid."++proteinS :: AlphabetSpec+proteinS = fromChars "ACDEFGHIKLMNPQRSTVWY" "-." [] "*" toStdPS++toStdPS :: Char -> String+toStdPS 'A' = "A"+toStdPS 'C' = "C"+toStdPS 'D' = "D"+toStdPS 'E' = "E"+toStdPS 'F' = "F"+toStdPS 'G' = "G"+toStdPS 'H' = "H"+toStdPS 'I' = "I"+toStdPS 'K' = "K"+toStdPS 'L' = "L"+toStdPS 'M' = "M"+toStdPS 'N' = "N"+toStdPS 'P' = "P"+toStdPS 'Q' = "Q"+toStdPS 'R' = "R"+toStdPS 'S' = "S"+toStdPS 'T' = "T"+toStdPS 'V' = "V"+toStdPS 'W' = "W"+toStdPS 'Y' = "Y"+toStdPS '-' = ""+toStdPS '.' = ""+toStdPS '*' = ""+toStdPS _ = error "toStdPS: Cannot convert to standard amino acid."++proteinI :: AlphabetSpec+proteinI = fromChars "ACDEFGHIKLMNPQRSTVWY" "-." "X?" "*JBZ" toStdPI++toStdPI :: Char -> String+toStdPI 'A' = "A"+toStdPI 'C' = "C"+toStdPI 'D' = "D"+toStdPI 'E' = "E"+toStdPI 'F' = "F"+toStdPI 'G' = "G"+toStdPI 'H' = "H"+toStdPI 'I' = "I"+toStdPI 'K' = "K"+toStdPI 'L' = "L"+toStdPI 'M' = "M"+toStdPI 'N' = "N"+toStdPI 'P' = "P"+toStdPI 'Q' = "Q"+toStdPI 'R' = "R"+toStdPI 'S' = "S"+toStdPI 'T' = "T"+toStdPI 'V' = "V"+toStdPI 'W' = "W"+toStdPI 'Y' = "Y"+toStdPI '-' = ""+toStdPI '.' = ""+toStdPI '*' = ""+toStdPI 'J' = "LI"+toStdPI 'B' = "DN"+toStdPI 'Z' = "EQ"+toStdPI 'X' = "ACDEFGHIKLMNPQRSTVWY"+toStdPI '?' = "ACDEFGHIKLMNPQRSTVWY"+toStdPI _ = error "toStdPI: Cannot convert to standard amino acid."

@@ -0,0 +1,76 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.Alphabet.Character+-- Description :  Alphabet characters+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Sun May 19 21:06:38 2019.+module ELynx.Alphabet.Character+  ( Character,+    toWord,+    fromWord,+    toChar,+    fromChar,+    toString,+    fromString,+    toCVec,+    fromCVec,+  )+where++import Data.ByteString.Internal (c2w, w2c)+import qualified Data.Vector.Unboxed as V+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Alphabet characters; abstracted so that representation can be changed at+-- some point.+newtype Character = Character Word8+  deriving (Read, Show, Eq, Ord, Bounded)++derivingUnbox+  "Character"+  [t|Character -> Word8|]+  [|\(Character w) -> w|]+  [|Character|]++-- | Conversion of 'Character's.+toWord :: Character -> Word8+toWord (Character w) = w++-- | Conversion of 'Character's.+fromWord :: Word8 -> Character+fromWord = Character++-- | Conversion of 'Character's.+toChar :: Character -> Char+toChar (Character w) = w2c w++-- | Conversion of 'Character's.+fromChar :: Char -> Character+fromChar = Character . c2w++-- | Conversion of 'Character's.+toString :: [Character] -> String+toString = map toChar++-- | Conversion of 'Character's.+fromString :: String -> [Character]+fromString = map fromChar++-- | Conversion of 'Character's.+toCVec :: C.Character a => V.Vector Character -> V.Vector a+toCVec = V.map (C.fromWord . toWord)++-- | Conversion of 'Character's.+fromCVec :: C.Character a => V.Vector a -> V.Vector Character+fromCVec = V.map (fromWord . C.toWord)

@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      :  ELynx.Alphabet.DistributionDiversity+-- Description :  Summarize statistics for alphabets+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Mon Feb 25 13:32:56 2019.+module ELynx.Alphabet.DistributionDiversity+  ( -- * Entropy+    entropy,+    kEffEntropy,++    -- * Homoplasy+    homoplasy,+    kEffHomoplasy,++    -- * Count characters+    frequencyCharacters,+  )+where++import qualified Data.Set as S+import Data.Vector.Generic+  ( Vector,+    toList,+  )+import qualified Data.Vector.Generic as V+import ELynx.Alphabet.Alphabet+import ELynx.Alphabet.Character++eps :: Double+eps = 1e-12++-- Calculate x*log(x) but set to 0.0 when x is smaller than 'eps'.+xLogX :: Double -> Double+xLogX x+  | x < 0.0 = error "Argument lower than zero."+  | eps > x = 0.0+  | otherwise = x * log x++-- | Entropy of vector.+entropy :: (Vector v Double) => v Double -> Double+entropy v =+  if isNaN res+    then+      error+        ("entropy: Sesult of following vector is NaN: " ++ show (toList v) ++ ".")+    else res+  where+    res = negate $ V.sum $ V.map xLogX v++-- | Effective number of used characters measured using 'entropy'. The result+-- only makes sense when the sum of the array is 1.0.+kEffEntropy :: Vector v Double => v Double -> Double+kEffEntropy v = if e < eps then 1.0 else exp e where e = entropy v++-- | Probability of homoplasy of vector. The result is the probability of+-- binomially sampling the same character twice and only makes sense when the+-- sum of the array is 1.0.+homoplasy :: Vector v Double => v Double -> Double+homoplasy v = V.sum $ V.map (\x -> x * x) v++-- | Effective number of used characters measured using 'homoplasy'. The result+-- only makes sense when the sum of the array is 1.0.+kEffHomoplasy :: Vector v Double => v Double -> Double+kEffHomoplasy v = 1.0 / homoplasy v++-- XXX: Use mutable vector; then V.// is much faster.+-- Increment element at index in vector by one.+incrementElemIndexByOne :: Vector v Int => [Int] -> v Int -> v Int+incrementElemIndexByOne is v = v V.// zip is es'+  where+    es' = [v V.! i + 1 | i <- is]++-- For a given code and counts vector, increment the count of the given character.+acc :: Vector v Int => AlphabetSpec -> v Int -> Character -> v Int+acc alph vec char = incrementElemIndexByOne is vec+  where+    is = [S.findIndex c (std alph) | c <- toStd alph char]++countCharacters ::+  (Vector v Character, Vector v Int) => AlphabetSpec -> v Character -> v Int+countCharacters alph = V.foldl' (acc alph) zeroCounts+  where+    nChars = length (std alph)+    zeroCounts = V.replicate nChars (0 :: Int)++saveDivision :: Int -> Int -> Double+saveDivision value divisor =+  if divisor == 0 then 0.0 else fromIntegral value / fromIntegral divisor++-- | For a given code vector of characters, calculate frequency of characters.+-- The input vector has arbitrary length (most often the number of sequences in+-- an alignment), the length of the output vector is the number of characters in+-- the alphabet.+frequencyCharacters ::+  (Vector v Character, Vector v Int, Vector v Double) =>+  AlphabetSpec ->+  v Character ->+  v Double+frequencyCharacters alph d = V.map (`saveDivision` s) counts+  where+    counts = countCharacters alph d+    s = V.sum counts

@@ -0,0 +1,113 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.AminoAcid+-- Description :  Amino acid related types and functions+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:26:35 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+--+-- Amino acids in alphabetical order.+--+-- @+-- Amino Acid Code:  Three letter Code:  Amino Acid:+-- ----------------  ------------------  -----------+-- A                 Ala                 Alanine+-- C                 Cys                 Cysteine+-- D                 Asp                 Aspartic Acid+-- E                 Glu                 Glutamic Acid+-- F                 Phe                 Phenylalanine+-- G                 Gly                 Glycine+-- H                 His                 Histidine+-- I                 Ile                 Isoleucine+-- K                 Lys                 Lysine+-- L                 Leu                 Leucine+-- M                 Met                 Methionine+-- N                 Asn                 Asparagine+-- P                 Pro                 Proline+-- Q                 Gln                 Glutamine+-- R                 Arg                 Arginine+-- S                 Ser                 Serine+-- T                 Thr                 Threonine+-- V                 Val                 Valine+-- W                 Trp                 Tryptophan+-- Y                 Tyr                 Tyrosine+-- @+module ELynx.Character.AminoAcid+  ( AminoAcid (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Amino acids.+data AminoAcid = A | C | D | E | F | G | H | I | K | L | M | N | P | Q | R | S | T | V | W | Y+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++toWord :: AminoAcid -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord D = c2w 'D'+toWord E = c2w 'E'+toWord F = c2w 'F'+toWord G = c2w 'G'+toWord H = c2w 'H'+toWord I = c2w 'I'+toWord K = c2w 'K'+toWord L = c2w 'L'+toWord M = c2w 'M'+toWord N = c2w 'N'+toWord P = c2w 'P'+toWord Q = c2w 'Q'+toWord R = c2w 'R'+toWord S = c2w 'S'+toWord T = c2w 'T'+toWord V = c2w 'V'+toWord W = c2w 'W'+toWord Y = c2w 'Y'++fromWord :: Word8 -> AminoAcid+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'D' -> D+  'E' -> E+  'F' -> F+  'G' -> G+  'H' -> H+  'I' -> I+  'K' -> K+  'L' -> L+  'M' -> M+  'N' -> N+  'P' -> P+  'Q' -> Q+  'R' -> R+  'S' -> S+  'T' -> T+  'V' -> V+  'W' -> W+  'Y' -> Y+  _ -> error "fromWord: Cannot convert to AminoAcid."++derivingUnbox+  "AminoAcid"+  [t|AminoAcid -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character AminoAcid where+  toWord = toWord+  fromWord = fromWord

@@ -0,0 +1,212 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.AminoAcid+-- Description :  Amino acid related types and functions+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:26:35 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+--+-- Amino acid IUPAC code. See also https://www.bioinformatics.org/sms/iupac.html or+-- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.+--+-- Remarks:+--+-- - Question marks (@?@) are interpreted as unknowns (same as @X@). However, when+--   a sequence is printed/exported, @X@s will be used.+--+-- - Full stops (@.@) are interpreted as gaps (same as @-@). However, when a+--   sequence is printed/exported, @-@s will be used+--+-- @+-- Amino Acid Code:  Three letter Code:  Amino Acid:+-- ----------------  ------------------  -----------+-- A                 Ala                 Alanine+-- C                 Cys                 Cysteine+-- D                 Asp                 Aspartic Acid+-- E                 Glu                 Glutamic Acid+-- F                 Phe                 Phenylalanine+-- G                 Gly                 Glycine+-- H                 His                 Histidine+-- I                 Ile                 Isoleucine+-- K                 Lys                 Lysine+-- L                 Leu                 Leucine+-- M                 Met                 Methionine+-- N                 Asn                 Asparagine+-- P                 Pro                 Proline+-- Q                 Gln                 Glutamine+-- R                 Arg                 Arginine+-- S                 Ser                 Serine+-- T                 Thr                 Threonine+-- V                 Val                 Valine+-- W                 Trp                 Tryptophan+-- Y                 Tyr                 Tyrosine+-- ----------------  ------------------  -----------+-- J                                     Leucine or Isoleucine+-- B                 Asx                 Aspartic acid or Asparagine+-- Z                 Glx                 Glutamine or Glutamic acid+-- ----------------  ------------------  -----------+-- X                 Xaa                 Any amino acid (preferred; used for printing)+-- ?                 Xaa                 Any amino acid+-- ----------------  ------------------  -----------+-- *                 Stp                 No amino acid+-- ----------------  ------------------  -----------+-- -                 Gap                 No amino acid (preferred; used for printing)+-- .                 Gap                 No amino acid+-- @+module ELynx.Character.AminoAcidI+  ( AminoAcidI (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Amino acids.+data AminoAcidI+  = A+  | C+  | D+  | E+  | F+  | G+  | H+  | I+  | K+  | L+  | M+  | N+  | P+  | Q+  | R+  | S+  | T+  | V+  | W+  | Y+  | J+  | B+  | Z+  | X+  | Stop+  | Gap+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++toWord :: AminoAcidI -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord D = c2w 'D'+toWord E = c2w 'E'+toWord F = c2w 'F'+toWord G = c2w 'G'+toWord H = c2w 'H'+toWord I = c2w 'I'+toWord K = c2w 'K'+toWord L = c2w 'L'+toWord M = c2w 'M'+toWord N = c2w 'N'+toWord P = c2w 'P'+toWord Q = c2w 'Q'+toWord R = c2w 'R'+toWord S = c2w 'S'+toWord T = c2w 'T'+toWord V = c2w 'V'+toWord W = c2w 'W'+toWord Y = c2w 'Y'+toWord J = c2w 'J'+toWord B = c2w 'B'+toWord Z = c2w 'Z'+toWord X = c2w 'X'+toWord Stop = c2w '*'+toWord Gap = c2w '-'++fromWord :: Word8 -> AminoAcidI+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'D' -> D+  'E' -> E+  'F' -> F+  'G' -> G+  'H' -> H+  'I' -> I+  'K' -> K+  'L' -> L+  'M' -> M+  'N' -> N+  'P' -> P+  'Q' -> Q+  'R' -> R+  'S' -> S+  'T' -> T+  'V' -> V+  'W' -> W+  'Y' -> Y+  'J' -> J+  'B' -> B+  'Z' -> Z+  'X' -> X+  -- Question marks code for @X@s.+  '?' -> X+  '*' -> Stop+  '-' -> Gap+  -- Full stops code for gaps (@-@s).+  '.' -> Gap+  _ -> error "fromWord: Cannot convert Word8 to AminoAcidI"++derivingUnbox+  "AminoAcidI"+  [t|AminoAcidI -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character AminoAcidI where+  toWord = toWord+  fromWord = fromWord++instance C.CharacterX AminoAcidI where+  gap = Gap++toStandard :: AminoAcidI -> [AminoAcidI]+toStandard A = [A]+toStandard C = [C]+toStandard D = [D]+toStandard E = [E]+toStandard F = [F]+toStandard G = [G]+toStandard H = [H]+toStandard I = [I]+toStandard K = [K]+toStandard L = [L]+toStandard M = [M]+toStandard N = [N]+toStandard P = [P]+toStandard Q = [Q]+toStandard R = [R]+toStandard S = [S]+toStandard T = [T]+toStandard V = [V]+toStandard W = [W]+toStandard Y = [Y]+toStandard J = [L, I]+toStandard B = [D, N]+toStandard Z = [E, Q]+toStandard X = [A, C, D, E, F, G, H, I, K, L, M, N, P, Q, R, S, T, V, W, Y]+toStandard Stop = []+toStandard Gap = []++instance C.CharacterI AminoAcidI where+  unknown = X+  iupac = [J, B, Z, X]+  toStandard = toStandard

@@ -0,0 +1,148 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.AminoAcid+-- Description :  Amino acid related types and functions+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:26:35 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+--+-- Amino acids with gaps and translation stops.+--+-- @+-- Amino Acid Code:  Three letter Code:  Amino Acid:+-- ----------------  ------------------  -----------+-- A                 Ala                 Alanine+-- C                 Cys                 Cysteine+-- D                 Asp                 Aspartic Acid+-- E                 Glu                 Glutamic Acid+-- F                 Phe                 Phenylalanine+-- G                 Gly                 Glycine+-- H                 His                 Histidine+-- I                 Ile                 Isoleucine+-- K                 Lys                 Lysine+-- L                 Leu                 Leucine+-- M                 Met                 Methionine+-- N                 Asn                 Asparagine+-- P                 Pro                 Proline+-- Q                 Gln                 Glutamine+-- R                 Arg                 Arginine+-- S                 Ser                 Serine+-- T                 Thr                 Threonine+-- V                 Val                 Valine+-- W                 Trp                 Tryptophan+-- Y                 Tyr                 Tyrosine+-- ----------------  ------------------  -----------+-- *                 Stp                 No amino acid+-- ----------------  ------------------  -----------+-- -                 Gap                 No amino acid (preferred)+-- .                 Gap                 No amino acid+-- @+module ELynx.Character.AminoAcidS+  ( AminoAcidS (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Amino acids.+data AminoAcidS+  = A+  | C+  | D+  | E+  | F+  | G+  | H+  | I+  | K+  | L+  | M+  | N+  | P+  | Q+  | R+  | S+  | T+  | V+  | W+  | Y+  | Stop+  | Gap+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++toWord :: AminoAcidS -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord D = c2w 'D'+toWord E = c2w 'E'+toWord F = c2w 'F'+toWord G = c2w 'G'+toWord H = c2w 'H'+toWord I = c2w 'I'+toWord K = c2w 'K'+toWord L = c2w 'L'+toWord M = c2w 'M'+toWord N = c2w 'N'+toWord P = c2w 'P'+toWord Q = c2w 'Q'+toWord R = c2w 'R'+toWord S = c2w 'S'+toWord T = c2w 'T'+toWord V = c2w 'V'+toWord W = c2w 'W'+toWord Y = c2w 'Y'+toWord Stop = c2w '*'+toWord Gap = c2w '-'++fromWord :: Word8 -> AminoAcidS+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'D' -> D+  'E' -> E+  'F' -> F+  'G' -> G+  'H' -> H+  'I' -> I+  'K' -> K+  'L' -> L+  'M' -> M+  'N' -> N+  'P' -> P+  'Q' -> Q+  'R' -> R+  'S' -> S+  'T' -> T+  'V' -> V+  'W' -> W+  'Y' -> Y+  '*' -> Stop+  '-' -> Gap+  '.' -> Gap+  _ -> error "fromWord: Cannot convert to AminoAcidS."++derivingUnbox+  "AminoAcidS"+  [t|AminoAcidS -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character AminoAcidS where+  toWord = toWord+  fromWord = fromWord++instance C.CharacterX AminoAcidS where+  gap = Gap

@@ -0,0 +1,145 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.AminoAcid+-- Description :  Amino acid related types and functions+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:26:35 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+--+-- Extended amino acid with gaps. See also+-- https://www.bioinformatics.org/sms/iupac.html or+-- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.+--+-- @+-- Amino Acid Code:  Three letter Code:  Amino Acid:+-- ----------------  ------------------  -----------+-- A                 Ala                 Alanine+-- C                 Cys                 Cysteine+-- D                 Asp                 Aspartic Acid+-- E                 Glu                 Glutamic Acid+-- F                 Phe                 Phenylalanine+-- G                 Gly                 Glycine+-- H                 His                 Histidine+-- I                 Ile                 Isoleucine+-- K                 Lys                 Lysine+-- L                 Leu                 Leucine+-- M                 Met                 Methionine+-- N                 Asn                 Asparagine+-- P                 Pro                 Proline+-- Q                 Gln                 Glutamine+-- R                 Arg                 Arginine+-- S                 Ser                 Serine+-- T                 Thr                 Threonine+-- V                 Val                 Valine+-- W                 Trp                 Tryptophan+-- Y                 Tyr                 Tyrosine+-- ----------------  ------------------  -----------+-- -                 Gap                 No amino acid+-- .                 Gap                 No amino acid+-- @+module ELynx.Character.AminoAcidX+  ( AminoAcidX (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Amino acids.+data AminoAcidX+  = A+  | C+  | D+  | E+  | F+  | G+  | H+  | I+  | K+  | L+  | M+  | N+  | P+  | Q+  | R+  | S+  | T+  | V+  | W+  | Y+  | Gap+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++toWord :: AminoAcidX -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord D = c2w 'D'+toWord E = c2w 'E'+toWord F = c2w 'F'+toWord G = c2w 'G'+toWord H = c2w 'H'+toWord I = c2w 'I'+toWord K = c2w 'K'+toWord L = c2w 'L'+toWord M = c2w 'M'+toWord N = c2w 'N'+toWord P = c2w 'P'+toWord Q = c2w 'Q'+toWord R = c2w 'R'+toWord S = c2w 'S'+toWord T = c2w 'T'+toWord V = c2w 'V'+toWord W = c2w 'W'+toWord Y = c2w 'Y'+toWord Gap = c2w '-'++fromWord :: Word8 -> AminoAcidX+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'D' -> D+  'E' -> E+  'F' -> F+  'G' -> G+  'H' -> H+  'I' -> I+  'K' -> K+  'L' -> L+  'M' -> M+  'N' -> N+  'P' -> P+  'Q' -> Q+  'R' -> R+  'S' -> S+  'T' -> T+  'V' -> V+  'W' -> W+  'Y' -> Y+  '-' -> Gap+  '.' -> Gap+  _ -> error "fromWord: Cannot convert to AminoAcidX."++derivingUnbox+  "AminoAcidX"+  [t|AminoAcidX -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character AminoAcidX where+  toWord = toWord+  fromWord = fromWord++instance C.CharacterX AminoAcidX where+  gap = Gap

@@ -0,0 +1,94 @@+-- |+-- Module      :  Character+-- Description :  Character interface+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Oct 12 16:24:02 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+module ELynx.Character.Character+  ( Character (..),+    fromChar,+    toChar,+    fromString,+    toString,+    CharacterX (..),+    isGap,+    CharacterI (..),+    isUnknown,+    isIUPAC,+    isStandard,+    convert,+  )+where++import Data.ByteString.Internal (c2w, w2c)+import qualified Data.Set as S+import Data.Vector.Unboxed.Base (Unbox)+import Data.Word8 (Word8)++-- XXX: Remove name clash with ELynx.Alphabet.Alphabet.Character?++-- | A set of characters forms an 'ELynx.Alphabet.Alphabet'. At the+-- moment, 'Word8' is used, since none of the alphabets has more than 255+-- characters.+class (Show a, Read a, Eq a, Ord a, Enum a, Bounded a, Unbox a) => Character a where+  -- | Write characters.+  toWord :: a -> Word8++  -- | Read characters.+  fromWord :: Word8 -> a++-- | Conversion to 'Char'.+toChar :: Character a => a -> Char+toChar = w2c . toWord++-- | Conversion from 'Char'.+fromChar :: Character a => Char -> a+fromChar = fromWord . c2w++-- | Conversion to 'String'.+toString :: Character a => [a] -> String+toString = map toChar++-- | Conversion from 'String'.+fromString :: Character a => String -> [a]+fromString = map fromChar++-- | An extended character type with gaps and unknowns.+class Character a => CharacterX a where+  gap :: a++-- | Is the character a gap or unknown?+isGap :: CharacterX a => a -> Bool+isGap c = c == gap++-- | IUPAC characters with a mapping to extended characters.+class CharacterX a => CharacterI a where+  unknown :: a+  iupac :: [a]+  toStandard :: a -> [a]++-- | Check if a IUPAC 'CharacterI' is unknown (e.g., N for nucleotides).+isUnknown :: CharacterI a => a -> Bool+isUnknown c = c == unknown++iupacLookup :: CharacterI a => S.Set a+iupacLookup = S.fromList iupac++-- | Is the given character a IUPAC character?+isIUPAC :: CharacterI a => a -> Bool+isIUPAC c = c `S.member` iupacLookup++-- | Is the given character a standard character?+isStandard :: CharacterI a => a -> Bool+isStandard c = not $ isIUPAC c++-- | Convert between character classes. May throw error.+convert :: (Character a, Character b) => a -> b+convert = fromWord . toWord

@@ -0,0 +1,258 @@+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module      :  ELynx.Character.Codon+-- Description :  Codons are triplets of nucleotides+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu May 16 07:58:50 2019.+--+-- The different universal codes.+-- - https://www.ncbi.nlm.nih.gov/Taxonomy/Utils/wprintgc.cgi?mode=c+-- - http://www.bioinformatics.org/sms2/genetic_code.html+-- - https://en.wikipedia.org/wiki/Genetic_code+module ELynx.Character.Codon+  ( Codon (Codon),+    fromVecUnsafe,+    UniversalCode (..),+    translate,+    translateX,+    translateI,+  )+where++import Data.Aeson+  ( FromJSON,+    ToJSON,+  )+import Data.List+import qualified Data.Map as M+import qualified Data.Vector.Generic as V+import qualified ELynx.Character.AminoAcidI as AI+import ELynx.Character.AminoAcidS+import qualified ELynx.Character.Character as C+import qualified ELynx.Character.Nucleotide as N+import qualified ELynx.Character.NucleotideI as NI+import qualified ELynx.Character.NucleotideX as NX+import GHC.Generics (Generic)++-- | Codons are triplets of characters.+newtype Codon a = Codon (a, a, a)+  deriving (Show, Read, Eq, Ord)++convert :: (C.Character a, C.Character b) => Codon a -> Codon b+convert (Codon (x, y, z)) = Codon (C.convert x, C.convert y, C.convert z)++-- | Unsafe conversion from vector with at least three elements; only the first+-- three elements are used, the rest is discarded.+fromVecUnsafe :: V.Vector v a => v a -> Codon a+fromVecUnsafe xs =+  Codon (V.head xs, V.head . V.tail $ xs, V.head . V.tail . V.tail $ xs)++-- | Universal codes.+data UniversalCode = Standard | VertebrateMitochondrial+  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)++instance FromJSON UniversalCode++instance ToJSON UniversalCode++-- It is important that the map is lazy, because some keys have errors as values.+mapFromLists :: Ord a => [a] -> [a] -> [a] -> [b] -> M.Map (Codon a) b+mapFromLists xs ys zs as =+  M.fromList $ zipWith4 (\f s t a -> (Codon (f, s, t), a)) xs ys zs as++nucs :: Enum a => [a]+nucs = map toEnum [3, 1, 0, 2] -- Order T, C, A , G.++-- Permutation of the triplets PLUS GAPS! I avoid 'Z' because I do not want to+-- translate DNAI.+base1, base2, base3 :: Enum a => [a]+base1 = [n | n <- nucs, _ <- [0 .. 3 :: Int], _ <- [0 .. 3 :: Int]]+-- base1 = "TTTTTTTTTTTTTTTTCCCCCCCCCCCCCCCCAAAAAAAAAAAAAAAAGGGGGGGGGGGGGGGG" ++ "-."+base2 = [n | _ <- [0 .. 3 :: Int], n <- nucs, _ <- [0 .. 3 :: Int]]+-- base2 = "TTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGG" ++ "-."+base3 = [n | _ <- [0 .. 3 :: Int], _ <- [0 .. 3 :: Int], n <- nucs]++-- base3 = "TCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAG" ++ "-."++-- The actual codes.+standard :: [AminoAcidS]+standard =+  [ F,+    F,+    L,+    L,+    S,+    S,+    S,+    S,+    Y,+    Y,+    Stop,+    Stop,+    C,+    C,+    Stop,+    W,+    L,+    L,+    L,+    L,+    P,+    P,+    P,+    P,+    H,+    H,+    Q,+    Q,+    R,+    R,+    R,+    R,+    I,+    I,+    I,+    M,+    T,+    T,+    T,+    T,+    N,+    N,+    K,+    K,+    S,+    S,+    R,+    R,+    V,+    V,+    V,+    V,+    A,+    A,+    A,+    A,+    D,+    D,+    E,+    E,+    G,+    G,+    G,+    G+  ]++-- "FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG" ++ "--"++vertebrateMitochondrial :: [AminoAcidS]+vertebrateMitochondrial =+  [ F,+    F,+    L,+    L,+    S,+    S,+    S,+    S,+    Y,+    Y,+    Stop,+    Stop,+    C,+    C,+    W,+    W,+    L,+    L,+    L,+    L,+    P,+    P,+    P,+    P,+    H,+    H,+    Q,+    Q,+    R,+    R,+    R,+    R,+    I,+    I,+    M,+    M,+    T,+    T,+    T,+    T,+    N,+    N,+    K,+    K,+    S,+    S,+    Stop,+    Stop,+    V,+    V,+    V,+    V,+    A,+    A,+    A,+    A,+    D,+    D,+    E,+    E,+    G,+    G,+    G,+    G+  ]++-- "FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSS**VVVVAAAADDEEGGGG" ++ "--"++-- | Translate a codon to amino acids including translation stops.+translate :: UniversalCode -> Codon N.Nucleotide -> AminoAcidS+translate code = (M.!) (universalCode code)++-- | Translate a codon to amino acids including translation stops. Translate+-- codons including gaps to amino acid gaps. Be careful, single or two character+-- gaps can lead to a reading frame shift and hence, the translated sequence may+-- be bogus.+translateX :: UniversalCode -> Codon NX.NucleotideX -> AminoAcidS+-- translateX _ (Codon (NX.Gap, NX.Gap, NX.Gap)) = Gap+-- translateX code codon                         = C.convert . translate code . convert $ codon+translateX code codon@(Codon (x, y, z))+  | C.isGap x || C.isGap y || C.isGap z = Gap+  | otherwise = C.convert . translate code . convert $ codon++-- | Translate a codon to amino acids including translation stops. Translate gap+-- triplets to amino acid gaps, and triplets including unknowns to amino acid+-- unknowns. Be careful, also translates other IUPAC characters to amino acid Xs!+translateI :: UniversalCode -> Codon NI.NucleotideI -> AI.AminoAcidI+translateI code codon@(Codon (x, y, z))+  | C.isIUPAC x || C.isIUPAC y || C.isIUPAC z = AI.X+  | otherwise = C.convert . translateX code . convert $ codon++-- translateI :: UniversalCode -> Codon NI.NucleotideI -> AI.AminoAcidI+-- translateI _ (Codon (NI.N, _,    _   )) = AI.X+-- translateI _ (Codon (_   , NI.N, _   )) = AI.X+-- translateI _ (Codon (_,    _,    NI.N)) = AI.X+-- translateI code codon                   = C.convert . translateX code . convert $ codon++-- Map from 'Codon' to amino acid character.+universalCode :: UniversalCode -> M.Map (Codon N.Nucleotide) AminoAcidS+universalCode Standard = mapFromLists base1 base2 base3 standard+universalCode VertebrateMitochondrial =+  mapFromLists base1 base2 base3 vertebrateMitochondrial

@@ -0,0 +1,67 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.Nucleotide+-- Description :  Nucleotides+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:26:35 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+--+-- @+-- Symbol  Description  Bases represented  Complement+-- ------  -----------  -----------------  ----------+-- A       Adenine      A                  T+-- C       Cytosine        C               G+-- G       Guanine            G            C+-- T       Thymine               T         A+-- @+module ELynx.Character.Nucleotide+  ( Nucleotide (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Nucleotides.+data Nucleotide = A | C | G | T+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++-- See https://stackoverflow.com/a/31527024; apparently, pattern matching (and+-- case statements) are fast because they are compiled to lookup tables. Hence,+-- they are faster than guards (because equality has to be checked), and faster+-- than lookups with sets.+toWord :: Nucleotide -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord G = c2w 'G'+toWord T = c2w 'T'++fromWord :: Word8 -> Nucleotide+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'G' -> G+  'T' -> T+  c -> error $ "fromWord: Cannot convert " ++ show c ++ " to Nucleotide."++derivingUnbox+  "Nucleotide"+  [t|Nucleotide -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character Nucleotide where+  toWord = toWord+  fromWord = fromWord

@@ -0,0 +1,168 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.NucleotideI+-- Description :  Nucleotides with IUPAC characters+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:26:35 2018.+--+-- See header of 'ELynx.Alphabet.Alphabet'.+--+-- Nucleotide IUPAC code. See also https://www.bioinformatics.org/sms/iupac.html or+-- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.+--+-- Remarks:+--+-- - Question marks (@?@) are interpreted as unknowns (same as @N@). However, when+--   a sequence is printed/exported, @N@s will be used.+--+-- - Full stops (@.@) are interpreted as gaps (same as @-@). However, when a+--   sequence is printed/exported, @-@s will be used+--+-- @+-- Symbol  Description  Bases represented  Complement+-- ------  -----------  -----------------  ----------+-- A       Adenine      A                  T+-- C       Cytosine        C               G+-- G       Guanine            G            C+-- T       Thymine               T         A+-- ------  -----------  -----------------  ----------+-- U       Uracil                U         A+-- W       Weak         A        T         W+-- S       Strong          C  G            S+-- M       aMino        A  C               K+-- K       Keto               G  T         M+-- R       puRine       A     G            Y+-- Y       pYrimidine      C     T         R+-- B       not A           C  G  T         V+-- D       not C        A     G  T         H+-- H       not G        A  C     T         D+-- V       not T        A  C  G            B+-- ------  -----------  -----------------  ----------+-- N       any          A  C  G  T         N           (preferred)+-- ?       any          A  C  G  T         N+-- ------  -----------  -----------------  ----------+-- -       Gap (Zero)                      -           (preferred)+-- .       Gap (Zero)                      -+-- @+module ELynx.Character.NucleotideI+  ( NucleotideI (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | NucleotideIs.+data NucleotideI+  = A+  | C+  | G+  | T+  | U+  | W+  | S+  | M+  | K+  | R+  | Y+  | B+  | D+  | H+  | V+  | N+  | Gap+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++-- See https://stackoverflow.com/a/31527024; apparently, pattern matching (and+-- case statements) are fast because they are compiled to lookup tables. Hence,+-- they are faster than guards (because equality has to be checked), and faster+-- than lookups with sets.+toWord :: NucleotideI -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord G = c2w 'G'+toWord T = c2w 'T'+toWord U = c2w 'U'+toWord W = c2w 'W'+toWord S = c2w 'S'+toWord M = c2w 'M'+toWord K = c2w 'K'+toWord R = c2w 'R'+toWord Y = c2w 'Y'+toWord B = c2w 'B'+toWord D = c2w 'D'+toWord H = c2w 'H'+toWord V = c2w 'V'+toWord N = c2w 'N'+toWord Gap = c2w '-'++fromWord :: Word8 -> NucleotideI+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'G' -> G+  'T' -> T+  'U' -> U+  'W' -> W+  'S' -> S+  'M' -> M+  'K' -> K+  'R' -> R+  'Y' -> Y+  'B' -> B+  'D' -> D+  'H' -> H+  'V' -> V+  'N' -> N+  '?' -> N+  '-' -> Gap+  '.' -> Gap+  _ -> error "fromWord: Cannot convert to NucleotideI."++derivingUnbox+  "NucleotideI"+  [t|NucleotideI -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character NucleotideI where+  toWord = toWord+  fromWord = fromWord++toStandard :: NucleotideI -> [NucleotideI]+toStandard A = [A]+toStandard C = [C]+toStandard G = [G]+toStandard T = [T]+toStandard U = [T]+toStandard W = [A, T]+toStandard S = [G, C]+toStandard M = [A, C]+toStandard K = [G, T]+toStandard R = [A, G]+toStandard Y = [C, T]+toStandard B = [C, G, T]+toStandard D = [A, G, T]+toStandard H = [A, C, T]+toStandard V = [A, C, G]+toStandard N = [A, C, G, T]+toStandard Gap = []++instance C.CharacterX NucleotideI where+  gap = Gap++instance C.CharacterI NucleotideI where+  unknown = N+  iupac = [U, W, S, M, K, R, Y, B, D, H, V, N]+  toStandard = toStandard

@@ -0,0 +1,79 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      :  ELynx.NucleotideX+-- Description :  Extended nucleotides including gaps and unknowns+-- Copyright   :  (c) Dominik Schrempf 2021+--+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- See header of 'ELynx.Alphabet'.+--+-- Extended nucleotides with gaps. See also+-- https://www.bioinformatics.org/sms/iupac.html or+-- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.+--+-- @+-- Symbol  Description  Bases represented  Complement+-- ------  -----------  -----------------  ----------+-- A       Adenine      A                  T+-- C       Cytosine        C               G+-- G       Guanine            G            C+-- T       Thymine               T         A+-- ------  -----------  -----------------  ----------+-- - or .  Gap (Zero)                      -+-- @+module ELynx.Character.NucleotideX+  ( NucleotideX (..),+  )+where++import Data.ByteString.Internal (c2w, w2c)+import Data.Vector.Unboxed.Deriving+import Data.Word8+import qualified ELynx.Character.Character as C++-- | Extended nucleotides.+data NucleotideX+  = A+  | C+  | G+  | T+  | Gap+  deriving (Show, Read, Eq, Ord, Enum, Bounded)++toWord :: NucleotideX -> Word8+toWord A = c2w 'A'+toWord C = c2w 'C'+toWord G = c2w 'G'+toWord T = c2w 'T'+toWord Gap = c2w '-'++fromWord :: Word8 -> NucleotideX+fromWord w = case w2c w of+  'A' -> A+  'C' -> C+  'G' -> G+  'T' -> T+  '-' -> Gap+  '.' -> Gap+  c -> error $ "fromWord: Cannot convert " ++ show c ++ " to NucleotideX."++derivingUnbox+  "NucleotideX"+  [t|NucleotideX -> Word8|]+  [|toWord|]+  [|fromWord|]++instance C.Character NucleotideX where+  toWord = toWord+  fromWord = fromWord++instance C.CharacterX NucleotideX where+  gap = Gap

@@ -1,310 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}---- |--- Module      :  ELynx.Data.Alphabet.Alphabet--- Description :  Alphabets store hereditary information--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable------ Portability :  portable------ Creation date: Fri May 10 11:10:32 2019.------ Hierarchy:------ 1. 'Character' type.------ 2. Sets of 'Character's form 'Alphabet's; each 'Alphabet' has a specification--- 'AlphabetSpec'.------ New alphabets have to be added manually to this module.------ This way of handling characters and alphabets IS NOT TYPE SAFE, but much, much--- faster. A second layer of modules such as 'ELynx.Data.Character.Nucleotide'--- depend on a 'ELynx.Data.Character.Character.Character' type class. Hence, they--- provide a type safe way of handling alphabets. Conversion is possible, for--- instance, with 'ELynx.Data.Alphabet.Character.fromCVec', and--- 'ELynx.Data.Alphabet.Character.toCVec'.-module ELynx.Data.Alphabet.Alphabet-  ( Alphabet (..),-    AlphabetSpec (..),-    alphabetSpec,-    alphabetDescription,-    isStd,-    isGap,-    isUnknown,-    isIUPAC,-    isMember,-  )-where--import Data.Aeson-  ( FromJSON,-    ToJSON,-  )-import qualified Data.Set as S-import ELynx.Data.Alphabet.Character-import GHC.Generics (Generic)-import Prelude hiding (all)---- | Available alphabets; for details see 'alphabetSpec'.-data Alphabet-  = DNA-  | DNAX-  | DNAI-  | Protein-  | ProteinX-  | ProteinS-  | ProteinI-  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)--instance FromJSON Alphabet--instance ToJSON Alphabet---- | Verbose alphabet name.-alphabetDescription :: Alphabet -> String-alphabetDescription DNA = "DNA (nucleotides)"-alphabetDescription DNAX = "DNAX (nucleotides; including gaps)"-alphabetDescription DNAI =-  "DNAI (nucleotides; including gaps, and IUPAC codes)"-alphabetDescription Protein = "Protein (amino acids)"-alphabetDescription ProteinX = "ProteinX (amino acids; including gaps)"-alphabetDescription ProteinS =-  "ProteinS (amino acids; including gaps, and translation stops)"-alphabetDescription ProteinI =-  "ProteinI (amino acids; including gaps, translation stops, and IUPAC codes)"---- | Alphabet specification. 'S.Set' is used because it provides fast lookups.-data AlphabetSpec = AlphabetSpec-  { -- | Standard characters.-    std :: !(S.Set Character),-    -- | Gap characters.-    gap :: !(S.Set Character),-    -- | Unknown characters.-    unknown :: !(S.Set Character),-    -- | Other IUPAC codes.-    iupac :: !(S.Set Character),-    -- | All characters in the alphabet.-    all :: !(S.Set Character),-    -- | Convert from IUPAC to the corresponding standard characters.-    toStd :: Character -> [Character]-  }---- Create alphabet spec.-fromChars ::-  String -> String -> String -> String -> (Char -> String) -> AlphabetSpec-fromChars st ga un iu to =-  AlphabetSpec-    st'-    ga'-    un'-    iu'-    al-    (fromString . to . toChar)-  where-    st' = S.fromList $ fromString st-    ga' = S.fromList $ fromString ga-    un' = S.fromList $ fromString un-    iu' = S.fromList $ fromString iu-    al = S.unions [st', ga', un', iu']---- | Get the alphabet specification for a given alphabet.-alphabetSpec :: Alphabet -> AlphabetSpec-alphabetSpec DNA = dna-alphabetSpec DNAX = dnaX-alphabetSpec DNAI = dnaI-alphabetSpec Protein = protein-alphabetSpec ProteinX = proteinX-alphabetSpec ProteinS = proteinS-alphabetSpec ProteinI = proteinI--isWith :: (AlphabetSpec -> S.Set Character) -> Alphabet -> Character -> Bool-isWith set alph char = char `S.member` set (alphabetSpec alph)---- | Test if standard character.-isStd :: Alphabet -> Character -> Bool-isStd = isWith std---- | Test if gap.-isGap :: Alphabet -> Character -> Bool-isGap = isWith gap---- | Test if unknown.-isUnknown :: Alphabet -> Character -> Bool-isUnknown = isWith unknown---- | Test if extended IUPAC character (excluding gaps and unknowns).-isIUPAC :: Alphabet -> Character -> Bool-isIUPAC = isWith iupac---- | Test if member of alphabet.-isMember :: Alphabet -> Character -> Bool-isMember = isWith all--dna :: AlphabetSpec-dna = fromChars "ACGT" [] [] [] toStdDNA--toStdDNA :: Char -> String-toStdDNA 'A' = "A"-toStdDNA 'C' = "C"-toStdDNA 'G' = "G"-toStdDNA 'T' = "T"-toStdDNA _ = error "tostdDNA: Cannot convert to standard nucleotide."--dnaX :: AlphabetSpec-dnaX = fromChars "ACGT" "-." [] [] toStdDNAX--toStdDNAX :: Char -> String-toStdDNAX 'A' = "A"-toStdDNAX 'C' = "C"-toStdDNAX 'G' = "G"-toStdDNAX 'T' = "T"-toStdDNAX '-' = []-toStdDNAX '.' = []-toStdDNAX _ = error "toStdDNAX: Cannot convert to standard nucleotide."--dnaI :: AlphabetSpec-dnaI = fromChars "ACGT" "-." "N?" "UWSMKRYBDHV" toStdDNAI--toStdDNAI :: Char -> String-toStdDNAI 'A' = "A"-toStdDNAI 'C' = "C"-toStdDNAI 'G' = "G"-toStdDNAI 'T' = "T"-toStdDNAI 'U' = "T"-toStdDNAI 'W' = "AT"-toStdDNAI 'S' = "GC"-toStdDNAI 'M' = "AC"-toStdDNAI 'K' = "GT"-toStdDNAI 'R' = "AG"-toStdDNAI 'Y' = "CT"-toStdDNAI 'B' = "CGT"-toStdDNAI 'D' = "AGT"-toStdDNAI 'H' = "ACT"-toStdDNAI 'V' = "ACG"-toStdDNAI 'N' = "ACGT"-toStdDNAI '?' = "ACGT"-toStdDNAI '-' = []-toStdDNAI '.' = []-toStdDNAI _ = error "toStdDNAI: Cannot convert to standard nucleotide."--protein :: AlphabetSpec-protein = fromChars "ACDEFGHIKLMNPQRSTVWY" [] [] [] toStdP--toStdP :: Char -> String-toStdP 'A' = "A"-toStdP 'C' = "C"-toStdP 'D' = "D"-toStdP 'E' = "E"-toStdP 'F' = "F"-toStdP 'G' = "G"-toStdP 'H' = "H"-toStdP 'I' = "I"-toStdP 'K' = "K"-toStdP 'L' = "L"-toStdP 'M' = "M"-toStdP 'N' = "N"-toStdP 'P' = "P"-toStdP 'Q' = "Q"-toStdP 'R' = "R"-toStdP 'S' = "S"-toStdP 'T' = "T"-toStdP 'V' = "V"-toStdP 'W' = "W"-toStdP 'Y' = "Y"-toStdP _ = error "toStdP: Cannot convert to standard amino acid."--proteinX :: AlphabetSpec-proteinX = fromChars "ACDEFGHIKLMNPQRSTVWY" "-." [] [] toStdPX--toStdPX :: Char -> String-toStdPX 'A' = "A"-toStdPX 'C' = "C"-toStdPX 'D' = "D"-toStdPX 'E' = "E"-toStdPX 'F' = "F"-toStdPX 'G' = "G"-toStdPX 'H' = "H"-toStdPX 'I' = "I"-toStdPX 'K' = "K"-toStdPX 'L' = "L"-toStdPX 'M' = "M"-toStdPX 'N' = "N"-toStdPX 'P' = "P"-toStdPX 'Q' = "Q"-toStdPX 'R' = "R"-toStdPX 'S' = "S"-toStdPX 'T' = "T"-toStdPX 'V' = "V"-toStdPX 'W' = "W"-toStdPX 'Y' = "Y"-toStdPX '-' = ""-toStdPX '.' = ""-toStdPX _ = error "toStdPX: Cannot convert to standard amino acid."--proteinS :: AlphabetSpec-proteinS = fromChars "ACDEFGHIKLMNPQRSTVWY" "-." [] "*" toStdPS--toStdPS :: Char -> String-toStdPS 'A' = "A"-toStdPS 'C' = "C"-toStdPS 'D' = "D"-toStdPS 'E' = "E"-toStdPS 'F' = "F"-toStdPS 'G' = "G"-toStdPS 'H' = "H"-toStdPS 'I' = "I"-toStdPS 'K' = "K"-toStdPS 'L' = "L"-toStdPS 'M' = "M"-toStdPS 'N' = "N"-toStdPS 'P' = "P"-toStdPS 'Q' = "Q"-toStdPS 'R' = "R"-toStdPS 'S' = "S"-toStdPS 'T' = "T"-toStdPS 'V' = "V"-toStdPS 'W' = "W"-toStdPS 'Y' = "Y"-toStdPS '-' = ""-toStdPS '.' = ""-toStdPS '*' = ""-toStdPS _ = error "toStdPS: Cannot convert to standard amino acid."--proteinI :: AlphabetSpec-proteinI = fromChars "ACDEFGHIKLMNPQRSTVWY" "-." "X?" "*JBZ" toStdPI--toStdPI :: Char -> String-toStdPI 'A' = "A"-toStdPI 'C' = "C"-toStdPI 'D' = "D"-toStdPI 'E' = "E"-toStdPI 'F' = "F"-toStdPI 'G' = "G"-toStdPI 'H' = "H"-toStdPI 'I' = "I"-toStdPI 'K' = "K"-toStdPI 'L' = "L"-toStdPI 'M' = "M"-toStdPI 'N' = "N"-toStdPI 'P' = "P"-toStdPI 'Q' = "Q"-toStdPI 'R' = "R"-toStdPI 'S' = "S"-toStdPI 'T' = "T"-toStdPI 'V' = "V"-toStdPI 'W' = "W"-toStdPI 'Y' = "Y"-toStdPI '-' = ""-toStdPI '.' = ""-toStdPI '*' = ""-toStdPI 'J' = "LI"-toStdPI 'B' = "DN"-toStdPI 'Z' = "EQ"-toStdPI 'X' = "ACDEFGHIKLMNPQRSTVWY"-toStdPI '?' = "ACDEFGHIKLMNPQRSTVWY"-toStdPI _ = error "toStdPI: Cannot convert to standard amino acid."

@@ -1,76 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.Alphabet.Character--- Description :  Alphabet characters--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Sun May 19 21:06:38 2019.-module ELynx.Data.Alphabet.Character-  ( Character,-    toWord,-    fromWord,-    toChar,-    fromChar,-    toString,-    fromString,-    toCVec,-    fromCVec,-  )-where--import Data.ByteString.Internal (c2w, w2c)-import qualified Data.Vector.Unboxed as V-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Alphabet characters; abstracted so that representation can be changed at--- some point.-newtype Character = Character Word8-  deriving (Read, Show, Eq, Ord, Bounded)--derivingUnbox-  "Character"-  [t|Character -> Word8|]-  [|\(Character w) -> w|]-  [|Character|]---- | Conversion of 'Character's.-toWord :: Character -> Word8-toWord (Character w) = w---- | Conversion of 'Character's.-fromWord :: Word8 -> Character-fromWord = Character---- | Conversion of 'Character's.-toChar :: Character -> Char-toChar (Character w) = w2c w---- | Conversion of 'Character's.-fromChar :: Char -> Character-fromChar = Character . c2w---- | Conversion of 'Character's.-toString :: [Character] -> String-toString = map toChar---- | Conversion of 'Character's.-fromString :: String -> [Character]-fromString = map fromChar---- | Conversion of 'Character's.-toCVec :: C.Character a => V.Vector Character -> V.Vector a-toCVec = V.map (C.fromWord . toWord)---- | Conversion of 'Character's.-fromCVec :: C.Character a => V.Vector a -> V.Vector Character-fromCVec = V.map (fromWord . C.toWord)

@@ -1,110 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- |--- Module      :  ELynx.Data.Alphabet.DistributionDiversity--- Description :  Summarize statistics for alphabets--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Mon Feb 25 13:32:56 2019.-module ELynx.Data.Alphabet.DistributionDiversity-  ( -- * Entropy-    entropy,-    kEffEntropy,--    -- * Homoplasy-    homoplasy,-    kEffHomoplasy,--    -- * Count characters-    frequencyCharacters,-  )-where--import qualified Data.Set as S-import Data.Vector.Generic-  ( Vector,-    toList,-  )-import qualified Data.Vector.Generic as V-import ELynx.Data.Alphabet.Alphabet-import ELynx.Data.Alphabet.Character--eps :: Double-eps = 1e-12---- Calculate x*log(x) but set to 0.0 when x is smaller than 'eps'.-xLogX :: Double -> Double-xLogX x-  | x < 0.0 = error "Argument lower than zero."-  | eps > x = 0.0-  | otherwise = x * log x---- | Entropy of vector.-entropy :: (Vector v Double) => v Double -> Double-entropy v =-  if isNaN res-    then-      error-        ("entropy: Sesult of following vector is NaN: " ++ show (toList v) ++ ".")-    else res-  where-    res = negate $ V.sum $ V.map xLogX v---- | Effective number of used characters measured using 'entropy'. The result--- only makes sense when the sum of the array is 1.0.-kEffEntropy :: Vector v Double => v Double -> Double-kEffEntropy v = if e < eps then 1.0 else exp e where e = entropy v---- | Probability of homoplasy of vector. The result is the probability of--- binomially sampling the same character twice and only makes sense when the--- sum of the array is 1.0.-homoplasy :: Vector v Double => v Double -> Double-homoplasy v = V.sum $ V.map (\x -> x * x) v---- | Effective number of used characters measured using 'homoplasy'. The result--- only makes sense when the sum of the array is 1.0.-kEffHomoplasy :: Vector v Double => v Double -> Double-kEffHomoplasy v = 1.0 / homoplasy v---- XXX: Use mutable vector; then V.// is much faster.--- Increment element at index in vector by one.-incrementElemIndexByOne :: Vector v Int => [Int] -> v Int -> v Int-incrementElemIndexByOne is v = v V.// zip is es'-  where-    es' = [v V.! i + 1 | i <- is]---- For a given code and counts vector, increment the count of the given character.-acc :: Vector v Int => AlphabetSpec -> v Int -> Character -> v Int-acc alph vec char = incrementElemIndexByOne is vec-  where-    is = [S.findIndex c (std alph) | c <- toStd alph char]--countCharacters ::-  (Vector v Character, Vector v Int) => AlphabetSpec -> v Character -> v Int-countCharacters alph = V.foldl' (acc alph) zeroCounts-  where-    nChars = length (std alph)-    zeroCounts = V.replicate nChars (0 :: Int)--saveDivision :: Int -> Int -> Double-saveDivision value divisor =-  if divisor == 0 then 0.0 else fromIntegral value / fromIntegral divisor---- | For a given code vector of characters, calculate frequency of characters.--- The input vector has arbitrary length (most often the number of sequences in--- an alignment), the length of the output vector is the number of characters in--- the alphabet.-frequencyCharacters ::-  (Vector v Character, Vector v Int, Vector v Double) =>-  AlphabetSpec ->-  v Character ->-  v Double-frequencyCharacters alph d = V.map (`saveDivision` s) counts-  where-    counts = countCharacters alph d-    s = V.sum counts

@@ -1,113 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.AminoAcid--- Description :  Amino acid related types and functions--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:26:35 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.------ Amino acids in alphabetical order.------ @--- Amino Acid Code:  Three letter Code:  Amino Acid:--- ----------------  ------------------  -------------- A                 Ala                 Alanine--- C                 Cys                 Cysteine--- D                 Asp                 Aspartic Acid--- E                 Glu                 Glutamic Acid--- F                 Phe                 Phenylalanine--- G                 Gly                 Glycine--- H                 His                 Histidine--- I                 Ile                 Isoleucine--- K                 Lys                 Lysine--- L                 Leu                 Leucine--- M                 Met                 Methionine--- N                 Asn                 Asparagine--- P                 Pro                 Proline--- Q                 Gln                 Glutamine--- R                 Arg                 Arginine--- S                 Ser                 Serine--- T                 Thr                 Threonine--- V                 Val                 Valine--- W                 Trp                 Tryptophan--- Y                 Tyr                 Tyrosine--- @-module ELynx.Data.Character.AminoAcid-  ( AminoAcid (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Amino acids.-data AminoAcid = A | C | D | E | F | G | H | I | K | L | M | N | P | Q | R | S | T | V | W | Y-  deriving (Show, Read, Eq, Ord, Enum, Bounded)--toWord :: AminoAcid -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord D = c2w 'D'-toWord E = c2w 'E'-toWord F = c2w 'F'-toWord G = c2w 'G'-toWord H = c2w 'H'-toWord I = c2w 'I'-toWord K = c2w 'K'-toWord L = c2w 'L'-toWord M = c2w 'M'-toWord N = c2w 'N'-toWord P = c2w 'P'-toWord Q = c2w 'Q'-toWord R = c2w 'R'-toWord S = c2w 'S'-toWord T = c2w 'T'-toWord V = c2w 'V'-toWord W = c2w 'W'-toWord Y = c2w 'Y'--fromWord :: Word8 -> AminoAcid-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'D' -> D-  'E' -> E-  'F' -> F-  'G' -> G-  'H' -> H-  'I' -> I-  'K' -> K-  'L' -> L-  'M' -> M-  'N' -> N-  'P' -> P-  'Q' -> Q-  'R' -> R-  'S' -> S-  'T' -> T-  'V' -> V-  'W' -> W-  'Y' -> Y-  _ -> error "fromWord: Cannot convert to AminoAcid."--derivingUnbox-  "AminoAcid"-  [t|AminoAcid -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character AminoAcid where-  toWord = toWord-  fromWord = fromWord

@@ -1,212 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.AminoAcid--- Description :  Amino acid related types and functions--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:26:35 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.------ Amino acid IUPAC code. See also https://www.bioinformatics.org/sms/iupac.html or--- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.------ Remarks:------ - Question marks (@?@) are interpreted as unknowns (same as @X@). However, when---   a sequence is printed/exported, @X@s will be used.------ - Full stops (@.@) are interpreted as gaps (same as @-@). However, when a---   sequence is printed/exported, @-@s will be used------ @--- Amino Acid Code:  Three letter Code:  Amino Acid:--- ----------------  ------------------  -------------- A                 Ala                 Alanine--- C                 Cys                 Cysteine--- D                 Asp                 Aspartic Acid--- E                 Glu                 Glutamic Acid--- F                 Phe                 Phenylalanine--- G                 Gly                 Glycine--- H                 His                 Histidine--- I                 Ile                 Isoleucine--- K                 Lys                 Lysine--- L                 Leu                 Leucine--- M                 Met                 Methionine--- N                 Asn                 Asparagine--- P                 Pro                 Proline--- Q                 Gln                 Glutamine--- R                 Arg                 Arginine--- S                 Ser                 Serine--- T                 Thr                 Threonine--- V                 Val                 Valine--- W                 Trp                 Tryptophan--- Y                 Tyr                 Tyrosine--- ----------------  ------------------  -------------- J                                     Leucine or Isoleucine--- B                 Asx                 Aspartic acid or Asparagine--- Z                 Glx                 Glutamine or Glutamic acid--- ----------------  ------------------  -------------- X                 Xaa                 Any amino acid (preferred; used for printing)--- ?                 Xaa                 Any amino acid--- ----------------  ------------------  -------------- *                 Stp                 No amino acid--- ----------------  ------------------  -------------- -                 Gap                 No amino acid (preferred; used for printing)--- .                 Gap                 No amino acid--- @-module ELynx.Data.Character.AminoAcidI-  ( AminoAcidI (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Amino acids.-data AminoAcidI-  = A-  | C-  | D-  | E-  | F-  | G-  | H-  | I-  | K-  | L-  | M-  | N-  | P-  | Q-  | R-  | S-  | T-  | V-  | W-  | Y-  | J-  | B-  | Z-  | X-  | Stop-  | Gap-  deriving (Show, Read, Eq, Ord, Enum, Bounded)--toWord :: AminoAcidI -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord D = c2w 'D'-toWord E = c2w 'E'-toWord F = c2w 'F'-toWord G = c2w 'G'-toWord H = c2w 'H'-toWord I = c2w 'I'-toWord K = c2w 'K'-toWord L = c2w 'L'-toWord M = c2w 'M'-toWord N = c2w 'N'-toWord P = c2w 'P'-toWord Q = c2w 'Q'-toWord R = c2w 'R'-toWord S = c2w 'S'-toWord T = c2w 'T'-toWord V = c2w 'V'-toWord W = c2w 'W'-toWord Y = c2w 'Y'-toWord J = c2w 'J'-toWord B = c2w 'B'-toWord Z = c2w 'Z'-toWord X = c2w 'X'-toWord Stop = c2w '*'-toWord Gap = c2w '-'--fromWord :: Word8 -> AminoAcidI-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'D' -> D-  'E' -> E-  'F' -> F-  'G' -> G-  'H' -> H-  'I' -> I-  'K' -> K-  'L' -> L-  'M' -> M-  'N' -> N-  'P' -> P-  'Q' -> Q-  'R' -> R-  'S' -> S-  'T' -> T-  'V' -> V-  'W' -> W-  'Y' -> Y-  'J' -> J-  'B' -> B-  'Z' -> Z-  'X' -> X-  -- Question marks code for @X@s.-  '?' -> X-  '*' -> Stop-  '-' -> Gap-  -- Full stops code for gaps (@-@s).-  '.' -> Gap-  _ -> error "fromWord: Cannot convert Word8 to AminoAcidI"--derivingUnbox-  "AminoAcidI"-  [t|AminoAcidI -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character AminoAcidI where-  toWord = toWord-  fromWord = fromWord--instance C.CharacterX AminoAcidI where-  gap = Gap--toStandard :: AminoAcidI -> [AminoAcidI]-toStandard A = [A]-toStandard C = [C]-toStandard D = [D]-toStandard E = [E]-toStandard F = [F]-toStandard G = [G]-toStandard H = [H]-toStandard I = [I]-toStandard K = [K]-toStandard L = [L]-toStandard M = [M]-toStandard N = [N]-toStandard P = [P]-toStandard Q = [Q]-toStandard R = [R]-toStandard S = [S]-toStandard T = [T]-toStandard V = [V]-toStandard W = [W]-toStandard Y = [Y]-toStandard J = [L, I]-toStandard B = [D, N]-toStandard Z = [E, Q]-toStandard X = [A, C, D, E, F, G, H, I, K, L, M, N, P, Q, R, S, T, V, W, Y]-toStandard Stop = []-toStandard Gap = []--instance C.CharacterI AminoAcidI where-  unknown = X-  iupac = [J, B, Z, X]-  toStandard = toStandard

@@ -1,148 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.AminoAcid--- Description :  Amino acid related types and functions--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:26:35 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.------ Amino acids with gaps and translation stops.------ @--- Amino Acid Code:  Three letter Code:  Amino Acid:--- ----------------  ------------------  -------------- A                 Ala                 Alanine--- C                 Cys                 Cysteine--- D                 Asp                 Aspartic Acid--- E                 Glu                 Glutamic Acid--- F                 Phe                 Phenylalanine--- G                 Gly                 Glycine--- H                 His                 Histidine--- I                 Ile                 Isoleucine--- K                 Lys                 Lysine--- L                 Leu                 Leucine--- M                 Met                 Methionine--- N                 Asn                 Asparagine--- P                 Pro                 Proline--- Q                 Gln                 Glutamine--- R                 Arg                 Arginine--- S                 Ser                 Serine--- T                 Thr                 Threonine--- V                 Val                 Valine--- W                 Trp                 Tryptophan--- Y                 Tyr                 Tyrosine--- ----------------  ------------------  -------------- *                 Stp                 No amino acid--- ----------------  ------------------  -------------- -                 Gap                 No amino acid (preferred)--- .                 Gap                 No amino acid--- @-module ELynx.Data.Character.AminoAcidS-  ( AminoAcidS (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Amino acids.-data AminoAcidS-  = A-  | C-  | D-  | E-  | F-  | G-  | H-  | I-  | K-  | L-  | M-  | N-  | P-  | Q-  | R-  | S-  | T-  | V-  | W-  | Y-  | Stop-  | Gap-  deriving (Show, Read, Eq, Ord, Enum, Bounded)--toWord :: AminoAcidS -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord D = c2w 'D'-toWord E = c2w 'E'-toWord F = c2w 'F'-toWord G = c2w 'G'-toWord H = c2w 'H'-toWord I = c2w 'I'-toWord K = c2w 'K'-toWord L = c2w 'L'-toWord M = c2w 'M'-toWord N = c2w 'N'-toWord P = c2w 'P'-toWord Q = c2w 'Q'-toWord R = c2w 'R'-toWord S = c2w 'S'-toWord T = c2w 'T'-toWord V = c2w 'V'-toWord W = c2w 'W'-toWord Y = c2w 'Y'-toWord Stop = c2w '*'-toWord Gap = c2w '-'--fromWord :: Word8 -> AminoAcidS-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'D' -> D-  'E' -> E-  'F' -> F-  'G' -> G-  'H' -> H-  'I' -> I-  'K' -> K-  'L' -> L-  'M' -> M-  'N' -> N-  'P' -> P-  'Q' -> Q-  'R' -> R-  'S' -> S-  'T' -> T-  'V' -> V-  'W' -> W-  'Y' -> Y-  '*' -> Stop-  '-' -> Gap-  '.' -> Gap-  _ -> error "fromWord: Cannot convert to AminoAcidS."--derivingUnbox-  "AminoAcidS"-  [t|AminoAcidS -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character AminoAcidS where-  toWord = toWord-  fromWord = fromWord--instance C.CharacterX AminoAcidS where-  gap = Gap

@@ -1,145 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.AminoAcid--- Description :  Amino acid related types and functions--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:26:35 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.------ Extended amino acid with gaps. See also--- https://www.bioinformatics.org/sms/iupac.html or--- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.------ @--- Amino Acid Code:  Three letter Code:  Amino Acid:--- ----------------  ------------------  -------------- A                 Ala                 Alanine--- C                 Cys                 Cysteine--- D                 Asp                 Aspartic Acid--- E                 Glu                 Glutamic Acid--- F                 Phe                 Phenylalanine--- G                 Gly                 Glycine--- H                 His                 Histidine--- I                 Ile                 Isoleucine--- K                 Lys                 Lysine--- L                 Leu                 Leucine--- M                 Met                 Methionine--- N                 Asn                 Asparagine--- P                 Pro                 Proline--- Q                 Gln                 Glutamine--- R                 Arg                 Arginine--- S                 Ser                 Serine--- T                 Thr                 Threonine--- V                 Val                 Valine--- W                 Trp                 Tryptophan--- Y                 Tyr                 Tyrosine--- ----------------  ------------------  -------------- -                 Gap                 No amino acid--- .                 Gap                 No amino acid--- @-module ELynx.Data.Character.AminoAcidX-  ( AminoAcidX (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Amino acids.-data AminoAcidX-  = A-  | C-  | D-  | E-  | F-  | G-  | H-  | I-  | K-  | L-  | M-  | N-  | P-  | Q-  | R-  | S-  | T-  | V-  | W-  | Y-  | Gap-  deriving (Show, Read, Eq, Ord, Enum, Bounded)--toWord :: AminoAcidX -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord D = c2w 'D'-toWord E = c2w 'E'-toWord F = c2w 'F'-toWord G = c2w 'G'-toWord H = c2w 'H'-toWord I = c2w 'I'-toWord K = c2w 'K'-toWord L = c2w 'L'-toWord M = c2w 'M'-toWord N = c2w 'N'-toWord P = c2w 'P'-toWord Q = c2w 'Q'-toWord R = c2w 'R'-toWord S = c2w 'S'-toWord T = c2w 'T'-toWord V = c2w 'V'-toWord W = c2w 'W'-toWord Y = c2w 'Y'-toWord Gap = c2w '-'--fromWord :: Word8 -> AminoAcidX-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'D' -> D-  'E' -> E-  'F' -> F-  'G' -> G-  'H' -> H-  'I' -> I-  'K' -> K-  'L' -> L-  'M' -> M-  'N' -> N-  'P' -> P-  'Q' -> Q-  'R' -> R-  'S' -> S-  'T' -> T-  'V' -> V-  'W' -> W-  'Y' -> Y-  '-' -> Gap-  '.' -> Gap-  _ -> error "fromWord: Cannot convert to AminoAcidX."--derivingUnbox-  "AminoAcidX"-  [t|AminoAcidX -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character AminoAcidX where-  toWord = toWord-  fromWord = fromWord--instance C.CharacterX AminoAcidX where-  gap = Gap

@@ -1,94 +0,0 @@--- |--- Module      :  Character--- Description :  Character interface--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Oct 12 16:24:02 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.-module ELynx.Data.Character.Character-  ( Character (..),-    fromChar,-    toChar,-    fromString,-    toString,-    CharacterX (..),-    isGap,-    CharacterI (..),-    isUnknown,-    isIUPAC,-    isStandard,-    convert,-  )-where--import Data.ByteString.Internal (c2w, w2c)-import qualified Data.Set as S-import Data.Vector.Unboxed.Base (Unbox)-import Data.Word8 (Word8)---- XXX: Remove name clash with ELynx.Data.Alphabet.Alphabet.Character?---- | A set of characters forms an 'ELynx.Data.Alphabet.Alphabet'. At the--- moment, 'Word8' is used, since none of the alphabets has more than 255--- characters.-class (Show a, Read a, Eq a, Ord a, Enum a, Bounded a, Unbox a) => Character a where-  -- | Write characters.-  toWord :: a -> Word8--  -- | Read characters.-  fromWord :: Word8 -> a---- | Conversion to 'Char'.-toChar :: Character a => a -> Char-toChar = w2c . toWord---- | Conversion from 'Char'.-fromChar :: Character a => Char -> a-fromChar = fromWord . c2w---- | Conversion to 'String'.-toString :: Character a => [a] -> String-toString = map toChar---- | Conversion from 'String'.-fromString :: Character a => String -> [a]-fromString = map fromChar---- | An extended character type with gaps and unknowns.-class Character a => CharacterX a where-  gap :: a---- | Is the character a gap or unknown?-isGap :: CharacterX a => a -> Bool-isGap c = c == gap---- | IUPAC characters with a mapping to extended characters.-class CharacterX a => CharacterI a where-  unknown :: a-  iupac :: [a]-  toStandard :: a -> [a]---- | Check if a IUPAC 'CharacterI' is unknown (e.g., N for nucleotides).-isUnknown :: CharacterI a => a -> Bool-isUnknown c = c == unknown--iupacLookup :: CharacterI a => S.Set a-iupacLookup = S.fromList iupac---- | Is the given character a IUPAC character?-isIUPAC :: CharacterI a => a -> Bool-isIUPAC c = c `S.member` iupacLookup---- | Is the given character a standard character?-isStandard :: CharacterI a => a -> Bool-isStandard c = not $ isIUPAC c---- | Convert between character classes. May throw error.-convert :: (Character a, Character b) => a -> b-convert = fromWord . toWord

@@ -1,258 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}---- |--- Module      :  ELynx.Data.Character.Codon--- Description :  Codons are triplets of nucleotides--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu May 16 07:58:50 2019.------ The different universal codes.--- - https://www.ncbi.nlm.nih.gov/Taxonomy/Utils/wprintgc.cgi?mode=c--- - http://www.bioinformatics.org/sms2/genetic_code.html--- - https://en.wikipedia.org/wiki/Genetic_code-module ELynx.Data.Character.Codon-  ( Codon (Codon),-    fromVecUnsafe,-    UniversalCode (..),-    translate,-    translateX,-    translateI,-  )-where--import Data.Aeson-  ( FromJSON,-    ToJSON,-  )-import Data.List-import qualified Data.Map as M-import qualified Data.Vector.Generic as V-import qualified ELynx.Data.Character.AminoAcidI as AI-import ELynx.Data.Character.AminoAcidS-import qualified ELynx.Data.Character.Character as C-import qualified ELynx.Data.Character.Nucleotide as N-import qualified ELynx.Data.Character.NucleotideI as NI-import qualified ELynx.Data.Character.NucleotideX as NX-import GHC.Generics (Generic)---- | Codons are triplets of characters.-newtype Codon a = Codon (a, a, a)-  deriving (Show, Read, Eq, Ord)--convert :: (C.Character a, C.Character b) => Codon a -> Codon b-convert (Codon (x, y, z)) = Codon (C.convert x, C.convert y, C.convert z)---- | Unsafe conversion from vector with at least three elements; only the first--- three elements are used, the rest is discarded.-fromVecUnsafe :: V.Vector v a => v a -> Codon a-fromVecUnsafe xs =-  Codon (V.head xs, V.head . V.tail $ xs, V.head . V.tail . V.tail $ xs)---- | Universal codes.-data UniversalCode = Standard | VertebrateMitochondrial-  deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)--instance FromJSON UniversalCode--instance ToJSON UniversalCode---- It is important that the map is lazy, because some keys have errors as values.-mapFromLists :: Ord a => [a] -> [a] -> [a] -> [b] -> M.Map (Codon a) b-mapFromLists xs ys zs as =-  M.fromList $ zipWith4 (\f s t a -> (Codon (f, s, t), a)) xs ys zs as--nucs :: Enum a => [a]-nucs = map toEnum [3, 1, 0, 2] -- Order T, C, A , G.---- Permutation of the triplets PLUS GAPS! I avoid 'Z' because I do not want to--- translate DNAI.-base1, base2, base3 :: Enum a => [a]-base1 = [n | n <- nucs, _ <- [0 .. 3 :: Int], _ <- [0 .. 3 :: Int]]--- base1 = "TTTTTTTTTTTTTTTTCCCCCCCCCCCCCCCCAAAAAAAAAAAAAAAAGGGGGGGGGGGGGGGG" ++ "-."-base2 = [n | _ <- [0 .. 3 :: Int], n <- nucs, _ <- [0 .. 3 :: Int]]--- base2 = "TTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGG" ++ "-."-base3 = [n | _ <- [0 .. 3 :: Int], _ <- [0 .. 3 :: Int], n <- nucs]---- base3 = "TCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAG" ++ "-."---- The actual codes.-standard :: [AminoAcidS]-standard =-  [ F,-    F,-    L,-    L,-    S,-    S,-    S,-    S,-    Y,-    Y,-    Stop,-    Stop,-    C,-    C,-    Stop,-    W,-    L,-    L,-    L,-    L,-    P,-    P,-    P,-    P,-    H,-    H,-    Q,-    Q,-    R,-    R,-    R,-    R,-    I,-    I,-    I,-    M,-    T,-    T,-    T,-    T,-    N,-    N,-    K,-    K,-    S,-    S,-    R,-    R,-    V,-    V,-    V,-    V,-    A,-    A,-    A,-    A,-    D,-    D,-    E,-    E,-    G,-    G,-    G,-    G-  ]---- "FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG" ++ "--"--vertebrateMitochondrial :: [AminoAcidS]-vertebrateMitochondrial =-  [ F,-    F,-    L,-    L,-    S,-    S,-    S,-    S,-    Y,-    Y,-    Stop,-    Stop,-    C,-    C,-    W,-    W,-    L,-    L,-    L,-    L,-    P,-    P,-    P,-    P,-    H,-    H,-    Q,-    Q,-    R,-    R,-    R,-    R,-    I,-    I,-    M,-    M,-    T,-    T,-    T,-    T,-    N,-    N,-    K,-    K,-    S,-    S,-    Stop,-    Stop,-    V,-    V,-    V,-    V,-    A,-    A,-    A,-    A,-    D,-    D,-    E,-    E,-    G,-    G,-    G,-    G-  ]---- "FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSS**VVVVAAAADDEEGGGG" ++ "--"---- | Translate a codon to amino acids including translation stops.-translate :: UniversalCode -> Codon N.Nucleotide -> AminoAcidS-translate code = (M.!) (universalCode code)---- | Translate a codon to amino acids including translation stops. Translate--- codons including gaps to amino acid gaps. Be careful, single or two character--- gaps can lead to a reading frame shift and hence, the translated sequence may--- be bogus.-translateX :: UniversalCode -> Codon NX.NucleotideX -> AminoAcidS--- translateX _ (Codon (NX.Gap, NX.Gap, NX.Gap)) = Gap--- translateX code codon                         = C.convert . translate code . convert $ codon-translateX code codon@(Codon (x, y, z))-  | C.isGap x || C.isGap y || C.isGap z = Gap-  | otherwise = C.convert . translate code . convert $ codon---- | Translate a codon to amino acids including translation stops. Translate gap--- triplets to amino acid gaps, and triplets including unknowns to amino acid--- unknowns. Be careful, also translates other IUPAC characters to amino acid Xs!-translateI :: UniversalCode -> Codon NI.NucleotideI -> AI.AminoAcidI-translateI code codon@(Codon (x, y, z))-  | C.isIUPAC x || C.isIUPAC y || C.isIUPAC z = AI.X-  | otherwise = C.convert . translateX code . convert $ codon---- translateI :: UniversalCode -> Codon NI.NucleotideI -> AI.AminoAcidI--- translateI _ (Codon (NI.N, _,    _   )) = AI.X--- translateI _ (Codon (_   , NI.N, _   )) = AI.X--- translateI _ (Codon (_,    _,    NI.N)) = AI.X--- translateI code codon                   = C.convert . translateX code . convert $ codon---- Map from 'Codon' to amino acid character.-universalCode :: UniversalCode -> M.Map (Codon N.Nucleotide) AminoAcidS-universalCode Standard = mapFromLists base1 base2 base3 standard-universalCode VertebrateMitochondrial =-  mapFromLists base1 base2 base3 vertebrateMitochondrial

@@ -1,67 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.Nucleotide--- Description :  Nucleotides--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:26:35 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.------ @--- Symbol  Description  Bases represented  Complement--- ------  -----------  -----------------  ------------- A       Adenine      A                  T--- C       Cytosine        C               G--- G       Guanine            G            C--- T       Thymine               T         A--- @-module ELynx.Data.Character.Nucleotide-  ( Nucleotide (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Nucleotides.-data Nucleotide = A | C | G | T-  deriving (Show, Read, Eq, Ord, Enum, Bounded)---- See https://stackoverflow.com/a/31527024; apparently, pattern matching (and--- case statements) are fast because they are compiled to lookup tables. Hence,--- they are faster than guards (because equality has to be checked), and faster--- than lookups with sets.-toWord :: Nucleotide -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord G = c2w 'G'-toWord T = c2w 'T'--fromWord :: Word8 -> Nucleotide-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'G' -> G-  'T' -> T-  c -> error $ "fromWord: Cannot convert " ++ show c ++ " to Nucleotide."--derivingUnbox-  "Nucleotide"-  [t|Nucleotide -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character Nucleotide where-  toWord = toWord-  fromWord = fromWord

@@ -1,168 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.NucleotideI--- Description :  Nucleotides with IUPAC characters--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:26:35 2018.------ See header of 'ELynx.Data.Alphabet.Alphabet'.------ Nucleotide IUPAC code. See also https://www.bioinformatics.org/sms/iupac.html or--- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.------ Remarks:------ - Question marks (@?@) are interpreted as unknowns (same as @N@). However, when---   a sequence is printed/exported, @N@s will be used.------ - Full stops (@.@) are interpreted as gaps (same as @-@). However, when a---   sequence is printed/exported, @-@s will be used------ @--- Symbol  Description  Bases represented  Complement--- ------  -----------  -----------------  ------------- A       Adenine      A                  T--- C       Cytosine        C               G--- G       Guanine            G            C--- T       Thymine               T         A--- ------  -----------  -----------------  ------------- U       Uracil                U         A--- W       Weak         A        T         W--- S       Strong          C  G            S--- M       aMino        A  C               K--- K       Keto               G  T         M--- R       puRine       A     G            Y--- Y       pYrimidine      C     T         R--- B       not A           C  G  T         V--- D       not C        A     G  T         H--- H       not G        A  C     T         D--- V       not T        A  C  G            B--- ------  -----------  -----------------  ------------- N       any          A  C  G  T         N           (preferred)--- ?       any          A  C  G  T         N--- ------  -----------  -----------------  ------------- -       Gap (Zero)                      -           (preferred)--- .       Gap (Zero)                      ---- @-module ELynx.Data.Character.NucleotideI-  ( NucleotideI (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | NucleotideIs.-data NucleotideI-  = A-  | C-  | G-  | T-  | U-  | W-  | S-  | M-  | K-  | R-  | Y-  | B-  | D-  | H-  | V-  | N-  | Gap-  deriving (Show, Read, Eq, Ord, Enum, Bounded)---- See https://stackoverflow.com/a/31527024; apparently, pattern matching (and--- case statements) are fast because they are compiled to lookup tables. Hence,--- they are faster than guards (because equality has to be checked), and faster--- than lookups with sets.-toWord :: NucleotideI -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord G = c2w 'G'-toWord T = c2w 'T'-toWord U = c2w 'U'-toWord W = c2w 'W'-toWord S = c2w 'S'-toWord M = c2w 'M'-toWord K = c2w 'K'-toWord R = c2w 'R'-toWord Y = c2w 'Y'-toWord B = c2w 'B'-toWord D = c2w 'D'-toWord H = c2w 'H'-toWord V = c2w 'V'-toWord N = c2w 'N'-toWord Gap = c2w '-'--fromWord :: Word8 -> NucleotideI-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'G' -> G-  'T' -> T-  'U' -> U-  'W' -> W-  'S' -> S-  'M' -> M-  'K' -> K-  'R' -> R-  'Y' -> Y-  'B' -> B-  'D' -> D-  'H' -> H-  'V' -> V-  'N' -> N-  '?' -> N-  '-' -> Gap-  '.' -> Gap-  _ -> error "fromWord: Cannot convert to NucleotideI."--derivingUnbox-  "NucleotideI"-  [t|NucleotideI -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character NucleotideI where-  toWord = toWord-  fromWord = fromWord--toStandard :: NucleotideI -> [NucleotideI]-toStandard A = [A]-toStandard C = [C]-toStandard G = [G]-toStandard T = [T]-toStandard U = [T]-toStandard W = [A, T]-toStandard S = [G, C]-toStandard M = [A, C]-toStandard K = [G, T]-toStandard R = [A, G]-toStandard Y = [C, T]-toStandard B = [C, G, T]-toStandard D = [A, G, T]-toStandard H = [A, C, T]-toStandard V = [A, C, G]-toStandard N = [A, C, G, T]-toStandard Gap = []--instance C.CharacterX NucleotideI where-  gap = Gap--instance C.CharacterI NucleotideI where-  unknown = N-  iupac = [U, W, S, M, K, R, Y, B, D, H, V, N]-  toStandard = toStandard

@@ -1,79 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- |--- Module      :  ELynx.Data.NucleotideX--- Description :  Extended nucleotides including gaps and unknowns--- Copyright   :  (c) Dominik Schrempf 2021------ License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ See header of 'ELynx.Data.Alphabet'.------ Extended nucleotides with gaps. See also--- https://www.bioinformatics.org/sms/iupac.html or--- https://en.wikipedia.org/wiki/International_Union_of_Pure_and_Applied_Chemistry.------ @--- Symbol  Description  Bases represented  Complement--- ------  -----------  -----------------  ------------- A       Adenine      A                  T--- C       Cytosine        C               G--- G       Guanine            G            C--- T       Thymine               T         A--- ------  -----------  -----------------  ------------- - or .  Gap (Zero)                      ---- @-module ELynx.Data.Character.NucleotideX-  ( NucleotideX (..),-  )-where--import Data.ByteString.Internal (c2w, w2c)-import Data.Vector.Unboxed.Deriving-import Data.Word8-import qualified ELynx.Data.Character.Character as C---- | Extended nucleotides.-data NucleotideX-  = A-  | C-  | G-  | T-  | Gap-  deriving (Show, Read, Eq, Ord, Enum, Bounded)--toWord :: NucleotideX -> Word8-toWord A = c2w 'A'-toWord C = c2w 'C'-toWord G = c2w 'G'-toWord T = c2w 'T'-toWord Gap = c2w '-'--fromWord :: Word8 -> NucleotideX-fromWord w = case w2c w of-  'A' -> A-  'C' -> C-  'G' -> G-  'T' -> T-  '-' -> Gap-  '.' -> Gap-  c -> error $ "fromWord: Cannot convert " ++ show c ++ " to NucleotideX."--derivingUnbox-  "NucleotideX"-  [t|NucleotideX -> Word8|]-  [|toWord|]-  [|fromWord|]--instance C.Character NucleotideX where-  toWord = toWord-  fromWord = fromWord--instance C.CharacterX NucleotideX where-  gap = Gap

@@ -1,323 +0,0 @@--- |--- Module      :  ELynx.Data.Sequence.Alignment--- Description :  Multi sequence alignment related types and functions--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable------ Portability :  portable------ Creation date: Thu Oct  4 18:40:18 2018.------ This module is to be imported qualified.-module ELynx.Data.Sequence.Alignment-  ( Alignment (..),-    length,-    nSequences,-    -- | * Input, output-    fromSequences,-    toSequences,-    summarize,-    -- | * Manipulation-    join,-    concat,-    concatAlignments,-    filterColsConstant,-    filterColsConstantSoft,-    filterColsOnlyStd,-    filterColsStd,-    filterColsNoGaps,-    -- | * Analysis-    FrequencyData,-    distribution,-    toFrequencyData,-    kEffEntropy,-    kEffHomoplasy,-    countIUPACChars,-    countGaps,-    countUnknowns,-    -- | * Sub sample-    subSample,-    randomSubSample,-  )-where--import Control.Monad hiding (join)-import Control.Monad.Primitive-import Control.Parallel.Strategies-import qualified Data.ByteString.Lazy.Char8 as BL-import Data.List hiding-  ( concat,-    length,-  )-import qualified Data.Matrix.Unboxed as M-import qualified Data.Vector.Unboxed as V-import qualified ELynx.Data.Alphabet.Alphabet as A-import ELynx.Data.Alphabet.Character-import qualified ELynx.Data.Alphabet.DistributionDiversity as D-import ELynx.Data.Sequence.Defaults-import qualified ELynx.Data.Sequence.Sequence as S-import System.Random.MWC-import Prelude hiding-  ( concat,-    length,-  )---- | A collection of sequences.-data Alignment = Alignment-  { names :: [S.Name],-    descriptions :: [S.Description],-    alphabet :: A.Alphabet,-    matrix :: M.Matrix Character-  }-  deriving (Show, Eq)---- | Number of sites.-length :: Alignment -> Int-length = M.cols . matrix---- | Number of sequences.-nSequences :: Alignment -> Int-nSequences = M.rows . matrix---- | Create 'Alignment' from a list of 'S.Sequence's.-fromSequences :: [S.Sequence] -> Either String Alignment-fromSequences ss-  | S.equalLength ss && allEqual (map S.alphabet ss) =-    Right $-      Alignment ns ds a d-  | S.equalLength ss = Left "Sequences do not have equal codes."-  | otherwise = Left "Sequences do not have equal lengths."-  where-    ns = map S.name ss-    ds = map S.description ss-    a = S.alphabet $ head ss-    bss = map S.characters ss-    d = M.fromRows bss-    allEqual [] = True-    allEqual xs = all (== head xs) $ tail xs---- | Conversion to list of 'S.Sequence's.-toSequences :: Alignment -> [S.Sequence]-toSequences (Alignment ns ds a da) =-  zipWith3-    (\n d r -> S.Sequence n d a r)-    ns-    ds-    rows-  where-    rows = M.toRows da--header :: Alignment -> BL.ByteString-header a =-  BL.unlines $-    [ BL.pack "Multi sequence alignment.",-      BL.pack $ "Code: " ++ A.alphabetDescription (alphabet a) ++ ".",-      BL.pack $ "Length: " ++ show (length a) ++ "."-    ]-      ++ reportLengthSummary-      ++ reportNumberSummary-  where-    reportLengthSummary =-      [ BL.pack $-          "For each sequence, the "-            ++ show summaryLength-            ++ " first bases are shown."-        | length a > summaryLength-      ]-    reportNumberSummary =-      [ BL.pack $-          show summaryNSequences-            ++ " out of "-            ++ show (nSequences a)-            ++ " sequences are shown."-        | nSequences a > summaryNSequences-      ]---- | Similar to 'S.summarizeSequenceList' but with different Header.-summarize :: Alignment -> BL.ByteString-summarize a = header a <> S.body (toSequences a)---- Vertical concatenation.-(===) :: V.Unbox a => M.Matrix a -> M.Matrix a -> M.Matrix a-(===) l r = M.fromRows $ lRs ++ rRs-  where-    lRs = M.toRows l-    rRs = M.toRows r---- Horizontal concatenation.-(|||) :: V.Unbox a => M.Matrix a -> M.Matrix a -> M.Matrix a-(|||) l r = M.fromColumns $ lCs ++ rCs-  where-    lCs = M.toColumns l-    rCs = M.toColumns r---- | Join two 'Alignment's vertically. That is, add more sequences--- to an alignment. See also 'concat'.-join :: Alignment -> Alignment -> Alignment--- top bottom.-join t b-  | length t /= length b =-    error-      "join: Multi sequence alignments do not have equal lengths."-  | alphabet t /= alphabet b =-    error-      "join: Multi sequence alignments do not have equal alphabets."-  | otherwise = Alignment ns ds al (tD === bD)-  where-    ns = names t ++ names b-    ds = descriptions t ++ descriptions b-    tD = matrix t-    bD = matrix b-    al = alphabet t---- | Concatenate two 'Alignment's horizontally. That is, add more--- sites to an alignment. See also 'join'.-concat :: Alignment -> Alignment -> Alignment--- left right.-concat l r-  | nSequences l /= nSequences r =-    error-      "concat: Multi sequence alignments do not have an equal number of sequences."-  | alphabet l /= alphabet r =-    error "concat: Multi sequence alignments do not have an equal alphabets."-  | names l /= names r =-    error "concat: Multi sequence alignments do not have an equal names."-  | descriptions l /= descriptions r =-    error "concat: Multi sequence alignments do not have an equal descriptions."-  | otherwise =-    Alignment (names l) (descriptions l) (alphabet l) (lD ||| rD)-  where-    lD = matrix l-    rD = matrix r---- | Concatenate a list of 'Alignment's horizontally. See--- 'concat'.-concatAlignments :: [Alignment] -> Alignment-concatAlignments [] = error "concatAlignments: Nothing to concatenate."-concatAlignments [a] = a-concatAlignments as = foldl' concat (head as) (tail as)---- Only keep columns from alignment that satisfy given predicate.-filterColsWith :: (V.Vector Character -> Bool) -> Alignment -> Alignment-filterColsWith p a = a {matrix = m'}-  where-    m' = M.fromColumns . filter p . M.toColumns $ matrix a---- | Only keep constant columns.-filterColsConstant :: Alignment -> Alignment-filterColsConstant = filterColsWith (\v -> V.all (== V.head v) v)---- | Only keep constant columns, and constant columns with at least one standard--- character as well as any number of gaps or unknowns.-filterColsConstantSoft :: Alignment -> Alignment-filterColsConstantSoft a = filterColsWith f a-  where-    al = alphabet a-    f v = case V.find (A.isStd al) v of-      Nothing -> False-      Just c -> V.all (\x -> x == c || A.isGap al x || A.isUnknown al x) v---- | Only keep columns with standard characters. Alignment columns with IUPAC--- characters are removed.-filterColsOnlyStd :: Alignment -> Alignment-filterColsOnlyStd a = filterColsWith (V.all $ A.isStd (alphabet a)) a---- | Filter columns with proportion of standard character larger than given number.-filterColsStd :: Double -> Alignment -> Alignment-filterColsStd prop a =-  filterColsWith-    (\col -> prop * n <= fromIntegral (V.length (V.filter (A.isStd al) col)))-    a-  where-    al = alphabet a-    n = fromIntegral $ nSequences a---- | Only keep columns without gaps or unknown characters.-filterColsNoGaps :: Alignment -> Alignment-filterColsNoGaps a = filterColsWith (V.all $ not . A.isGap (alphabet a)) a---- | Frequency data; do not store the actual characters, but their frequencies.--- The matrix is of size @N x K@, where @N@ is the number of sites, and @K@ is--- the number of characters.-type FrequencyData = M.Matrix Double---- Map a function on each column of a DIM2 array; parallel version with given chunk size.-fMapColParChunk ::-  (V.Unbox a, V.Unbox b) =>-  Int ->-  (V.Vector a -> V.Vector b) ->-  M.Matrix a ->-  M.Matrix b-fMapColParChunk n f m =-  M.fromColumns (map f (M.toColumns m) `using` parListChunk n rseq)---- | Calculcate frequency of characters at each site of a multi sequence alignment.-toFrequencyData :: Alignment -> FrequencyData-toFrequencyData a = fMapColParChunk 100 (D.frequencyCharacters spec) (matrix a)-  where-    spec = A.alphabetSpec (alphabet a)---- | Calculate the distribution of characters.-distribution :: FrequencyData -> [Double]-distribution fd =-  map (/ fromIntegral nSites) $-    V.toList $-      foldl1-        (V.zipWith (+))-        (M.toColumns fd)-  where-    nSites = M.cols fd---- Parallel map with given chunk size.-parMapChunk :: Int -> (a -> b) -> [a] -> [b]-parMapChunk n f as = map f as `using` parListChunk n rseq--chunksize :: Int-chunksize = 500---- | Diversity analysis. See 'kEffEntropy'.-kEffEntropy :: FrequencyData -> [Double]-kEffEntropy fd = parMapChunk chunksize D.kEffEntropy (M.toColumns fd)---- | Diversity analysis. See 'kEffEntropy'.-kEffHomoplasy :: FrequencyData -> [Double]-kEffHomoplasy fd = parMapChunk chunksize D.kEffHomoplasy (M.toColumns fd)---- | Count the number of standard (i.e., not extended IUPAC) characters in the--- alignment.-countIUPACChars :: Alignment -> Int-countIUPACChars a = V.length . V.filter (A.isIUPAC (alphabet a)) $ allChars-  where-    allChars = M.flatten $ matrix a---- | Count the number of gaps in the alignment.-countGaps :: Alignment -> Int-countGaps a = V.length . V.filter (A.isGap (alphabet a)) $ allChars-  where-    allChars = M.flatten $ matrix a---- | Count the number of unknown characters in the alignment.-countUnknowns :: Alignment -> Int-countUnknowns a = V.length . V.filter (A.isUnknown (alphabet a)) $ allChars-  where-    allChars = M.flatten $ matrix a---- Sample the given sites from a matrix.-subSampleMatrix :: V.Unbox a => [Int] -> M.Matrix a -> M.Matrix a-subSampleMatrix is m =-  M.fromColumns $ foldl' (\a i -> M.takeColumn m i : a) [] (reverse is)---- | Sample the given sites from a multi sequence alignment.-subSample :: [Int] -> Alignment -> Alignment-subSample is a = a {matrix = m'} where m' = subSampleMatrix is $ matrix a---- | Randomly sample a given number of sites of the multi sequence alignment.-randomSubSample ::-  PrimMonad m => Int -> Alignment -> Gen (PrimState m) -> m Alignment-randomSubSample n a g = do-  let l = length a-  is <- replicateM n $ uniformR (0, l - 1) g-  return $ subSample is a

@@ -1,34 +0,0 @@--- |--- Module      :  ELynx.Defaults--- Description :  Various default values--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Oct  5 23:00:17 2018.-module ELynx.Data.Sequence.Defaults-  ( nameWidth,-    summaryLength,-    summaryNSequences,-    fieldWidth,-  )-where---- | Space reserved for sequence names when printing them.-nameWidth :: Int-nameWidth = 23---- | The length shown when summarizing sequences.-summaryLength :: Int-summaryLength = 60---- | How many sequences are shown in summary.-summaryNSequences :: Int-summaryNSequences = 200---- | Field width for tables.-fieldWidth :: Int-fieldWidth = 13

@@ -1,33 +0,0 @@--- |--- Module      :  ELynx.Data.Sequence.Distance--- Description :  Distance functions between sequences--- Copyright   :  (c) Dominik Schrempf, 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Aug 21 15:09:58 2020.-module ELynx.Data.Sequence.Distance-  ( hamming,-  )-where--import qualified Data.Vector.Unboxed as V-import ELynx.Data.Sequence.Sequence--countFalses :: (Int -> Bool -> Int)-countFalses n False = succ n-countFalses n True = n---- | Compute hamming distance between two sequences.-hamming :: Sequence -> Sequence -> Either String Int-hamming l r-  | alphabet l /= alphabet r = Left "hamming: Alphabets of sequences differ."-  | V.length csL /= V.length csR = Left "hamming: Sequence lengths differ."-  | V.null csL || V.null csR = Left "hamming: Empty sequence encountered."-  | otherwise = Right $ V.foldl' countFalses 0 $ V.zipWith (==) (characters l) (characters r)-  where-    csL = characters l-    csR = characters r

@@ -1,244 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      :  ELynx.Data.Sequence--- Description :  Hereditary sequences--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Thu Oct  4 18:54:51 2018.------ This module is to be imported qualified.-module ELynx.Data.Sequence.Sequence-  ( -- * Types-    Name,-    Description,-    Characters,-    Sequence (..),--    -- * Input-    fromByteString,--    -- * Output-    toByteString,-    header,-    summarize,-    summarizeSequences,-    body,--    -- * Analysis-    length,-    equalLength,-    longest,--    -- * Manipulation-    trim,-    concat,-    concatSequences,--    -- * Filtering-    filterShorterThan,-    filterLongerThan,-    filterStandard,-  )-where--import Control.Parallel.Strategies-import qualified Data.ByteString.Lazy.Char8 as BL-import Data.List (maximumBy)-import Data.Ord (comparing)-import qualified Data.Vector.Unboxed as V-import qualified ELynx.Data.Alphabet.Alphabet as A-import ELynx.Data.Alphabet.Character-import ELynx.Data.Sequence.Defaults-import qualified Text.Printf as P-import Prelude hiding-  ( concat,-    length,-  )-import qualified Prelude as Pr-  ( length,-  )---- | For now, 'Name's are just 'BL.ByteString's.-type Name = BL.ByteString---- | The description of a sequence.-type Description = BL.ByteString---- | The vector of characters of a sequence.-type Characters = V.Vector Character---- | Convert byte string to sequence characters.-fromByteString :: BL.ByteString -> Characters-fromByteString = V.fromList . map fromChar . BL.unpack---- | Convert sequence characters to byte string.-toByteString :: Characters -> BL.ByteString-toByteString = BL.pack . map toChar . V.toList---- | Sequences have a name, a possibly empty description, a code and hopefully a--- lot of data.-data Sequence = Sequence-  { name :: Name,-    description :: Description,-    alphabet :: A.Alphabet,-    characters :: Characters-  }-  deriving (Show, Eq)--alignRight :: Int -> BL.ByteString -> BL.ByteString-alignRight n s =-  BL.replicate (fromIntegral n - l) ' ' <> BL.take (fromIntegral n) s-  where-    l = BL.length s--alignLeft :: Int -> BL.ByteString -> BL.ByteString-alignLeft n s =-  BL.take (fromIntegral n) s <> BL.replicate (fromIntegral n - l) ' '-  where-    l = BL.length s--getInfo :: Sequence -> BL.ByteString-getInfo s =-  BL.unwords-    [ alignLeft nameWidth (name s),-      alignRight fieldWidth (BL.pack $ show $ alphabet s),-      alignRight fieldWidth (BL.pack . show $ len),-      alignRight fieldWidth (BL.pack $ P.printf "%2.2f" pGaps)-    ]-  where-    len = length s-    nGaps = countGaps s-    pGaps = 100 * fromIntegral nGaps / fromIntegral len :: Double---- If a string is longer than a given value, trim it and add some dots.-summarizeByteString :: Int -> BL.ByteString -> BL.ByteString-summarizeByteString l s-  | BL.length s >= fromIntegral l = BL.take (fromIntegral l) s <> BL.pack "..."-  | otherwise = s---- | Trim and show a 'Sequence'.-summarize :: Sequence -> BL.ByteString-summarize s =-  BL.unwords-    [getInfo s, summarizeByteString summaryLength $ toByteString (characters s)]---- | Trim and show a list of 'Sequence's.-summarizeSequences :: [Sequence] -> BL.ByteString-summarizeSequences ss = header ss <> body (take summaryNSequences ss)---- | Header printed before 'Sequence' list.-tableHeader :: BL.ByteString-tableHeader =-  BL.unwords-    [ alignLeft nameWidth "Name",-      alignRight fieldWidth "Code",-      alignRight fieldWidth "Length",-      alignRight fieldWidth "Gaps [%]",-      "Sequence"-    ]---- | A short description of the sequence.-header :: [Sequence] -> BL.ByteString-header ss =-  BL.unlines $-    reportIfSubsetIsShown-      ++ [ BL.pack $-             "For each sequence, the "-               ++ show summaryLength-               ++ " first bases are shown.",-           BL.pack $ "List contains " ++ show (Pr.length ss) ++ " sequences.",-           "",-           tableHeader-         ]-  where-    l = Pr.length ss-    s =-      show summaryNSequences-        ++ " out of "-        ++ show (Pr.length ss)-        ++ " sequences are shown."-    reportIfSubsetIsShown-      | l > summaryNSequences = [BL.pack s]-      | otherwise = []---- | Trim and show a list of 'Sequence's.-body :: [Sequence] -> BL.ByteString-body ss = BL.unlines (map summarize ss `using` parListChunk 5 rdeepseq)---- | Calculate length of 'Sequence'.-length :: Sequence -> Int-length = fromIntegral . V.length . characters---- | Check if all 'Sequence's have equal length.-equalLength :: [Sequence] -> Bool-equalLength = allEqual . map length-  where-    allEqual [] = True-    allEqual xs = all (== head xs) $ tail xs---- | Find the longest 'Sequence' in a list.-longest :: [Sequence] -> Sequence-longest = maximumBy (comparing length)---- | Count number of gaps or unknown characters in sequence.-countGaps :: Sequence -> Int-countGaps s = V.length . V.filter (A.isGap $ alphabet s) $ characters s---- | Trim to given length.-trim :: Int -> Sequence -> Sequence-trim n (Sequence nm d a cs) = Sequence nm d a (V.take (fromIntegral n) cs)---- | Concatenate two sequences. 'Name's have to match.-concat :: Sequence -> Sequence -> Sequence-concat (Sequence i d c cs) (Sequence j f k ks)-  | i /= j =-    error $-      "concatenate: Sequences do not have equal names: "-        ++ BL.unpack i-        ++ ", "-        ++ BL.unpack j-        ++ "."-  | d /= f =-    error $-      "concatenate: Sequences do not have equal descriptions: "-        ++ BL.unpack d-        ++ ", "-        ++ BL.unpack f-        ++ "."-  | c /= k =-    error $-      "concatenate: Sequences do not have equal alphabets: "-        ++ show c-        ++ ", "-        ++ show k-        ++ "."-  | otherwise =-    Sequence i d c (cs <> ks)---- | Concatenate a list of sequences, see 'concat'.-concatSequences :: [[Sequence]] -> [Sequence]-concatSequences [] = error "concatenateSequences: Nothing to concatenate."-concatSequences [ss] = ss-concatSequences sss = foldl1 (zipWith concat) sss---- | Only take 'Sequence's that are shorter than a given number.-filterShorterThan :: Int -> [Sequence] -> [Sequence]-filterShorterThan n = filter (\x -> length x < n)---- | Only take 'Sequence's that are longer than a given number.-filterLongerThan :: Int -> [Sequence] -> [Sequence]-filterLongerThan n = filter (\x -> length x > n)---- | Only take 'Sequence's that contain at least on non-IUPAC character.-filterStandard :: [Sequence] -> [Sequence]-filterStandard = filter (\s -> anyStandard (alphabet s) s)---- Are all characters IUPAC characters?-anyStandard :: A.Alphabet -> Sequence -> Bool-anyStandard a s = V.any (A.isStd a) cs where cs = characters s

@@ -1,53 +0,0 @@--- |--- Module      :  ELynx.Data.Sequence.Translate--- Description :  Translate sequences--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri May 17 13:49:18 2019.-module ELynx.Data.Sequence.Translate-  ( translateSeq,-  )-where--import qualified Data.Vector.Unboxed as V-import ELynx.Data.Alphabet.Alphabet-import qualified ELynx.Data.Alphabet.Character as C-import ELynx.Data.Character.Codon-import ELynx.Data.Sequence.Sequence---- Chop list into chunks of given length. If the last chop is shorter than--- length, it is dropped.-chopVec :: V.Unbox a => Int -> V.Vector a -> [V.Vector a]-chopVec n xs-  | V.length xs < n = []-  | otherwise = V.take n xs : chopVec n (V.drop n xs)---- | Translate a sequence from 'DNA' or 'DNAX' to 'ProteinS'.-translateSeq :: UniversalCode -> Int -> Sequence -> Sequence-translateSeq uc rf (Sequence n d a cs) = case a of-  DNA -> Sequence n d ProteinS (cs' $ translate uc)-  DNAX -> Sequence n d ProteinS (cs' $ translateX uc)-  DNAI -> Sequence n d ProteinI (cs' $ translateI uc)-  _ -> error "translate: can only translate DNA, DNAX, and DNAI."-  where-    cs' f = C.fromCVec $ translateVecWith f rf (C.toCVec cs)---- Translate from DNA to Protein with given reading frame (0, 1, 2).-translateVecWith ::-  (V.Unbox a, Ord a, V.Unbox b) =>-  (Codon a -> b) ->-  Int ->-  V.Vector a ->-  V.Vector b-translateVecWith f rf cs-  | rf > 2 = error "translateVecWith: reading frame is larger than 2."-  | rf < 0 = error "translateVecWith: reading frame is negative."-  | otherwise = aas-  where-    codons = map fromVecUnsafe $ chopVec 3 $ V.drop rf cs-    aas = V.fromList $ map f codons

@@ -1,36 +0,0 @@--- |--- Module      :  ELynx.Export.Sequence.Fasta--- Description :  Export Fasta sequences--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later--------- Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Write FASTA files.------ [NCBI file specifications](https://blast.ncbi.nlm.nih.gov/Blast.cgi?CMD=Web&PAGE_TYPE=BlastDocs&DOC_TYPE=BlastHelp).-module ELynx.Export.Sequence.Fasta-  ( sequenceToFasta,-    sequencesToFasta,-  )-where--import qualified Data.ByteString.Lazy.Char8 as BL-import ELynx.Data.Sequence.Sequence--fastaHeader :: BL.ByteString -> BL.ByteString -> BL.ByteString-fastaHeader n d =-  BL.singleton '>' <> n <> if BL.null d then BL.empty else BL.pack " " <> d---- | Convert a 'Sequence' to Fasta format.-sequenceToFasta :: Sequence -> BL.ByteString-sequenceToFasta s =-  BL.unlines [fastaHeader (name s) (description s), toByteString $ characters s]---- | Convert a list 'Sequence's to Fasta format. A newline is added between any--- two 'Sequence's.-sequencesToFasta :: [Sequence] -> BL.ByteString-sequencesToFasta ss = BL.concat $ map sequenceToFasta ss

@@ -1,70 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- |--- Module      :  ELynx.Import.Sequence.Fasta--- Description :  Import Fasta sequences--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later--------- Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Parse FASTA files.------ [NCBI file specifications](https://blast.ncbi.nlm.nih.gov/Blast.cgi?CMD=Web&PAGE_TYPE=BlastDocs&DOC_TYPE=BlastHelp).-module ELynx.Import.Sequence.Fasta-  ( fastaSequence,-    fasta,-  )-where--import Control.Applicative-import qualified Data.Attoparsec.ByteString as AS-import qualified Data.Attoparsec.ByteString.Char8 as AC-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Set as S-import Data.Word8 (Word8)-import ELynx.Data.Alphabet.Alphabet as A-import ELynx.Data.Alphabet.Character-import ELynx.Data.Sequence.Sequence--isSpecial :: Char -> Bool-isSpecial w = w `elem` ['_', '|', '.', '-']--isHeader :: Char -> Bool-isHeader w = AC.isAlpha_ascii w || AC.isDigit w || isSpecial w--sequenceHeader :: AS.Parser (BL.ByteString, BL.ByteString)-sequenceHeader = do-  _ <- AC.char '>'-  n <- AC.takeWhile1 isHeader-  _ <- AS.takeWhile AC.isHorizontalSpace-  d <- AC.takeWhile isHeader-  _ <- AC.endOfLine-  return (BL.fromStrict n, BL.fromStrict d)---- It is a little faster to directly pass the set of allowed characters. Then,--- this set only has to be calculcated once per sequence in 'fastaSequence'.-sequenceLine :: S.Set Word8 -> AS.Parser BL.ByteString-sequenceLine s = do-  -- XXX: Will fail for non-capital letters.-  !xs <- AS.takeWhile1 (`S.member` s)-  return (BL.fromStrict xs)---- XXX: If sequences are parsed line by line, the lines have to be copied when--- forming the complete sequence. This is not memory efficient.---- | Parse a sequence of characters.-fastaSequence :: Alphabet -> AS.Parser Sequence-fastaSequence a = do-  (n, d) <- sequenceHeader-  let !alph = S.map toWord (A.all . alphabetSpec $ a)-  lns <- sequenceLine alph `AS.sepBy1` AC.endOfLine-  _ <- many AC.endOfLine-  return $ Sequence n d a (fromByteString $ BL.concat lns)---- | Parse a Fasta file with given 'Alphabet'.-fasta :: Alphabet -> AS.Parser [Sequence]-fasta a = some (fastaSequence a) <* AS.endOfInput

@@ -0,0 +1,323 @@+-- |+-- Module      :  ELynx.Sequence.Alignment+-- Description :  Multi sequence alignment related types and functions+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+--+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:40:18 2018.+--+-- This module is to be imported qualified.+module ELynx.Sequence.Alignment+  ( Alignment (..),+    length,+    nSequences,+    -- | * Input, output+    fromSequences,+    toSequences,+    summarize,+    -- | * Manipulation+    join,+    concat,+    concatAlignments,+    filterColsConstant,+    filterColsConstantSoft,+    filterColsOnlyStd,+    filterColsStd,+    filterColsNoGaps,+    -- | * Analysis+    FrequencyData,+    distribution,+    toFrequencyData,+    kEffEntropy,+    kEffHomoplasy,+    countIUPACChars,+    countGaps,+    countUnknowns,+    -- | * Sub sample+    subSample,+    randomSubSample,+  )+where++import Control.Monad hiding (join)+import Control.Monad.Primitive+import Control.Parallel.Strategies+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.List hiding+  ( concat,+    length,+  )+import qualified Data.Matrix.Unboxed as M+import qualified Data.Vector.Unboxed as V+import qualified ELynx.Alphabet.Alphabet as A+import ELynx.Alphabet.Character+import qualified ELynx.Alphabet.DistributionDiversity as D+import ELynx.Sequence.Defaults+import qualified ELynx.Sequence.Sequence as S+import System.Random.MWC+import Prelude hiding+  ( concat,+    length,+  )++-- | A collection of sequences.+data Alignment = Alignment+  { names :: [S.Name],+    descriptions :: [S.Description],+    alphabet :: A.Alphabet,+    matrix :: M.Matrix Character+  }+  deriving (Show, Eq)++-- | Number of sites.+length :: Alignment -> Int+length = M.cols . matrix++-- | Number of sequences.+nSequences :: Alignment -> Int+nSequences = M.rows . matrix++-- | Create 'Alignment' from a list of 'S.Sequence's.+fromSequences :: [S.Sequence] -> Either String Alignment+fromSequences ss+  | S.equalLength ss && allEqual (map S.alphabet ss) =+    Right $+      Alignment ns ds a d+  | S.equalLength ss = Left "Sequences do not have equal codes."+  | otherwise = Left "Sequences do not have equal lengths."+  where+    ns = map S.name ss+    ds = map S.description ss+    a = S.alphabet $ head ss+    bss = map S.characters ss+    d = M.fromRows bss+    allEqual [] = True+    allEqual xs = all (== head xs) $ tail xs++-- | Conversion to list of 'S.Sequence's.+toSequences :: Alignment -> [S.Sequence]+toSequences (Alignment ns ds a da) =+  zipWith3+    (\n d r -> S.Sequence n d a r)+    ns+    ds+    rows+  where+    rows = M.toRows da++header :: Alignment -> BL.ByteString+header a =+  BL.unlines $+    [ BL.pack "Multi sequence alignment.",+      BL.pack $ "Code: " ++ A.alphabetDescription (alphabet a) ++ ".",+      BL.pack $ "Length: " ++ show (length a) ++ "."+    ]+      ++ reportLengthSummary+      ++ reportNumberSummary+  where+    reportLengthSummary =+      [ BL.pack $+          "For each sequence, the "+            ++ show summaryLength+            ++ " first bases are shown."+        | length a > summaryLength+      ]+    reportNumberSummary =+      [ BL.pack $+          show summaryNSequences+            ++ " out of "+            ++ show (nSequences a)+            ++ " sequences are shown."+        | nSequences a > summaryNSequences+      ]++-- | Similar to 'S.summarizeSequenceList' but with different Header.+summarize :: Alignment -> BL.ByteString+summarize a = header a <> S.body (toSequences a)++-- Vertical concatenation.+(===) :: V.Unbox a => M.Matrix a -> M.Matrix a -> M.Matrix a+(===) l r = M.fromRows $ lRs ++ rRs+  where+    lRs = M.toRows l+    rRs = M.toRows r++-- Horizontal concatenation.+(|||) :: V.Unbox a => M.Matrix a -> M.Matrix a -> M.Matrix a+(|||) l r = M.fromColumns $ lCs ++ rCs+  where+    lCs = M.toColumns l+    rCs = M.toColumns r++-- | Join two 'Alignment's vertically. That is, add more sequences+-- to an alignment. See also 'concat'.+join :: Alignment -> Alignment -> Alignment+-- top bottom.+join t b+  | length t /= length b =+    error+      "join: Multi sequence alignments do not have equal lengths."+  | alphabet t /= alphabet b =+    error+      "join: Multi sequence alignments do not have equal alphabets."+  | otherwise = Alignment ns ds al (tD === bD)+  where+    ns = names t ++ names b+    ds = descriptions t ++ descriptions b+    tD = matrix t+    bD = matrix b+    al = alphabet t++-- | Concatenate two 'Alignment's horizontally. That is, add more+-- sites to an alignment. See also 'join'.+concat :: Alignment -> Alignment -> Alignment+-- left right.+concat l r+  | nSequences l /= nSequences r =+    error+      "concat: Multi sequence alignments do not have an equal number of sequences."+  | alphabet l /= alphabet r =+    error "concat: Multi sequence alignments do not have an equal alphabets."+  | names l /= names r =+    error "concat: Multi sequence alignments do not have an equal names."+  | descriptions l /= descriptions r =+    error "concat: Multi sequence alignments do not have an equal descriptions."+  | otherwise =+    Alignment (names l) (descriptions l) (alphabet l) (lD ||| rD)+  where+    lD = matrix l+    rD = matrix r++-- | Concatenate a list of 'Alignment's horizontally. See+-- 'concat'.+concatAlignments :: [Alignment] -> Alignment+concatAlignments [] = error "concatAlignments: Nothing to concatenate."+concatAlignments [a] = a+concatAlignments as = foldl' concat (head as) (tail as)++-- Only keep columns from alignment that satisfy given predicate.+filterColsWith :: (V.Vector Character -> Bool) -> Alignment -> Alignment+filterColsWith p a = a {matrix = m'}+  where+    m' = M.fromColumns . filter p . M.toColumns $ matrix a++-- | Only keep constant columns.+filterColsConstant :: Alignment -> Alignment+filterColsConstant = filterColsWith (\v -> V.all (== V.head v) v)++-- | Only keep constant columns, and constant columns with at least one standard+-- character as well as any number of gaps or unknowns.+filterColsConstantSoft :: Alignment -> Alignment+filterColsConstantSoft a = filterColsWith f a+  where+    al = alphabet a+    f v = case V.find (A.isStd al) v of+      Nothing -> False+      Just c -> V.all (\x -> x == c || A.isGap al x || A.isUnknown al x) v++-- | Only keep columns with standard characters. Alignment columns with IUPAC+-- characters are removed.+filterColsOnlyStd :: Alignment -> Alignment+filterColsOnlyStd a = filterColsWith (V.all $ A.isStd (alphabet a)) a++-- | Filter columns with proportion of standard character larger than given number.+filterColsStd :: Double -> Alignment -> Alignment+filterColsStd prop a =+  filterColsWith+    (\col -> prop * n <= fromIntegral (V.length (V.filter (A.isStd al) col)))+    a+  where+    al = alphabet a+    n = fromIntegral $ nSequences a++-- | Only keep columns without gaps or unknown characters.+filterColsNoGaps :: Alignment -> Alignment+filterColsNoGaps a = filterColsWith (V.all $ not . A.isGap (alphabet a)) a++-- | Frequency data; do not store the actual characters, but their frequencies.+-- The matrix is of size @N x K@, where @N@ is the number of sites, and @K@ is+-- the number of characters.+type FrequencyData = M.Matrix Double++-- Map a function on each column of a DIM2 array; parallel version with given chunk size.+fMapColParChunk ::+  (V.Unbox a, V.Unbox b) =>+  Int ->+  (V.Vector a -> V.Vector b) ->+  M.Matrix a ->+  M.Matrix b+fMapColParChunk n f m =+  M.fromColumns (map f (M.toColumns m) `using` parListChunk n rseq)++-- | Calculcate frequency of characters at each site of a multi sequence alignment.+toFrequencyData :: Alignment -> FrequencyData+toFrequencyData a = fMapColParChunk 100 (D.frequencyCharacters spec) (matrix a)+  where+    spec = A.alphabetSpec (alphabet a)++-- | Calculate the distribution of characters.+distribution :: FrequencyData -> [Double]+distribution fd =+  map (/ fromIntegral nSites) $+    V.toList $+      foldl1+        (V.zipWith (+))+        (M.toColumns fd)+  where+    nSites = M.cols fd++-- Parallel map with given chunk size.+parMapChunk :: Int -> (a -> b) -> [a] -> [b]+parMapChunk n f as = map f as `using` parListChunk n rseq++chunksize :: Int+chunksize = 500++-- | Diversity analysis. See 'kEffEntropy'.+kEffEntropy :: FrequencyData -> [Double]+kEffEntropy fd = parMapChunk chunksize D.kEffEntropy (M.toColumns fd)++-- | Diversity analysis. See 'kEffEntropy'.+kEffHomoplasy :: FrequencyData -> [Double]+kEffHomoplasy fd = parMapChunk chunksize D.kEffHomoplasy (M.toColumns fd)++-- | Count the number of standard (i.e., not extended IUPAC) characters in the+-- alignment.+countIUPACChars :: Alignment -> Int+countIUPACChars a = V.length . V.filter (A.isIUPAC (alphabet a)) $ allChars+  where+    allChars = M.flatten $ matrix a++-- | Count the number of gaps in the alignment.+countGaps :: Alignment -> Int+countGaps a = V.length . V.filter (A.isGap (alphabet a)) $ allChars+  where+    allChars = M.flatten $ matrix a++-- | Count the number of unknown characters in the alignment.+countUnknowns :: Alignment -> Int+countUnknowns a = V.length . V.filter (A.isUnknown (alphabet a)) $ allChars+  where+    allChars = M.flatten $ matrix a++-- Sample the given sites from a matrix.+subSampleMatrix :: V.Unbox a => [Int] -> M.Matrix a -> M.Matrix a+subSampleMatrix is m =+  M.fromColumns $ foldl' (\a i -> M.takeColumn m i : a) [] (reverse is)++-- | Sample the given sites from a multi sequence alignment.+subSample :: [Int] -> Alignment -> Alignment+subSample is a = a {matrix = m'} where m' = subSampleMatrix is $ matrix a++-- | Randomly sample a given number of sites of the multi sequence alignment.+randomSubSample ::+  PrimMonad m => Int -> Alignment -> Gen (PrimState m) -> m Alignment+randomSubSample n a g = do+  let l = length a+  is <- replicateM n $ uniformR (0, l - 1) g+  return $ subSample is a

@@ -0,0 +1,34 @@+-- |+-- Module      :  ELynx.Defaults+-- Description :  Various default values+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Oct  5 23:00:17 2018.+module ELynx.Sequence.Defaults+  ( nameWidth,+    summaryLength,+    summaryNSequences,+    fieldWidth,+  )+where++-- | Space reserved for sequence names when printing them.+nameWidth :: Int+nameWidth = 23++-- | The length shown when summarizing sequences.+summaryLength :: Int+summaryLength = 60++-- | How many sequences are shown in summary.+summaryNSequences :: Int+summaryNSequences = 200++-- | Field width for tables.+fieldWidth :: Int+fieldWidth = 13

@@ -0,0 +1,33 @@+-- |+-- Module      :  ELynx.Sequence.Distance+-- Description :  Distance functions between sequences+-- Copyright   :  (c) Dominik Schrempf, 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Aug 21 15:09:58 2020.+module ELynx.Sequence.Distance+  ( hamming,+  )+where++import qualified Data.Vector.Unboxed as V+import ELynx.Sequence.Sequence++countFalses :: (Int -> Bool -> Int)+countFalses n False = succ n+countFalses n True = n++-- | Compute hamming distance between two sequences.+hamming :: Sequence -> Sequence -> Either String Int+hamming l r+  | alphabet l /= alphabet r = Left "hamming: Alphabets of sequences differ."+  | V.length csL /= V.length csR = Left "hamming: Sequence lengths differ."+  | V.null csL || V.null csR = Left "hamming: Empty sequence encountered."+  | otherwise = Right $ V.foldl' countFalses 0 $ V.zipWith (==) (characters l) (characters r)+  where+    csL = characters l+    csR = characters r

@@ -0,0 +1,36 @@+-- |+-- Module      :  ELynx.Sequence.Export.Fasta+-- Description :  Export Fasta sequences+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Write FASTA files.+--+-- [NCBI file specifications](https://blast.ncbi.nlm.nih.gov/Blast.cgi?CMD=Web&PAGE_TYPE=BlastDocs&DOC_TYPE=BlastHelp).+module ELynx.Sequence.Export.Fasta+  ( sequenceToFasta,+    sequencesToFasta,+  )+where++import qualified Data.ByteString.Lazy.Char8 as BL+import ELynx.Sequence.Sequence++fastaHeader :: BL.ByteString -> BL.ByteString -> BL.ByteString+fastaHeader n d =+  BL.singleton '>' <> n <> if BL.null d then BL.empty else BL.pack " " <> d++-- | Convert a 'Sequence' to Fasta format.+sequenceToFasta :: Sequence -> BL.ByteString+sequenceToFasta s =+  BL.unlines [fastaHeader (name s) (description s), toByteString $ characters s]++-- | Convert a list 'Sequence's to Fasta format. A newline is added between any+-- two 'Sequence's.+sequencesToFasta :: [Sequence] -> BL.ByteString+sequencesToFasta ss = BL.concat $ map sequenceToFasta ss

@@ -0,0 +1,70 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  ELynx.Sequence.Import.Fasta+-- Description :  Import Fasta sequences+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Parse FASTA files.+--+-- [NCBI file specifications](https://blast.ncbi.nlm.nih.gov/Blast.cgi?CMD=Web&PAGE_TYPE=BlastDocs&DOC_TYPE=BlastHelp).+module ELynx.Sequence.Import.Fasta+  ( fastaSequence,+    fasta,+  )+where++import Control.Applicative+import qualified Data.Attoparsec.ByteString as AS+import qualified Data.Attoparsec.ByteString.Char8 as AC+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Set as S+import Data.Word8 (Word8)+import ELynx.Alphabet.Alphabet as A+import ELynx.Alphabet.Character+import ELynx.Sequence.Sequence++isSpecial :: Char -> Bool+isSpecial w = w `elem` ['_', '|', '.', '-']++isHeader :: Char -> Bool+isHeader w = AC.isAlpha_ascii w || AC.isDigit w || isSpecial w++sequenceHeader :: AS.Parser (BL.ByteString, BL.ByteString)+sequenceHeader = do+  _ <- AC.char '>'+  n <- AC.takeWhile1 isHeader+  _ <- AS.takeWhile AC.isHorizontalSpace+  d <- AC.takeWhile isHeader+  _ <- AC.endOfLine+  return (BL.fromStrict n, BL.fromStrict d)++-- It is a little faster to directly pass the set of allowed characters. Then,+-- this set only has to be calculcated once per sequence in 'fastaSequence'.+sequenceLine :: S.Set Word8 -> AS.Parser BL.ByteString+sequenceLine s = do+  -- XXX: Will fail for non-capital letters.+  !xs <- AS.takeWhile1 (`S.member` s)+  return (BL.fromStrict xs)++-- XXX: If sequences are parsed line by line, the lines have to be copied when+-- forming the complete sequence. This is not memory efficient.++-- | Parse a sequence of characters.+fastaSequence :: Alphabet -> AS.Parser Sequence+fastaSequence a = do+  (n, d) <- sequenceHeader+  let !alph = S.map toWord (A.all . alphabetSpec $ a)+  lns <- sequenceLine alph `AS.sepBy1` AC.endOfLine+  _ <- many AC.endOfLine+  return $ Sequence n d a (fromByteString $ BL.concat lns)++-- | Parse a Fasta file with given 'Alphabet'.+fasta :: Alphabet -> AS.Parser [Sequence]+fasta a = some (fastaSequence a) <* AS.endOfInput

@@ -0,0 +1,244 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      :  ELynx.Sequence+-- Description :  Hereditary sequences+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Thu Oct  4 18:54:51 2018.+--+-- This module is to be imported qualified.+module ELynx.Sequence.Sequence+  ( -- * Types+    Name,+    Description,+    Characters,+    Sequence (..),++    -- * Input+    fromByteString,++    -- * Output+    toByteString,+    header,+    summarize,+    summarizeSequences,+    body,++    -- * Analysis+    length,+    equalLength,+    longest,++    -- * Manipulation+    trim,+    concat,+    concatSequences,++    -- * Filtering+    filterShorterThan,+    filterLongerThan,+    filterStandard,+  )+where++import Control.Parallel.Strategies+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.List (maximumBy)+import Data.Ord (comparing)+import qualified Data.Vector.Unboxed as V+import qualified ELynx.Alphabet.Alphabet as A+import ELynx.Alphabet.Character+import ELynx.Sequence.Defaults+import qualified Text.Printf as P+import Prelude hiding+  ( concat,+    length,+  )+import qualified Prelude as Pr+  ( length,+  )++-- | For now, 'Name's are just 'BL.ByteString's.+type Name = BL.ByteString++-- | The description of a sequence.+type Description = BL.ByteString++-- | The vector of characters of a sequence.+type Characters = V.Vector Character++-- | Convert byte string to sequence characters.+fromByteString :: BL.ByteString -> Characters+fromByteString = V.fromList . map fromChar . BL.unpack++-- | Convert sequence characters to byte string.+toByteString :: Characters -> BL.ByteString+toByteString = BL.pack . map toChar . V.toList++-- | Sequences have a name, a possibly empty description, a code and hopefully a+-- lot of data.+data Sequence = Sequence+  { name :: Name,+    description :: Description,+    alphabet :: A.Alphabet,+    characters :: Characters+  }+  deriving (Show, Eq)++alignRight :: Int -> BL.ByteString -> BL.ByteString+alignRight n s =+  BL.replicate (fromIntegral n - l) ' ' <> BL.take (fromIntegral n) s+  where+    l = BL.length s++alignLeft :: Int -> BL.ByteString -> BL.ByteString+alignLeft n s =+  BL.take (fromIntegral n) s <> BL.replicate (fromIntegral n - l) ' '+  where+    l = BL.length s++getInfo :: Sequence -> BL.ByteString+getInfo s =+  BL.unwords+    [ alignLeft nameWidth (name s),+      alignRight fieldWidth (BL.pack $ show $ alphabet s),+      alignRight fieldWidth (BL.pack . show $ len),+      alignRight fieldWidth (BL.pack $ P.printf "%2.2f" pGaps)+    ]+  where+    len = length s+    nGaps = countGaps s+    pGaps = 100 * fromIntegral nGaps / fromIntegral len :: Double++-- If a string is longer than a given value, trim it and add some dots.+summarizeByteString :: Int -> BL.ByteString -> BL.ByteString+summarizeByteString l s+  | BL.length s >= fromIntegral l = BL.take (fromIntegral l) s <> BL.pack "..."+  | otherwise = s++-- | Trim and show a 'Sequence'.+summarize :: Sequence -> BL.ByteString+summarize s =+  BL.unwords+    [getInfo s, summarizeByteString summaryLength $ toByteString (characters s)]++-- | Trim and show a list of 'Sequence's.+summarizeSequences :: [Sequence] -> BL.ByteString+summarizeSequences ss = header ss <> body (take summaryNSequences ss)++-- | Header printed before 'Sequence' list.+tableHeader :: BL.ByteString+tableHeader =+  BL.unwords+    [ alignLeft nameWidth "Name",+      alignRight fieldWidth "Code",+      alignRight fieldWidth "Length",+      alignRight fieldWidth "Gaps [%]",+      "Sequence"+    ]++-- | A short description of the sequence.+header :: [Sequence] -> BL.ByteString+header ss =+  BL.unlines $+    reportIfSubsetIsShown+      ++ [ BL.pack $+             "For each sequence, the "+               ++ show summaryLength+               ++ " first bases are shown.",+           BL.pack $ "List contains " ++ show (Pr.length ss) ++ " sequences.",+           "",+           tableHeader+         ]+  where+    l = Pr.length ss+    s =+      show summaryNSequences+        ++ " out of "+        ++ show (Pr.length ss)+        ++ " sequences are shown."+    reportIfSubsetIsShown+      | l > summaryNSequences = [BL.pack s]+      | otherwise = []++-- | Trim and show a list of 'Sequence's.+body :: [Sequence] -> BL.ByteString+body ss = BL.unlines (map summarize ss `using` parListChunk 5 rdeepseq)++-- | Calculate length of 'Sequence'.+length :: Sequence -> Int+length = fromIntegral . V.length . characters++-- | Check if all 'Sequence's have equal length.+equalLength :: [Sequence] -> Bool+equalLength = allEqual . map length+  where+    allEqual [] = True+    allEqual xs = all (== head xs) $ tail xs++-- | Find the longest 'Sequence' in a list.+longest :: [Sequence] -> Sequence+longest = maximumBy (comparing length)++-- | Count number of gaps or unknown characters in sequence.+countGaps :: Sequence -> Int+countGaps s = V.length . V.filter (A.isGap $ alphabet s) $ characters s++-- | Trim to given length.+trim :: Int -> Sequence -> Sequence+trim n (Sequence nm d a cs) = Sequence nm d a (V.take (fromIntegral n) cs)++-- | Concatenate two sequences. 'Name's have to match.+concat :: Sequence -> Sequence -> Sequence+concat (Sequence i d c cs) (Sequence j f k ks)+  | i /= j =+    error $+      "concatenate: Sequences do not have equal names: "+        ++ BL.unpack i+        ++ ", "+        ++ BL.unpack j+        ++ "."+  | d /= f =+    error $+      "concatenate: Sequences do not have equal descriptions: "+        ++ BL.unpack d+        ++ ", "+        ++ BL.unpack f+        ++ "."+  | c /= k =+    error $+      "concatenate: Sequences do not have equal alphabets: "+        ++ show c+        ++ ", "+        ++ show k+        ++ "."+  | otherwise =+    Sequence i d c (cs <> ks)++-- | Concatenate a list of sequences, see 'concat'.+concatSequences :: [[Sequence]] -> [Sequence]+concatSequences [] = error "concatenateSequences: Nothing to concatenate."+concatSequences [ss] = ss+concatSequences sss = foldl1 (zipWith concat) sss++-- | Only take 'Sequence's that are shorter than a given number.+filterShorterThan :: Int -> [Sequence] -> [Sequence]+filterShorterThan n = filter (\x -> length x < n)++-- | Only take 'Sequence's that are longer than a given number.+filterLongerThan :: Int -> [Sequence] -> [Sequence]+filterLongerThan n = filter (\x -> length x > n)++-- | Only take 'Sequence's that contain at least on non-IUPAC character.+filterStandard :: [Sequence] -> [Sequence]+filterStandard = filter (\s -> anyStandard (alphabet s) s)++-- Are all characters IUPAC characters?+anyStandard :: A.Alphabet -> Sequence -> Bool+anyStandard a s = V.any (A.isStd a) cs where cs = characters s

@@ -0,0 +1,53 @@+-- |+-- Module      :  ELynx.Sequence.Translate+-- Description :  Translate sequences+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri May 17 13:49:18 2019.+module ELynx.Sequence.Translate+  ( translateSeq,+  )+where++import qualified Data.Vector.Unboxed as V+import ELynx.Alphabet.Alphabet+import qualified ELynx.Alphabet.Character as C+import ELynx.Character.Codon+import ELynx.Sequence.Sequence++-- Chop list into chunks of given length. If the last chop is shorter than+-- length, it is dropped.+chopVec :: V.Unbox a => Int -> V.Vector a -> [V.Vector a]+chopVec n xs+  | V.length xs < n = []+  | otherwise = V.take n xs : chopVec n (V.drop n xs)++-- | Translate a sequence from 'DNA' or 'DNAX' to 'ProteinS'.+translateSeq :: UniversalCode -> Int -> Sequence -> Sequence+translateSeq uc rf (Sequence n d a cs) = case a of+  DNA -> Sequence n d ProteinS (cs' $ translate uc)+  DNAX -> Sequence n d ProteinS (cs' $ translateX uc)+  DNAI -> Sequence n d ProteinI (cs' $ translateI uc)+  _ -> error "translate: can only translate DNA, DNAX, and DNAI."+  where+    cs' f = C.fromCVec $ translateVecWith f rf (C.toCVec cs)++-- Translate from DNA to Protein with given reading frame (0, 1, 2).+translateVecWith ::+  (V.Unbox a, Ord a, V.Unbox b) =>+  (Codon a -> b) ->+  Int ->+  V.Vector a ->+  V.Vector b+translateVecWith f rf cs+  | rf > 2 = error "translateVecWith: reading frame is larger than 2."+  | rf < 0 = error "translateVecWith: reading frame is negative."+  | otherwise = aas+  where+    codons = map fromVecUnsafe $ chopVec 3 $ V.drop rf cs+    aas = V.fromList $ map f codons

@@ -0,0 +1,54 @@+-- |+-- Module      :  ELynx.Alphabet.DistributionDiversitySpec+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Mon Feb 25 13:41:12 2019.+module ELynx.Alphabet.DistributionDiversitySpec+  ( spec,+  )+where++import qualified Data.Vector.Unboxed as V+import ELynx.Alphabet.DistributionDiversity+import ELynx.Tools.Equality+import Test.Hspec++testArr1 :: V.Vector Double+testArr1 = V.replicate 20 0.0++testArr2 :: V.Vector Double+testArr2 = V.fromList [0, 0, 0, 1, 0]++-- Compare results from random array tested with Python functions.+testArr3 :: V.Vector Double+testArr3 = V.fromList [0.3, 0.4, 0.7]++spec :: Spec+spec = do+  describe "entropy" $+    it "calculates entropy of vectors" $ do+      entropy testArr1 `shouldBe` 0.0+      entropy testArr2 `shouldBe` 0.0+      entropy testArr3 `shouldSatisfy` nearlyEq 0.9773805948045555+  describe "kEffEntropy" $+    it "calculates the effective number of used states using entropy" $+      do+        kEffEntropy testArr1 `shouldBe` 1.0+        kEffEntropy testArr2 `shouldBe` 1.0+        kEffEntropy testArr3 `shouldSatisfy` nearlyEq 2.6574860842252765+  describe "homoplasy" $+    it "calculates homoplasy of vectors" $ do+      homoplasy testArr1 `shouldBe` 0.0+      homoplasy testArr2 `shouldBe` 1.0+      homoplasy testArr3 `shouldSatisfy` nearlyEq 0.74+  describe "kEffHomoplasy" $+    it "calculates the effective number of used states using homoplasy" $+      do+        kEffHomoplasy testArr1 `shouldSatisfy` isInfinite+        kEffHomoplasy testArr2 `shouldBe` 1.0+        kEffHomoplasy testArr3 `shouldSatisfy` nearlyEq 1.3513513513513513

@@ -1,54 +0,0 @@--- |--- Module      :  ELynx.Data.Alphabet.DistributionDiversitySpec--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Mon Feb 25 13:41:12 2019.-module ELynx.Data.Alphabet.DistributionDiversitySpec-  ( spec,-  )-where--import qualified Data.Vector.Unboxed as V-import ELynx.Data.Alphabet.DistributionDiversity-import ELynx.Tools.Equality-import Test.Hspec--testArr1 :: V.Vector Double-testArr1 = V.replicate 20 0.0--testArr2 :: V.Vector Double-testArr2 = V.fromList [0, 0, 0, 1, 0]---- Compare results from random array tested with Python functions.-testArr3 :: V.Vector Double-testArr3 = V.fromList [0.3, 0.4, 0.7]--spec :: Spec-spec = do-  describe "entropy" $-    it "calculates entropy of vectors" $ do-      entropy testArr1 `shouldBe` 0.0-      entropy testArr2 `shouldBe` 0.0-      entropy testArr3 `shouldSatisfy` nearlyEq 0.9773805948045555-  describe "kEffEntropy" $-    it "calculates the effective number of used states using entropy" $-      do-        kEffEntropy testArr1 `shouldBe` 1.0-        kEffEntropy testArr2 `shouldBe` 1.0-        kEffEntropy testArr3 `shouldSatisfy` nearlyEq 2.6574860842252765-  describe "homoplasy" $-    it "calculates homoplasy of vectors" $ do-      homoplasy testArr1 `shouldBe` 0.0-      homoplasy testArr2 `shouldBe` 1.0-      homoplasy testArr3 `shouldSatisfy` nearlyEq 0.74-  describe "kEffHomoplasy" $-    it "calculates the effective number of used states using homoplasy" $-      do-        kEffHomoplasy testArr1 `shouldSatisfy` isInfinite-        kEffHomoplasy testArr2 `shouldBe` 1.0-        kEffHomoplasy testArr3 `shouldSatisfy` nearlyEq 1.3513513513513513

@@ -1,47 +0,0 @@--- |--- Module      :  ELynx.Data.Sequence.AlignmentSpec--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Oct  5 14:25:42 2018.-module ELynx.Data.Sequence.AlignmentSpec-  ( spec,-  )-where--import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Matrix.Unboxed as M-import ELynx.Data.Alphabet.Alphabet-import ELynx.Data.Alphabet.Character-import ELynx.Data.Sequence.Alignment-import ELynx.Import.Sequence.Fasta-import ELynx.Tools.InputOutput-import Test.Hspec--fastaNucleotideIUPACFN :: FilePath-fastaNucleotideIUPACFN = "data/NucleotideIUPAC.fasta"--ssData :: M.Matrix Character-ssData = M.fromLists $ map (map fromChar) ["AAA", "GAA", "TAA"]--ssA :: Alignment-ssA =-  Alignment-    (map BL.pack ["SEQUENCE_1", "SEQUENCE_2", "SEQUENCE_3"])-    (replicate 3 BL.empty)-    DNAI-    ssData--spec :: Spec-spec = describe "subSample" $-  it "correctly sub sample an Alignment" $ do-    a <--      either error id-        . fromSequences-        <$> parseFileWith (fasta DNAI) fastaNucleotideIUPACFN-    let ss = subSample [0, 3, 5] a-    ss `shouldBe` ssA

@@ -1,48 +0,0 @@--- |--- Module      :  ELynx.Data.Sequence.SequenceSpec--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Oct  5 14:25:42 2018.-module ELynx.Data.Sequence.SequenceSpec-  ( spec,-  )-where--import qualified Data.ByteString.Lazy.Char8 as BL-import ELynx.Data.Alphabet.Alphabet-import ELynx.Data.Sequence.Sequence-import ELynx.Import.Sequence.Fasta-import ELynx.Tools.InputOutput-import Test.Hspec--fastaDifferentLengthFN :: FilePath-fastaDifferentLengthFN = "data/NucleotideDifferentLength.fasta"--fastaDifferentLengthTrimmedFN :: FilePath-fastaDifferentLengthTrimmedFN = "data/NucleotideDifferentLengthTrimmed.fasta"--longestSequenceInFileBS :: BL.ByteString-longestSequenceInFileBS =-  BL.unlines $-    map BL.pack [">SEQUENCE_3", "ATTTAAAAAAACCCAAAACCCGGGCCCCGGGTTTTTTTA"]--longestSequenceInFile :: Sequence-longestSequenceInFile = parseByteStringWith (fastaSequence DNA) longestSequenceInFileBS--spec :: Spec-spec = do-  describe "longest" $-    it "finds the longest sequence" $ do-      ss <- parseFileWith (fasta DNA) fastaDifferentLengthFN-      longest ss `shouldBe` longestSequenceInFile-  describe "filterLongerThan" $-    it "filters sequences that are longer than a specified length" $-      do-        ss <- parseFileWith (fasta DNA) fastaDifferentLengthFN-        ss' <- parseFileWith (fasta DNA) fastaDifferentLengthTrimmedFN-        filterLongerThan 10 ss `shouldBe` ss'

@@ -1,35 +0,0 @@--- |--- Module      :  ELynx.Data.Sequence.TranslateSpec--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Oct  5 14:25:42 2018.-module ELynx.Data.Sequence.TranslateSpec-  ( spec,-  )-where--import ELynx.Data.Alphabet.Alphabet-import ELynx.Data.Character.Codon-import ELynx.Data.Sequence.Translate-import ELynx.Import.Sequence.Fasta-import ELynx.Tools.InputOutput-import Test.Hspec--fastaTranslateDNAFN :: FilePath-fastaTranslateDNAFN = "data/TranslateMitochondrialVertebrateDNA.fasta"--fastaTranslateProteinFN :: FilePath-fastaTranslateProteinFN = "data/TranslateMitochondrialVertebrateProtein.fasta"--spec :: Spec-spec =-  describe "translateDNAX" $-    it "correctly translates a test sequence" $ do-      ss <- parseFileWith (fasta DNAX) fastaTranslateDNAFN-      ss' <- parseFileWith (fasta ProteinS) fastaTranslateProteinFN-      map (translateSeq VertebrateMitochondrial 0) ss `shouldBe` ss'

@@ -1,34 +0,0 @@--- |--- Module      :  ELynx.Export.Sequence.FastaSpec--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Jan 18 09:59:57 2019.-module ELynx.Export.Sequence.FastaSpec-  ( spec,-  )-where--import ELynx.Data.Alphabet.Alphabet-import ELynx.Export.Sequence.Fasta-import ELynx.Import.Sequence.Fasta-import ELynx.Tools.InputOutput-import Test.Hspec--fastaNucleotideIUPACFN :: FilePath-fastaNucleotideIUPACFN = "data/NucleotideIUPAC.fasta"--spec :: Spec-spec =-  describe "sequencesToFasta" $-    it-      "should create a fasta bytestring that, when parsed again, is the original sequence"-      $ do-        ss <- parseFileWith (fasta DNAI) fastaNucleotideIUPACFN-        let f = sequencesToFasta ss-            ss' = parseByteStringWith (fasta DNAI) f-        ss `shouldBe` ss'

@@ -1,64 +0,0 @@--- |--- Module      :  ELynx.Import.Sequence.FastaSpec--- Copyright   :  (c) Dominik Schrempf 2021--- License     :  GPL-3.0-or-later------ Maintainer  :  dominik.schrempf@gmail.com--- Stability   :  unstable--- Portability :  portable------ Creation date: Fri Jan 18 09:54:38 2019.-module ELynx.Import.Sequence.FastaSpec-  ( spec,-  )-where--import Data.Either-import ELynx.Data.Alphabet.Alphabet-import qualified ELynx.Data.Sequence.Alignment as M-import ELynx.Import.Sequence.Fasta-import ELynx.Tools.InputOutput-import Test.Hspec--fastaNucleotideFN :: FilePath-fastaNucleotideFN = "data/Nucleotide.fasta"--fastaNucleotideIUPACFN :: FilePath-fastaNucleotideIUPACFN = "data/NucleotideIUPAC.fasta"--fastaErroneousFN :: FilePath-fastaErroneousFN = "data/Erroneous.fasta"--fastaAminoAcidFN :: FilePath-fastaAminoAcidFN = "data/AminoAcid.fasta"--spec :: Spec-spec = describe "fastaFileAlignment" $ do-  it "parses a fasta file with nucleotide sequences with equal length" $ do-    a <--      either error id-        . M.fromSequences-        <$> parseFileWith (fasta DNA) fastaNucleotideFN-    M.nSequences a `shouldBe` 3-    M.length a `shouldBe` 40-  it "parses a fasta file with nucleotide IUPAC sequences with equal length" $-    do-      a <--        either error id-          . M.fromSequences-          <$> parseFileWith (fasta DNAI) fastaNucleotideIUPACFN-      M.nSequences a `shouldBe` 3-      M.length a `shouldBe` 40-  it "should not parse erroneous files" $ do-    ea <- runParserOnFile (fasta DNAI) fastaErroneousFN-    ea `shouldSatisfy` isLeft-  it "parses a fasta file with amino acid sequences with equal length" $ do-    a <--      either error id-        . M.fromSequences-        <$> parseFileWith (fasta Protein) fastaAminoAcidFN-    M.nSequences a `shouldBe` 2-    M.length a `shouldBe` 237-  it "should not parse erroneous files" $ do-    a <- runParserOnFile (fasta ProteinI) fastaErroneousFN-    a `shouldSatisfy` isLeft

@@ -0,0 +1,47 @@+-- |+-- Module      :  ELynx.Sequence.AlignmentSpec+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Oct  5 14:25:42 2018.+module ELynx.Sequence.AlignmentSpec+  ( spec,+  )+where++import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.Matrix.Unboxed as M+import ELynx.Alphabet.Alphabet+import ELynx.Alphabet.Character+import ELynx.Sequence.Alignment+import ELynx.Sequence.Import.Fasta+import ELynx.Tools.InputOutput+import Test.Hspec++fastaNucleotideIUPACFN :: FilePath+fastaNucleotideIUPACFN = "data/NucleotideIUPAC.fasta"++ssData :: M.Matrix Character+ssData = M.fromLists $ map (map fromChar) ["AAA", "GAA", "TAA"]++ssA :: Alignment+ssA =+  Alignment+    (map BL.pack ["SEQUENCE_1", "SEQUENCE_2", "SEQUENCE_3"])+    (replicate 3 BL.empty)+    DNAI+    ssData++spec :: Spec+spec = describe "subSample" $+  it "correctly sub sample an Alignment" $ do+    a <-+      either error id+        . fromSequences+        <$> parseFileWith (fasta DNAI) fastaNucleotideIUPACFN+    let ss = subSample [0, 3, 5] a+    ss `shouldBe` ssA

@@ -0,0 +1,34 @@+-- |+-- Module      :  ELynx.Sequence.Export.FastaSpec+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Jan 18 09:59:57 2019.+module ELynx.Sequence.Export.FastaSpec+  ( spec,+  )+where++import ELynx.Alphabet.Alphabet+import ELynx.Sequence.Export.Fasta+import ELynx.Sequence.Import.Fasta+import ELynx.Tools.InputOutput+import Test.Hspec++fastaNucleotideIUPACFN :: FilePath+fastaNucleotideIUPACFN = "data/NucleotideIUPAC.fasta"++spec :: Spec+spec =+  describe "sequencesToFasta" $+    it+      "should create a fasta bytestring that, when parsed again, is the original sequence"+      $ do+        ss <- parseFileWith (fasta DNAI) fastaNucleotideIUPACFN+        let f = sequencesToFasta ss+            ss' = parseByteStringWith (fasta DNAI) f+        ss `shouldBe` ss'

@@ -0,0 +1,64 @@+-- |+-- Module      :  ELynx.Sequence.Import.FastaSpec+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Jan 18 09:54:38 2019.+module ELynx.Sequence.Import.FastaSpec+  ( spec,+  )+where++import Data.Either+import ELynx.Alphabet.Alphabet+import qualified ELynx.Sequence.Alignment as M+import ELynx.Sequence.Import.Fasta+import ELynx.Tools.InputOutput+import Test.Hspec++fastaNucleotideFN :: FilePath+fastaNucleotideFN = "data/Nucleotide.fasta"++fastaNucleotideIUPACFN :: FilePath+fastaNucleotideIUPACFN = "data/NucleotideIUPAC.fasta"++fastaErroneousFN :: FilePath+fastaErroneousFN = "data/Erroneous.fasta"++fastaAminoAcidFN :: FilePath+fastaAminoAcidFN = "data/AminoAcid.fasta"++spec :: Spec+spec = describe "fastaFileAlignment" $ do+  it "parses a fasta file with nucleotide sequences with equal length" $ do+    a <-+      either error id+        . M.fromSequences+        <$> parseFileWith (fasta DNA) fastaNucleotideFN+    M.nSequences a `shouldBe` 3+    M.length a `shouldBe` 40+  it "parses a fasta file with nucleotide IUPAC sequences with equal length" $+    do+      a <-+        either error id+          . M.fromSequences+          <$> parseFileWith (fasta DNAI) fastaNucleotideIUPACFN+      M.nSequences a `shouldBe` 3+      M.length a `shouldBe` 40+  it "should not parse erroneous files" $ do+    ea <- runParserOnFile (fasta DNAI) fastaErroneousFN+    ea `shouldSatisfy` isLeft+  it "parses a fasta file with amino acid sequences with equal length" $ do+    a <-+      either error id+        . M.fromSequences+        <$> parseFileWith (fasta Protein) fastaAminoAcidFN+    M.nSequences a `shouldBe` 2+    M.length a `shouldBe` 237+  it "should not parse erroneous files" $ do+    a <- runParserOnFile (fasta ProteinI) fastaErroneousFN+    a `shouldSatisfy` isLeft

@@ -0,0 +1,48 @@+-- |+-- Module      :  ELynx.Sequence.SequenceSpec+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Oct  5 14:25:42 2018.+module ELynx.Sequence.SequenceSpec+  ( spec,+  )+where++import qualified Data.ByteString.Lazy.Char8 as BL+import ELynx.Alphabet.Alphabet+import ELynx.Sequence.Import.Fasta+import ELynx.Sequence.Sequence+import ELynx.Tools.InputOutput+import Test.Hspec++fastaDifferentLengthFN :: FilePath+fastaDifferentLengthFN = "data/NucleotideDifferentLength.fasta"++fastaDifferentLengthTrimmedFN :: FilePath+fastaDifferentLengthTrimmedFN = "data/NucleotideDifferentLengthTrimmed.fasta"++longestSequenceInFileBS :: BL.ByteString+longestSequenceInFileBS =+  BL.unlines $+    map BL.pack [">SEQUENCE_3", "ATTTAAAAAAACCCAAAACCCGGGCCCCGGGTTTTTTTA"]++longestSequenceInFile :: Sequence+longestSequenceInFile = parseByteStringWith (fastaSequence DNA) longestSequenceInFileBS++spec :: Spec+spec = do+  describe "longest" $+    it "finds the longest sequence" $ do+      ss <- parseFileWith (fasta DNA) fastaDifferentLengthFN+      longest ss `shouldBe` longestSequenceInFile+  describe "filterLongerThan" $+    it "filters sequences that are longer than a specified length" $+      do+        ss <- parseFileWith (fasta DNA) fastaDifferentLengthFN+        ss' <- parseFileWith (fasta DNA) fastaDifferentLengthTrimmedFN+        filterLongerThan 10 ss `shouldBe` ss'

@@ -0,0 +1,35 @@+-- |+-- Module      :  ELynx.Sequence.TranslateSpec+-- Copyright   :  (c) Dominik Schrempf 2021+-- License     :  GPL-3.0-or-later+--+-- Maintainer  :  dominik.schrempf@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Creation date: Fri Oct  5 14:25:42 2018.+module ELynx.Sequence.TranslateSpec+  ( spec,+  )+where++import ELynx.Alphabet.Alphabet+import ELynx.Character.Codon+import ELynx.Sequence.Import.Fasta+import ELynx.Sequence.Translate+import ELynx.Tools.InputOutput+import Test.Hspec++fastaTranslateDNAFN :: FilePath+fastaTranslateDNAFN = "data/TranslateMitochondrialVertebrateDNA.fasta"++fastaTranslateProteinFN :: FilePath+fastaTranslateProteinFN = "data/TranslateMitochondrialVertebrateProtein.fasta"++spec :: Spec+spec =+  describe "translateDNAX" $+    it "correctly translates a test sequence" $ do+      ss <- parseFileWith (fasta DNAX) fastaTranslateDNAFN+      ss' <- parseFileWith (fasta ProteinS) fastaTranslateProteinFN+      map (translateSeq VertebrateMitochondrial 0) ss `shouldBe` ss'