-- test strict integers
-- >let input = Data.ByteString.pack (map Data.ByteString.Internal.c2w "yabadabadoo")

-----------------------------------------------------------------------------
-- 
-- Module      :  Data.Algorithms.Palindromes.Palindromes
-- Copyright   :  (c) 2007 - 2013 Johan Jeuring
-- License     :  BSD3
--
-- Maintainer  :  johan@jeuring.net
-- Stability   :  experimental
-- Portability :  portable
--
-----------------------------------------------------------------------------


module Data.Algorithms.Palindromes.Palindromes 
       (palindrome
       ,palindromesAroundCentres
       ,dnaLengthGappedApproximatePalindromeAround
       )  where
 
import Data.List (maximumBy,intercalate)
import qualified Data.ByteString as B
import Data.Algorithms.Palindromes.PalindromesUtils 
       (showPalindrome
       ,showPalindromeDNA
       ,showTextPalindrome
       ,myToLower
       ,myIsLetterW
       ,listArrayl0
       ,appendseq
       ,Flag(..)
       ,(=:=)
       ,surroundedByPunctuation
       )
import qualified Data.Sequence as S 
import Data.Word (Word8)
import Data.Array(Array,(!))


-----------------------------------------------------------------------------
-- palindrome dispatches to the desired variant of the palindrome finding
-- algorithm. It captures all the variablity, in input format, output format,
-- and length restrictions. Variability has been `pushed down' into the code
-- as much as possible, using extra arguments whenever needed, for example
-- for word palindromes (which have not been implemented correctly at the 
-- moment: I do get the longest word palindromes, but shorter ones may 
-- actually not be word palindromes).
-----------------------------------------------------------------------------

-- | palindrome captures all possible variants of finding palindromes.
palindrome        :: Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> B.ByteString -> String
palindrome palindromeVariant outputFormat algorithmComplexity lengthModifier gap nrOfErrors input = 
  let predicate          =  case lengthModifier of
                              Just (LengthAtLeast m)    ->  (m<=)
                              Just (LengthAtMost  m)    ->  (<=m)
                              Just (LengthExact   m)    ->  \l -> m<=l && (odd l == odd m)
                              Just (LengthBetween m n)  ->  \pl -> pl >= m && pl <= n
                              _                         ->  const True
      post               =  case lengthModifier of
                              Just (LengthExact   m)    ->  \_ -> m  
                              _                         ->  id
      textinput          =  B.map myToLower (B.filter myIsLetterW input) 
      positionTextInput  =  listArrayl0 (B.findIndices myIsLetterW input)
      input'             =  case palindromeVariant of
                              Just Text                 ->  textinput
                              Just Word                 ->  textinput
                              _                         ->  input
      show'              =  case palindromeVariant of
                              Just Text                 ->  showTextPalindrome input positionTextInput
                              Just Word                 ->  showTextPalindrome input positionTextInput
                              Just DNA                  ->  showPalindromeDNA input
                              _                         ->  showPalindrome input
      outputf           =  case outputFormat of
                             Just LengthLongest         ->  show . maximum . map post . filter predicate 
                             Just Maximal               ->  intercalate "\n" . map show' . map (\(l,r) -> (post l,r)) . filter (predicate . fst) . flip zip [0..] 
                             Just LengthMaximal         ->  show . map post . filter predicate 
                             _                          ->  show' . maximumBy (\(l,_) (l',_) -> compare l l') . map (\(l,r) -> (post l,r)) . filter (predicate . fst) . flip zip [0..] 
  in outputf $ palindromesAroundCentres palindromeVariant algorithmComplexity gap nrOfErrors input input' positionTextInput

{- 
-- The following code is replaced by the equivalent code using a more efficient
-- data structure. It is kept here because this is most probably easier to understand,
-- and it is the code explained on the blog.

-----------------------------------------------------------------------------
-- palindromesAroundCentres 
--
-- The function that implements the palindrome finding algorithm.
-- Used in all the above interface functions.
-----------------------------------------------------------------------------

-- | palindromesAroundCentres is the central function of the module. It returns
--   the list of lenghths of the longest palindrome around each position in a
--   string.
palindromesAroundCentres        :: B.ByteString -> [Int]
palindromesAroundCentres input  =  reverse $ extendPalindrome input 0 0 []

extendPalindrome :: B.ByteString -> Int -> Int -> [Int] -> [Int]
extendPalindrome input rightmost currentPalindrome currentMaximalPalindromes 
  | rightmost > last
      -- reached the end of the array
      =  finalPalindromes currentPalindrome currentMaximalPalindromes (currentPalindrome:currentMaximalPalindromes)
  | rightmost-currentPalindrome == first ||
    not (B.index input rightmost == B.index input (rightmost-currentPalindrome-1))
      -- the current palindrome extends to the start of the array, 
      -- or it cannot be extended 
      =  moveCenter input rightmost (currentPalindrome:currentMaximalPalindromes) currentMaximalPalindromes currentPalindrome 
  | otherwise                                           
      -- the current palindrome can be extended
      =  extendPalindrome input (rightmost+1) (currentPalindrome+2) currentMaximalPalindromes      
  where  first = 0
         last  = B.length input - 1

moveCenter :: B.ByteString -> Int -> [Int] -> [Int] -> Int -> [Int]
moveCenter input rightmost currentMaximalPalindromes previousMaximalPalindromes nrOfCenters
  | nrOfCenters == 0
      -- the last centre is on the last element: try to extend the tail of length 1
      =  extendPalindrome input (rightmost+1) 1 currentMaximalPalindromes
  | nrOfCenters-1 == head previousMaximalPalindromes
      -- the previous element in the centre list reaches exactly to the end of the last 
      -- tail palindrome use the mirror property of palindromes to find the longest tail palindrome
      =  extendPalindrome input rightmost (head previousMaximalPalindromes) currentMaximalPalindromes
  | otherwise
      -- move the centres one step add the length of the longest palindrome to the centres
      =  moveCenter input rightmost (min (head previousMaximalPalindromes) (nrOfCenters-1):currentMaximalPalindromes) (tail previousMaximalPalindromes) (nrOfCenters-1)

finalPalindromes :: Int -> [Int] -> [Int] -> [Int]
finalPalindromes nrOfCenters previousMaximalPalindromes currentMaximalPalindromes  
  | nrOfCenters == 0
      =  currentMaximalPalindromes
  | nrOfCenters > 0
      =  finalPalindromes (nrOfCenters-1) (tail previousMaximalPalindromes) (min (head previousMaximalPalindromes) (nrOfCenters-1):currentMaximalPalindromes)
  | otherwise  
      =  error "finalCentres: input < 0"               

-}

-----------------------------------------------------------------------------
-- palindromesAroundCentresS 
--
-- The function that implements the palindrome finding algorithm.
-- Used in all the above interface functions.
-- 
-- I use the Seq datatype to pass on the maximal palindromes that are used for 
-- finding the maximal palindromes to the right of the center of the current
-- longest tail paindrome.
-----------------------------------------------------------------------------

-- | palindromesAroundCentres is the central function of the module. It returns
--   the list of lenghths of the longest palindrome around each position in a
--   string. 
palindromesAroundCentres        :: Maybe Flag -> Maybe Flag -> Maybe Flag -> Maybe Flag -> B.ByteString -> B.ByteString -> Array Int Int -> [Int]
palindromesAroundCentres palindromeVariant algorithmComplexity gap nrOfErrors input input' positionTextInput = 
  case (algorithmComplexity,gap,nrOfErrors) of
    (Just Linear   ,Nothing,Nothing)  ->  case palindromeVariant of
                                            Just DNA   ->  reverse $ appendseq $ extendPalindromeS 2 0 input' [] S.empty 0 0 
                                            Just Word  ->  reverse $ map (head . snd) $ extendTailWord input input' positionTextInput [] 0 (0,[0]) 
                                            _          ->  reverse $ appendseq $ extendPalindromeS 1 1 input' [] S.empty 0 0 
    (Just Linear   ,_      ,_      )  ->  error "palindromesAroundCentres: cannot calculate approximate or gapped palindromes using the linear-time algorithm"  
    (Just Quadratic,g      ,k      )  ->  let g'  =  case g of
                                                       Just (Gap g'')         ->  g''
                                                       _                      ->  0
                                              k'  =  case k of
                                                       Just (NrOfErrors k'')  ->  k''
                                                       _                      ->  0   
                                          in  gappedApproximatePalindromesAroundCentres palindromeVariant input g' k' 
    (_             ,_      ,_      )  ->  error "palindromesAroundCentres: case not defined"

extendPalindromeS :: Int -> Int -> B.ByteString -> [Int] -> S.Seq Int -> Int -> Int -> ([Int],S.Seq Int)
extendPalindromeS centerfactor tailfactor input = 
  let ePS maximalPalindromesPre maximalPalindromesIn rightmost currentPalindrome 
        | rightmost > lastPos
          -- reached the end of the array
          =  finalPalindromesS centerfactor currentPalindrome maximalPalindromesPre (currentPalindrome S.<| maximalPalindromesIn) maximalPalindromesIn
        | rightmost-currentPalindrome == first ||
          not (B.index input rightmost == B.index input (rightmost-currentPalindrome-1))
            -- the current palindrome extends to the start of the array, 
            -- or it cannot be extended 
            =  mCS rightmost maximalPalindromesPre (currentPalindrome S.<| maximalPalindromesIn) maximalPalindromesIn currentPalindrome 
        | otherwise                                           
            -- the current palindrome can be extended
            =  let (left,rest) = splitAt 2 maximalPalindromesPre
               in  ePS rest (foldr (flip (S.|>)) maximalPalindromesIn left) (rightmost+1) (currentPalindrome+2) 
        where  first = 0
               lastPos  = B.length input - 1
      mCS rightmost maximalPalindromesPre maximalPalindromesIn maximalPalindromesIn' nrOfCenters
        | nrOfCenters == 0
          -- the last centre is on the last element: try to extend the tail of length 1
          =  ePS maximalPalindromesPre maximalPalindromesIn (rightmost+1) tailfactor 
        | nrOfCenters-centerfactor == S.index maximalPalindromesIn' 0
          -- the previous element in the centre list reaches exactly to the end of the last 
          -- tail palindrome use the mirror property of palindromes to find the longest tail palindrome
          =  ePS maximalPalindromesPre maximalPalindromesIn rightmost (nrOfCenters-centerfactor)
        | otherwise
          -- move the centres one step add the length of the longest palindrome to the centres
          =  case S.viewl maximalPalindromesIn' of
               headq S.:< tailq -> mCS rightmost maximalPalindromesPre (min headq (nrOfCenters-centerfactor) S.<| maximalPalindromesIn) tailq (nrOfCenters-centerfactor)
               S.EmptyL         -> error "extendPalindromeS: empty sequence"
  in ePS

-- moveCenterS :: B.ByteString -> Int -> [Int] -> S.Seq Int -> S.Seq Int -> Int -> ([Int],S.Seq Int)

finalPalindromesS :: Int -> Int -> [Int] -> S.Seq Int -> S.Seq Int -> ([Int],S.Seq Int)
finalPalindromesS centerfactor nrOfCenters maximalPalindromesPre maximalPalindromesIn maximalPalindromesIn'  
  | nrOfCenters == 0
      =  (maximalPalindromesPre,maximalPalindromesIn)
  | nrOfCenters > 0
      =  case S.viewl maximalPalindromesIn' of
	       headq S.:< tailq -> finalPalindromesS centerfactor (nrOfCenters-centerfactor) maximalPalindromesPre (min headq (nrOfCenters-centerfactor) S.<| maximalPalindromesIn) tailq 
	       S.EmptyL         -> error "finalPalindromesS: empty sequence"
  | otherwise  
      =  error "finalPalindromesS: input < 0"              

gappedApproximatePalindromesAroundCentres :: Maybe Flag -> B.ByteString -> Int -> Int -> [Int]
gappedApproximatePalindromesAroundCentres palindromeVariant input g k = 
  case palindromeVariant of
    Just DNA -> map (lengthGappedApproximatePalindromeAround (=:=) 1 input g k) (if even g then [0 .. B.length input] else [0 .. B.length input-1])
    _        -> map (lengthGappedApproximatePalindromeAround (==)      2 input g k) [0 .. 2*B.length input]

-- I probably get the wrong positions printed for odd-gapped palindromes
-- the next two functions should be mergable, with a centerdivfactor
lengthGappedApproximatePalindromeAround :: (Word8 -> Word8 -> Bool) -> Int -> B.ByteString -> Int -> Int -> Int -> Int
lengthGappedApproximatePalindromeAround (===) centerfactor input g k center =
  let halfg        =  div g 2
      c            =  div center centerfactor
      lengthInput  =  B.length input
      halfg'       |  c < halfg                =  c
                   |  c + halfg > lengthInput  =  lengthInput-c
                   |  otherwise                =  halfg
      left         =  c-1-halfg'
      right        =  if even g then c+halfg' else c+1+halfg' 
  in  lengthApproximatePalindrome (===) input k left right

lengthApproximatePalindrome :: (Word8 -> Word8 -> Bool) -> B.ByteString  -> Int -> Int -> Int -> Int 
lengthApproximatePalindrome (===) input k start end  
  |  start < 0 || end > lastPos                 =  end-start-1
  |  B.index input start === B.index input end  =  lengthApproximatePalindrome (===) input k (start-1) (end+1) 
  |  k > 0                                      =  lengthApproximatePalindrome (===) input (k-1) (start-1) (end+1) 
  |  otherwise                                  =  end-start-1
  where lastPos = B.length input - 1
         
dnaLengthGappedApproximatePalindromeAround :: Maybe Flag -> Maybe Flag -> Int -> B.ByteString -> String
dnaLengthGappedApproximatePalindromeAround (Just (Gap gap)) (Just (NrOfErrors k)) center input = show $ lengthGappedApproximatePalindromeAround (=:=) 1 input gap k center 
dnaLengthGappedApproximatePalindromeAround _                _                     center input = show $ lengthGappedApproximatePalindromeAround (=:=) 1 input 0   0 center 

extendTailWord :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> (Int,[Int]) -> [(Int,[Int])] 
extendTailWord input textInput positionTextInput centres n current@(currentTail,currentTailWords)  
  | n > alast                          =  
      -- reached the end of the text input array                                     
      finalWordCentres input textInput positionTextInput (current:centres) currentTail centres (1+length centres)
  | n-currentTail == afirst            =  
      -- the current longest tail palindrome extends to the start of the text input array
      extendWordCentres input textInput positionTextInput (current:centres) n centres currentTail
  | B.index textInput n == B.index textInput (n-currentTail-1)     =  
      -- the current longest tail palindrome can be extended
      -- check whether or not the extended palindrome is a wordpalindrome
      if surroundedByPunctuation (positionTextInput!(n-currentTail-1)) (positionTextInput!n) input
      then extendTailWord input textInput positionTextInput centres (n+1) (currentTail+2,currentTail+2:currentTailWords) 
      else extendTailWord input textInput positionTextInput centres (n+1) (currentTail+2,currentTailWords)       
  | otherwise                          =  
      -- the current longest tail palindrome cannot be extended                 
      extendWordCentres input textInput positionTextInput (current:centres) n centres currentTail
  where  (afirst,alast)  =  (0,B.length textInput -1)

extendWordCentres :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> [(Int,[Int])] -> Int -> [(Int,[Int])]
extendWordCentres input textInput positionTextInput centres n tcentres centreDistance
  | centreDistance == 0                =  
      -- the last centre is on the last element: 
      -- try to extend the tail of length 1
      if surroundedByPunctuation (positionTextInput!n) (positionTextInput!n) input
      then extendTailWord input textInput positionTextInput centres (n+1) (1,[1,0]) 
      else extendTailWord input textInput positionTextInput centres (n+1) (1,[0]) 
  | centreDistance-1 == fst (head tcentres)  =  
      -- the previous element in the centre list 
      -- reaches exactly to the end of the last 
      -- tail palindrome use the mirror property 
      -- of palindromes to find the longest tail 
      -- palindrome
      let (currentTail,oldWord:oldWords) = head tcentres
      in if surroundedByPunctuation (positionTextInput!(n-currentTail)) (positionTextInput!(n-1)) input
         then if oldWord == currentTail
		      then extendTailWord input textInput positionTextInput centres n (head tcentres) 
		      else extendTailWord input textInput positionTextInput centres n (currentTail,currentTail:oldWord:oldWords) 
		 else if oldWord == currentTail && oldWord > 0
			  then extendTailWord input textInput positionTextInput centres n (currentTail, tail (snd (head tcentres)))  
		      else extendTailWord input textInput positionTextInput centres n (head tcentres) 
  | otherwise                          =  
      -- move the centres one step
      -- add the length of the longest palindrome 
      -- to the centres
      let newTail   =  min (fst (head tcentres)) (centreDistance-1)
          oldWord   =  head (snd (head tcentres))
          newWords | oldWord < newTail  
	                   = if surroundedByPunctuation (positionTextInput!(n-newTail+1)) (positionTextInput!n) input
		                 then newTail:snd (head tcentres) 
		                 else snd (head tcentres) 
		            | null (tail (snd (head tcentres)))
			           = snd (head tcentres) 
			        | otherwise 
			           = tail (snd (head tcentres))
      in extendWordCentres input textInput positionTextInput ((newTail,newWords):centres) n (tail tcentres) (centreDistance-1)

finalWordCentres :: B.ByteString -> B.ByteString -> Array Int Int -> [(Int,[Int])] -> Int -> [(Int,[Int])] -> Int -> [(Int,[Int])]
finalWordCentres input textInput positionTextInput centres n tcentres mirrorPoint 
  | n == 0     =  centres
  | n > 0      =  let tlast                       =  B.length textInput - 1
                      (oldTail,oldWord:oldWords)  =  head tcentres
                      newTail                     =  min oldTail (n-1)
                      newWord                     =  min oldWord (n-1)
                      tailFirstMirror             =  min tlast (div (mirrorPoint - newTail) 2)
                      tailLastMirror              =  min tlast (if odd newTail then div (mirrorPoint + newTail) 2 else div (mirrorPoint + newTail) 2 - 1)
                      wordFirstMirror             =  min tlast (div (mirrorPoint - newWord) 2)
                      wordLastMirror              =  min tlast (if odd newWord then div (mirrorPoint + newTail) 2 else div (mirrorPoint + newTail) 2 - 1)
                      newWords | surroundedByPunctuation (positionTextInput!tailFirstMirror) (positionTextInput!tailLastMirror) input
		                                             =    if newWord == newTail
	                                                      then newTail:oldWords
		                                                  else newTail:oldWord:oldWords
		                       | surroundedByPunctuation (positionTextInput!wordFirstMirror) (positionTextInput!wordLastMirror) input ||
			                     null oldWords       =    newWord:oldWords
			                   | otherwise           =    oldWords
                 in  finalWordCentres input textInput positionTextInput ((newTail,newWords):centres) (n-1) (tail tcentres)  (mirrorPoint+1)
  | otherwise  = error "finalWordCentres: input < 0"