palindromes 0.2.1 → 0.2.2

raw patch · 8 files changed

+266/−350 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• README +2/−2
• RELEASE_HISTORY +8/−1
• palindromes.cabal +1/−1
• src/Data/Algorithms/Palindromes/Main.hs +5/−6
• src/Data/Algorithms/Palindromes/Options.hs +4/−4
• src/Data/Algorithms/Palindromes/Palindromes.hs +229/−130
• tests/Main.hs +16/−205

@@ -1,4 +1,4 @@-Copyright (c) 2007 - 2010 Johan Jeuring+Copyright (c) 2007 - 2012 Johan Jeuring All rights reserved.  Redistribution and use in source and binary forms, with or without modification,

@@ -25,9 +25,9 @@  Palindromes has the following requirements: -*  [GHC] version 6.8.1 or later - It has been tested with version 6.10.1.+*  [GHC] version 6.8.1 or later - It has been tested with version 7.0.4. *  [Cabal] library version 1.2.1 or later - It has been tested with version -           1.6.0.1.+           1.10.2.0.  [GHC]: http://www.haskell.org/ghc/ [Cabal]: http://www.haskell.org/cabal/

@@ -1,6 +1,13 @@ Release history: -100110 Version 2+170312 Version 0.2.2+Corrected the word palindromes solution++261211 Version 0.2.1+Updated base dependency from <=4 to <5+Used latin1 character set for input files++100110 Version 0.2 Read from standard input, via the flag -i More flexible flag handling Read multiple files

@@ -1,5 +1,5 @@ name:                   palindromes-version:                0.2.1+version:                0.2.2 synopsis:               Finding palindromes in strings homepage:               http://www.jeuring.net/Palindromes description:

@@ -26,12 +26,11 @@   let hFW filenames =          case filenames of           []        ->  putStr (f "")-          (fn:fns)  ->  do -- input <- readFile fn-                         fn' <- openFile fn ReadMode-                         hSetEncoding fn' latin1 -                         input <- hGetContents fn' -                         putStrLn (f input)-                         hFW fns+          (fn:fns)  ->  do fn' <- openFile fn ReadMode+                           hSetEncoding fn' latin1 +                           input <- hGetContents fn' +                           putStrLn (f input)+                           hFW fns   in hFW                                   handleStandardInputWith :: (String -> String) -> IO ()

@@ -91,15 +91,15 @@                      case flag of                         Help                      ->                            const (usageInfo headerHelpMessage options)-                       LongestPalindrome         ->  longestPalindrome +                       LongestPalindrome         ->  longestPalindrome                        LongestPalindromes        ->  longestPalindromes m-                       LengthLongestPalindrome   ->  lengthLongestPalindrome +                       LengthLongestPalindrome   ->  lengthLongestPalindrome                        LengthLongestPalindromes  ->  lengthLongestPalindromes                        LongestTextPalindrome     ->  longestTextPalindrome                         LongestTextPalindromes    ->  longestTextPalindromes m                        LongestWordPalindrome     ->  longestWordPalindrome		-                       LongestWordPalindromes    ->  longestWordPalindromes m		-                       _                         ->  error "handleOptions"+                       LongestWordPalindromes    ->  longestWordPalindromes m +                       _                         ->  error "handleOptions"    in (function,fromfile)  headerHelpMessage :: String

