diff --git a/CREDITS b/CREDITS new file mode 100644 --- /dev/null +++ b/CREDITS @@ -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 + + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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/ + + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#! /usr/bin/env runhaskell + +> import Distribution.Simple +> main = defaultMain diff --git a/palindromes.cabal b/palindromes.cabal new file mode 100644 --- /dev/null +++ b/palindromes.cabal @@ -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 + + +-------------------------------------------------------------------------------- + diff --git a/src/Data/Algorithm/Palindromes/Main.hs b/src/Data/Algorithm/Palindromes/Main.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/Palindromes/Main.hs @@ -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 diff --git a/src/Data/Algorithm/Palindromes/Palindromes.hs b/src/Data/Algorithm/Palindromes/Palindromes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Algorithm/Palindromes/Palindromes.hs @@ -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) + + + + + + + + + + + diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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 +