palindromes-0.1: tests/Main.hs

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