diff --git a/CREDITS b/CREDITS --- a/CREDITS +++ b/CREDITS @@ -13,11 +13,12 @@ using suffix trees. This version was slower, and could process less data than this released version. -Bug reports and feature requests +Bug reports, testing, feature requests -------------------------------- * Rafael Cunha de Almeida * Henning Thielemann * Anjana Ramnath +* Jennifer Hughes diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2007 - 2012 Johan Jeuring +Copyright (c) 2007 - 2013 Johan Jeuring All rights reserved. Redistribution and use in source and binary forms, with or without modification, diff --git a/README b/README --- a/README +++ b/README @@ -19,6 +19,11 @@ * Linear-time algorithm for finding word palindromes, text palindromes surrounded by (if at all) non-letters. * Linear-time algorithm for finding palindromes in DNA. +* Quadratic-time algorithm for finding approximate + palindromes, in which a limited number of symbols + may be substituted by other symbols +* Quadratic-time algorithm for finding palindromes with + gaps in the center. Requirements @@ -26,7 +31,7 @@ [Palindromes] has the following requirements: -* [GHC] version 6.8.1 or later - It has been tested with version 7.2.2. +* [GHC] version 6.8.1 or later - It has been tested with version 7.4.1. * [Cabal] library version 1.2.1 or later - It has been tested with version 1.10.2.0. @@ -56,11 +61,11 @@ Guide]. [Palindromes package]: - http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Palindromes + http://hackage.haskell.org/package/palindromes [cabal-install]: - http://hackage.haskell.org/cgi-bin/hackage-scripts/package/cabal-install + http://www.haskell.org/haskellwiki/Cabal-Install [Cabal User's Guide]: - http://www.haskell.org/cabal/release/latest/doc/users-guide/ + http://www.haskell.org/cabal/users-guide/ Documentation @@ -69,9 +74,9 @@ The API is documented using [Haddock] and available on the [Palindromes package] site. -[Haddock]: http://www.haskell.org/haddock/ +[Haddock]: http://hackage.haskell.org/package/haddock [Palindromes package]: - http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Palindromes + http://hackage.haskell.org/package/palindromes Examples @@ -107,7 +112,7 @@ Credits ------- -[Palindromes] is based on the functional program developed by [Johan Jeuring] in +Palindromes is based on the functional program developed by [Johan Jeuring] in his PhD thesis. The current authors and maintainer of palindromes is [Johan Jeuring]. diff --git a/RELEASE_HISTORY b/RELEASE_HISTORY --- a/RELEASE_HISTORY +++ b/RELEASE_HISTORY @@ -1,6 +1,14 @@ Release history: -------- +08072012 Version 0.4 +-------- +Cleaned up the options, to make them available for other kinds +of palindromes besides DNA palindromes. Code size has been reduced +by more than 40% by using higher-order functions and laziness to +properly deal with variability. + +-------- 08072012 Version 0.3.2 -------- Only maximal palindromes are shown by the maximalEvenPalindromesLengthBetweenDNA diff --git a/palindromes.cabal b/palindromes.cabal --- a/palindromes.cabal +++ b/palindromes.cabal @@ -1,5 +1,5 @@ name: palindromes -version: 0.3.2 +version: 0.4 synopsis: Finding palindromes in strings homepage: http://www.jeuring.net/homepage/palindromes/index.html description: @@ -8,7 +8,7 @@ returns information about palindromes in the file. category: Algorithms -copyright: (c) 2007 - 2012 Johan Jeuring +copyright: (c) 2007 - 2013 Johan Jeuring license: BSD3 license-file: LICENSE author: Johan Jeuring @@ -19,9 +19,12 @@ RELEASE_HISTORY tests/Main.hs build-type: Simple -cabal-version: >= 1.2.1 -tested-with: GHC == 7.2.2 - +cabal-version: >= 1.6 +tested-with: GHC == 7.4.1 +source-repository this + type: svn + location: https://svn.science.uu.nl/repos/sci.jeuri101.palindromes + tag: 0.4 -------------------------------------------------------------------------------- Library @@ -30,14 +33,15 @@ Executable palindromes Main-is: Data/Algorithms/Palindromes/Main.hs - ghc-options: -Wall -O2 + ghc-options: -Wall -O2 -rtsopts -threaded hs-source-dirs: src other-modules: Data.Algorithms.Palindromes.Palindromes, - Data.Algorithms.Palindromes.PalindromesDNA, + Data.Algorithms.Palindromes.PalindromesUtils, Data.Algorithms.Palindromes.Options build-depends: base >= 3.0 && < 5, array, - bytestring + bytestring, + containers -------------------------------------------------------------------------------- diff --git a/src/Data/Algorithms/Palindromes/Main.hs b/src/Data/Algorithms/Palindromes/Main.hs --- a/src/Data/Algorithms/Palindromes/Main.hs +++ b/src/Data/Algorithms/Palindromes/Main.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Algorithms.Palindromes.Main --- Copyright : (c) 2007 - 2010 Johan Jeuring +-- Copyright : (c) 2007 - 2013 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net @@ -24,17 +24,18 @@ ----------------------------------------------------------------------------- handleFilesWith :: (B.ByteString -> String) -> [String] -> IO () -handleFilesWith f = +handleFilesWith f [] = putStr $ f undefined +handleFilesWith f xs = let hFW filenames = case filenames of - [] -> putStr (f B.empty) - (fn:fns) -> do -- input <- B.readFile fn - fn' <- openFile fn ReadMode + [] -> putStr "" + (fn:fns) -> do fn' <- openFile fn ReadMode hSetEncoding fn' latin1 input <- B.hGetContents fn' putStrLn (f input) + hClose fn' hFW fns - in hFW + in hFW xs handleStandardInputWith :: (B.ByteString -> String) -> IO () handleStandardInputWith function = @@ -46,8 +47,8 @@ let (optionArgs,files,errors) = getOpt Permute options args if not (null errors) then putStrLn (concat errors) - else let (function,fromfile) = handleOptions optionArgs - in if fromfile - then handleFilesWith function files - else handleStandardInputWith function + else let (function,standardInput) = handleOptions optionArgs + in if standardInput + then handleStandardInputWith function + else handleFilesWith function files diff --git a/src/Data/Algorithms/Palindromes/Options.hs b/src/Data/Algorithms/Palindromes/Options.hs --- a/src/Data/Algorithms/Palindromes/Options.hs +++ b/src/Data/Algorithms/Palindromes/Options.hs @@ -1,7 +1,10 @@ +-- Did not yet translate all options. Complete the table in dispatchFlags. +-- Default doesn't work yet + ----------------------------------------------------------------------------- -- -- Module : Data.Algorithms.Palindromes.Options --- Copyright : (c) 2007 - 2012 Johan Jeuring +-- Copyright : (c) 2007 - 2013 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net @@ -15,249 +18,217 @@ import qualified Data.ByteString as B -import Data.Algorithms.Palindromes.Palindromes -import Data.Algorithms.Palindromes.PalindromesDNA +import Data.Algorithms.Palindromes.PalindromesUtils (Flag(..)) +import Data.Algorithms.Palindromes.Palindromes (palindrome,dnaLengthGappedApproximatePalindromeAround) ----------------------------------------------------------------------------- --- flags +-- Options ----------------------------------------------------------------------------- -data Flag = Help - | StandardInput - | LongestPalindrome - | LengthLongestPalindrome - | LongestTextPalindrome - | LongestWordPalindrome - | MaximalPalindromes - | LengthMaximalPalindromes - | MaximalTextPalindromes - | MaximalWordPalindromes - | LengthAtLeast Int - | LengthAtMost Int - | LengthExact Int - | DNA - | Odd deriving Show - +-- I am using single letter options here (except for help): getOpt handles +-- options too flexible: in case a letter within a multiple letter option is +-- recognized, it is taken as a single letter option. +options :: [OptDescr Flag] +options = + [Option "h" ["help"] (NoArg Help) + "This message" + ,Option "p" [] (NoArg Plain) + "Plain palindrome (default)" + ,Option "t" [] (NoArg Text) + "Palindrome ignoring case, spacing and punctuation" + ,Option "w" [] (NoArg Word) + "Palindrome surrounded by punctuation (if any)" + ,Option "d" [] (NoArg DNA) + "DNA palindrome" + ,Option "l" [] (NoArg Longest) + "Longest palindrome (deafult)" + ,Option "e" [] (NoArg LengthLongest) + "Length of the longest palindrome" + ,Option "m" [] (NoArg Maximal) + "Maximal palindrome around each position in the input" + ,Option "a" [] (NoArg LengthMaximal) + "Length of the maximal palindrome around each position in the input" + ,Option "g" [] (ReqArg (Gap . (read :: String -> Int)) "arg") + "Allow a gap of length [arg] in the palindrome" + ,Option "n" [] (ReqArg (NrOfErrors . (read :: String -> Int)) "arg") + "Allow at most [arg] errors in the palindrome" + ,Option "b" [] (ReqArg (LengthAtLeast . (read :: String -> Int)) "arg") + "Maximal palindromes of length at least [arg]" + ,Option "c" [] (ReqArg (LengthAtMost . (read :: String -> Int)) "arg") + "Maximal palindromes (possibly cut off) of length at most [arg]" + ,Option "f" [] (ReqArg (LengthExact . (read :: String -> Int)) "arg") + "Maximal palindromes (possibly cut off) of length exactly [arg]" + ,Option "r" [] (NoArg Linear) + "Use the linear algorithm" + ,Option "q" [] (NoArg Quadratic) + "Use the potentially quadratic algorithm (default)" + ,Option "i" [] (NoArg StandardInput) + "Read input from standard input" + ,Option "x" [] (ReqArg (Extend . (read :: String -> Int)) "arg") + "Extend a palindrome around center [arg]" + ] + isHelp :: Flag -> Bool -isHelp Help = True -isHelp _ = False +isHelp Help = True +isHelp _ = False +isPlain :: Flag -> Bool +isPlain Plain = True +isPlain _ = False + +isText :: Flag -> Bool +isText Text = True +isText _ = False + +isWord :: Flag -> Bool +isWord Word = True +isWord _ = False + isDNA :: Flag -> Bool -isDNA DNA = True -isDNA _ = False +isDNA DNA = True +isDNA _ = False -isOdd :: Flag -> Bool -isOdd Odd = True -isOdd _ = False +isLongest :: Flag -> Bool +isLongest Longest = True +isLongest _ = False -isStandardInput :: Flag -> Bool -isStandardInput StandardInput = True -isStandardInput _ = False +isLengthLongest :: Flag -> Bool +isLengthLongest LengthLongest = True +isLengthLongest _ = False +isMaximal :: Flag -> Bool +isMaximal Maximal = True +isMaximal _ = False + +isLengthMaximal :: Flag -> Bool +isLengthMaximal LengthMaximal = True +isLengthMaximal _ = False + +isGap :: Flag -> Bool +isGap (Gap _) = True +isGap _ = False + +isNrOfErrors :: Flag -> Bool +isNrOfErrors (NrOfErrors _) = True +isNrOfErrors _ = False + isLengthAtLeast :: Flag -> Bool -isLengthAtLeast (LengthAtLeast _) = True -isLengthAtLeast _ = False +isLengthAtLeast (LengthAtLeast _) = True +isLengthAtLeast _ = False isLengthAtMost :: Flag -> Bool -isLengthAtMost (LengthAtMost _) = True -isLengthAtMost _ = False +isLengthAtMost (LengthAtMost _) = True +isLengthAtMost _ = False isLengthExact :: Flag -> Bool -isLengthExact (LengthExact _) = True -isLengthExact _ = False +isLengthExact (LengthExact _) = True +isLengthExact _ = False -isLength :: Flag -> Bool -isLength flag = isLengthAtLeast flag || isLengthAtMost flag || isLengthExact flag +isLinear :: Flag -> Bool +isLinear Linear = True +isLinear _ = False -getLength :: Flag -> Int -getLength (LengthAtLeast n) = n -getLength (LengthAtMost n) = n -getLength (LengthExact n) = n -getLength _ = error "No length specified" +isQuadratic :: Flag -> Bool +isQuadratic Quadratic = True +isQuadratic _ = False --- I am using single letter options here (except for help): getOpt handles --- options too flexible: in case a letter within a multiple letter option is --- recognized, it is taken as a single letter option. -options :: [OptDescr Flag] -options = - [Option "h" ["help"] (NoArg Help) - "This message" - ,Option "i" [] (NoArg StandardInput) - "Read input from standard input" - ,Option "p" [] (NoArg LongestPalindrome) - "Longest palindrome (default)" - ,Option "l" [] (NoArg LengthLongestPalindrome) - "Length of the longest palindrome" - ,Option "t" [] (NoArg LongestTextPalindrome) - "Longest palindrome ignoring case, spacing and punctuation" - ,Option "v" [] (NoArg LongestWordPalindrome) - "Longest text palindrome preceded and followed by punctuation symbols (if any)" - ,Option "m" [] (NoArg MaximalPalindromes) - "Maximal palindrome around each position in the input" - ,Option "k" [] (NoArg LengthMaximalPalindromes) - "Length of the longest palindrome around each position in the input" - ,Option "s" [] (NoArg MaximalTextPalindromes) - "Maximal text palindrome around each position in the input" - ,Option "w" [] (NoArg MaximalWordPalindromes) - "Longest word palindrome around each position in the input" - ,Option "a" [] (ReqArg (LengthAtLeast . (read :: String -> Int)) "arg") - "Maximal palindromes of length at least [arg]" - ,Option "b" [] (ReqArg (LengthAtMost . (read :: String -> Int)) "arg") - "Maximal palindromes (possibly cut off) of length at most [arg]" - ,Option "c" [] (ReqArg (LengthExact . (read :: String -> Int)) "arg") - "Maximal alindromes (possibly cut off) of length exactly [arg]" - ,Option "d" [] (NoArg DNA) - "Use DNA equality" - ,Option "o" [] (NoArg Odd) - "Return palindromes of odd length (for palindromes in DNA; the default here is even length)" - ] +isStandardInput :: Flag -> Bool +isStandardInput StandardInput = True +isStandardInput _ = False --- This needs to be refactored seriously! +isExtend :: Flag -> Bool +isExtend (Extend _) = True +isExtend _ = False + +palindromeVariant :: [Flag] -> Maybe Flag +palindromeVariant flags + | any isHelp flags = Just Help + | any isPlain flags = Just Plain + | any isText flags = Just Text + | any isWord flags = Just Word + | any isDNA flags = Just DNA + | any isExtend flags = Just $ head $ filter isExtend flags + | otherwise = Nothing + +outputFormat :: [Flag] -> Maybe Flag +outputFormat flags + | any isLongest flags = Just Longest + | any isLengthLongest flags = Just LengthLongest + | any isMaximal flags = Just Maximal + | any isLengthMaximal flags = Just LengthMaximal + | otherwise = Nothing + +algorithmComplexity :: [Flag] -> Maybe Flag +algorithmComplexity flags + | any isLinear flags = Just Linear + | any isQuadratic flags = Just Quadratic + | otherwise = Nothing + +lengthModifier :: [Flag] -> Maybe Flag +lengthModifier flags + | any isLengthExact flags = Just $ head $ filter isLengthExact flags + | any isLengthAtLeast flags + && any isLengthAtMost flags = Just $ LengthBetween (getLengthAtLeasts flags) (getLengthAtMosts flags) + | any isLengthAtLeast flags = Just $ head $ filter isLengthAtLeast flags + | any isLengthAtMost flags = Just $ head $ filter isLengthAtMost flags + | otherwise = Nothing + +gap :: [Flag] -> Maybe Flag +gap flags + | any isGap flags = Just $ head $ filter isGap flags + | otherwise = Nothing + +nrOfErrors :: [Flag] -> Maybe Flag +nrOfErrors flags + | any isNrOfErrors flags = Just $ head $ filter isNrOfErrors flags + | otherwise = Nothing + +isLengthInBetween :: [Flag] -> Bool +isLengthInBetween flags = length flags == 2 + && any isLengthAtLeast flags + && any isLengthAtMost flags + +getLengthAtLeast :: Flag -> Int +getLengthAtLeast (LengthAtLeast n) = n +getLengthAtLeast _ = error "No length at least specified" + +getLengthAtLeasts :: [Flag] -> Int +getLengthAtLeasts flags = case filter isLengthAtLeast flags of + [lal] -> getLengthAtLeast lal + _ -> error "No or too many length at least specified" + +getLengthAtMost :: Flag -> Int +getLengthAtMost (LengthAtMost n) = n +getLengthAtMost _ = error "No length at most specified" + +getLengthAtMosts :: [Flag] -> Int +getLengthAtMosts flags = case filter isLengthAtMost flags of + [lal] -> getLengthAtMost lal + _ -> error "No or too many length at least specified" + handleOptions :: [Flag] -> (B.ByteString -> String,Bool) handleOptions flags = - let lengthFlags = filter isLength flags - dna = any isDNA flags - isodd = any isOdd flags - flags' = filter (\f -> not (isLength f || isStandardInput f || isDNA f)) flags - fromfile = not (any isStandardInput flags) - function = case flags' of - [] -> longestPalindrome - (flag:_) -> - case flag of - Help -> - const (usageInfo headerHelpMessage options) - LongestPalindrome -> longestPalindrome - LengthLongestPalindrome -> lengthLongestPalindrome - LongestTextPalindrome -> longestTextPalindrome - LongestWordPalindrome -> longestWordPalindrome - f -> dispatchMaximalFlags dna isodd lengthFlags f - in (function,fromfile) + (dispatchFlags + (palindromeVariant flags) + (outputFormat flags) + (algorithmComplexity flags) + (lengthModifier flags) + (gap flags) + (nrOfErrors flags) + ,any isStandardInput flags + ) -dispatchMaximalFlags :: Bool -> Bool -> [Flag] -> Flag -> B.ByteString -> String -dispatchMaximalFlags True False lengthFlags f - | null lengthFlags - = case f of - MaximalPalindromes -> maximalEvenPalindromesDNA . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions, no length flags" - | length lengthFlags == 1 - = let l = getLength (head lengthFlags) in - if isLengthAtLeast (head lengthFlags) - then case f of - MaximalPalindromes -> maximalEvenPalindromesLengthAtLeastDNA l . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions length at least" - else if isLengthAtMost (head lengthFlags) - then case f of - MaximalPalindromes -> maximalEvenPalindromesLengthAtMostDNA l . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions length at most" - else case f of - MaximalPalindromes -> evenPalindromesLengthExactDNA l . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions length exact" - | length lengthFlags == 2 && length (filter isLengthAtMost lengthFlags) == 1 && length (filter isLengthAtLeast lengthFlags) == 1 - = let m = minimum (map getLength lengthFlags); n = maximum (map getLength lengthFlags) - in case f of - MaximalPalindromes -> maximalEvenPalindromesLengthBetweenDNA m n . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error ("handleOptions two length flags: " ++ show f) - | otherwise - = error "handleOptions" -dispatchMaximalFlags True True lengthFlags f - | null lengthFlags - = case f of - MaximalPalindromes -> maximalOddPalindromesDNA . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions, no length flags" - | length lengthFlags == 1 - = let l = getLength (head lengthFlags) in - if isLengthAtLeast (head lengthFlags) - then case f of - MaximalPalindromes -> maximalOddPalindromesLengthAtLeastDNA l . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions length at least" - else if isLengthAtMost (head lengthFlags) - then case f of - MaximalPalindromes -> maximalOddPalindromesLengthAtMostDNA l . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions length at most" - else case f of - MaximalPalindromes -> oddPalindromesLengthExactDNA l . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error "handleOptions length exact" - | length lengthFlags == 2 && length (filter isLengthAtMost lengthFlags) == 1 && length (filter isLengthAtLeast lengthFlags) == 1 - = let m = minimum (map getLength lengthFlags); n = maximum (map getLength lengthFlags) - in case f of - MaximalPalindromes -> maximalOddPalindromesLengthBetweenDNA m n . B.filter isDNASymbol - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported for DNA palindromes" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported for DNA palindromes" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromesLengthAtLeast not supported for DNA palindromes" - _ -> error ("handleOptions two length flags: " ++ show f) - | otherwise = error "handleOptions" -dispatchMaximalFlags False _ lengthFlags f - | null lengthFlags - = case f of - MaximalPalindromes -> maximalPalindromes - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported" - MaximalTextPalindromes -> maximalTextPalindromesLengthAtLeast 0 - MaximalWordPalindromes -> maximalWordPalindromesLengthAtLeast 0 - _ -> error "handleOptions, no length flags" - | length lengthFlags == 1 - = let l = getLength (head lengthFlags) in - if isLengthAtLeast (head lengthFlags) - then case f of - MaximalPalindromes -> maximalPalindromesLengthAtLeast l - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported" - MaximalTextPalindromes -> maximalTextPalindromesLengthAtLeast l - MaximalWordPalindromes -> maximalWordPalindromesLengthAtLeast l - _ -> error "handleOptions length at least" - else if isLengthAtMost (head lengthFlags) - then case f of - MaximalPalindromes -> maximalPalindromesLengthAtMost l - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option LengthMaximalPalindromes not supported" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option MaximalTextPalindromes not supported" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option MaximalWordPalindromes not supported" - _ -> error "handleOptions length at most" - else case f of - MaximalPalindromes -> palindromesLengthExact l - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option not supported" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option not supported" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option not supported" - _ -> error "handleOptions length exact" - | length lengthFlags == 2 && length (filter isLengthAtMost lengthFlags) == 1 && length (filter isLengthAtLeast lengthFlags) == 1 - = let m = minimum (map getLength lengthFlags); n = maximum (map getLength lengthFlags) - in case f of - MaximalPalindromes -> maximalPalindromesLengthBetween m n - LengthMaximalPalindromes -> error "dispatchMaximalFlags: option not supported" - MaximalTextPalindromes -> error "dispatchMaximalFlags: option not supported" - MaximalWordPalindromes -> error "dispatchMaximalFlags: option not supported" - _ -> error ("handleOptions two length flags: " ++ show f) - | otherwise - = error "handleOptions" +dispatchFlags :: Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> B.ByteString -> String +dispatchFlags pvariant out ac l g k = case pvariant of + Nothing -> const (usageInfo headerHelpMessage options) + Just Help -> const (usageInfo headerHelpMessage options) + Just (Extend c) -> dnaLengthGappedApproximatePalindromeAround g k c + _ -> palindrome pvariant out ac l g k headerHelpMessage :: String headerHelpMessage = "*********************\n" ++ "* Palindrome Finder *\n" - ++ "* version 0.3.2 *\n" + ++ "* version 0.4 *\n" ++ "*********************\n" ++ "Usage:" diff --git a/src/Data/Algorithms/Palindromes/Palindromes.hs b/src/Data/Algorithms/Palindromes/Palindromes.hs --- a/src/Data/Algorithms/Palindromes/Palindromes.hs +++ b/src/Data/Algorithms/Palindromes/Palindromes.hs @@ -1,7 +1,10 @@ +-- test strict integers +-- >let input = Data.ByteString.pack (map Data.ByteString.Internal.c2w "yabadabadoo") + ----------------------------------------------------------------------------- -- -- Module : Data.Algorithms.Palindromes.Palindromes --- Copyright : (c) 2007 - 2012 Johan Jeuring +-- Copyright : (c) 2007 - 2013 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net @@ -12,165 +15,74 @@ module Data.Algorithms.Palindromes.Palindromes - (longestPalindrome - ,maximalPalindromes - ,maximalPalindromesLengthAtLeast - ,maximalPalindromesLengthBetween - ,maximalPalindromesLengthAtMost - ,palindromesLengthExact - ,lengthLongestPalindrome - ,lengthMaximalPalindromes - ,longestTextPalindrome - ,maximalTextPalindromesLengthAtLeast - ,longestWordPalindrome - ,maximalWordPalindromesLengthAtLeast + (palindrome ,palindromesAroundCentres - ,myIsLetterC + ,dnaLengthGappedApproximatePalindromeAround ) where import Data.List (maximumBy,intercalate) -import Data.Word -import Data.Char (toLower,isPunctuation,isSpace,isControl) -import Data.Array (Array(),bounds,listArray,(!)) import qualified Data.ByteString as B -import Data.ByteString.Internal +import Data.Algorithms.Palindromes.PalindromesUtils + (showPalindrome + ,showPalindromeDNA + ,showTextPalindrome + ,myToLower + ,myIsLetterW + ,listArrayl0 + ,appendseq + ,Flag(..) + ,(=:=) + ,surroundedByPunctuation + ) +import qualified Data.Sequence as S +import Data.Word (Word8) +import Data.Array(Array,(!)) ------------------------------------------------------------------------------ --- longestPalindrome ------------------------------------------------------------------------------ --- | longestPalindrome returns the longest palindrome in a string. -longestPalindrome :: B.ByteString -> String -longestPalindrome input = - let (maxLength,pos) = maximumBy - (\(l,_) (l',_) -> compare l l') - (zip (palindromesAroundCentres input) [0..]) - in showPalindrome input (maxLength,pos) - ----------------------------------------------------------------------------- --- maximalPalindromes ------------------------------------------------------------------------------ - --- | maximalPalindromes returns the maximal palindrome around each position --- in a string. -maximalPalindromes :: B.ByteString -> String -maximalPalindromes input = - intercalate "\n" - $ map (showPalindrome input) - $ zip (palindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalPalindromesLengthAtLeast ------------------------------------------------------------------------------ - --- | maximalPalindromesLengthAtLeast returns the longest palindrome around --- each position in a string. The integer argument is used to only show --- palindromes of length at least this integer. -maximalPalindromesLengthAtLeast :: Int -> B.ByteString -> String -maximalPalindromesLengthAtLeast m input = - intercalate "\n" - $ map (showPalindrome input) - $ filter ((m<=) . fst) - $ zip (palindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalPalindromesLengthBetween ------------------------------------------------------------------------------ - --- | maximalPalindromesLengthBetween returns the longest palindrome around each --- position in a string. The integer arguments are used to only show palindromes --- of length in between the specified lengths. -maximalPalindromesLengthBetween :: Int -> Int -> B.ByteString -> String -maximalPalindromesLengthBetween m n input = - intercalate "\n" - $ map (showPalindrome input) - $ filter (\(pl,_) -> pl >= m && pl <= n) - $ zip (palindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalPalindromesLengthAtMost ------------------------------------------------------------------------------ - --- | maximalPalindromesLengthAtMost returns the longest palindrome around each --- position in a string. The integer arguments are used to only show palindromes --- of length in between the specified lengths. -maximalPalindromesLengthAtMost :: Int -> B.ByteString -> String -maximalPalindromesLengthAtMost m input = - intercalate "\n" - $ map (showPalindrome input) - $ filter ((<=m) . fst) - $ zip (palindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- palindromesLengthExact ------------------------------------------------------------------------------ - --- | palindromesLengthExact returns the longest palindrome around each --- position in a string. The integer arguments are used to only show palindromes --- of length in between the specified lengths. -palindromesLengthExact :: Int -> B.ByteString -> String -palindromesLengthExact m input = - intercalate "\n" - $ map (showPalindrome input . \(_,p) -> (m,p)) - $ filter (\(l,_) -> m<=l && (odd l == odd m)) - $ zip (palindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- lengthLongestPalindrome ------------------------------------------------------------------------------ - --- | lengthLongestPalindrome returns the length of the longest palindrome in --- a string. -lengthLongestPalindrome :: B.ByteString -> String -lengthLongestPalindrome = show . maximum . palindromesAroundCentres - ------------------------------------------------------------------------------ --- lengthLongestPalindromes ------------------------------------------------------------------------------ - --- | lengthMaximalPalindromes returns the lengths of the longest palindrome --- around each position in a string. -lengthMaximalPalindromes :: B.ByteString -> String -lengthMaximalPalindromes = show . palindromesAroundCentres - ------------------------------------------------------------------------------ --- longestTextPalindrome ------------------------------------------------------------------------------ - --- | longestTextPalindrome returns the longest text palindrome in a string, --- ignoring spacing, punctuation symbols, and case of letters. -longestTextPalindrome :: B.ByteString -> String -longestTextPalindrome input = - let textInput = B.map myToLower (B.filter myIsLetterW input) - positionTextInput = listArrayl0 (B.findIndices myIsLetterW input) - in longestTextPalindromeBS input textInput positionTextInput - -longestTextPalindromeBS :: B.ByteString -> B.ByteString -> Array Int Int -> String -longestTextPalindromeBS input textInput positionTextInput = - let (len,pos) = maximumBy - (\(l,_) (l',_) -> compare l l') - (zip (palindromesAroundCentres textInput) [0..]) - in showTextPalindrome input positionTextInput (len,pos) - ------------------------------------------------------------------------------ --- longestTextPalindromes +-- palindrome dispatches to the desired variant of the palindrome finding +-- algorithm. It captures all the variablity, in input format, output format, +-- and length restrictions. Variability has been `pushed down' into the code +-- as much as possible, using extra arguments whenever needed, for example +-- for word palindromes (which have not been implemented correctly at the +-- moment: I do get the longest word palindromes, but shorter ones may +-- actually not be word palindromes). ----------------------------------------------------------------------------- --- | longestTextPalindromes returns the longest text palindrome around each --- position in a string. The integer argument is used to only show palindromes --- of length at least this integer. -maximalTextPalindromesLengthAtLeast :: Int -> B.ByteString -> String -maximalTextPalindromesLengthAtLeast m input = - let textInput = B.map myToLower (B.filter myIsLetterW input) +-- | palindrome captures all possible variants of finding palindromes. +palindrome :: Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> B.ByteString -> String +palindrome palindromeVariant outputFormat algorithmComplexity lengthModifier gap nrOfErrors input = + let predicate = case lengthModifier of + Just (LengthAtLeast m) -> (m<=) + Just (LengthAtMost m) -> (<=m) + Just (LengthExact m) -> \l -> m<=l && (odd l == odd m) + Just (LengthBetween m n) -> \pl -> pl >= m && pl <= n + _ -> const True + post = case lengthModifier of + Just (LengthExact m) -> \_ -> m + _ -> id + textinput = B.map myToLower (B.filter myIsLetterW input) positionTextInput = listArrayl0 (B.findIndices myIsLetterW input) - in intercalate "\n" - $ maximalTextPalindromesLengthAtLeastBS m textInput positionTextInput input + input' = case palindromeVariant of + Just Text -> textinput + Just Word -> textinput + _ -> input + show' = case palindromeVariant of + Just Text -> showTextPalindrome input positionTextInput + Just Word -> showTextPalindrome input positionTextInput + Just DNA -> showPalindromeDNA input + _ -> showPalindrome input + outputf = case outputFormat of + Just LengthLongest -> show . maximum . map post . filter predicate + Just Maximal -> intercalate "\n" . map show' . map (\(l,r) -> (post l,r)) . filter (predicate . fst) . flip zip [0..] + Just LengthMaximal -> show . map post . filter predicate + _ -> show' . maximumBy (\(l,_) (l',_) -> compare l l') . map (\(l,r) -> (post l,r)) . filter (predicate . fst) . flip zip [0..] + in outputf $ palindromesAroundCentres palindromeVariant algorithmComplexity gap nrOfErrors input input' positionTextInput -maximalTextPalindromesLengthAtLeastBS :: Int -> B.ByteString -> Array Int Int -> B.ByteString -> [String] -maximalTextPalindromesLengthAtLeastBS m textInput positionTextInput input = - map (showTextPalindrome input positionTextInput) - $ filter ((m<=) . fst) - $ zip (palindromesAroundCentres textInput) [0..] +{- +-- The following code is replaced by the equivalent code using a more efficient +-- data structure. It is kept here because this is most probably easier to understand, +-- and it is the code explained on the blog. ----------------------------------------------------------------------------- -- palindromesAroundCentres @@ -191,9 +103,9 @@ -- reached the end of the array = finalPalindromes currentPalindrome currentMaximalPalindromes (currentPalindrome:currentMaximalPalindromes) | rightmost-currentPalindrome == first || - B.index input rightmost /= B.index input (rightmost-currentPalindrome-1) - -- the current palindrome extends to the start of the array, or - -- it cannot be extended + not (B.index input rightmost == B.index input (rightmost-currentPalindrome-1)) + -- the current palindrome extends to the start of the array, + -- or it cannot be extended = moveCenter input rightmost (currentPalindrome:currentMaximalPalindromes) currentMaximalPalindromes currentPalindrome | otherwise -- the current palindrome can be extended @@ -202,17 +114,17 @@ last = B.length input - 1 moveCenter :: B.ByteString -> Int -> [Int] -> [Int] -> Int -> [Int] -moveCenter input rightmost currentMaximalPalindromes previousMaximalPalindromes centreDistance - | centreDistance == 0 +moveCenter input rightmost currentMaximalPalindromes previousMaximalPalindromes nrOfCenters + | nrOfCenters == 0 -- the last centre is on the last element: try to extend the tail of length 1 = extendPalindrome input (rightmost+1) 1 currentMaximalPalindromes - | centreDistance-1 == head previousMaximalPalindromes + | nrOfCenters-1 == head previousMaximalPalindromes -- the previous element in the centre list reaches exactly to the end of the last -- tail palindrome use the mirror property of palindromes to find the longest tail palindrome = extendPalindrome input rightmost (head previousMaximalPalindromes) currentMaximalPalindromes | otherwise -- move the centres one step add the length of the longest palindrome to the centres - = moveCenter input rightmost (min (head previousMaximalPalindromes) (centreDistance-1):currentMaximalPalindromes) (tail previousMaximalPalindromes) (centreDistance-1) + = moveCenter input rightmost (min (head previousMaximalPalindromes) (nrOfCenters-1):currentMaximalPalindromes) (tail previousMaximalPalindromes) (nrOfCenters-1) finalPalindromes :: Int -> [Int] -> [Int] -> [Int] finalPalindromes nrOfCenters previousMaximalPalindromes currentMaximalPalindromes @@ -220,56 +132,118 @@ = currentMaximalPalindromes | nrOfCenters > 0 = finalPalindromes (nrOfCenters-1) (tail previousMaximalPalindromes) (min (head previousMaximalPalindromes) (nrOfCenters-1):currentMaximalPalindromes) - | otherwise = error "finalCentres: input < 0" + | otherwise + = error "finalCentres: input < 0" +-} + ----------------------------------------------------------------------------- --- longestWordPalindromes +-- palindromesAroundCentresS +-- +-- The function that implements the palindrome finding algorithm. +-- Used in all the above interface functions. +-- +-- I use the Seq datatype to pass on the maximal palindromes that are used for +-- finding the maximal palindromes to the right of the center of the current +-- longest tail paindrome. ----------------------------------------------------------------------------- --- | longestWordPalindromes returns the longest word palindrome around each --- position in a string. The integer argument is used to only show --- palindromes of length at least this integer. -maximalWordPalindromesLengthAtLeast :: Int -> B.ByteString -> String -maximalWordPalindromesLengthAtLeast m input = - let textInput = B.map myToLower (B.filter myIsLetterW input) - positionTextInput = listArrayl0 (B.findIndices myIsLetterW input) - in intercalate "\n" - $ maximalWordPalindromesLengthAtLeastBS m input textInput positionTextInput +-- | palindromesAroundCentres is the central function of the module. It returns +-- the list of lenghths of the longest palindrome around each position in a +-- string. +palindromesAroundCentres :: Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> B.ByteString -> B.ByteString -> Array Int Int -> [Int] +palindromesAroundCentres palindromeVariant algorithmComplexity gap nrOfErrors input input' positionTextInput = + case (algorithmComplexity,gap,nrOfErrors) of + (Just Linear ,Nothing,Nothing) -> case palindromeVariant of + Just DNA -> reverse $ appendseq $ extendPalindromeS 2 0 input' [] S.empty 0 0 + Just Word -> reverse $ map (head . snd) $ extendTailWord input input' positionTextInput [] 0 (0,[0]) + _ -> reverse $ appendseq $ extendPalindromeS 1 1 input' [] S.empty 0 0 + (Just Linear ,_ ,_ ) -> error "palindromesAroundCentres: cannot calculate approximate or gapped palindromes using the linear-time algorithm" + (Just Quadratic,g ,k ) -> let g' = case g of + Just (Gap g'') -> g'' + _ -> 0 + k' = case k of + Just (NrOfErrors k'') -> k'' + _ -> 0 + in gappedApproximatePalindromesAroundCentres palindromeVariant input g' k' + (_ ,_ ,_ ) -> error "palindromesAroundCentres: case not defined" +extendPalindromeS :: Int -> Int -> B.ByteString -> [Int] -> S.Seq Int -> Int -> Int -> ([Int],S.Seq Int) +extendPalindromeS centerfactor tailfactor input = + let ePS maximalPalindromesPre maximalPalindromesIn rightmost currentPalindrome + | rightmost > lastPos + -- reached the end of the array + = finalPalindromesS centerfactor currentPalindrome maximalPalindromesPre (currentPalindrome S.<| maximalPalindromesIn) maximalPalindromesIn + | rightmost-currentPalindrome == first || + not (B.index input rightmost == B.index input (rightmost-currentPalindrome-1)) + -- the current palindrome extends to the start of the array, + -- or it cannot be extended + = mCS rightmost maximalPalindromesPre (currentPalindrome S.<| maximalPalindromesIn) maximalPalindromesIn currentPalindrome + | otherwise + -- the current palindrome can be extended + = let (left,rest) = splitAt 2 maximalPalindromesPre + in ePS rest (foldr (flip (S.|>)) maximalPalindromesIn left) (rightmost+1) (currentPalindrome+2) + where first = 0 + lastPos = B.length input - 1 + mCS rightmost maximalPalindromesPre maximalPalindromesIn maximalPalindromesIn' nrOfCenters + | nrOfCenters == 0 + -- the last centre is on the last element: try to extend the tail of length 1 + = ePS maximalPalindromesPre maximalPalindromesIn (rightmost+1) tailfactor + | nrOfCenters-centerfactor == S.index maximalPalindromesIn' 0 + -- the previous element in the centre list reaches exactly to the end of the last + -- tail palindrome use the mirror property of palindromes to find the longest tail palindrome + = ePS maximalPalindromesPre maximalPalindromesIn rightmost (nrOfCenters-centerfactor) + | otherwise + -- move the centres one step add the length of the longest palindrome to the centres + = case S.viewl maximalPalindromesIn' of + headq S.:< tailq -> mCS rightmost maximalPalindromesPre (min headq (nrOfCenters-centerfactor) S.<| maximalPalindromesIn) tailq (nrOfCenters-centerfactor) + S.EmptyL -> error "extendPalindromeS: empty sequence" + in ePS -maximalWordPalindromesLengthAtLeastBS :: Int -> B.ByteString -> B.ByteString -> Array Int Int -> [String] -maximalWordPalindromesLengthAtLeastBS m input textInput positionTextInput = - map (showTextPalindrome input positionTextInput) - $ filter ((m<=) . fst) - $ zip (wordPalindromesAroundCentres input textInput positionTextInput) [0..] +-- moveCenterS :: B.ByteString -> Int -> [Int] -> S.Seq Int -> S.Seq Int -> Int -> ([Int],S.Seq Int) --- | longestWordPalindrome returns the longest text palindrome preceded and --- followed by non-letter symbols (if any). -longestWordPalindrome :: B.ByteString -> String -longestWordPalindrome input = - let textInput = B.map myToLower (B.filter myIsLetterW input) - positionTextInput = listArrayl0 (B.findIndices myIsLetterW input) - (len,pos) = maximumBy - (\(w,_) (w',_) -> compare w w') - (zip (wordPalindromesAroundCentres input textInput positionTextInput) [0..]) - in showTextPalindrome input positionTextInput (len,pos) +finalPalindromesS :: Int -> Int -> [Int] -> S.Seq Int -> S.Seq Int -> ([Int],S.Seq Int) +finalPalindromesS centerfactor nrOfCenters maximalPalindromesPre maximalPalindromesIn maximalPalindromesIn' + | nrOfCenters == 0 + = (maximalPalindromesPre,maximalPalindromesIn) + | nrOfCenters > 0 + = case S.viewl maximalPalindromesIn' of + headq S.:< tailq -> finalPalindromesS centerfactor (nrOfCenters-centerfactor) maximalPalindromesPre (min headq (nrOfCenters-centerfactor) S.<| maximalPalindromesIn) tailq + S.EmptyL -> error "finalPalindromesS: empty sequence" + | otherwise + = error "finalPalindromesS: input < 0" ------------------------------------------------------------------------------ --- wordPalindromesAroundCentres --- --- This is the function palindromesAroundCentres, extended with the longest --- word palindromes around each centre. ------------------------------------------------------------------------------ +gappedApproximatePalindromesAroundCentres :: Maybe Flag -> B.ByteString -> Int -> Int -> [Int] +gappedApproximatePalindromesAroundCentres palindromeVariant input g k = + case palindromeVariant of + Just DNA -> map (lengthGappedApproximatePalindromeAround (=:=) 1 input g k) (if even g then [0 .. B.length input] else [0 .. B.length input-1]) + _ -> map (lengthGappedApproximatePalindromeAround (==) 2 input g k) [0 .. 2*B.length input] --- | wordPalindromesAroundCentres returns the same lengths of palindromes as --- palindromesAroundCentres, but at the same time also the length of the --- longest word palindromes around the centres. -wordPalindromesAroundCentres :: B.ByteString -> B.ByteString -> Array Int Int -> [Int] -wordPalindromesAroundCentres input textInput positionTextInput = - let tfirst = 0 - in reverse $ map (head . snd) $ extendTailWord input textInput positionTextInput [] tfirst (0,[0]) +-- I probably get the wrong positions printed for odd-gapped palindromes +-- the next two functions should be mergable, with a centerdivfactor +lengthGappedApproximatePalindromeAround :: (Word8 -> Word8 -> Bool) -> Int -> B.ByteString -> Int -> Int -> Int -> Int +lengthGappedApproximatePalindromeAround (===) centerfactor input g k center = + let halfg = div g 2 + c = div center centerfactor + lengthInput = B.length input + halfg' | c < halfg = c + | c + halfg > lengthInput = lengthInput-c + | otherwise = halfg + left = c-1-halfg' + right = if even g then c+halfg' else c+1+halfg' + in lengthApproximatePalindrome (===) input k left right --- extendTailWordold textInput positionTextInput input n current centres = extendTailWord input textInput positionTextInput centres n current +lengthApproximatePalindrome :: (Word8 -> Word8 -> Bool) -> B.ByteString -> Int -> Int -> Int -> Int +lengthApproximatePalindrome (===) input k start end + | start < 0 || end > lastPos = end-start-1 + | B.index input start === B.index input end = lengthApproximatePalindrome (===) input k (start-1) (end+1) + | k > 0 = lengthApproximatePalindrome (===) input (k-1) (start-1) (end+1) + | otherwise = end-start-1 + where lastPos = B.length input - 1 + +dnaLengthGappedApproximatePalindromeAround :: Maybe Flag -> Maybe Flag -> Int -> B.ByteString -> String +dnaLengthGappedApproximatePalindromeAround (Just (Gap gap)) (Just (NrOfErrors k)) center input = show $ lengthGappedApproximatePalindromeAround (=:=) 1 input gap k center +dnaLengthGappedApproximatePalindromeAround _ _ center input = show $ lengthGappedApproximatePalindromeAround (=:=) 1 input 0 0 center extendTailWord :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> (Int,[Int]) -> [(Int,[Int])] extendTailWord input textInput positionTextInput centres n current@(currentTail,currentTailWords) @@ -349,69 +323,3 @@ in finalWordCentres input textInput positionTextInput ((newTail,newWords):centres) (n-1) (tail tcentres) (mirrorPoint+1) | otherwise = error "finalWordCentres: input < 0" ------------------------------------------------------------------------------ --- Showing palindromes and other text related functionality ------------------------------------------------------------------------------ - -showPalindrome :: B.ByteString -> (Int,Int) -> String -showPalindrome input (len,pos) = - let startpos = pos `div` 2 - len `div` 2 - in show $ B.take len $ B.drop startpos input - -showTextPalindrome :: B.ByteString -> Array Int Int -> (Int,Int) -> String -showTextPalindrome input positionTextInput (len,pos) = - let startpos = pos `div` 2 - len `div` 2 - endpos = if odd len - then pos `div` 2 + len `div` 2 - else pos `div` 2 + len `div` 2 - 1 - (pfirst,plast) = bounds positionTextInput - (ifirst,ilast) = (0,1 + B.length input) - in if endpos < startpos - then [] - else let start = if startpos > pfirst - then (positionTextInput!(startpos-1))+1 - else ifirst - end = if endpos < plast - then (positionTextInput!(endpos+1))-1 - else ilast - in show (B.take (end-start+1) (B.drop start input)) - -{- Using this code instead of the last else above shows text palindromes without - all punctuation around it. Right now this punctuation is shown. - - else let start = positionArray!!!startpos - end = positionArray!!!endpos --} - --- For palindromes in strings, punctuation, spacing, and control characters --- are often ignored - -myIsLetterW :: Word8 -> Bool -myIsLetterW c' = not (isPunctuation c) - && not (isControl c) - && not (isSpace c) - where c = w2c c' - -myIsLetterC :: Char -> Bool -myIsLetterC c = not (isPunctuation c) - && not (isControl c) - && not (isSpace c) - -myToLower :: Word8 -> Word8 -myToLower = c2w . toLower . w2c - -surroundedByPunctuation :: Int -> Int -> B.ByteString -> Bool -surroundedByPunctuation begin end input - | begin > afirst && end < alast = not (myIsLetterW (B.index input (begin-1))) && not (myIsLetterW (B.index input (end+1))) - | begin <= afirst && end < alast = not (myIsLetterW (B.index input (end+1))) - | begin <= afirst && end >= alast = True - | begin > afirst && end >= alast = not (myIsLetterW (B.index input (begin-1))) - | otherwise = error "surroundedByPunctuation" - where (afirst,alast) = (0,B.length input - 1) - ------------------------------------------------------------------------------ --- Array utils ------------------------------------------------------------------------------ - -listArrayl0 :: [a] -> Array Int a -listArrayl0 string = listArray (0,length string - 1) string diff --git a/src/Data/Algorithms/Palindromes/PalindromesDNA.hs b/src/Data/Algorithms/Palindromes/PalindromesDNA.hs deleted file mode 100644 --- a/src/Data/Algorithms/Palindromes/PalindromesDNA.hs +++ /dev/null @@ -1,288 +0,0 @@ --- >let input = B.pack (map c2w "AATAATT") --- >oddDNAPalindromesAroundCentres input - ------------------------------------------------------------------------------ --- --- Module : Data.Algorithms.Palindromes.PalindromesDNA --- Copyright : (c) 2012 Johan Jeuring --- License : BSD3 --- --- Maintainer : johan@jeuring.net --- Stability : experimental --- Portability : portable --- ------------------------------------------------------------------------------ - -module Data.Algorithms.Palindromes.PalindromesDNA - (maximalEvenPalindromesDNA - ,maximalEvenPalindromesLengthAtLeastDNA - ,maximalEvenPalindromesLengthBetweenDNA - ,maximalEvenPalindromesLengthAtMostDNA - ,evenPalindromesLengthExactDNA - ,maximalOddPalindromesDNA - ,maximalOddPalindromesLengthAtLeastDNA - ,maximalOddPalindromesLengthBetweenDNA - ,maximalOddPalindromesLengthAtMostDNA - ,oddPalindromesLengthExactDNA - ,negateDNA - ,isDNASymbol - ) where - -import Data.List (intercalate) -import Data.Char (toUpper) -import Data.Word (Word8) -import qualified Data.ByteString as B -import Data.ByteString.Internal as BI - ------------------------------------------------------------------------------ --- maximalEvenPalindromesDNA ------------------------------------------------------------------------------ - --- | maximalEvenPalindromesDNA returns the maximal even-length DNA palindrome --- around each position in a string. -maximalEvenPalindromesDNA :: B.ByteString -> String -maximalEvenPalindromesDNA input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ zip (evenDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalEvenPalindromesLengthAtLeastDNA ------------------------------------------------------------------------------ - --- | maximalEvenPalindromesLengthAtLeastDNA returns the maximal even-length --- DNA palindrome around each position in a string. The integer argument is --- used to only show palindromes of length at least this integer. -maximalEvenPalindromesLengthAtLeastDNA :: Int -> B.ByteString -> String -maximalEvenPalindromesLengthAtLeastDNA m input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ filter ((m<=) . fst) - $ zip (evenDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalEvenPalindromesLengthBetweenDNA ------------------------------------------------------------------------------ - --- | maximalEvenPalindromesLengthBetweenDNA returns the maximal even-length --- palindrome around each position in a string. The integer arguments are --- used to only show (or cut off to) palindromes of length in between the --- specified lengths. -maximalEvenPalindromesLengthBetweenDNA :: Int -> Int -> B.ByteString -> String -maximalEvenPalindromesLengthBetweenDNA m n input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ filter (\(pl,_) -> m <= pl && pl <= n) - $ zip (evenDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalEvenPalindromesLengthAtMostDNA ------------------------------------------------------------------------------ - --- | maximalEvenPalindromesLengthAtMostDNA returns the maximal even-length --- palindrome around each position in a string. The integer argument is --- used to only show (or cut off to) palindromes of length at most the --- specified length. -maximalEvenPalindromesLengthAtMostDNA :: Int -> B.ByteString -> String -maximalEvenPalindromesLengthAtMostDNA m input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ filter ((<=m) . fst) - $ zip (evenDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- evenPalindromesLengthExactDNA ------------------------------------------------------------------------------ - --- | evenPalindromesLengthExactDNA returns the maximal even-length palindrome --- around each position in a string. The integer argument is used to only --- show (or cut off to) the palindrome of exactly this length. -evenPalindromesLengthExactDNA :: Int -> B.ByteString -> String -evenPalindromesLengthExactDNA m input = - intercalate "\n" - $ map (showPalindromeDNA input . \(_,p) -> (m,p)) - $ filter (\(l,_) -> m<=l && (odd l == odd m)) - $ zip (evenDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- evenDNAPalindromesAroundCentres --- --- The function that implements the palindrome finding algorithm. --- Used in all the above interface functions. ------------------------------------------------------------------------------ - --- | evenDNAPalindromesAroundCentres is the central function of the module. It --- returns the list of lenghths of maximal even-length palindromes around --- each position in a string. -evenDNAPalindromesAroundCentres :: B.ByteString -> [Int] -evenDNAPalindromesAroundCentres input = reverse $ evenExtendTail input 0 0 [] - -evenExtendTail :: B.ByteString -> Int -> Int -> [Int] -> [Int] -evenExtendTail input n currentTail centres - | n > inputlast = evenFinalCentres currentTail centres (currentTail:centres) - -- reached the end of the array - | n-currentTail == inputfirst = evenExtendCentres input n (currentTail:centres) centres currentTail - -- the current longest tail palindrome extends to the start of the array - | B.index input n `eqDNA` B.index input (n-currentTail-1) = evenExtendTail input (n+1) (currentTail+2) centres - -- the current longest tail palindrome can be extended - | otherwise = evenExtendCentres input n (currentTail:centres) centres currentTail - -- the current longest tail palindrome cannot be extended - where inputfirst = 0 - inputlast = B.length input - 1 - -evenExtendCentres :: B.ByteString -> Int -> [Int] -> [Int] -> Int -> [Int] -evenExtendCentres input n centres tcentres centreDistance - | centreDistance == 0 = evenExtendTail input (n+1) 0 centres - -- the last centre is on the last element: try to extend the tail of length 1 - | centreDistance-2 == head tcentres = evenExtendTail input n (head tcentres) centres - -- the previous element in the centre list reaches exactly to the end of the last - -- tail palindrome use the mirror property of palindromes to find the longest tail palindrome - | otherwise = evenExtendCentres input n (min (head tcentres) (centreDistance-2):centres) (tail tcentres) (centreDistance-2) - -- move the centres one step add the length of the longest palindrome to the centres - -evenFinalCentres :: Int -> [Int] -> [Int] -> [Int] -evenFinalCentres n tcentres centres - | n == 0 = centres - | n > 0 = evenFinalCentres (n-2) (tail tcentres) (min (head tcentres) (n-2):centres) - | otherwise = error "finalCentres: input < 0" - ------------------------------------------------------------------------------ --- maximalOddPalindromesDNA ------------------------------------------------------------------------------ - --- | maximalOddPalindromesDNA returns the maximal odd-length palindrome --- around each position in a string. -maximalOddPalindromesDNA :: B.ByteString -> String -maximalOddPalindromesDNA input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ zip (oddDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalOddPalindromesLengthAtLeastDNA ------------------------------------------------------------------------------ - --- | maximalOddPalindromesLengthAtLeastDNA returns the maximal odd-length --- palindrome around each position in a string. The integer argument is --- used to only show palindromes of length at least this integer. -maximalOddPalindromesLengthAtLeastDNA :: Int -> B.ByteString -> String -maximalOddPalindromesLengthAtLeastDNA m input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ filter ((m<=) . fst) - $ zip (oddDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalOddPalindromesLengthBetweenDNA ------------------------------------------------------------------------------ - --- | maximalOddPalindromesLengthBetweenDNA returns the maximal odd-length --- palindrome around each position in a string. The integer arguments are --- used to only show (or cut off to) palindromes of length in between the --- specified lengths. -maximalOddPalindromesLengthBetweenDNA :: Int -> Int -> B.ByteString -> String -maximalOddPalindromesLengthBetweenDNA m n input = - intercalate "\n" - $ map (showPalindromeDNA input . \(pl,pc) -> (min pl n,pc)) - $ filter (\(pl,_) -> m <= pl) - $ zip (oddDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- maximalOddPalindromesLengthAtMostDNA ------------------------------------------------------------------------------ - --- | maximalOddPalindromesLengthAtMostDNA returns the maximal odd-length --- palindrome around each position in a string. The integer argument is --- used to only show (or cut off to) palindromes of length at most the --- specified length. -maximalOddPalindromesLengthAtMostDNA :: Int -> B.ByteString -> String -maximalOddPalindromesLengthAtMostDNA m input = - intercalate "\n" - $ map (showPalindromeDNA input) - $ filter ((<=m) . fst) - $ zip (oddDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- oddPalindromesLengthExactDNA ------------------------------------------------------------------------------ - --- | oddPalindromesLengthExactDNA returns the maximal odd-length palindrome --- around each position in a string. The integer arguments are used to only --- show (or cut off to) palindromes of exactly the specified length. -oddPalindromesLengthExactDNA :: Int -> B.ByteString -> String -oddPalindromesLengthExactDNA m input = - intercalate "\n" - $ map (showPalindromeDNA input . \(_,p) -> (m,p)) - $ filter (\(l,_) -> m<=l && (odd l == odd m)) - $ zip (oddDNAPalindromesAroundCentres input) [0..] - ------------------------------------------------------------------------------ --- oddDNAPalindromesAroundCentres --- --- The function that implements the palindrome finding algorithm. --- Used in all the above interface functions. ------------------------------------------------------------------------------ - --- | oddDNAPalindromesAroundCentres is the central function of the module. It --- returns the list of lenghths of the maximal odd-length palindrome around --- each position in a string. -oddDNAPalindromesAroundCentres :: B.ByteString -> [Int] -oddDNAPalindromesAroundCentres input = if B.null input - then [] - else reverse $ oddExtendTail input 1 1 [] - -oddExtendTail :: B.ByteString -> Int -> Int -> [Int] -> [Int] -oddExtendTail input n currentTail centres - | n > inputlast = oddFinalCentres currentTail centres (currentTail:centres) - -- reached the end of the array - | n-currentTail <= inputfirst = oddExtendCentres input n (currentTail:centres) centres currentTail - -- the current longest tail palindrome extends to the start of the array - | B.index input n `eqDNA` B.index input (n-currentTail-1) = oddExtendTail input (n+1) (currentTail+2) centres - -- the current longest tail palindrome can be extended - | otherwise = oddExtendCentres input n (currentTail:centres) centres currentTail - -- the current longest tail palindrome cannot be extended - where inputfirst = 0 - inputlast = B.length input - 1 - -oddExtendCentres :: B.ByteString -> Int -> [Int] -> [Int] -> Int -> [Int] -oddExtendCentres input n centres tcentres centreDistance - | centreDistance == 1 || null tcentres = oddExtendTail input (n+1) 1 centres - -- the last centre is on the last element: try to extend the tail of length 1 - | centreDistance-2 == head tcentres = oddExtendTail input n (head tcentres) centres - -- the previous element in the centre list reaches exactly to the end of the last - -- tail palindrome use the mirror property of palindromes to find the longest tail palindrome - | otherwise = oddExtendCentres input n (min (head tcentres) (centreDistance-2):centres) (tail tcentres) (centreDistance-2) - -- move the centres one step add the length of the longest palindrome to the centres - -oddFinalCentres :: Int -> [Int] -> [Int] -> [Int] -oddFinalCentres n tcentres centres - | n > 1 = oddFinalCentres (n-2) (tail tcentres) (min (head tcentres) (n-2):centres) - | otherwise = centres - ------------------------------------------------------------------------------ --- Equality on DNA ------------------------------------------------------------------------------ - -negateDNA :: Char -> Char -negateDNA 'A' = 'T' -negateDNA 'T' = 'A' -negateDNA 'C' = 'G' -negateDNA 'G' = 'C' -negateDNA _ = error "negateDNA: not a DNA character" - -eqDNA :: Word8 -> Word8 -> Bool -eqDNA l r = let cl = BI.w2c l - cr = BI.w2c r - in toUpper cl == negateDNA (toUpper cr) - ------------------------------------------------------------------------------ --- Showing palindromes and other text related functionality ------------------------------------------------------------------------------ - -showPalindromeDNA :: B.ByteString -> (Int,Int) -> String -showPalindromeDNA input (len,pos) = - let startpos = pos - len `div` 2 - in (show startpos ++) . (" to " ++) . (show (startpos+len) ++) . ("\t" ++) . (show (B.take len $ B.drop startpos input) ++) . ("\t" ++) $ show len - -isDNASymbol :: Word8 -> Bool -isDNASymbol w = w2c w `elem` "ACTGactg" diff --git a/src/Data/Algorithms/Palindromes/PalindromesUtils.hs b/src/Data/Algorithms/Palindromes/PalindromesUtils.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithms/Palindromes/PalindromesUtils.hs @@ -0,0 +1,175 @@ +----------------------------------------------------------------------------- +-- +-- Module : Data.Algorithms.Palindromes.PalindromesUtils +-- Copyright : (c) 2007 - 2013 Johan Jeuring +-- License : BSD3 +-- +-- Maintainer : johan@jeuring.net +-- Stability : experimental +-- Portability : portable +-- +----------------------------------------------------------------------------- + + +module Data.Algorithms.Palindromes.PalindromesUtils + (Flag(..) + ,negateDNA + ,showPalindromeDNA + ,(=:=) + ,showPalindrome + ,showTextPalindrome + ,myIsLetterC + ,myIsLetterW + ,myToLower + ,surroundedByPunctuation + ,appendseq + ,listArrayl0 + ) where + +import Data.Word (Word8) +import Data.Char (toLower,toUpper,isPunctuation,isSpace,isControl) +import Data.Array (Array,bounds,listArray,(!)) +import qualified Data.ByteString as B +import Data.ByteString.Internal (w2c,c2w) +import qualified Data.Sequence as S + +----------------------------------------------------------------------------- +-- Flags a user can specify +----------------------------------------------------------------------------- + +data Flag = -- Palindromic variants (choose 1 out of 6; mutually exclusive): + Help + | Plain + | Text + | Word + | DNA + | Extend Int + -- Algorithm complexity (choose 1 out of 2; mutually exclusive): + | Linear + | Quadratic + -- Output format (choose 1 out of 4; mutually exclusive): + | Longest + | LengthLongest + | Maximal + | LengthMaximal + -- Modifiers (choose 0 to 5; where the length restrictions need to fit together) + | Gap Int + | NrOfErrors Int + | LengthAtLeast Int + | LengthAtMost Int + | LengthExact Int + | LengthBetween Int Int -- input via AtLeast and AtMost. Adapt? + -- Input format + | StandardInput + +----------------------------------------------------------------------------- +-- Equality on DNA +----------------------------------------------------------------------------- + +negateDNA :: Char -> Char +negateDNA 'A' = 'T' +negateDNA 'T' = 'A' +negateDNA 'C' = 'G' +negateDNA 'G' = 'C' +negateDNA _ = error "negateDNA: not a DNA character" + +(=:=) :: Word8 -> Word8 -> Bool +l =:= r = let cl = toUpper (w2c l) + cr = toUpper (w2c r) + in if cl `elem` "ATCG" && cr `elem` "ATCG" + then cl == negateDNA cr + else False + +----------------------------------------------------------------------------- +-- Showing DNA palindromes +----------------------------------------------------------------------------- + +showPalindromeDNA :: B.ByteString -> (Int,Int) -> String +showPalindromeDNA input (len,pos) = + let startpos = pos - len `div` 2 + in (show startpos ++) + . (" to " ++) + . (show (startpos+len) ++) + . ("\t" ++) + . (show (B.take len $ B.drop startpos input) ++) + . ("\t" ++) + $ show len + +----------------------------------------------------------------------------- +-- Showing palindromes and other text related functionality +----------------------------------------------------------------------------- + +showPalindrome :: B.ByteString -> (Int,Int) -> String +showPalindrome input (len,pos) = + let startpos = pos `div` 2 - len `div` 2 + in show $ B.take len $ B.drop startpos input + +showTextPalindrome :: B.ByteString -> Array Int Int -> (Int,Int) -> String +showTextPalindrome input positionTextInput (len,pos) = + let startpos = pos `div` 2 - len `div` 2 + endpos = if odd len + then pos `div` 2 + len `div` 2 + else pos `div` 2 + len `div` 2 - 1 + (pfirst,plast) = bounds positionTextInput + (ifirst,ilast) = (0,1 + B.length input) + in if endpos < startpos + then [] + else let start = if startpos > pfirst + then (positionTextInput!(startpos-1))+1 + else ifirst + end = if endpos < plast + then (positionTextInput!(endpos+1))-1 + else ilast + in show (B.take (end-start+1) (B.drop start input)) + +{- Using this code instead of the last else above shows text palindromes without + all punctuation around it. Right now this punctuation is shown. + + else let start = positionArray!!!startpos + end = positionArray!!!endpos +-} + +-- For palindromes in strings, punctuation, spacing, and control characters +-- are often ignored + +myIsLetterW :: Word8 -> Bool +myIsLetterW c' = not (isPunctuation c) + && not (isControl c) + && not (isSpace c) + where c = w2c c' + +myIsLetterC :: Char -> Bool +myIsLetterC c = not (isPunctuation c) + && not (isControl c) + && not (isSpace c) + +myToLower :: Word8 -> Word8 +myToLower = c2w . toLower . w2c + +surroundedByPunctuation :: Int -> Int -> B.ByteString -> Bool +surroundedByPunctuation begin end input + | begin > afirst && end < alast = not (myIsLetterW (B.index input (begin-1))) && not (myIsLetterW (B.index input (end+1))) + | begin <= afirst && end < alast = not (myIsLetterW (B.index input (end+1))) + | begin <= afirst && end >= alast = True + | begin > afirst && end >= alast = not (myIsLetterW (B.index input (begin-1))) + | otherwise = error "surroundedByPunctuation" + where (afirst,alast) = (0,B.length input - 1) + +----------------------------------------------------------------------------- +-- Seq utils +----------------------------------------------------------------------------- + +appendseq :: ([a],S.Seq a) -> [a] +appendseq (list,s) = tolist s ++ list + +tolist :: S.Seq a -> [a] +tolist s = case S.viewl s of + S.EmptyL -> [] + a S.:< r -> a:tolist r + +----------------------------------------------------------------------------- +-- Array utils +----------------------------------------------------------------------------- + +listArrayl0 :: [a] -> Array Int a +listArrayl0 string = listArray (0,length string - 1) string diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- --- | +-- -- Module : tests.Main --- Copyright : (c) 2007 - 2011 Johan Jeuring +-- Copyright : (c) 2007 - 2013 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net @@ -19,16 +19,20 @@ import Test.QuickCheck import Test.HUnit -import Data.Algorithms.Palindromes.Palindromes -import qualified PalindromesConstantArguments as P +import Data.Algorithms.Palindromes.Palindromes +import Data.Algorithms.Palindromes.PalindromesUtils import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC + +longestTextPalindrome = Data.Algorithms.Palindromes.Palindromes.palindrome (Just Text) (Just Longest) (Just Linear) Nothing Nothing Nothing +longestWordPalindrome = Data.Algorithms.Palindromes.Palindromes.palindrome (Just Word) (Just Longest) (Just Linear) Nothing Nothing Nothing + propPalindromesAroundCentres :: Property propPalindromesAroundCentres = forAll (arbitrary:: Gen [Char]) $ \l -> let input = BC.pack l - in palindromesAroundCentres input == longestPalindromesQ input + in palindromesAroundCentres (Just Text) (Just Linear) Nothing Nothing input == longestPalindromesQ input longestPalindromesQ :: B.ByteString -> [Int] longestPalindromesQ input = @@ -129,7 +133,7 @@ ) testTextPalindrome10 = - TestCase (do string <- B.readFile "examples/palindromes/Damnitimmad.txt" + TestCase (do string <- B.readFile "/Users/johan/Documents/Palindromes/Software/staff.johanj.palindromes/trunk/examples/palindromes/Damnitimmad.txt" assertEqual "textPalindrome10" (concatMap (\c -> case c of @@ -143,7 +147,7 @@ ) testTextPalindrome11 = - TestCase (do string <- B.readFile "examples/palindromes/pal17.txt" + TestCase (do string <- B.readFile "/Users/johan/Documents/Palindromes/Software/staff.johanj.palindromes/trunk/examples/palindromes/pal17.txt" assertEqual "textPalindrome11" (concatMap (\c -> case c of @@ -197,6 +201,13 @@ (longestWordPalindrome (BC.pack "w waaw wo waw")) ) +testWordPalindrome7 = + TestCase (assertEqual + "wordPalindrome" + "\" waaw \"" + (longestWordPalindrome (BC.pack "vwaawvxy v waaw v")) + ) + tests :: Test tests = TestList [TestLabel "testTextPalindrome1" testTextPalindrome1 ,TestLabel "testTextPalindrome2" testTextPalindrome2 @@ -215,6 +226,7 @@ ,TestLabel "testWordPalindrome4" testWordPalindrome4 ,TestLabel "testWordPalindrome5" testWordPalindrome5 ,TestLabel "testWordPalindrome6" testWordPalindrome6 + ,TestLabel "testWordPalindrome7" testWordPalindrome7 ] main :: IO Counts