palindromes (empty) → 0.1
raw patch · 8 files changed
+660/−0 lines, 8 filesdep +arraydep +basesetup-changed
Dependencies added: array, base
Files
- CREDITS +11/−0
- LICENSE +28/−0
- README +115/−0
- Setup.lhs +4/−0
- palindromes.cabal +42/−0
- src/Data/Algorithm/Palindromes/Main.hs +52/−0
- src/Data/Algorithm/Palindromes/Palindromes.hs +257/−0
- tests/Main.hs +151/−0
+ CREDITS view
@@ -0,0 +1,11 @@++Credits for Finding Palindromes+===============================++This is a list of those who have contributed to the research, +concept, code, and/or other issues of Finding Palindromes.++* Johan Jeuring+++
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2007 - 2009 Johan Jeuring+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of Johan Jeuring nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README view
@@ -0,0 +1,115 @@++Palindromes+==============================================++[Palindromes] is a package for finding palindromes in files.++[Palindromes]: http://www.jeuring.net/Palindromes/+++Features+--------++The primary features of Palindromes include:++* Linear-time algorithm for finding exact palindromes+* Linear-time algorithm for finding text palindromes, + ignoring spaces, case of characters, and punctuation + symbols.+* A set of example palindromes.+++Requirements+------------++Palindromes has the following requirements:++* [GHC] version 6.8.1 or later - It has been tested with version 6.10.1.+* [Cabal] library version 1.2.1 or later - It has been tested with version + 1.6.0.1.++[GHC]: http://www.haskell.org/ghc/+[Cabal]: http://www.haskell.org/cabal/+++Download & Installation+-----------------------++*If you have [cabal-install]*, you should use that to install the package,+because it will handle everything for you.++ cabal install palindromes++*If you don't have cabal-install*, you must download the [Palindromes package] +from HackageDB and install it manually. Get the `tar.gz` file and decompress it.++Once downloaded, use the following commands for configuring, building, and+installing the library.++ runghc Setup.lhs configure+ runghc Setup.lhs build+ runghc Setup.lhs install++For more details on the general options available, refer to the [Cabal User's+Guide].++[Palindromes package]: + http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Palindromes+[cabal-install]: + http://hackage.haskell.org/cgi-bin/hackage-scripts/package/cabal-install+[Cabal User's Guide]: + http://www.haskell.org/cabal/release/latest/doc/users-guide/+++Documentation+-------------++The API is documented using [Haddock] and available on the [Palindromes package] +site.++[Haddock]: http://www.haskell.org/haddock/+[Palindromes package]: + http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Palindromes+++Examples+--------++You can find example palindromes, on which Palindromes has been tested, in the +[`examples` directory] of the source distribution.++[`examples` directory]: + https://subversion.cs.uu.nl/repos/staff.johanj.palindromes/trunk/examples/palindromes+++Bugs & Support+--------------++To report bugs, use the Google Code [project page for Palindromes].++For general concerns and questions, [email the author].++[project page for Palindromes]: http://code.google.com/p/palindromes/+[email the author]: johan at jeuring.net+++Licensing+---------++Palindromes is licensed under the so-called [BSD3 license]. See the included +`LICENSE` file.++[BSD3 license]: http://www.opensource.org/licenses/bsd-license.php+++Credits+-------++Palindromes is based on the functional program developed by [Johan Jeuring] in +his PhD thesis. ++The current authors and maintainer of Palindromes is [Johan Jeuring].++[Johan Jeuring]: http://www.jeuring.net/++
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ palindromes.cabal view
@@ -0,0 +1,42 @@+name: palindromes+version: 0.1+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 + returns information about palindromes in the file.++category: Algorithm+copyright: (c) 2007 - 2009 Johan Jeuring+license: BSD3+license-file: LICENSE+author: Johan Jeuring+maintainer: johan@jeuring.net+stability: experimental+extra-source-files: README,+ CREDITS,+ tests/Main.hs+build-type: Simple+cabal-version: >= 1.2.1+tested-with: GHC == 6.10.1++--------------------------------------------------------------------------------++Library+ hs-source-dirs: src+ exposed-modules: Data.Algorithm.Palindromes.Palindromes++Executable palindromes+ Main-is: Data/Algorithm/Palindromes/Main.hs+ ghc-options: -Wall+ hs-source-dirs: src+ other-modules: Data.Algorithm.Palindromes.Palindromes+++ build-depends: base >= 3.0 && < 4.0,+ array+++--------------------------------------------------------------------------------+
+ src/Data/Algorithm/Palindromes/Main.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- 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
+ src/Data/Algorithm/Palindromes/Palindromes.hs view
@@ -0,0 +1,257 @@+-----------------------------------------------------------------------------+-- |+-- 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)++++++++ +++
+ tests/Main.hs view
@@ -0,0 +1,151 @@+module Main where++import Data.Array+import Data.Char++import Test.QuickCheck+import Test.HUnit++import Data.Algorithm.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)+ )++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+ ]++main = do + check defaultConfig propPalindromesAroundCentres+ check defaultConfig propTextPalindrome+ runTestTT tests+