diff --git a/README b/README --- a/README +++ b/README @@ -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 diff --git a/RELEASE_HISTORY b/RELEASE_HISTORY --- a/RELEASE_HISTORY +++ b/RELEASE_HISTORY @@ -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 diff --git a/palindromes.cabal b/palindromes.cabal --- a/palindromes.cabal +++ b/palindromes.cabal @@ -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 -------------------------------------------------------------------------------- diff --git a/src/Data/Algorithms/Palindromes/Palindromes.hs b/src/Data/Algorithms/Palindromes/Palindromes.hs --- a/src/Data/Algorithms/Palindromes/Palindromes.hs +++ b/src/Data/Algorithms/Palindromes/Palindromes.hs @@ -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 -----------------------------------------------------------------------------