palindromes 0.2.2.2 → 0.3
raw patch · 9 files changed
+862/−405 lines, 9 filesdep +bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring
API changes (from Hackage documentation)
- Data.Algorithms.Palindromes.Palindromes: lengthLongestPalindromes :: Eq a => [a] -> String
- Data.Algorithms.Palindromes.Palindromes: listArrayl0 :: [a] -> Array Int a
- Data.Algorithms.Palindromes.Palindromes: longestPalindromes :: (Eq a, Show a) => Int -> [a] -> String
- Data.Algorithms.Palindromes.Palindromes: longestTextPalindromes :: Int -> String -> String
- Data.Algorithms.Palindromes.Palindromes: longestWordPalindromes :: Int -> String -> String
+ Data.Algorithms.Palindromes.Palindromes: lengthMaximalPalindromes :: ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: maximalPalindromes :: ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: maximalPalindromesLengthAtLeast :: Int -> ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: maximalPalindromesLengthAtMost :: Int -> ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: maximalPalindromesLengthBetween :: Int -> Int -> ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: maximalTextPalindromesLengthAtLeast :: Int -> ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: maximalWordPalindromesLengthAtLeast :: Int -> ByteString -> String
+ Data.Algorithms.Palindromes.Palindromes: myIsLetterC :: Char -> Bool
+ Data.Algorithms.Palindromes.Palindromes: palindromesLengthExact :: Int -> ByteString -> String
- Data.Algorithms.Palindromes.Palindromes: lengthLongestPalindrome :: Eq a => [a] -> String
+ Data.Algorithms.Palindromes.Palindromes: lengthLongestPalindrome :: ByteString -> String
- Data.Algorithms.Palindromes.Palindromes: longestPalindrome :: (Eq a, Show a) => [a] -> String
+ Data.Algorithms.Palindromes.Palindromes: longestPalindrome :: ByteString -> String
- Data.Algorithms.Palindromes.Palindromes: longestTextPalindrome :: String -> String
+ Data.Algorithms.Palindromes.Palindromes: longestTextPalindrome :: ByteString -> String
- Data.Algorithms.Palindromes.Palindromes: longestWordPalindrome :: String -> String
+ Data.Algorithms.Palindromes.Palindromes: longestWordPalindrome :: ByteString -> String
- Data.Algorithms.Palindromes.Palindromes: palindromesAroundCentres :: Eq a => Array Int a -> [Int]
+ Data.Algorithms.Palindromes.Palindromes: palindromesAroundCentres :: ByteString -> [Int]
Files
- CREDITS +1/−0
- README +6/−5
- RELEASE_HISTORY +37/−16
- palindromes.cabal +6/−4
- src/Data/Algorithms/Palindromes/Main.hs +10/−8
- src/Data/Algorithms/Palindromes/Options.hs +198/−49
- src/Data/Algorithms/Palindromes/Palindromes.hs +240/−272
- src/Data/Algorithms/Palindromes/PalindromesDNA.hs +288/−0
- tests/Main.hs +76/−51
CREDITS view
@@ -18,5 +18,6 @@ * Rafael Cunha de Almeida * Henning Thielemann+* Anjana Ramnath
README view
@@ -10,7 +10,7 @@ Features -------- -The primary features of Palindromes include:+The primary features of [Palindromes] include: * Linear-time algorithm for finding exact palindromes * Linear-time algorithm for finding text palindromes, @@ -18,14 +18,15 @@ symbols. * Linear-time algorithm for finding word palindromes, text palindromes surrounded by (if at all) non-letters.+* Linear-time algorithm for finding palindromes in DNA. Requirements ------------ -Palindromes has the following requirements:+[Palindromes] has the following requirements: -* [GHC] version 6.8.1 or later - It has been tested with version 7.0.4.+* [GHC] version 6.8.1 or later - It has been tested with version 7.2.2. * [Cabal] library version 1.2.1 or later - It has been tested with version 1.10.2.0. @@ -106,10 +107,10 @@ 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].+The current authors and maintainer of palindromes is [Johan Jeuring]. [Johan Jeuring]: http://www.jeuring.net/
RELEASE_HISTORY view
@@ -1,28 +1,49 @@ Release history: -190312 Version 0.2.2.2-Corrected a non-critical error in finalWordCentres+--------+01072012 Version 0.3+--------+Uses Data.Bytestring instead of String+Includes functionality for determining palindromes in DNA+Added many flags for determining the length of the palindromes returned -190312 Version 0.2.2.1-Corrected a link+--------+19032012 Version 0.2.2.2+--------+Corrects a non-critical error in finalWordCentres -170312 Version 0.2.2-Corrected the word palindromes solution+--------+19032012 Version 0.2.2.1+--------+Corrects a link -261211 Version 0.2.1-Updated base dependency from <=4 to <5-Used latin1 character set for input files+--------+17032012 Version 0.2.2+--------+Corrects the word palindromes solution -100110 Version 0.2-Read from standard input, via the flag -i+--------+26122011 Version 0.2.1+--------+Updates base dependency from <=4 to <5+Uses latin1 character set for input files++--------+10012010 Version 0.2+--------+Reads from standard input, via the flag -i More flexible flag handling-Read multiple files-Specify minimum length of palindromes returned, via the flag -m int+Reads multiple files+Specifies minimum length of palindromes returned, via the flag -m int -070909 Version 0.1.1-Corrected two errors in the flags+--------+07092009 Version 0.1.1+--------+Corrects two errors in the flags -060909 Version 0.1+--------+06092009 Version 0.1+-------- First version of the package
palindromes.cabal view
@@ -1,5 +1,5 @@ name: palindromes-version: 0.2.2.2+version: 0.3 synopsis: Finding palindromes in strings homepage: http://www.jeuring.net/homepage/palindromes/index.html description:@@ -20,7 +20,7 @@ tests/Main.hs build-type: Simple cabal-version: >= 1.2.1-tested-with: GHC == 7.0.4+tested-with: GHC == 7.2.2 -------------------------------------------------------------------------------- @@ -30,12 +30,14 @@ Executable palindromes Main-is: Data/Algorithms/Palindromes/Main.hs- ghc-options: -Wall+ ghc-options: -Wall -O2 hs-source-dirs: src other-modules: Data.Algorithms.Palindromes.Palindromes,+ Data.Algorithms.Palindromes.PalindromesDNA, Data.Algorithms.Palindromes.Options build-depends: base >= 3.0 && < 5,- array+ array,+ bytestring --------------------------------------------------------------------------------
src/Data/Algorithms/Palindromes/Main.hs view
@@ -15,27 +15,30 @@ import System.Console.GetOpt import System.IO +import qualified Data.ByteString as B+ import Data.Algorithms.Palindromes.Options ----------------------------------------------------------------------------- -- main ----------------------------------------------------------------------------- -handleFilesWith :: (String -> String) -> [String] -> IO ()+handleFilesWith :: (B.ByteString -> String) -> [String] -> IO () handleFilesWith f = let hFW filenames = case filenames of- [] -> putStr (f "")- (fn:fns) -> do fn' <- openFile fn ReadMode+ [] -> putStr (f B.empty)+ (fn:fns) -> do -- input <- B.readFile fn+ fn' <- openFile fn ReadMode hSetEncoding fn' latin1 - input <- hGetContents fn' + input <- B.hGetContents fn' putStrLn (f input) hFW fns in hFW -handleStandardInputWith :: (String -> String) -> IO ()+handleStandardInputWith :: (B.ByteString -> String) -> IO () handleStandardInputWith function = - do input <- getContents+ do input <- B.getContents putStrLn (function input) main :: IO ()@@ -47,5 +50,4 @@ in if fromfile then handleFilesWith function files else handleStandardInputWith function - - +
src/Data/Algorithms/Palindromes/Options.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- |+-- -- Module : Data.Algorithms.Palindromes.Options--- Copyright : (c) 2007 - 2010 Johan Jeuring+-- Copyright : (c) 2007 - 2012 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net@@ -13,7 +13,10 @@ import System.Console.GetOpt +import qualified Data.ByteString as B+ import Data.Algorithms.Palindromes.Palindromes+import Data.Algorithms.Palindromes.PalindromesDNA ----------------------------------------------------------------------------- -- flags@@ -22,30 +25,54 @@ data Flag = Help | StandardInput | LongestPalindrome- | LongestPalindromes | LengthLongestPalindrome- | LengthLongestPalindromes | LongestTextPalindrome- | LongestTextPalindromes | LongestWordPalindrome- | LongestWordPalindromes- | LengthAtLeast Int deriving Show+ | MaximalPalindromes+ | LengthMaximalPalindromes+ | MaximalTextPalindromes+ | MaximalWordPalindromes+ | LengthAtLeast Int+ | LengthAtMost Int+ | LengthExact Int + | DNA + | Odd deriving Show - isHelp :: Flag -> Bool-isHelp Help = True-isHelp _ = False +isHelp Help = True+isHelp _ = False +isDNA :: Flag -> Bool+isDNA DNA = True+isDNA _ = False ++isOdd :: Flag -> Bool+isOdd Odd = True+isOdd _ = False + isStandardInput :: Flag -> Bool-isStandardInput StandardInput = True-isStandardInput _ = False +isStandardInput StandardInput = True+isStandardInput _ = False isLengthAtLeast :: Flag -> Bool isLengthAtLeast (LengthAtLeast _) = True isLengthAtLeast _ = False +isLengthAtMost :: Flag -> Bool+isLengthAtMost (LengthAtMost _) = True+isLengthAtMost _ = False ++isLengthExact :: Flag -> Bool+isLengthExact (LengthExact _) = True+isLengthExact _ = False ++isLength :: Flag -> Bool+isLength flag = isLengthAtLeast flag || isLengthAtMost flag || isLengthExact flag+ getLength :: Flag -> Int getLength (LengthAtLeast n) = n +getLength (LengthAtMost n) = n +getLength (LengthExact n) = n getLength _ = error "No length specified" -- I am using single letter options here (except for help): getOpt handles @@ -57,57 +84,179 @@ "This message" ,Option "i" [] (NoArg StandardInput) "Read input from standard input"- ,Option "o" [] (NoArg LongestPalindrome) + ,Option "p" [] (NoArg LongestPalindrome) "Longest palindrome (default)"- ,Option "p" [] (NoArg LongestPalindromes)- "Longest palindrome around each position in the input"- ,Option "k" [] (NoArg LengthLongestPalindrome)+ ,Option "l" [] (NoArg LengthLongestPalindrome) "Length of the longest palindrome"- ,Option "l" [] (NoArg LengthLongestPalindromes)- "Length of the longest palindrome around each position in the input"- ,Option "s" [] (NoArg LongestTextPalindrome)+ ,Option "t" [] (NoArg LongestTextPalindrome) "Longest palindrome ignoring case, spacing and punctuation"- ,Option "t" [] (NoArg LongestTextPalindromes)- "Longest text palindrome around each position in the input" ,Option "v" [] (NoArg LongestWordPalindrome) "Longest text palindrome preceded and followed by punctuation symbols (if any)"- ,Option "w" [] (NoArg LongestWordPalindromes)+ ,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 "m" [] (ReqArg (LengthAtLeast . (read :: String -> Int)) "arg")- "Palindromes of length at least [arg]"+ ,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)" ] -handleOptions :: [Flag] -> (String -> String,Bool)+-- This needs to be refactored seriously!+handleOptions :: [Flag] -> (B.ByteString -> String,Bool) handleOptions flags = - let lal = filter isLengthAtLeast flags- flags' = filter (\f -> not (isLengthAtLeast f || isStandardInput f)) flags- m = if null lal - then 0- else getLength (head lal) - fromfile = null $ filter isStandardInput flags - function = case flags' of- [] -> longestPalindrome- (flag:_) -> - case flag of - Help -> - const (usageInfo headerHelpMessage options)- LongestPalindrome -> longestPalindrome- LongestPalindromes -> longestPalindromes m- LengthLongestPalindrome -> lengthLongestPalindrome- LengthLongestPalindromes -> lengthLongestPalindromes- LongestTextPalindrome -> longestTextPalindrome - LongestTextPalindromes -> longestTextPalindromes m- LongestWordPalindrome -> longestWordPalindrome - LongestWordPalindromes -> longestWordPalindromes m - _ -> error "handleOptions" + 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) +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"+ headerHelpMessage :: String headerHelpMessage = "*********************\n" ++ "* Palindrome Finder *\n" ++ "*********************\n" ++ "Usage:"- - -
src/Data/Algorithms/Palindromes/Palindromes.hs view
@@ -1,13 +1,5 @@--- palindromesAroundCentres--- palindromeWordsAroundCentres--- approximatePalindromesAroundCentres--- are the central functions of this module--- approximatePalindromesAroundCentres is easily defined in the style of--- the others.--- Use the text-based palindrome finding, and check for each addition whether or not it is a wordpalindrome- -------------------------------------------------------------------------------- |+-- -- Module : Data.Algorithms.Palindromes.Palindromes -- Copyright : (c) 2007 - 2012 Johan Jeuring -- License : BSD3@@ -18,74 +10,128 @@ -- ----------------------------------------------------------------------------- + module Data.Algorithms.Palindromes.Palindromes (longestPalindrome- ,longestPalindromes+ ,maximalPalindromes+ ,maximalPalindromesLengthAtLeast+ ,maximalPalindromesLengthBetween+ ,maximalPalindromesLengthAtMost+ ,palindromesLengthExact ,lengthLongestPalindrome- ,lengthLongestPalindromes+ ,lengthMaximalPalindromes ,longestTextPalindrome- ,longestTextPalindromes+ ,maximalTextPalindromesLengthAtLeast ,longestWordPalindrome- ,longestWordPalindromes+ ,maximalWordPalindromesLengthAtLeast ,palindromesAroundCentres- ,listArrayl0+ ,myIsLetterC ) where -import Data.List (maximumBy,intersperse)-import Data.Char(toLower,isPunctuation,isSpace,isControl)-import Data.Array(Array(),bounds,listArray,(!)) --- import Debug.Trace- -import Control.Arrow+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 ----------------------------------------------------------------------------- -- longestPalindrome ----------------------------------------------------------------------------- -- | longestPalindrome returns the longest palindrome in a string.-longestPalindrome :: (Eq a,Show a) => [a] -> String-longestPalindrome input = - let inputArray = listArrayl0 input- (maxLength,pos) = maximumBy - (\(l,_) (l',_) -> compare l l') - (zip (palindromesAroundCentres inputArray) [0..]) - in showPalindrome inputArray (maxLength,pos)+longestPalindrome :: B.ByteString -> String+longestPalindrome input = + let (maxLength,pos) = maximumBy + (\(l,_) (l',_) -> compare l l') + (zip (palindromesAroundCentres input) [0..]) + in showPalindrome input (maxLength,pos) -------------------------------------------------------------------------------- longestPalindromes+-- maximalPalindromes ----------------------------------------------------------------------------- --- | longestPalindromes 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.-longestPalindromes :: (Eq a,Show a) => Int -> [a] -> String-longestPalindromes m input = - let inputArray = listArrayl0 input- in concat - $ intersperse "\n" - $ map (showPalindrome inputArray) - $ filter ((m<=) . fst)- $ zip (palindromesAroundCentres inputArray) [0..]+-- | 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 :: Eq a => [a] -> String-lengthLongestPalindrome =- show . maximum . palindromesAroundCentres . listArrayl0+lengthLongestPalindrome :: B.ByteString -> String+lengthLongestPalindrome = show . maximum . palindromesAroundCentres ----------------------------------------------------------------------------- -- lengthLongestPalindromes ----------------------------------------------------------------------------- --- | lengthLongestPalindromes returns the lengths of the longest palindrome +-- | lengthMaximalPalindromes returns the lengths of the longest palindrome -- around each position in a string.-lengthLongestPalindromes :: Eq a => [a] -> String-lengthLongestPalindromes =- show . palindromesAroundCentres . listArrayl0+lengthMaximalPalindromes :: B.ByteString -> String+lengthMaximalPalindromes = show . palindromesAroundCentres ----------------------------------------------------------------------------- -- longestTextPalindrome@@ -93,26 +139,18 @@ -- | longestTextPalindrome returns the longest text palindrome in a string, -- ignoring spacing, punctuation symbols, and case of letters.-longestTextPalindrome :: String -> String-longestTextPalindrome input = - let inputArray = listArrayl0 input- ips = zip input [0..]- textinput = map (first toLower) - (filter (myIsLetter.fst) ips)- textInputArray = listArrayl0 (map fst textinput)- positionTextInputArray = listArrayl0 (map snd textinput)- in longestTextPalindromeArray - textInputArray - positionTextInputArray - inputArray+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 -longestTextPalindromeArray :: - Array Int Char -> Array Int Int -> Array Int Char -> String-longestTextPalindromeArray a positionArray inputArray = +longestTextPalindromeBS :: B.ByteString -> B.ByteString -> Array Int Int -> String+longestTextPalindromeBS input textInput positionTextInput = let (len,pos) = maximumBy (\(l,_) (l',_) -> compare l l') - (zip (palindromesAroundCentres a) [0..]) - in showTextPalindrome positionArray inputArray (len,pos) + (zip (palindromesAroundCentres textInput) [0..]) + in showTextPalindrome input positionTextInput (len,pos) ----------------------------------------------------------------------------- -- longestTextPalindromes@@ -121,30 +159,18 @@ -- | 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.-longestTextPalindromes :: Int -> String -> String-longestTextPalindromes m input = - let inputArray = listArrayl0 input- ips = zip input [0..]- textinput = map (first toLower) - (filter (myIsLetter.fst) ips)- textInputArray = listArrayl0 (map fst textinput)- positionTextInputArray = listArrayl0 (map snd textinput)- in concat - $ intersperse "\n" - $ longestTextPalindromesArray- m- textInputArray - positionTextInputArray - inputArray+maximalTextPalindromesLengthAtLeast :: Int -> B.ByteString -> String+maximalTextPalindromesLengthAtLeast m input = + let textInput = B.map myToLower (B.filter myIsLetterW input)+ positionTextInput = listArrayl0 (B.findIndices myIsLetterW input)+ in intercalate "\n" + $ maximalTextPalindromesLengthAtLeastBS m textInput positionTextInput input -longestTextPalindromesArray :: - Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String]-longestTextPalindromesArray m a positionArray inputArray = - map (showTextPalindrome positionArray inputArray) +maximalTextPalindromesLengthAtLeastBS :: Int -> B.ByteString -> Array Int Int -> B.ByteString -> [String]+maximalTextPalindromesLengthAtLeastBS m textInput positionTextInput input = + map (showTextPalindrome input positionTextInput) $ filter ((m<=) . fst)- $ zip (palindromesAroundCentres a) [0..]---- introduce == only here (not in longestTextPalindromes)?+ $ zip (palindromesAroundCentres textInput) [0..] ----------------------------------------------------------------------------- -- palindromesAroundCentres @@ -156,53 +182,44 @@ -- | 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 :: Eq a => Array Int a -> [Int]-palindromesAroundCentres a = - let (afirst,_) = bounds a- in reverse $ extendTail a afirst 0 []+palindromesAroundCentres :: B.ByteString -> [Int]+palindromesAroundCentres input = reverse $ extendPalindrome input 0 0 [] -extendTail :: Eq a => Array Int a -> Int -> Int -> [Int] -> [Int]-extendTail a n currentTail centres - | n > alast = - -- reached the end of the array - finalCentres currentTail centres (currentTail:centres)- | n-currentTail == afirst = - -- the current longest tail palindrome - -- extends to the start of the array- extendCentres a n (currentTail:centres) centres currentTail - | (a!n) == (a!(n-currentTail-1)) = - -- the current longest tail palindrome - -- can be extended- extendTail a (n+1) (currentTail+2) centres - | otherwise = - -- the current longest tail palindrome - -- cannot be extended - extendCentres a n (currentTail:centres) centres currentTail- where (afirst,alast) = bounds a+extendPalindrome :: B.ByteString -> Int -> Int -> [Int] -> [Int]+extendPalindrome input rightmost currentPalindrome currentMaximalPalindromes + | rightmost > last+ -- 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 + = moveCenter input rightmost (currentPalindrome:currentMaximalPalindromes) currentMaximalPalindromes currentPalindrome + | otherwise + -- the current palindrome can be extended+ = extendPalindrome input (rightmost+1) (currentPalindrome+2) currentMaximalPalindromes + where first = 0+ last = B.length input - 1 -extendCentres :: Eq a => Array Int a -> Int -> [Int] -> [Int] -> Int -> [Int]-extendCentres a n centres tcentres centreDistance- | centreDistance == 0 = - -- the last centre is on the last element: - -- try to extend the tail of length 1- extendTail a (n+1) 1 centres- | centreDistance-1 == head tcentres = - -- 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- extendTail a n (head tcentres) centres- | otherwise = - -- move the centres one step- -- add the length of the longest palindrome - -- to the centres- extendCentres a n (min (head tcentres) (centreDistance-1):centres) (tail tcentres) (centreDistance-1)+moveCenter :: B.ByteString -> Int -> [Int] -> [Int] -> Int -> [Int]+moveCenter input rightmost currentMaximalPalindromes previousMaximalPalindromes centreDistance+ | centreDistance == 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+ -- 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) -finalCentres :: Int -> [Int] -> [Int] -> [Int]-finalCentres n tcentres centres - | n == 0 = centres- | n > 0 = finalCentres (n-1) (tail tcentres) (min (head tcentres) (n-1):centres)+finalPalindromes :: Int -> [Int] -> [Int] -> [Int]+finalPalindromes nrOfCenters previousMaximalPalindromes currentMaximalPalindromes + | nrOfCenters == 0+ = currentMaximalPalindromes+ | nrOfCenters > 0+ = finalPalindromes (nrOfCenters-1) (tail previousMaximalPalindromes) (min (head previousMaximalPalindromes) (nrOfCenters-1):currentMaximalPalindromes) | otherwise = error "finalCentres: input < 0" -----------------------------------------------------------------------------@@ -212,42 +229,30 @@ -- | 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.-longestWordPalindromes :: Int -> String -> String-longestWordPalindromes m input = - let inputArray = listArrayl0 input- ips = zip input [0..]- textinput = map (first toLower) - (filter (myIsLetter.fst) ips)- textInputArray = listArrayl0 (map fst textinput)- positionTextInputArray = listArrayl0 (map snd textinput)- in concat - $ intersperse "\n" - $ longestWordPalindromesArray- m- textInputArray - positionTextInputArray - inputArray+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 -longestWordPalindromesArray :: Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String]-longestWordPalindromesArray m textInputArray positionArray inputArray = - map (showTextPalindrome positionArray inputArray) ++maximalWordPalindromesLengthAtLeastBS :: Int -> B.ByteString -> B.ByteString -> Array Int Int -> [String]+maximalWordPalindromesLengthAtLeastBS m input textInput positionTextInput = + map (showTextPalindrome input positionTextInput) $ filter ((m<=) . fst)- $ zip (wordPalindromesAroundCentres textInputArray positionArray inputArray) [0..]+ $ zip (wordPalindromesAroundCentres input textInput positionTextInput) [0..] -- | longestWordPalindrome returns the longest text palindrome preceded and -- followed by non-letter symbols (if any). -longestWordPalindrome :: String -> String+longestWordPalindrome :: B.ByteString -> String longestWordPalindrome input =- let inputArray = listArrayl0 input- ips = zip input [0..]- textinput = map (first toLower) - (filter (myIsLetter.fst) ips)- textInputArray = listArrayl0 (map fst textinput)- positionArray = listArrayl0 (map snd textinput)- (maxLength,pos) = maximumBy - (\(w,_) (w',_) -> compare w w') - (zip (wordPalindromesAroundCentres textInputArray positionArray inputArray) [0..]) - in showTextPalindrome positionArray inputArray (maxLength,pos)+ 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) ----------------------------------------------------------------------------- -- wordPalindromesAroundCentres @@ -259,45 +264,40 @@ -- | 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 :: Array Int Char -> Array Int Int -> Array Int Char -> [Int]-wordPalindromesAroundCentres textInputArray positionArray inputArray = - let (afirst,_) = bounds textInputArray- in reverse $ map (head . snd) $ extendTailWord textInputArray positionArray inputArray afirst (0,[0]) []+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]) -extendTailWord :: Array Int Char -> Array Int Int -> Array Int Char -> Int -> (Int,[Int]) -> [(Int,[Int])] -> [(Int,[Int])]-extendTailWord textInputArray positionArray inputArray n current@(currentTail,currentTailWords) centres +-- extendTailWordold textInput positionTextInput input n current centres = extendTailWord input textInput positionTextInput centres n current++extendTailWord :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> (Int,[Int]) -> [(Int,[Int])] +extendTailWord input textInput positionTextInput centres n current@(currentTail,currentTailWords) | n > alast = -- reached the end of the text input array - -- trace ("ETW 1 " ++ show current ++ " " ++ "\n") $ - finalWordCentres textInputArray positionArray inputArray currentTail centres (current:centres) (1+length centres)+ finalWordCentres input textInput positionTextInput (current:centres) currentTail centres (1+length centres) | n-currentTail == afirst = -- the current longest tail palindrome extends to the start of the text input array- -- trace ("ETW 2 " ++ show current ++ " " ++ "\n") $ - extendWordCentres textInputArray positionArray inputArray n (current:centres) centres currentTail- | (textInputArray!!!n) == (textInputArray!!!(n-currentTail-1)) = + extendWordCentres input textInput positionTextInput (current:centres) n centres currentTail+ | B.index textInput n == B.index textInput (n-currentTail-1) = -- the current longest tail palindrome can be extended -- check whether or not the extended palindrome is a wordpalindrome- if surroundedByPunctuation (positionArray!!!(n-currentTail-1)) (positionArray!!!n) inputArray- then -- trace ("ETW 3 " ++ show (currentTail+2,currentTail+2:currentTailWords) ++ " " ++ "\n") $ - extendTailWord textInputArray positionArray inputArray (n+1) (currentTail+2,currentTail+2:currentTailWords) centres- else -- trace ("ETW 4 " ++ show (currentTail+2,currentTailWords) ++ " " ++ show (n-currentTail-1) ++ " " ++ show n ++ "\n") $ - extendTailWord textInputArray positionArray inputArray (n+1) (currentTail+2,currentTailWords) centres + if surroundedByPunctuation (positionTextInput!(n-currentTail-1)) (positionTextInput!n) input+ then extendTailWord input textInput positionTextInput centres (n+1) (currentTail+2,currentTail+2:currentTailWords) + else extendTailWord input textInput positionTextInput centres (n+1) (currentTail+2,currentTailWords) | otherwise = -- the current longest tail palindrome cannot be extended - -- trace ("ETW 5" ++ "\n") $- extendWordCentres textInputArray positionArray inputArray n (current:centres) centres currentTail- where (afirst,alast) = bounds textInputArray+ extendWordCentres input textInput positionTextInput (current:centres) n centres currentTail+ where (afirst,alast) = (0,B.length textInput -1) -extendWordCentres :: Array Int Char -> Array Int Int -> Array Int Char -> Int -> [(Int,[Int])] -> [(Int,[Int])] -> Int -> [(Int,[Int])]-extendWordCentres textInputArray positionArray inputArray n centres tcentres centreDistance+extendWordCentres :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> [(Int,[Int])] -> Int -> [(Int,[Int])]+extendWordCentres input textInput positionTextInput centres n tcentres centreDistance | centreDistance == 0 = -- the last centre is on the last element: -- try to extend the tail of length 1- if surroundedByPunctuation (positionArray!n) (positionArray!n) inputArray- then -- trace ("EWC 1 " ++ show [1,0] ++ " " ++ "\n") $ - extendTailWord textInputArray positionArray inputArray (n+1) (1,[1,0]) centres- else -- trace ("EWC 2 " ++ show [0] ++ " " ++ "\n") $ - extendTailWord textInputArray positionArray inputArray (n+1) (1,[0]) centres+ if surroundedByPunctuation (positionTextInput!n) (positionTextInput!n) input+ then extendTailWord input textInput positionTextInput centres (n+1) (1,[1,0]) + else extendTailWord input textInput positionTextInput centres (n+1) (1,[0]) | centreDistance-1 == fst (head tcentres) = -- the previous element in the centre list -- reaches exactly to the end of the last @@ -305,37 +305,33 @@ -- of palindromes to find the longest tail -- palindrome let (currentTail,oldWord:oldWords) = head tcentres- in if surroundedByPunctuation (positionArray!(n-currentTail)) (positionArray!(n-1)) inputArray+ in if surroundedByPunctuation (positionTextInput!(n-currentTail)) (positionTextInput!(n-1)) input then if oldWord == currentTail- then -- trace ("EWC 3 " ++ show (head tcentres) ++ " " ++ "\n") $- extendTailWord textInputArray positionArray inputArray n (head tcentres) centres- else -- trace ("EWC 4 " ++ show (currentTail,currentTail:snd (head tcentres)) ++ " " ++ "\n") $- extendTailWord textInputArray positionArray inputArray n (currentTail,currentTail:oldWord:oldWords) centres+ then extendTailWord input textInput positionTextInput centres n (head tcentres) + else extendTailWord input textInput positionTextInput centres n (currentTail,currentTail:oldWord:oldWords) else if oldWord == currentTail && oldWord > 0- then -- trace ("EWC 5 " ++ show (currentTail, tail (snd (head tcentres))) ++ " " ++ "\n") $- extendTailWord textInputArray positionArray inputArray n (currentTail, tail (snd (head tcentres))) centres- else -- trace ("EWC 6 " ++ show (head tcentres) ++ " " ++ show (n-currentTail) ++ " " ++ show (n-1) ++ "\n") $- extendTailWord textInputArray positionArray inputArray n (head tcentres) centres+ then extendTailWord input textInput positionTextInput centres n (currentTail, tail (snd (head tcentres))) + else extendTailWord input textInput positionTextInput centres n (head tcentres) | otherwise = -- move the centres one step -- add the length of the longest palindrome -- to the centres let newTail = min (fst (head tcentres)) (centreDistance-1) oldWord = head (snd (head tcentres))- newWords = if oldWord < newTail- then if surroundedByPunctuation (positionArray!(n-newTail+1)) (positionArray!n) inputArray- then newTail:snd (head tcentres) - else snd (head tcentres) - else if null (tail (snd (head tcentres)))- then snd (head tcentres) - else tail (snd (head tcentres))- in -- trace ("EWC 7 " ++ show (newTail,newWords) ++ " " ++ "\n") $ - extendWordCentres textInputArray positionArray inputArray n ((newTail,newWords):centres) (tail tcentres) (centreDistance-1)+ newWords | oldWord < newTail + = if surroundedByPunctuation (positionTextInput!(n-newTail+1)) (positionTextInput!n) input+ then newTail:snd (head tcentres) + else snd (head tcentres) + | null (tail (snd (head tcentres)))+ = snd (head tcentres) + | otherwise + = tail (snd (head tcentres))+ in extendWordCentres input textInput positionTextInput ((newTail,newWords):centres) n (tail tcentres) (centreDistance-1) -finalWordCentres :: Array Int Char -> Array Int Int -> Array Int Char -> Int -> [(Int,[Int])] -> [(Int,[Int])] -> Int -> [(Int,[Int])]-finalWordCentres textInputArray positionArray inputArray n tcentres centres mirrorPoint +finalWordCentres :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> [(Int,[Int])] -> Int -> [(Int,[Int])]+finalWordCentres input textInput positionTextInput centres n tcentres mirrorPoint | n == 0 = centres- | n > 0 = let (_,tlast) = bounds textInputArray+ | n > 0 = let tlast = B.length textInput - 1 (oldTail,oldWord:oldWords) = head tcentres newTail = min oldTail (n-1) newWord = min oldWord (n-1)@@ -343,49 +339,42 @@ tailLastMirror = min tlast (if odd newTail then div (mirrorPoint + newTail) 2 else div (mirrorPoint + newTail) 2 - 1) wordFirstMirror = min tlast (div (mirrorPoint - newWord) 2) wordLastMirror = min tlast (if odd newWord then div (mirrorPoint + newTail) 2 else div (mirrorPoint + newTail) 2 - 1)- newWords = if -- trace ("FWC !" ++ show (positionArray!tailFirstMirror) ++ " " ++ show (positionArray!tailLastMirror)) $- surroundedByPunctuation (positionArray!tailFirstMirror) (positionArray!tailLastMirror) inputArray- then if newWord == newTail+ newWords | surroundedByPunctuation (positionTextInput!tailFirstMirror) (positionTextInput!tailLastMirror) input+ = if newWord == newTail then newTail:oldWords else newTail:oldWord:oldWords- else if -- trace ("FWC !" ++ show (positionArray!wordFirstMirror) ++ " " ++ show (positionArray!wordLastMirror)) $- surroundedByPunctuation (positionArray!wordFirstMirror) (positionArray!wordLastMirror) inputArray- then newWord:oldWords- else if null oldWords then newWord:oldWords else oldWords- in -- trace ("FWC 1 " ++ " " ++ show (newTail,newWords) ++ "\n") $ - finalWordCentres textInputArray positionArray inputArray (n-1) (tail tcentres) ((newTail,newWords):centres) (mirrorPoint+1)+ | surroundedByPunctuation (positionTextInput!wordFirstMirror) (positionTextInput!wordLastMirror) input ||+ null oldWords = newWord:oldWords+ | otherwise = oldWords+ 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 :: (Show a) => Array Int a -> (Int,Int) -> String-showPalindrome a (len,pos) = +showPalindrome :: B.ByteString -> (Int,Int) -> String+showPalindrome input (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- in show [a!n|n <- [startpos .. endpos]]+ in show $ B.take len $ B.drop startpos input -showTextPalindrome :: (Show a) => - Array Int Int -> Array Int a -> (Int,Int) -> String-showTextPalindrome positionArray inputArray (len,pos) = +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 positionArray- (ifirst,ilast) = bounds inputArray+ (pfirst,plast) = bounds positionTextInput+ (ifirst,ilast) = (0,1 + B.length input) in if endpos < startpos then [] else let start = if startpos > pfirst- then (positionArray!(startpos-1))+1+ then (positionTextInput!(startpos-1))+1 else ifirst end = if endpos < plast- then (positionArray!(endpos+1))-1+ then (positionTextInput!(endpos+1))-1 else ilast- in show [inputArray!n | n<- [start..end]]+ 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.@@ -396,54 +385,33 @@ -- For palindromes in strings, punctuation, spacing, and control characters -- are often ignored-myIsLetter :: Char -> Bool-myIsLetter c = (not $ isPunctuation c)- && (not $ isControl c)- && (not $ isSpace c)- -surroundedByPunctuation :: Int -> Int -> Array Int Char -> Bool-surroundedByPunctuation begin end inputArray - | begin > afirst && end < alast = not (myIsLetter (inputArray!(begin-1))) && not (myIsLetter (inputArray!(end+1)))- | begin <= afirst && end < alast = not (myIsLetter (inputArray!(end+1)))++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 (myIsLetter (inputArray!(begin-1)))+ | begin > afirst && end >= alast = not (myIsLetterW (B.index input (begin-1))) | otherwise = error "surroundedByPunctuation"- where (afirst,alast) = bounds inputArray+ where (afirst,alast) = (0,B.length input - 1) ----------------------------------------------------------------------------- -- Array utils ----------------------------------------------------------------------------- listArrayl0 :: [a] -> Array Int a-listArrayl0 string = listArray (0,length string - 1) string---- (!!!) is a variant of (!), which prints out the problem in case of--- an index out of bounds.-(!!!) :: Array Int a -> Int -> a-a!!! n = -- trace (show n ++ " " ++ show (snd (bounds a))) $- if n >= fst (bounds a) && n <= snd (bounds a) - then a!n - else error (show (fst (bounds a)) ++ " " ++ show (snd (bounds a)) ++ " " ++ show n)---{---- Used for testing purposes.--wpac = wordPalindromesAroundCentres-lwp = longestWordPalindromes 0-s = "aaaab a" -- "w woow wawaw woow w" -- "what is non si, not?"-- "www www www www"-- "wwww w woow waw wwwwwww w"-a = listArrayl0 s-i = zip s [0..]-t' = map (first toLower) (filter (myIsLetter.fst) i)-t = listArrayl0 (map fst t')-p::Array Int Int-p = listArrayl0 (map snd t')-sbp = surroundedByPunctuation-te = sbp 2 2 a-etw = extendTailWord-et = etw t p a 0 (0,[0]) [] -ret = reverse $ map (head . snd) $ et-zret = zip ret [0..]-mzret = maximumBy (\(w,_) (w',_) -> compare w w') zret---}+listArrayl0 string = listArray (0,length string - 1) string
+ src/Data/Algorithms/Palindromes/PalindromesDNA.hs view
@@ -0,0 +1,288 @@+-- >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 . \(pl,pc) -> (min pl n,pc)) + $ filter (\(pl,_) -> m <= pl)+ $ 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)++isDNASymbol :: Word8 -> Bool+isDNASymbol w = w2c w `elem` "ACTGactg"
tests/Main.hs view
@@ -12,48 +12,52 @@ module Main where + import Data.Array import Data.Char import Test.QuickCheck import Test.HUnit -import Data.Algorithms.Palindromes.Palindromes+import Data.Algorithms.Palindromes.Palindromes +import qualified PalindromesConstantArguments as P+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC propPalindromesAroundCentres :: Property propPalindromesAroundCentres = - forAll (arbitrary:: Gen [Int]) $ - \l -> let a = array (0,length l - 1) (zip [0..] l)- in palindromesAroundCentres a == longestPalindromesQ a+ forAll (arbitrary:: Gen [Char]) $ + \l -> let input = BC.pack l+ in palindromesAroundCentres input == longestPalindromesQ input -longestPalindromesQ :: Eq a => Array Int a -> [Int]-longestPalindromesQ a = - let (afirst,alast) = bounds a+longestPalindromesQ :: B.ByteString -> [Int]+longestPalindromesQ input = + let (afirst,alast) = (0,B.length input - 1) positions = [0 .. 2*(alast-afirst+1)]- in map (lengthPalindromeAround a) positions+ in map (lengthPalindromeAround input) positions -lengthPalindromeAround :: Eq a => Array Int a +lengthPalindromeAround :: B.ByteString -> Int -> Int-lengthPalindromeAround a position +lengthPalindromeAround input position | even position = extendPalindromeAround (afirst+pos-1) (afirst+pos) | odd position = extendPalindromeAround (afirst+pos-1) (afirst+pos+1) where pos = div position 2- (afirst,alast) = bounds a+ (afirst,alast) = (0,B.length input -1) extendPalindromeAround start end = if start < 0 || end > alast-afirst - || a!start /= a!end+ || B.index input start /= B.index input end then end-start-1 else extendPalindromeAround (start-1) (end+1) propTextPalindrome :: Property propTextPalindrome = forAll (arbitrary:: Gen [Char]) $ - \l -> let ltp = longestTextPalindrome l- ltp' = map toLower (filter isLetter (unescape ltp))+ \l -> let ltp = longestTextPalindrome (BC.pack l)+ ltp' = map toLower (filter myIsLetterC (unescape ltp)) in ltp' == reverse ltp' unescape :: String -> String@@ -73,83 +77,81 @@ TestCase (assertEqual "textPalindrome1" "\"a,ba.\"" - (longestTextPalindrome "abcdea,ba.")+ (longestTextPalindrome (BC.pack "abcdea,ba.")) ) testTextPalindrome2 = TestCase (assertEqual "textPalindrome2" "\"a,ba\"" - (longestTextPalindrome "abcdea,ba")+ (longestTextPalindrome (BC.pack "abcdea,ba")) ) testTextPalindrome3 = TestCase (assertEqual "textPalindrome3" "\".a,ba\"" - (longestTextPalindrome "abcde.a,ba")+ (longestTextPalindrome (BC.pack "abcde.a,ba")) ) testTextPalindrome4 = TestCase (assertEqual "textPalindrome4" "\".a,ba\"" - (longestTextPalindrome "abcde.a,baf")+ (longestTextPalindrome (BC.pack "abcde.a,baf")) ) testTextPalindrome5 = TestCase (assertEqual "textPalindrome5" "\".ab,a\"" - (longestTextPalindrome ".ab,acdef")+ (longestTextPalindrome (BC.pack ".ab,acdef")) ) testTextPalindrome6 = TestCase (assertEqual "textPalindrome6" "\"ab,a\"" - (longestTextPalindrome "ab,acdef")+ (longestTextPalindrome (BC.pack "ab,acdef")) ) testTextPalindrome7 = TestCase (assertEqual "textPalindrome7" "\"ab,a.\"" - (longestTextPalindrome "ab,a.cdef")+ (longestTextPalindrome (BC.pack "ab,a.cdef")) ) testTextPalindrome8 = TestCase (assertEqual "textPalindrome8" "\".ab,a.\"" - (longestTextPalindrome "g.ab,a.cdef")+ (longestTextPalindrome (BC.pack "g.ab,a.cdef")) ) testTextPalindrome9 = TestCase (assertEqual "textPalindrome9" "" - (longestTextPalindrome "")+ (longestTextPalindrome B.empty) ) testTextPalindrome10 =- TestCase (do string <- readFile "examples/palindromes/Damnitimmad.txt"+ TestCase (do string <- B.readFile "examples/palindromes/Damnitimmad.txt" assertEqual "textPalindrome10" (concatMap (\c -> case c of '\n' -> "\\n" - '\"' -> "\\\""+ '\"' -> "\""--""\\\"" d -> [d] )- string+ (show string) )- (init . tail $ longestTextPalindrome string)+ (longestTextPalindrome string) ) testTextPalindrome11 =- TestCase (do string <- readFile "examples/palindromes/pal17.txt"+ TestCase (do string <- B.readFile "examples/palindromes/pal17.txt" assertEqual "textPalindrome11" - ("\"" ++ - concatMap (\c -> case c of+ (concatMap (\c -> case c of '\n' -> "\\n" - '\"' -> "\\\""+ '\"' -> "\"" d -> [d] )- string ++ - "\"")+ (show string)) (longestTextPalindrome string) ) @@ -157,42 +159,42 @@ TestCase (assertEqual "wordPalindrome" "\" is non si, \"" - (longestWordPalindrome "what is non si, not?")+ (longestWordPalindrome (BC.pack "what is non si, not?")) ) testWordPalindrome2 = TestCase (assertEqual "wordPalindrome" "\" is non si\"" - (longestWordPalindrome "what is non si")+ (longestWordPalindrome (BC.pack "what is non si")) ) testWordPalindrome3 = TestCase (assertEqual "wordPalindrome" "\"is non si, \"" - (longestWordPalindrome "is non si, not?")+ (longestWordPalindrome (BC.pack "is non si, not?")) ) testWordPalindrome4 = TestCase (assertEqual "wordPalindrome" "" - (longestWordPalindrome "aaaaba")+ (longestWordPalindrome (BC.pack "aaaaba")) ) testWordPalindrome5 = TestCase (assertEqual "wordPalindrome" "\" a\"" - (longestWordPalindrome "aaaab a")+ (longestWordPalindrome (BC.pack "aaaab a")) ) testWordPalindrome6 = TestCase (assertEqual "wordPalindrome" "\" waaw \"" - (longestWordPalindrome "w waaw wo waw")+ (longestWordPalindrome (BC.pack "w waaw wo waw")) ) tests :: Test@@ -220,28 +222,51 @@ quickCheck propPalindromesAroundCentres quickCheck propTextPalindrome runTestTT tests- -{- -Code for benchmarking. Needs to go in a separate file. -To compare my solution and Rampion's lazy solution:+{-+2nd property falsified by+"m\159:t\231\202\r\STX-me\230\&9JS/\EM'5\164\171\148\&5A@\196\242\f\157jY\NULB,\134\179\ESCS`:\ff\203\b\130\&0\DC3Yni>L" - [bench "lengthLongestPalindromes" (nf (palindromesAroundCentres (==) . listArrayl0) input)- ,bench "Rampion's solution" (nf maximalPalindromeLengths input)- ]+"\GS[\242\tx\ENQ3\247\&3\130(\NUL?zX\215\DC3" +"\213\SI6+\ESCU:1\165\254\228\SUB9\200\231\USM,3\227\&3\176\214X\203\SOH\130UI9\154\239<w\231kPbmvY|!sc\133\b$#v\203LM\235H"++-}++{-++-- Code for benchmarking. Needs to go in a separate file.+ import Criterion.Main import Data.Algorithms.Palindromes.Palindromes-import PalindromeRampion import System.IO+import qualified Data.ByteString as B main :: IO () main = - do fn <- openFile "../../../TestSources/Bibles/engelskingjames.txt" ReadMode- hSetEncoding fn latin1 - input <- hGetContents fn+ do fnenhl <- openFile "examples/palindromes/Damnitimmad.txt" ReadMode-- "../../TestSources/Bibles/engelskingjames.txt" ReadMode+ hSetEncoding fnenhl latin1 + inputenB <- B.hGetContents fnenhl+-- fnnlhl <- openFile "../../TestSources/Bibles/nederlands.txt" ReadMode+-- hSetEncoding fnnlhl latin1 +-- inputnlB <- B.hGetContents fnnlhl defaultMain- [bench "lengthLongestPalindrome-Eq" (nf lengthLongestPalindrome input)] + [+-- bench "longestPalindromeConstantArguments Dutch" (nf CA.longestPalindrome inputnlB)--,+-- bench "longestPalindrome Dutch" (nf longestPalindrome inputnlB)--,+-- bench "longestPalindromeConstantArguments English" (nf CA.longestPalindrome inputenB)--,+ bench "longestPalindrome English" (nf longestPalindrome inputenB)--,--,+ ] -}+{-++To compare my solution and Rampion's lazy solution:++ [bench "lengthLongestPalindromes" (nf (palindromesAroundCentres (==) . listArrayl0) input)+ ,bench "Rampion's solution" (nf maximalPalindromeLengths input)+ ]++-}+