module Data.Algorithms.Palindromes.Palindromes
(longestPalindrome
,longestPalindromes
,lengthLongestPalindrome
,lengthLongestPalindromes
,longestTextPalindrome
,longestTextPalindromes
,longestWordPalindrome
,longestWordPalindromes
,palindromesAroundCentres
) where
import Data.List (maximumBy,intersperse)
import Data.Char
import Data.Array
import Control.Arrow
longestPalindrome :: String -> String
longestPalindrome input =
let inputArray = listArrayl0 input
(maxLength,pos) = maximumBy
(\(l,_) (l',_) -> compare l l')
(zip (palindromesAroundCentres inputArray) [0..])
in showPalindrome inputArray (maxLength,pos)
longestPalindromes :: Int -> String -> String
longestPalindromes m input =
let inputArray = listArrayl0 input
in concat
$ intersperse "\n"
$ map (showPalindrome inputArray)
$ filter ((m<=) . fst)
$ zip (palindromesAroundCentres inputArray) [0..]
lengthLongestPalindrome :: String -> String
lengthLongestPalindrome =
show . maximum . palindromesAroundCentres . listArrayl0
lengthLongestPalindromes :: String -> String
lengthLongestPalindromes =
show . palindromesAroundCentres . listArrayl0
longestTextPalindrome :: String -> String
longestTextPalindrome input =
let inputArray = listArrayl0 input
ips = zip input [0..]
textinput = map (first toLower)
(filter (isLetter.fst) ips)
textInputArray = listArrayl0 (map fst textinput)
positionTextInputArray = listArrayl0 (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 :: Int -> String -> String
longestTextPalindromes m input =
let inputArray = listArrayl0 input
ips = zip input [0..]
textinput = map (first toLower)
(filter (isLetter.fst) ips)
textInputArray = listArrayl0 (map fst textinput)
positionTextInputArray = listArrayl0 (map snd textinput)
in concat
$ intersperse "\n"
$ longestTextPalindromesArray
m
textInputArray
positionTextInputArray
inputArray
longestTextPalindromesArray ::
(Show a, Eq a) =>
Int -> Array Int a -> Array Int Int -> Array Int a -> [String]
longestTextPalindromesArray m a positionArray inputArray =
map (showTextPalindrome positionArray inputArray)
$ filter ((m<=) . fst)
$ zip (palindromesAroundCentres a) [0..]
longestWordPalindrome :: String -> String
longestWordPalindrome input =
let inputArray = listArrayl0 input
ips = zip input [0..]
textinput = map (first toLower)
(filter (isLetter.fst) ips)
textInputArray = listArrayl0 (map fst textinput)
positionTextInputArray = listArrayl0 (map snd textinput)
in longestWordPalindromeArray
textInputArray
positionTextInputArray
inputArray
longestWordPalindromeArray ::
Array Int Char -> Array Int Int -> Array Int Char -> String
longestWordPalindromeArray a positionArray inputArray =
let wordPalindromes = filter (isWordpalindrome positionArray inputArray)
$ zip (palindromesAroundCentres a) [0..]
in if null wordPalindromes
then ""
else showTextPalindrome positionArray inputArray $
maximumBy (\(l,_) (l',_) -> compare l l') wordPalindromes
longestWordPalindromes :: Int -> String -> String
longestWordPalindromes m input =
let inputArray = listArrayl0 input
ips = zip input [0..]
textinput = map (first toLower)
(filter (isLetter.fst) ips)
textInputArray = listArrayl0 (map fst textinput)
positionTextInputArray = listArrayl0 (map snd textinput)
in concat
$ intersperse "\n"
$ longestWordPalindromesArray
m
textInputArray
positionTextInputArray
inputArray
longestWordPalindromesArray ::
Int -> Array Int Char -> Array Int Int -> Array Int Char -> [String]
longestWordPalindromesArray m a positionArray inputArray =
map (showTextPalindrome positionArray inputArray)
$ filter ((m<=) . fst)
$ filter (isWordpalindrome positionArray inputArray)
$ zip (palindromesAroundCentres a) [0..]
isWordpalindrome :: Array Int Int -> Array Int Char -> (Int,Int) -> Bool
isWordpalindrome 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
startpos' = positionArray!!!startpos
endpos' = positionArray!!!endpos
in if endpos < startpos
then False
else if startpos' <= fst (bounds inputArray)
then endpos' >= snd (bounds inputArray) ||
not (isLetter (inputArray!!!(endpos'+1)))
else if endpos' >= snd (bounds inputArray)
then not (isLetter (inputArray!!!(startpos'1)))
else not (isLetter (inputArray!!!(startpos'1)))
&& not (isLetter (inputArray!!!(endpos'+1)))
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]]
listArrayl0 :: [a] -> Array Int a
listArrayl0 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 (fst (bounds a)) ++ " " ++ show (snd (bounds a)) ++ " " ++ show n)