palindromes 0.1 → 0.1.1

raw patch · 7 files changed

+317/−316 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README +0/−1
• palindromes.cabal +5/−5
• src/Data/Algorithm/Palindromes/Main.hs +0/−52
• src/Data/Algorithm/Palindromes/Palindromes.hs +0/−257
• src/Data/Algorithms/Palindromes/Main.hs +54/−0
• src/Data/Algorithms/Palindromes/Palindromes.hs +257/−0
• tests/Main.hs +1/−1

@@ -16,7 +16,6 @@ *  Linear-time algorithm for finding text palindromes,     ignoring spaces, case of characters, and punctuation     symbols.-*  A set of example palindromes.   Requirements

@@ -1,5 +1,5 @@ name:                   palindromes-version:                0.1+version:                0.1.1 synopsis:               Finding palindromes in strings homepage:               http://www.jeuring.net/Palindromes description:@@ -7,7 +7,7 @@   FindingPalindromes is an executable and a library which takes a file name, and    returns information about palindromes in the file. -category:               Algorithm+category:               Algorithms copyright:              (c) 2007 - 2009 Johan Jeuring license:                BSD3 license-file:           LICENSE@@ -25,13 +25,13 @@  Library   hs-source-dirs:       src-  exposed-modules:      Data.Algorithm.Palindromes.Palindromes+  exposed-modules:      Data.Algorithms.Palindromes.Palindromes  Executable	            palindromes-  Main-is:				Data/Algorithm/Palindromes/Main.hs+  Main-is:				Data/Algorithms/Palindromes/Main.hs   ghc-options:          -Wall   hs-source-dirs:       src-  other-modules:        Data.Algorithm.Palindromes.Palindromes+  other-modules:        Data.Algorithms.Palindromes.Palindromes     build-depends:        base >= 3.0 && < 4.0,

@@ -1,52 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Algorithm.Palindromes.Main--- Copyright   :  (c) 2007 - 2009 Johan Jeuring--- License     :  BSD3------ Maintainer  :  johan@jeuring.net--- Stability   :  experimental--- Portability :  non-portable----------------------------------------------------------------------------------module Main where--import System.Environment (getArgs)-import System.IO --import Data.Algorithm.Palindromes.Palindromes--helpMessage :: String-helpMessage = -     "Usage:\n\n"-  ++ "    palindrome [command-line-options] input-file\n\n"-  ++ "The following options are available:\n"-  ++ "  --h: This message\n"-  ++ "  -p : Print the longest palindrome (default)\n"-  ++ "  -ps: Print the longest palindrome around each position in the input\n"-  ++ "  -l : Print the length of the longest palindrome\n"-  ++ "  -ls: Print the length of the longest palindrome around each position in the input\n"-  ++ "  -t : Print the longest palindrome ignoring case, spacing and punctuation\n"-  ++ "  -tl: Print the length of the longest text palindrome\n"-  -main :: IO ()-main = do-    putStrLn "*********************"-    putStrLn "* Palindrome Finder *"-    putStrLn "*********************"-    args <- getArgs-    case args of-      [flag ,filePath]  ->  do let function =  -                                     case flag of -                                       "-p"   ->  longestPalindrome -                                       "-ps"  ->  longestPalindromes -                                       "-l"   ->  lengthLongestPalindrome -                                       "-ls"  ->  lengthLongestPalindromes-                                       "-t"   ->  longestTextPalindrome-                                       "-ts"  ->  longestTextPalindromes-                                       _      ->  const helpMessage-                               input <- readFile filePath-                               putStrLn (function input)                                 -      [filePath]        ->  do input <- readFile filePath-                               putStrLn (longestPalindrome input)-      _                 ->  putStrLn helpMessage

