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
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 :: String -> String
longestPalindromes input =
let inputArray = stringArray input
in concat
$ intersperse "\n"
$ map (showPalindrome inputArray)
$ zip (palindromesAroundCentres inputArray) [0..]
lengthLongestPalindrome :: String -> String
lengthLongestPalindrome =
show . maximum . palindromesAroundCentres . stringArray
lengthLongestPalindromes :: String -> String
lengthLongestPalindromes =
show . palindromesAroundCentres . stringArray
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,lti1) (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 :: 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,lti1) (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 :: (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 =
finalCentres currentTail centres
(currentTail:centres)
| ncurrentTail == afirst =
extendCentres a n (currentTail:centres)
centres currentTail
| a!n == a!(ncurrentTail1) =
extendTail a (n+1) (currentTail+2) centres
| otherwise =
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 =
extendTail a (n+1) 1 centres
| centreDistance1 == head tcentres =
extendTail a n (head tcentres) centres
| otherwise =
extendCentres a n (min (head tcentres)
(centreDistance1):centres)
(tail tcentres) (centreDistance1)
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"
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!!!(startpos1)+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]]
stringArray :: String -> Array Int Char
stringArray string = listArray (0,length string 1) string
(!!!) :: 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)