@@ -1,7 +1,15 @@+-- 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 - 2010 Johan Jeuring+-- Copyright   :  (c) 2007 - 2012 Johan Jeuring -- License     :  BSD3 -- -- Maintainer  :  johan@jeuring.net@@ -10,7 +18,7 @@ -- ----------------------------------------------------------------------------- -module Data.Algorithms.Palindromes.Palindromes+module Data.Algorithms.Palindromes.Palindromes         (longestPalindrome        ,longestPalindromes        ,lengthLongestPalindrome@@ -20,23 +28,22 @@        ,longestWordPalindrome        ,longestWordPalindromes        ,palindromesAroundCentres-       ) where+       ,listArrayl0+       )  where   import Data.List (maximumBy,intersperse)-import Data.Char-import Data.Array +import Data.Char(toLower,isPunctuation,isSpace,isControl)+import Data.Array(Array(),bounds,listArray,(!)) +-- import Debug.Trace   import Control.Arrow- --- All functions in the interface, except palindromesAroundCentres --- have the type String -> String-       + ----------------------------------------------------------------------------- -- longestPalindrome -----------------------------------------------------------------------------  -- | longestPalindrome returns the longest palindrome in a string.-longestPalindrome :: String -> String+longestPalindrome :: (Eq a,Show a) => [a] -> String longestPalindrome input =    let inputArray       =  listArrayl0 input       (maxLength,pos)  =  maximumBy @@ -51,7 +58,7 @@ -- | 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 :: Int -> String -> String+longestPalindromes :: (Eq a,Show a) => Int -> [a] -> String longestPalindromes m input =    let inputArray       =  listArrayl0 input   in    concat @@ -66,7 +73,7 @@  -- | lengthLongestPalindrome returns the length of the longest palindrome in  --   a string.-lengthLongestPalindrome :: String -> String+lengthLongestPalindrome :: Eq a => [a] -> String lengthLongestPalindrome =   show . maximum . palindromesAroundCentres . listArrayl0 @@ -76,7 +83,7 @@  -- | lengthLongestPalindromes returns the lengths of the longest palindrome   --   around each position in a string.-lengthLongestPalindromes :: String -> String+lengthLongestPalindromes :: Eq a => [a] -> String lengthLongestPalindromes =   show . palindromesAroundCentres . listArrayl0 @@ -100,7 +107,7 @@         inputArray  longestTextPalindromeArray :: -  (Show a, Eq a) => Array Int a -> Array Int Int -> Array Int a -> String+  Array Int Char -> Array Int Int -> Array Int Char -> String longestTextPalindromeArray a positionArray inputArray =    let (len,pos) = maximumBy                      (\(l,_) (l',_) -> compare l l') @@ -124,53 +131,80 @@       positionTextInputArray  =  listArrayl0 (map snd textinput)   in  concat      $ intersperse "\n" -    $ longestTextPalindromesArray +    $ longestTextPalindromesArray         m         textInputArray          positionTextInputArray          inputArray  longestTextPalindromesArray :: -  (Show a, Eq a) => -    Int -> Array Int a -> Array Int Int -> Array Int a -> [String]+  Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String] longestTextPalindromesArray m a positionArray inputArray =      map (showTextPalindrome positionArray inputArray)    $ filter ((m<=) . fst)   $ zip (palindromesAroundCentres a) [0..] +-- introduce == only here (not in longestTextPalindromes)?+ -------------------------------------------------------------------------------- longestWordPalindrome+-- palindromesAroundCentres +--+-- The function that implements the palindrome finding algorithm.+-- Used in all the above interface functions. ----------------------------------------------------------------------------- --- | longestWordPalindrome returns the longest text palindrome preceded and ---   followed by punctuation symbols (if any). Note that if a word palindrome is ---   accidentally surrounded by the same symbols, it won't be found. For ---   example, the longest word palindrome in "w waaw wo waw" is "waw". We could ---   change longestWordPalindrome to return the longest enclosed word ---   palindrome, but that would give a quadratic time algorithm.-longestWordPalindrome :: String -> String-longestWordPalindrome 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  longestWordPalindromeArray -        textInputArray -        positionTextInputArray -        inputArray+-- | 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 [] -longestWordPalindromeArray :: -    Array Int Char -> Array Int Int -> Array Int Char -> String-longestWordPalindromeArray a positionArray inputArray = -  let wordPalindromes = filter (isWordpalindrome positionArray inputArray)-                      $ zip (palindromesAroundCentres a) [0..]-  in  if null wordPalindromes -      then ""-      else showTextPalindrome positionArray inputArray $-             maximumBy (\(l,_) (l',_) -> compare l l') wordPalindromes+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 +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)++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)+  | otherwise  =  error "finalCentres: input < 0"               + ----------------------------------------------------------------------------- -- longestWordPalindromes -----------------------------------------------------------------------------@@ -188,109 +222,134 @@       positionTextInputArray  =  listArrayl0 (map snd textinput)   in  concat      $ intersperse "\n" -    $ longestWordPalindromesArray +    $ longestWordPalindromesArray         m         textInputArray          positionTextInputArray          inputArray -longestWordPalindromesArray :: -    Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String]-longestWordPalindromesArray m a positionArray inputArray = +longestWordPalindromesArray :: Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String]+longestWordPalindromesArray m textInputArray positionArray inputArray =      map (showTextPalindrome positionArray inputArray)    $ filter ((m<=) . fst)-  $ filter (isWordpalindrome positionArray inputArray)-  $ zip (palindromesAroundCentres a) [0..]+  $ zip (wordPalindromesAroundCentres textInputArray positionArray inputArray) [0..] -isWordpalindrome :: Array Int Int -> Array Int Char -> (Int,Int) -> Bool-isWordpalindrome positionArray inputArray (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-      startpos'  =  positionArray!!!startpos-      endpos'    =  positionArray!!!endpos-  in  if endpos < startpos-      then False-      else if startpos' <= fst (bounds inputArray)-           then endpos' >= snd (bounds inputArray) ||-                not (myIsLetter (inputArray!!!(endpos'+1)))-           else if endpos' >= snd (bounds inputArray) -                then not (myIsLetter (inputArray!!!(startpos'-1)))-                else not (myIsLetter (inputArray!!!(startpos'-1)))-                  && not (myIsLetter (inputArray!!!(endpos'+1)))+-- | longestWordPalindrome returns the longest text palindrome preceded and +--   followed by non-letter symbols (if any). 	+longestWordPalindrome :: String -> 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)  -------------------------------------------------------------------------------- palindromesAroundCentres +-- wordPalindromesAroundCentres  ----- The function that implements the palindrome finding algorithm.--- Used in all the interface functions.+-- This is the function palindromesAroundCentres, extended with the longest+-- word palindromes around each centre. ----------------------------------------------------------------------------- --- | 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 []+-- | 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]) [] -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+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                                     +      -- 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      +  | otherwise                          =  +      -- the current longest tail palindrome cannot be extended                 +      extendWordCentres textInputArray positionArray inputArray n (current:centres) centres currentTail+  where  (afirst,alast)  =  bounds textInputArray -extendCentres :: (Eq a) =>-                 Array Int a -> Int -> [Int] -> [Int] -> Int -> [Int]-extendCentres a n centres tcentres centreDistance+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-      extendTail a (n+1) 1 centres-  | centreDistance-1 == head tcentres  =  +      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+  | 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-      extendTail a n (head tcentres) centres+      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+		 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   | 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)+      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) -finalCentres :: Int -> [Int] -> [Int] -> [Int]-finalCentres 0     _        centres  =  centres-finalCentres (n+1) tcentres centres  =  -  finalCentres n -               (tail tcentres) -               (min (head tcentres) n:centres)-finalCentres _     _        _        =  error "finalCentres: input < 0"               +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  -- 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)+  | otherwise  = error "finalWordCentres: input < 0"          -------------------------------------------------------------------------------- Showing palindromes+-- Showing palindromes and other text related functionality -----------------------------------------------------------------------------  showPalindrome :: (Show a) => Array Int a -> (Int,Int) -> String@@ -308,23 +367,41 @@       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   in  if endpos < startpos       then []-      else let start      =  if startpos > fst (bounds positionArray)-                             then positionArray!!!(startpos-1)+1-                             else fst (bounds inputArray)-               end        =  if endpos < snd (bounds positionArray)-                             then positionArray!!!(endpos+1)-1-                             else snd (bounds inputArray) +      else let start      =  if startpos > pfirst+                             then (positionArray!(startpos-1))+1+                             else ifirst +               end        =  if endpos < plast+                             then (positionArray!(endpos+1))-1+                             else ilast            in  show [inputArray!n | n<- [start..end]] --------------------------------------------------------------------------------- Character utils------------------------------------------------------------------------------+{- Using this code instead of the last else above shows text palindromes without +   all punctuation around it. Right now this punctuation is shown. -myIsLetter :: Char -> Bool-myIsLetter = not . flip elem ",.;:!?`~/<> \a\b\f\n\r\t\v\\\"\'\&"+      else let start      =  positionArray!!!startpos+               end        =  positionArray!!!endpos+-} +-- 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)))+  | begin <= afirst && end >= alast  =  True+  | begin > afirst  && end >= alast  =  not (myIsLetter (inputArray!(begin-1)))+  | otherwise                        =  error "surroundedByPunctuation"+  where (afirst,alast) = bounds inputArray+ ----------------------------------------------------------------------------- -- Array utils -----------------------------------------------------------------------------@@ -335,6 +412,28 @@ -- (!!!) is a variant of (!), which prints out the problem in case of -- an index out of bounds. (!!!)   :: Array Int a -> Int -> a-a!!! n  =  if n >= fst (bounds a) && n <= snd (bounds 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" -- "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+-}