@@ -1,257 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.Algorithm.Palindromes.Palindromes--- Copyright   :  (c) 2007 - 2009 Johan Jeuring--- License     :  BSD3------ Maintainer  :  johan@jeuring.net--- Stability   :  experimental--- Portability :  portable (requires ghc)-----------------------------------------------------------------------------------module Data.Algorithm.Palindromes.Palindromes-       (longestPalindrome-       ,longestPalindromes-       ,lengthLongestPalindrome-       ,lengthLongestPalindromes-       ,longestTextPalindrome-       ,longestTextPalindromes-       ,palindromesAroundCentres-       ) where- -import Debug.Trace()--import Data.List (maximumBy,intersperse)-import Data.Char-import Data.Array - --- 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 input = -  let inputArray       =  stringArray input-      (maxLength,pos)  =  maximumBy -                            (\(l,_) (l',_) -> compare l l') -                            (zip (palindromesAroundCentres inputArray) [0..])    -  in showPalindrome inputArray (maxLength,pos)---------------------------------------------------------------------------------- longestPalindromes---------------------------------------------------------------------------------- | longestPalindromes returns the longest palindrome around each position---   in a string.-longestPalindromes :: String -> String-longestPalindromes input = -  let inputArray       =  stringArray input-  in    concat -      $ intersperse "\n" -      $ map (showPalindrome inputArray) -      $ zip (palindromesAroundCentres inputArray) [0..]---------------------------------------------------------------------------------- lengthLongestPalindrome---------------------------------------------------------------------------------- | lengthLongestPalindrome returns the length of the longest palindrome in ---   a string.-lengthLongestPalindrome :: String -> String-lengthLongestPalindrome =-  show . maximum . palindromesAroundCentres . stringArray---------------------------------------------------------------------------------- lengthLongestPalindromes---------------------------------------------------------------------------------- | lengthLongestPalindromes returns the lengths of the longest palindrome  ---   around each position in a string.-lengthLongestPalindromes :: String -> String-lengthLongestPalindromes =-  show . palindromesAroundCentres . stringArray---------------------------------------------------------------------------------- longestTextPalindrome---------------------------------------------------------------------------------- | longestTextPalindrome returns the longest text palindrome in a string,---   ignoring spacing, punctuation symbols, and case of letters.-longestTextPalindrome :: String -> String-longestTextPalindrome input = -  let inputArray              =  stringArray input-      ips                     =  zip input [0..]-      textinput               =  map (\(i,p) -> (toLower i,p)) -                                     (filter (isLetter.fst) ips)-      textInputArray          =  stringArray  (map fst textinput)-      lti                     =  length textinput-      positionTextInputArray  =  listArray (0,lti-1) (map snd textinput)-  in  longestTextPalindromeArray -        textInputArray -        positionTextInputArray -        inputArray--longestTextPalindromeArray :: -  (Show a, Eq a) => Array Int a -> Array Int Int -> Array Int a -> String-longestTextPalindromeArray a positionArray inputArray = -  let (len,pos) = maximumBy -                    (\(l,_) (l',_) -> compare l l') -                    (zip (palindromesAroundCentres a) [0..])    -  in showTextPalindrome positionArray inputArray (len,pos) ---------------------------------------------------------------------------------- longestTextPalindromes---------------------------------------------------------------------------------- | longestTextPalindromes returns the longest text palindrome around each---   position in a string.-longestTextPalindromes :: String -> String-longestTextPalindromes input = -  let inputArray              =  stringArray input-      ips                     =  zip input [0..]-      textinput               =  map (\(i,p) -> (toLower i,p)) -                                     (filter (isLetter.fst) ips)-      textInputArray          =  stringArray (map fst textinput)-      lti                     =  length textinput-      positionTextInputArray  =  listArray (0,lti-1) (map snd textinput)-  in  concat -    $ intersperse "\n" -    $ longestTextPalindromesArray -        textInputArray -        positionTextInputArray -        inputArray--longestTextPalindromesArray :: -  (Show a, Eq a) => Array Int a -> Array Int Int -> Array Int a -> [String]-longestTextPalindromesArray a positionArray inputArray = -  map (showTextPalindrome positionArray inputArray) -      (zip (palindromesAroundCentres a) [0..])  ---------------------------------------------------------------------------------- palindromesAroundCentres ------ The function that implements the palindrome finding algorithm.--- Used in all the interface functions.---------------------------------------------------------------------------------- | 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 []--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 0     _        centres  =  centres-finalCentres (n+1) tcentres centres  =  -  finalCentres n -               (tail tcentres) -               (min (head tcentres) n:centres)-finalCentres _     _        _        =  error "finalCentres: input < 0"               ---------------------------------------------------------------------------------- Showing palindreoms--------------------------------------------------------------------------------showPalindrome :: (Show a) => Array Int a -> (Int,Int) -> String-showPalindrome a (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]]--showTextPalindrome :: (Show a) => -                      Array Int Int -> Array Int a -> (Int,Int) -> String-showTextPalindrome 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-  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) -           in  show $ [inputArray!n | n<- [start..end]]---------------------------------------------------------------------------------- Array utils--------------------------------------------------------------------------------stringArray         :: String -> Array Int Char-stringArray 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  =  if n >= fst (bounds a) && n <= snd (bounds a) -           then a!n -           else error (show (snd (bounds a)) ++ " " ++ show n)-------- ---

