palindromes-0.2.2.2: tests/Main.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  tests.Main
-- Copyright   :  (c) 2007 - 2011 Johan Jeuring
-- License     :  BSD3
--
-- Maintainer  :  johan@jeuring.net
-- Stability   :  experimental
-- Portability :  portable
--
-----------------------------------------------------------------------------

module Main where

import Data.Array
import Data.Char

import Test.QuickCheck
import Test.HUnit

import Data.Algorithms.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 (unescape ltp))
          in ltp' == reverse ltp'

unescape :: String -> String
unescape [] = []
unescape cs = case readLitChar cs of
                (c,rest):xs -> c:unescape rest
                []          -> []   

testTextPalindrome1, testTextPalindrome2, testTextPalindrome3, testTextPalindrome4, 
  testTextPalindrome5, testTextPalindrome6, testTextPalindrome7, testTextPalindrome8,
  testTextPalindrome9, testTextPalindrome10, testTextPalindrome11 :: Test

testWordPalindrome1, testWordPalindrome2, testWordPalindrome3, testWordPalindrome4,
  testWordPalindrome5, testWordPalindrome6 :: Test

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)
           )

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" 
              "\" waaw \"" 
              (longestWordPalindrome "w waaw wo waw")
           )

tests :: Test
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
                 ,TestLabel "testWordPalindrome1"  testWordPalindrome1
                 ,TestLabel "testWordPalindrome2"  testWordPalindrome2
                 ,TestLabel "testWordPalindrome3"  testWordPalindrome3
                 ,TestLabel "testWordPalindrome4"  testWordPalindrome4
                 ,TestLabel "testWordPalindrome5"  testWordPalindrome5
                 ,TestLabel "testWordPalindrome6"  testWordPalindrome6
                 ]

main :: IO Counts
main = do 
          quickCheck  propPalindromesAroundCentres
          quickCheck  propTextPalindrome
          runTestTT tests
          

{- 
Code for benchmarking. Needs to go in a separate file.

To compare my solution and Rampion's lazy solution:

       [bench "lengthLongestPalindromes" (nf (palindromesAroundCentres (==) . listArrayl0) input)
       ,bench "Rampion's solution" (nf maximalPalindromeLengths input)
       ]

import Criterion.Main
import Data.Algorithms.Palindromes.Palindromes
import PalindromeRampion
import System.IO

main :: IO ()
main = 
  do fn <- openFile  "../../../TestSources/Bibles/engelskingjames.txt" ReadMode
     hSetEncoding fn latin1 
     input <- hGetContents fn
     defaultMain
       [bench "lengthLongestPalindrome-Eq" (nf lengthLongestPalindrome input)]       

-}