palindromes 0.3.2 → 0.4
raw patch · 11 files changed
+598/−801 lines, 11 filesdep +containers
Dependencies added: containers
Files
- CREDITS +2/−1
- LICENSE +1/−1
- README +12/−7
- RELEASE_HISTORY +8/−0
- palindromes.cabal +12/−8
- src/Data/Algorithms/Palindromes/Main.hs +11/−10
- src/Data/Algorithms/Palindromes/Options.hs +189/−218
- src/Data/Algorithms/Palindromes/Palindromes.hs +169/−261
- src/Data/Algorithms/Palindromes/PalindromesDNA.hs +0/−288
- src/Data/Algorithms/Palindromes/PalindromesUtils.hs +175/−0
- tests/Main.hs +19/−7
CREDITS view
@@ -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
LICENSE view
@@ -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,
README view
@@ -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].
RELEASE_HISTORY view
@@ -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
palindromes.cabal view
@@ -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 --------------------------------------------------------------------------------
src/Data/Algorithms/Palindromes/Main.hs view
@@ -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
src/Data/Algorithms/Palindromes/Options.hs view
@@ -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:"
src/Data/Algorithms/Palindromes/Palindromes.hs view
@@ -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
− src/Data/Algorithms/Palindromes/PalindromesDNA.hs
@@ -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"
+ src/Data/Algorithms/Palindromes/PalindromesUtils.hs view
@@ -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
tests/Main.hs view
@@ -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