@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Algorithms.Palindromes.Main+-- Copyright   :  (c) 2007 - 2009 Johan Jeuring+-- License     :  BSD3+--+-- Maintainer  :  johan@jeuring.net+-- Stability   :  experimental+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+module Main where++import System.Environment (getArgs)+import System.IO ++import Data.Algorithms.Palindromes.Palindromes++helpMessage :: String+helpMessage = +     "Usage:\n\n"+  ++ "    palindrome [command-line-options] input-file\n\n"+  ++ "The following options are available:\n"+  ++ "  --h: This message\n"+  ++ "  -p : Print the longest palindrome (default)\n"+  ++ "  -ps: Print the longest palindrome around each position in the input\n"+  ++ "  -l : Print the length of the longest palindrome\n"+  ++ "  -ls: Print the length of the longest palindrome around each position in the input\n"+  ++ "  -t : Print the longest palindrome ignoring case, spacing and punctuation\n"+  ++ "  -ts: Print the length of the longest text palindrome\n"+  +main :: IO ()+main = do+    putStrLn "*********************"+    putStrLn "* Palindrome Finder *"+    putStrLn "*********************"+    args <- getArgs+    case args of+      ['-':flag,filePath]  ->  do let function =  +                                        case flag of +                                          "p"   ->  longestPalindrome +                                          "ps"  ->  longestPalindromes +                                          "l"   ->  lengthLongestPalindrome +                                          "ls"  ->  lengthLongestPalindromes+                                          "t"   ->  longestTextPalindrome+                                          "ts"  ->  longestTextPalindromes+                                          _     ->  const helpMessage+                                  input <- readFile filePath+                                  putStrLn (function input)                                 +      [arg]                ->  do case arg of+                                    '-':_  -> putStrLn helpMessage +                                    _      -> do input <- readFile arg+                                                 putStrLn (longestPalindrome input)+      _                    ->  putStrLn helpMessage

