diff --git a/README b/README --- a/README +++ b/README @@ -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 diff --git a/palindromes.cabal b/palindromes.cabal --- a/palindromes.cabal +++ b/palindromes.cabal @@ -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, diff --git a/src/Data/Algorithm/Palindromes/Main.hs b/src/Data/Algorithm/Palindromes/Main.hs deleted file mode 100644 --- a/src/Data/Algorithm/Palindromes/Main.hs +++ /dev/null @@ -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 diff --git a/src/Data/Algorithm/Palindromes/Palindromes.hs b/src/Data/Algorithm/Palindromes/Palindromes.hs deleted file mode 100644 --- a/src/Data/Algorithm/Palindromes/Palindromes.hs +++ /dev/null @@ -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) - - - - - - - - - - - diff --git a/src/Data/Algorithms/Palindromes/Main.hs b/src/Data/Algorithms/Palindromes/Main.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithms/Palindromes/Main.hs @@ -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 diff --git a/src/Data/Algorithms/Palindromes/Palindromes.hs b/src/Data/Algorithms/Palindromes/Palindromes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithms/Palindromes/Palindromes.hs @@ -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) + + + + + + + + + + + diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -6,7 +6,7 @@ import Test.QuickCheck import Test.HUnit -import Data.Algorithm.Palindromes.Palindromes +import Data.Algorithms.Palindromes.Palindromes propPalindromesAroundCentres :: Property propPalindromesAroundCentres =