palindromes 0.1.1 → 0.2
raw patch · 9 files changed
+364/−93 lines, 9 files
Files
- CREDITS +11/−0
- LICENSE +1/−1
- README +2/−0
- RELEASE_HISTORY +15/−0
- palindromes.cabal +6/−7
- src/Data/Algorithms/Palindromes/Main.hs +34/−39
- src/Data/Algorithms/Palindromes/Options.hs +113/−0
- src/Data/Algorithms/Palindromes/Palindromes.hs +122/−46
- tests/Main.hs +60/−0
CREDITS view
@@ -5,7 +5,18 @@ This is a list of those who have contributed to the research, concept, code, and/or other issues of Finding Palindromes. +Research and code+-----------------+ * Johan Jeuring+* Bastiaan Heeren developed an implementation of palindromes + using suffix trees. This version was slower, and could + process less data than this released version. +Bug reports and feature requests+--------------------------------++* Rafael Cunha de Almeida+* Henning Thielemann
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2007 - 2009 Johan Jeuring+Copyright (c) 2007 - 2010 Johan Jeuring All rights reserved. Redistribution and use in source and binary forms, with or without modification,
README view
@@ -16,6 +16,8 @@ * Linear-time algorithm for finding text palindromes, ignoring spaces, case of characters, and punctuation symbols.+* Linear-time algorithm for finding word palindromes,+ text palindromes surrounded by (if at all) non-letters. Requirements
+ RELEASE_HISTORY view
@@ -0,0 +1,15 @@+Release history:++Version 2+Read from standard input, via the flag -i+More flexible flag handling+Read multiple files+Specify minimum length of palindromes returned, via the flag -m int++070909 Version 0.1.1+Corrected two errors in the flags++060909 Version 0.1+First version of the package++
palindromes.cabal view
@@ -1,14 +1,14 @@ name: palindromes-version: 0.1.1+version: 0.2 synopsis: Finding palindromes in strings homepage: http://www.jeuring.net/Palindromes description: - FindingPalindromes is an executable and a library which takes a file name, and + 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 - 2009 Johan Jeuring+copyright: (c) 2007 - 2010 Johan Jeuring license: BSD3 license-file: LICENSE author: Johan Jeuring@@ -16,6 +16,7 @@ stability: experimental extra-source-files: README, CREDITS,+ RELEASE_HISTORY tests/Main.hs build-type: Simple cabal-version: >= 1.2.1@@ -31,12 +32,10 @@ Main-is: Data/Algorithms/Palindromes/Main.hs ghc-options: -Wall hs-source-dirs: src- other-modules: Data.Algorithms.Palindromes.Palindromes--+ other-modules: Data.Algorithms.Palindromes.Palindromes,+ Data.Algorithms.Palindromes.Options build-depends: base >= 3.0 && < 4.0, array- --------------------------------------------------------------------------------
src/Data/Algorithms/Palindromes/Main.hs view
@@ -1,54 +1,49 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Algorithms.Palindromes.Main--- Copyright : (c) 2007 - 2009 Johan Jeuring+-- Copyright : (c) 2007 - 2010 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net -- Stability : experimental--- Portability : non-portable+-- Portability : portable -- ----------------------------------------------------------------------------- module Main where import System.Environment (getArgs)-import System.IO +import System.Console.GetOpt +import System.IO -import Data.Algorithms.Palindromes.Palindromes+import Data.Algorithms.Palindromes.Options -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+-----------------------------------------------------------------------------++handleFilesWith :: (String -> String) -> [String] -> IO ()+handleFilesWith f = + let hFW filenames = + case filenames of+ [] -> putStr (f "")+ (fn:fns) -> do input <- readFile fn+ putStrLn (f input)+ hFW fns+ in hFW ++handleStandardInputWith :: (String -> String) -> IO ()+handleStandardInputWith function = + do input <- getContents+ putStrLn (function input) + 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+main = do args <- getArgs+ let (optionArgs,files,errors) = getOpt Permute options args+ if not (null errors) + then putStrLn (concat errors) + else let (function,fromfile) = handleOptions optionArgs+ in if fromfile + then handleFilesWith function files + else handleStandardInputWith function + +
+ src/Data/Algorithms/Palindromes/Options.hs view
@@ -0,0 +1,113 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.Algorithms.Palindromes.Options+-- Copyright : (c) 2007 - 2010 Johan Jeuring+-- License : BSD3+--+-- Maintainer : johan@jeuring.net+-- Stability : experimental+-- Portability : portable+--+-----------------------------------------------------------------------------+module Data.Algorithms.Palindromes.Options where++import System.Console.GetOpt ++import Data.Algorithms.Palindromes.Palindromes++-----------------------------------------------------------------------------+-- flags+-----------------------------------------------------------------------------++data Flag = Help+ | StandardInput+ | LongestPalindrome+ | LongestPalindromes+ | LengthLongestPalindrome+ | LengthLongestPalindromes+ | LongestTextPalindrome+ | LongestTextPalindromes+ | LongestWordPalindrome+ | LongestWordPalindromes+ | LengthAtLeast Int deriving Show+ ++isHelp :: Flag -> Bool+isHelp Help = True+isHelp _ = False ++isStandardInput :: Flag -> Bool+isStandardInput StandardInput = True+isStandardInput _ = False ++isLengthAtLeast :: Flag -> Bool+isLengthAtLeast (LengthAtLeast _) = True+isLengthAtLeast _ = False ++getLength :: Flag -> Int+getLength (LengthAtLeast n) = n +getLength _ = error "No length specified"++-- I am using single letter options here (except for help): getOpt handles +-- options too flexible: in case a letter within a multiple letter option is +-- recognized, it is taken as a single letter option.+options :: [OptDescr Flag] +options = + [Option "h" ["help"] (NoArg Help)+ "This message"+ ,Option "i" [] (NoArg StandardInput)+ "Read input from standard input"+ ,Option "o" [] (NoArg LongestPalindrome) + "Longest palindrome (default)"+ ,Option "p" [] (NoArg LongestPalindromes)+ "Longest palindrome around each position in the input"+ ,Option "k" [] (NoArg LengthLongestPalindrome)+ "Length of the longest palindrome"+ ,Option "l" [] (NoArg LengthLongestPalindromes)+ "Length of the longest palindrome around each position in the input"+ ,Option "s" [] (NoArg LongestTextPalindrome)+ "Longest palindrome ignoring case, spacing and punctuation"+ ,Option "t" [] (NoArg LongestTextPalindromes)+ "Longest text palindrome around each position in the input"+ ,Option "v" [] (NoArg LongestWordPalindrome)+ "Longest text palindrome preceded and followed by punctuation symbols (if any)"+ ,Option "w" [] (NoArg LongestWordPalindromes)+ "Longest word palindrome around each position in the input"+ ,Option "m" [] (ReqArg (LengthAtLeast . (read :: String -> Int)) "arg")+ "Palindromes of length at least [arg]"+ ]++handleOptions :: [Flag] -> (String -> String,Bool)+handleOptions flags = + let lal = filter isLengthAtLeast flags+ flags' = filter (\f -> not (isLengthAtLeast f || isStandardInput f)) flags+ m = if null lal + then 0+ else getLength (head lal) + fromfile = null $ filter isStandardInput flags + function = case flags' of+ [] -> longestPalindrome+ (flag:_) -> + case flag of + Help -> + const (usageInfo headerHelpMessage options)+ LongestPalindrome -> longestPalindrome + LongestPalindromes -> longestPalindromes m+ LengthLongestPalindrome -> lengthLongestPalindrome + LengthLongestPalindromes -> lengthLongestPalindromes+ LongestTextPalindrome -> longestTextPalindrome + LongestTextPalindromes -> longestTextPalindromes m+ LongestWordPalindrome -> longestWordPalindrome + LongestWordPalindromes -> longestWordPalindromes m + _ -> error "handleOptions"+ in (function,fromfile)++headerHelpMessage :: String+headerHelpMessage = + "*********************\n"+ ++ "* Palindrome Finder *\n"+ ++ "*********************\n"+ ++ "Usage:"+ + +
src/Data/Algorithms/Palindromes/Palindromes.hs view
@@ -1,12 +1,12 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Algorithms.Palindromes.Palindromes--- Copyright : (c) 2007 - 2009 Johan Jeuring+-- Copyright : (c) 2007 - 2010 Johan Jeuring -- License : BSD3 -- -- Maintainer : johan@jeuring.net -- Stability : experimental--- Portability : portable (requires ghc)+-- Portability : portable -- ----------------------------------------------------------------------------- @@ -17,15 +17,17 @@ ,lengthLongestPalindromes ,longestTextPalindrome ,longestTextPalindromes+ ,longestWordPalindrome+ ,longestWordPalindromes ,palindromesAroundCentres ) where -import Debug.Trace()- import Data.List (maximumBy,intersperse) import Data.Char import Data.Array +import Control.Arrow+ -- All functions in the interface, except palindromesAroundCentres -- have the type String -> String @@ -36,7 +38,7 @@ -- | longestPalindrome returns the longest palindrome in a string. longestPalindrome :: String -> String longestPalindrome input = - let inputArray = stringArray input+ let inputArray = listArrayl0 input (maxLength,pos) = maximumBy (\(l,_) (l',_) -> compare l l') (zip (palindromesAroundCentres inputArray) [0..]) @@ -47,13 +49,15 @@ ----------------------------------------------------------------------------- -- | longestPalindromes returns the longest palindrome around each position--- in a string.-longestPalindromes :: String -> String-longestPalindromes input = - let inputArray = stringArray input+-- in a string. The integer argument is used to only show palindromes+-- of length at least this integer.+longestPalindromes :: Int -> String -> String+longestPalindromes m input = + let inputArray = listArrayl0 input in concat $ intersperse "\n" $ map (showPalindrome inputArray) + $ filter ((m<=) . fst) $ zip (palindromesAroundCentres inputArray) [0..] -----------------------------------------------------------------------------@@ -64,7 +68,7 @@ -- a string. lengthLongestPalindrome :: String -> String lengthLongestPalindrome =- show . maximum . palindromesAroundCentres . stringArray+ show . maximum . palindromesAroundCentres . listArrayl0 ----------------------------------------------------------------------------- -- lengthLongestPalindromes@@ -74,7 +78,7 @@ -- around each position in a string. lengthLongestPalindromes :: String -> String lengthLongestPalindromes =- show . palindromesAroundCentres . stringArray+ show . palindromesAroundCentres . listArrayl0 ----------------------------------------------------------------------------- -- longestTextPalindrome@@ -84,13 +88,12 @@ -- ignoring spacing, punctuation symbols, and case of letters. longestTextPalindrome :: String -> String longestTextPalindrome input = - let inputArray = stringArray input+ let inputArray = listArrayl0 input ips = zip input [0..]- textinput = map (\(i,p) -> (toLower i,p)) + textinput = map (first toLower) (filter (isLetter.fst) ips)- textInputArray = stringArray (map fst textinput)- lti = length textinput- positionTextInputArray = listArray (0,lti-1) (map snd textinput)+ textInputArray = listArrayl0 (map fst textinput)+ positionTextInputArray = listArrayl0 (map snd textinput) in longestTextPalindromeArray textInputArray positionTextInputArray @@ -109,30 +112,115 @@ ----------------------------------------------------------------------------- -- | longestTextPalindromes returns the longest text palindrome around each--- position in a string.-longestTextPalindromes :: String -> String-longestTextPalindromes input = - let inputArray = stringArray input+-- position in a string. The integer argument is used to only show palindromes+-- of length at least this integer.+longestTextPalindromes :: Int -> String -> String+longestTextPalindromes m input = + let inputArray = listArrayl0 input ips = zip input [0..]- textinput = map (\(i,p) -> (toLower i,p)) + textinput = map (first toLower) (filter (isLetter.fst) ips)- textInputArray = stringArray (map fst textinput)- lti = length textinput- positionTextInputArray = listArray (0,lti-1) (map snd textinput)+ textInputArray = listArrayl0 (map fst textinput)+ positionTextInputArray = listArrayl0 (map snd textinput) in concat $ intersperse "\n" $ longestTextPalindromesArray + m 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..]) + (Show a, Eq a) => + Int -> Array Int a -> Array Int Int -> Array Int a -> [String]+longestTextPalindromesArray m a positionArray inputArray = + map (showTextPalindrome positionArray inputArray) + $ filter ((m<=) . fst)+ $ zip (palindromesAroundCentres a) [0..] -----------------------------------------------------------------------------+-- longestWordPalindrome+-----------------------------------------------------------------------------++-- | 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 (isLetter.fst) ips)+ textInputArray = listArrayl0 (map fst textinput)+ positionTextInputArray = listArrayl0 (map snd textinput)+ in longestWordPalindromeArray + textInputArray + positionTextInputArray + inputArray++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++-----------------------------------------------------------------------------+-- longestWordPalindromes+-----------------------------------------------------------------------------++-- | longestWordPalindromes returns the longest word palindrome around each+-- position in a string. The integer argument is used to only show +-- palindromes of length at least this integer.+longestWordPalindromes :: Int -> String -> String+longestWordPalindromes m input = + let inputArray = listArrayl0 input+ ips = zip input [0..]+ textinput = map (first toLower) + (filter (isLetter.fst) ips)+ textInputArray = listArrayl0 (map fst textinput)+ positionTextInputArray = listArrayl0 (map snd textinput)+ in concat + $ intersperse "\n" + $ longestWordPalindromesArray + m+ textInputArray + positionTextInputArray + inputArray++longestWordPalindromesArray :: + Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String]+longestWordPalindromesArray m a positionArray inputArray = + map (showTextPalindrome positionArray inputArray) + $ filter ((m<=) . fst)+ $ filter (isWordpalindrome positionArray inputArray)+ $ zip (palindromesAroundCentres a) [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 (isLetter (inputArray!!!(endpos'+1)))+ else if endpos' >= snd (bounds inputArray) + then not (isLetter (inputArray!!!(startpos'-1)))+ else not (isLetter (inputArray!!!(startpos'-1)))+ && not (isLetter (inputArray!!!(endpos'+1)))++----------------------------------------------------------------------------- -- palindromesAroundCentres -- -- The function that implements the palindrome finding algorithm.@@ -171,7 +259,6 @@ centres currentTail where (afirst,alast) = bounds a - extendCentres :: (Eq a) => Array Int a -> Int -> [Int] -> [Int] -> Int -> [Int] extendCentres a n centres tcentres centreDistance@@ -203,7 +290,7 @@ finalCentres _ _ _ = error "finalCentres: input < 0" -------------------------------------------------------------------------------- Showing palindreoms+-- Showing palindromes ----------------------------------------------------------------------------- showPalindrome :: (Show a) => Array Int a -> (Int,Int) -> String@@ -212,7 +299,7 @@ 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]]+ in show [a!n|n <- [startpos .. endpos]] showTextPalindrome :: (Show a) => Array Int Int -> Array Int a -> (Int,Int) -> String@@ -229,29 +316,18 @@ end = if endpos < snd (bounds positionArray) then positionArray!!!(endpos+1)-1 else snd (bounds inputArray) - in show $ [inputArray!n | n<- [start..end]]+ in show [inputArray!n | n<- [start..end]] ----------------------------------------------------------------------------- -- Array utils ----------------------------------------------------------------------------- -stringArray :: String -> Array Int Char-stringArray string = listArray (0,length string - 1) string+listArrayl0 :: [a] -> Array Int a+listArrayl0 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)-------- ---+ else error (show (fst (bounds a)) ++ " " ++ show (snd (bounds a)) ++ " " ++ show n)
tests/Main.hs view
@@ -1,3 +1,15 @@+-----------------------------------------------------------------------------+-- |+-- 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@@ -131,6 +143,48 @@ (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")+ )++testWordPalindrome5 =+ TestCase (assertEqual+ "wordPalindrome" + "\" a\"" + (longestWordPalindrome "aaaab a")+ )++testWordPalindrome6 =+ TestCase (assertEqual+ "wordPalindrome" + "\" waw\"" + (longestWordPalindrome "w waaw wo waw")+ )+ tests = TestList [TestLabel "testTextPalindrome1" testTextPalindrome1 ,TestLabel "testTextPalindrome2" testTextPalindrome2 ,TestLabel "testTextPalindrome3" testTextPalindrome3@@ -142,6 +196,12 @@ ,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 ] main = do