@@ -0,0 +1,257 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Algorithms.Palindromes.Palindromes+-- Copyright   :  (c) 2007 - 2009 Johan Jeuring+-- License     :  BSD3+--+-- Maintainer  :  johan@jeuring.net+-- Stability   :  experimental+-- Portability :  portable (requires ghc)+--+-----------------------------------------------------------------------------++module Data.Algorithms.Palindromes.Palindromes+       (longestPalindrome+       ,longestPalindromes+       ,lengthLongestPalindrome+       ,lengthLongestPalindromes+       ,longestTextPalindrome+       ,longestTextPalindromes+       ,palindromesAroundCentres+       ) where+ +import Debug.Trace()++import Data.List (maximumBy,intersperse)+import Data.Char+import Data.Array + +-- 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 input = +  let inputArray       =  stringArray input+      (maxLength,pos)  =  maximumBy +                            (\(l,_) (l',_) -> compare l l') +                            (zip (palindromesAroundCentres inputArray) [0..])    +  in showPalindrome inputArray (maxLength,pos)++-----------------------------------------------------------------------------+-- longestPalindromes+-----------------------------------------------------------------------------++-- | longestPalindromes returns the longest palindrome around each position+--   in a string.+longestPalindromes :: String -> String+longestPalindromes input = +  let inputArray       =  stringArray input+  in    concat +      $ intersperse "\n" +      $ map (showPalindrome inputArray) +      $ zip (palindromesAroundCentres inputArray) [0..]++-----------------------------------------------------------------------------+-- lengthLongestPalindrome+-----------------------------------------------------------------------------++-- | lengthLongestPalindrome returns the length of the longest palindrome in +--   a string.+lengthLongestPalindrome :: String -> String+lengthLongestPalindrome =+  show . maximum . palindromesAroundCentres . stringArray++-----------------------------------------------------------------------------+-- lengthLongestPalindromes+-----------------------------------------------------------------------------++-- | lengthLongestPalindromes returns the lengths of the longest palindrome  +--   around each position in a string.+lengthLongestPalindromes :: String -> String+lengthLongestPalindromes =+  show . palindromesAroundCentres . stringArray++-----------------------------------------------------------------------------+-- longestTextPalindrome+-----------------------------------------------------------------------------++-- | longestTextPalindrome returns the longest text palindrome in a string,+--   ignoring spacing, punctuation symbols, and case of letters.+longestTextPalindrome :: String -> String+longestTextPalindrome input = +  let inputArray              =  stringArray input+      ips                     =  zip input [0..]+      textinput               =  map (\(i,p) -> (toLower i,p)) +                                     (filter (isLetter.fst) ips)+      textInputArray          =  stringArray  (map fst textinput)+      lti                     =  length textinput+      positionTextInputArray  =  listArray (0,lti-1) (map snd textinput)+  in  longestTextPalindromeArray +        textInputArray +        positionTextInputArray +        inputArray++longestTextPalindromeArray :: +  (Show a, Eq a) => Array Int a -> Array Int Int -> Array Int a -> String+longestTextPalindromeArray a positionArray inputArray = +  let (len,pos) = maximumBy +                    (\(l,_) (l',_) -> compare l l') +                    (zip (palindromesAroundCentres a) [0..])    +  in showTextPalindrome positionArray inputArray (len,pos) ++-----------------------------------------------------------------------------+-- longestTextPalindromes+-----------------------------------------------------------------------------++-- | longestTextPalindromes returns the longest text palindrome around each+--   position in a string.+longestTextPalindromes :: String -> String+longestTextPalindromes input = +  let inputArray              =  stringArray input+      ips                     =  zip input [0..]+      textinput               =  map (\(i,p) -> (toLower i,p)) +                                     (filter (isLetter.fst) ips)+      textInputArray          =  stringArray (map fst textinput)+      lti                     =  length textinput+      positionTextInputArray  =  listArray (0,lti-1) (map snd textinput)+  in  concat +    $ intersperse "\n" +    $ longestTextPalindromesArray +        textInputArray +        positionTextInputArray +        inputArray++longestTextPalindromesArray :: +  (Show a, Eq a) => Array Int a -> Array Int Int -> Array Int a -> [String]+longestTextPalindromesArray a positionArray inputArray = +  map (showTextPalindrome positionArray inputArray) +      (zip (palindromesAroundCentres a) [0..])  ++-----------------------------------------------------------------------------+-- palindromesAroundCentres +--+-- The function that implements the palindrome finding algorithm.+-- Used in all the interface functions.+-----------------------------------------------------------------------------++-- | 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 []++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 0     _        centres  =  centres+finalCentres (n+1) tcentres centres  =  +  finalCentres n +               (tail tcentres) +               (min (head tcentres) n:centres)+finalCentres _     _        _        =  error "finalCentres: input < 0"               ++-----------------------------------------------------------------------------+-- Showing palindreoms+-----------------------------------------------------------------------------++showPalindrome :: (Show a) => Array Int a -> (Int,Int) -> String+showPalindrome a (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]]++showTextPalindrome :: (Show a) => +                      Array Int Int -> Array Int a -> (Int,Int) -> String+showTextPalindrome 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+  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) +           in  show $ [inputArray!n | n<- [start..end]]++-----------------------------------------------------------------------------+-- Array utils+-----------------------------------------------------------------------------++stringArray         :: String -> Array Int Char+stringArray 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  =  if n >= fst (bounds a) && n <= snd (bounds a) +           then a!n +           else error (show (snd (bounds a)) ++ " " ++ show n)++++++++ +++

@@ -6,7 +6,7 @@ import Test.QuickCheck import Test.HUnit -import Data.Algorithm.Palindromes.Palindromes+import Data.Algorithms.Palindromes.Palindromes  propPalindromesAroundCentres :: Property propPalindromesAroundCentres =