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