@@ -1,211 +1,22 @@--------------------------------------------------------------------------------- |--- Module      :  tests.Main--- Copyright   :  (c) 2007 - 2010 Johan Jeuring--- License     :  BSD3------ Maintainer  :  johan@jeuring.net--- Stability   :  experimental--- Portability :  portable---------------------------------------------------------------------------------- module Main where--import Data.Array-import Data.Char--import Test.QuickCheck-import Test.HUnit-+	+import Criterion.Main import Data.Algorithms.Palindromes.Palindromes--propPalindromesAroundCentres :: Property-propPalindromesAroundCentres = -  forAll (arbitrary:: Gen [Int]) $ -  \l -> let a = array (0,length l - 1) (zip [0..] l)-        in palindromesAroundCentres a == longestPalindromesQ a--longestPalindromesQ    ::  Eq a => Array Int a -> [Int]-longestPalindromesQ a  =   -  let (afirst,alast)  =  bounds a-      positions       =  [0 .. 2*(alast-afirst+1)]-  in  map (lengthPalindromeAround a) positions--lengthPalindromeAround  ::  Eq a => Array Int a -                                 -> Int -                                 -> Int-lengthPalindromeAround a 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-         extendPalindromeAround start end  = -            if   start < 0 -              || end > alast-afirst -              || a!start /= a!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 ltp)-          in ltp' == reverse ltp'--instance Arbitrary Char where-  arbitrary = choose (minBound::Char,maxBound::Char)--testTextPalindrome1 =-  TestCase (assertEqual -              "textPalindrome1" -              "\"a,ba.\"" -              (longestTextPalindrome "abcdea,ba.")-           )-testTextPalindrome2 =-  TestCase (assertEqual -              "textPalindrome2" -              "\"a,ba\"" -              (longestTextPalindrome "abcdea,ba")-           )-testTextPalindrome3 =-  TestCase (assertEqual -              "textPalindrome3" -              "\".a,ba\"" -              (longestTextPalindrome "abcde.a,ba")-           )-testTextPalindrome4 =-  TestCase (assertEqual -              "textPalindrome4" -              "\".a,ba\"" -              (longestTextPalindrome "abcde.a,baf")-           )-testTextPalindrome5 =-  TestCase (assertEqual -              "textPalindrome5" -              "\".ab,a\"" -              (longestTextPalindrome ".ab,acdef")-           )-testTextPalindrome6 =-  TestCase (assertEqual -              "textPalindrome6" -              "\"ab,a\"" -              (longestTextPalindrome "ab,acdef")-           )-testTextPalindrome7 =-  TestCase (assertEqual -              "textPalindrome7" -              "\"ab,a.\"" -              (longestTextPalindrome "ab,a.cdef")-           )-testTextPalindrome8 =-  TestCase (assertEqual -              "textPalindrome8" -              "\".ab,a.\"" -              (longestTextPalindrome "g.ab,a.cdef")-           )-testTextPalindrome9 =-  TestCase (assertEqual -              "textPalindrome9" -              "" -              (longestTextPalindrome "")-           )--testTextPalindrome10 =-  TestCase (do string <- readFile "examples/palindromes/Damnitimmad.txt"-               assertEqual -                 "textPalindrome10" -                 (concatMap (\c -> case c of-                                     '\n' -> "\\n" -                                     '\"' -> "\\\""-                                     d    -> [d]-                            )-                            string-                 )-                 (init . tail $ longestTextPalindrome string)-           )--testTextPalindrome11 =-  TestCase (do string <- readFile "examples/palindromes/pal17.txt"-               assertEqual -                 "textPalindrome11" -                 ("\"" ++ -                  concatMap (\c -> case c of-                                     '\n' -> "\\n" -                                     '\"' -> "\\\""-                                     d    -> [d]-                            )-                  string ++ -                  "\"")-                 (longestTextPalindrome string)-           )--testWordPalindrome1 =-  TestCase (assertEqual-              "wordPalindrome" -              "\" is non si, \"" -              (longestWordPalindrome "what is non si, not?")-           )--testWordPalindrome2 =-  TestCase (assertEqual-              "wordPalindrome" -              "\" is non si\"" -              (longestWordPalindrome "what is non si")-           )--testWordPalindrome3 =-  TestCase (assertEqual-              "wordPalindrome" -              "\"is non si, \"" -              (longestWordPalindrome "is non si, not?")-           )--testWordPalindrome4 =-  TestCase (assertEqual-              "wordPalindrome" -              "" -              (longestWordPalindrome "aaaaba")-           )+import PalindromeRampion+import System.IO -testWordPalindrome5 =-  TestCase (assertEqual-              "wordPalindrome" -              "\" a\"" -              (longestWordPalindrome "aaaab a")-           )+main :: IO ()+main = +  do fn <- openFile  "../../../TestSources/Bibles/engelskingjames.txt" ReadMode+     hSetEncoding fn latin1 +     input <- hGetContents fn+     defaultMain+       [bench "lengthLongestPalindrome-Eq" (nf lengthLongestPalindrome input)]        -testWordPalindrome6 =-  TestCase (assertEqual-              "wordPalindrome" -              "\" waw\"" -              (longestWordPalindrome "w waaw wo waw")-           )+{- To compare my solution and Rampion's lazy solution: -tests = TestList [TestLabel "testTextPalindrome1"  testTextPalindrome1-                 ,TestLabel "testTextPalindrome2"  testTextPalindrome2-                 ,TestLabel "testTextPalindrome3"  testTextPalindrome3-                 ,TestLabel "testTextPalindrome4"  testTextPalindrome4-                 ,TestLabel "testTextPalindrome5"  testTextPalindrome5-                 ,TestLabel "testTextPalindrome6"  testTextPalindrome6-                 ,TestLabel "testTextPalindrome7"  testTextPalindrome7-                 ,TestLabel "testTextPalindrome8"  testTextPalindrome8-                 ,TestLabel "testTextPalindrome9"  testTextPalindrome9-                 ,TestLabel "testTextPalindrome10" testTextPalindrome10-                 ,TestLabel "testTextPalindrome11" testTextPalindrome11-                 ,TestLabel "testWordPalindrome1"  testWordPalindrome1-                 ,TestLabel "testWordPalindrome2"  testWordPalindrome2-                 ,TestLabel "testWordPalindrome3"  testWordPalindrome3-                 ,TestLabel "testWordPalindrome4"  testWordPalindrome4-                 ,TestLabel "testWordPalindrome5"  testWordPalindrome5-                 ,TestLabel "testWordPalindrome6"  testWordPalindrome6-                 ]+       [bench "lengthLongestPalindromes" (nf (palindromesAroundCentres (==) . listArrayl0) input)+       ,bench "Rampion's solution" (nf maximalPalindromeLengths input)+       ] -main = do -          check defaultConfig propPalindromesAroundCentres-          check defaultConfig propTextPalindrome-          runTestTT tests-          +-}