palindromes 0.2.2 → 0.2.2.1
raw patch · 4 files changed
+127/−29 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.Algorithms.Palindromes.Palindromes: listArrayl0 :: [a] -> Array Int a
Files
- README +1/−1
- RELEASE_HISTORY +3/−0
- palindromes.cabal +4/−4
- src/Data/Algorithms/Palindromes/Palindromes.hs +119/−24
README view
@@ -4,7 +4,7 @@ [Palindromes] is a package for finding palindromes in files. -[Palindromes]: http://www.jeuring.net/Palindromes/+[Palindromes]: http://www.jeuring.net/homepage/palindromes/index.html Features
RELEASE_HISTORY view
@@ -1,5 +1,8 @@ Release history: +190312 Version 0.2.2.1+Corrected a link+ 170312 Version 0.2.2 Corrected the word palindromes solution
palindromes.cabal view
@@ -1,14 +1,14 @@ name: palindromes-version: 0.2.2+version: 0.2.2.1 synopsis: Finding palindromes in strings-homepage: http://www.jeuring.net/Palindromes+homepage: http://www.jeuring.net/homepage/palindromes/index.html description: palindromes is an executable and a library which takes a file name, and returns information about palindromes in the file. category: Algorithms-copyright: (c) 2007 - 2011 Johan Jeuring+copyright: (c) 2007 - 2012 Johan Jeuring license: BSD3 license-file: LICENSE author: Johan Jeuring@@ -20,7 +20,7 @@ tests/Main.hs build-type: Simple cabal-version: >= 1.2.1-tested-with: GHC == 6.10.1+tested-with: GHC == 7.0.4 --------------------------------------------------------------------------------
src/Data/Algorithms/Palindromes/Palindromes.hs view
@@ -28,13 +28,11 @@ ,longestWordPalindrome ,longestWordPalindromes ,palindromesAroundCentres- ,listArrayl0 ) 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 @@ -268,20 +266,16 @@ extendTailWord textInputArray positionArray inputArray n current@(currentTail,currentTailWords) centres | n > alast = -- reached the end of the text input array - -- trace ("ETW 1 " ++ show current ++ " " ++ "\n") $ finalWordCentres textInputArray positionArray inputArray currentTail centres (current: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)) = -- 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 + then extendTailWord textInputArray positionArray inputArray (n+1) (currentTail+2,currentTail+2:currentTailWords) centres+ else extendTailWord textInputArray positionArray inputArray (n+1) (currentTail+2,currentTailWords) centres | otherwise = -- the current longest tail palindrome cannot be extended extendWordCentres textInputArray positionArray inputArray n (current:centres) centres currentTail@@ -293,10 +287,8 @@ -- 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+ then extendTailWord textInputArray positionArray inputArray (n+1) (1,[1,0]) centres+ else extendTailWord textInputArray positionArray inputArray (n+1) (1,[0]) centres | centreDistance-1 == fst (head tcentres) = -- the previous element in the centre list -- reaches exactly to the end of the last @@ -306,15 +298,11 @@ let (currentTail,oldWord:oldWords) = head tcentres in if surroundedByPunctuation (positionArray!(n-currentTail)) (positionArray!(n-1)) inputArray 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 textInputArray positionArray inputArray n (head tcentres) centres+ else extendTailWord textInputArray positionArray inputArray n (currentTail,currentTail:oldWord:oldWords) centres 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 textInputArray positionArray inputArray n (currentTail, tail (snd (head tcentres))) centres+ else extendTailWord textInputArray positionArray inputArray n (head tcentres) centres | otherwise = -- move the centres one step -- add the length of the longest palindrome @@ -328,8 +316,7 @@ 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)+ in extendWordCentres textInputArray positionArray inputArray n ((newTail,newWords):centres) (tail tcentres) (centreDistance-1) finalWordCentres :: Array Int Char -> Array Int Int -> Array Int Char -> Int -> [(Int,[Int])] -> [(Int,[Int])] -> [(Int,[Int])] finalWordCentres textInputArray positionArray inputArray n tcentres centres @@ -344,10 +331,118 @@ && surroundedByPunctuation (positionArray!firstMirror) (positionArray!lastMirror) inputArray then newTail:oldWord:oldWords else if null oldWords then oldWord:oldWords else oldWords- in -- trace ("FWC 1 " ++ show (newTail,newWords) ++ show (tlast-diff) ++ " " ++ show (tlast-diff-newTail+1) ++ " " ++ show diff ++ show (newTail,newWords) ++ "\n") $ - finalWordCentres textInputArray positionArray inputArray (n-1) (tail tcentres) ((newTail,newWords):centres)+ in finalWordCentres textInputArray positionArray inputArray (n-1) (tail tcentres) ((newTail,newWords):centres) | otherwise = error "finalWordCentres: input < 0" +{- Outcommented for release 0.2.2.1; gives away what is going to appear in 0.3+-----------------------------------------------------------------------------+-- longestApproximatePalindromes+-----------------------------------------------------------------------------++-- | longestApproximatePalindromes returns the longest approximate +-- palindrome around each position in a string. An approximate palindrome+-- is a palindrome with at most a specified number of errors.+longestApproximatePalindromes :: (Eq a,Show a) => Int -> [a] -> String+longestApproximatePalindromes nrOfErrors input = + let inputArray = listArrayl0 input+ (maxLength,pos) = (\(((l,nrOfErrors):xs),p) -> (l,p)) $ + maximumBy + (\((l,_):_,_) ((l',_):_,_) -> compare l l') + (zip (approximatePalindromesAroundCentres nrOfErrors inputArray) [0..]) + in showPalindrome inputArray (maxLength,pos)++-----------------------------------------------------------------------------+-- approximatePalindromesAroundCentres +--+-- This is the function palindromesAroundCentres, but now the palindrome+-- may contain a specified number of errors.+-----------------------------------------------------------------------------++-- | for each centre, approximatePalindromesAroundCentres calculates a list +-- palindromes with corresponding nrOfErrors, in decreasing length.+approximatePalindromesAroundCentres :: Int -> Array Int a -> [[(Int,Int)]]+approximatePalindromesAroundCentres nrOfErrors inputArray = + let (afirst,_) = bounds inputArray+ in reverse $ extendTailWord inputArray afirst (0,[0]) []++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]) []++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 + | n > alast = + -- reached the end of the text input array + finalWordCentres textInputArray positionArray inputArray currentTail centres (current:centres)+ | n-currentTail == afirst = + -- the current longest tail palindrome extends to the start of the text input array+ extendWordCentres textInputArray positionArray inputArray n (current:centres) centres currentTail+ | (textInputArray!!!n) == (textInputArray!!!(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 extendTailWord textInputArray positionArray inputArray (n+1) (currentTail+2,currentTail+2:currentTailWords) centres+ else extendTailWord textInputArray positionArray inputArray (n+1) (currentTail+2,currentTailWords) centres + | otherwise = + -- the current longest tail palindrome cannot be extended + extendWordCentres textInputArray positionArray inputArray n (current:centres) centres currentTail+ where (afirst,alast) = bounds textInputArray++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+ | 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 extendTailWord textInputArray positionArray inputArray (n+1) (1,[1,0]) centres+ else extendTailWord textInputArray positionArray inputArray (n+1) (1,[0]) centres+ | centreDistance-1 == fst (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+ let (currentTail,oldWord:oldWords) = head tcentres+ in if surroundedByPunctuation (positionArray!(n-currentTail)) (positionArray!(n-1)) inputArray+ then if oldWord == currentTail+ then extendTailWord textInputArray positionArray inputArray n (head tcentres) centres+ else extendTailWord textInputArray positionArray inputArray n (currentTail,currentTail:oldWord:oldWords) centres+ else if oldWord == currentTail && oldWord > 0+ then extendTailWord textInputArray positionArray inputArray n (currentTail, tail (snd (head tcentres))) centres+ else extendTailWord textInputArray positionArray inputArray n (head tcentres) centres+ | 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 extendWordCentres textInputArray positionArray inputArray n ((newTail,newWords):centres) (tail tcentres) (centreDistance-1)++finalWordCentres :: Array Int Char -> Array Int Int -> Array Int Char -> Int -> [(Int,[Int])] -> [(Int,[Int])] -> [(Int,[Int])]+finalWordCentres textInputArray positionArray inputArray n tcentres centres + | n == 0 = centres+ | n > 0 = let (_,tlast) = bounds textInputArray+ (oldTail,oldWord:oldWords) = head tcentres+ newTail = min oldTail (n-1)+ diff = if oldTail < n-1 then n - 1 - oldTail else 0+ firstMirror = min tlast (tlast-diff-newTail+1)+ lastMirror = tlast-diff+ newWords = if oldWord < newTail + && surroundedByPunctuation (positionArray!firstMirror) (positionArray!lastMirror) inputArray+ then newTail:oldWord:oldWords+ else if null oldWords then oldWord:oldWords else oldWords+ in finalWordCentres textInputArray positionArray inputArray (n-1) (tail tcentres) ((newTail,newWords):centres)+ | otherwise = error "finalWordCentres: input < 0" ++-} ----------------------------------------------------------------------------- -- Showing palindromes and other text related functionality -----------------------------------------------------------------------------