{-# LANGUAGE BangPatterns #-}
module Data.RangeMin.Int.Catalan (catalanIndexer) where

import Data.RangeMin.Common
import qualified Data.RangeMin.Fusion as F
import qualified Data.Vector as V
import qualified Data.Vector.Primitive as PV
import qualified Data.RangeMin.Int.Quadratic as N2 
import qualified Data.RangeMin.Int.Linearithmic as Nlogn
import qualified Data.Vector.Unboxed as UV
import Data.RangeMin.Int.Catalan.Combinators
import Data.RangeMin.Int.Catalan.Table
import Prelude hiding (drop, read)

data IL = {-# UNPACK #-} !Int :< IL | Nil

{-# INLINE [0] catalanIndex #-}
catalanIndex :: PV.Vector Int -> Int -> IP
catalanIndex !vec !bS = catalans `seq` scan 0 (bS-1) bS 0 0 Nil where
	!n = PV.length vec
	scan !y !p !q !cum !mi !ys
	  | y == n	= IP cum mi
	  | otherwise	= let
		vy = vec ! y
		catp = catalan p
		scan' !q !cum xs0@(vx :< xs)
			| vx > vy
			  = scan' (q-1) (cum + catp q) xs
			| otherwise
			  = scan (y+1) (p-1) q cum mi (vy :< xs0)
		scan' !q !cum ys
			= scan (y+1) (p-1) q cum y (vy :< ys)
		in scan' q cum ys

catalanIndexer :: PV.Vector Int -> Int -> (PV.Vector Int, V.Vector RM, PV.Vector Int)
catalanIndexer !xs !bS = catalans `seq` (catIxs0, typeRMs0, minIxs0)
	where	!typeRMs0 = equivClasses cat (F.generate (m-1) (\ b -> (catIxs0 ! b, rmAlgo (block b))) `F.snoc` lastMin)
		!lastMin = (catIxs0 ! mm, rmAlgo lastBlock)
		lastBlock = drop (bS * mm) xs
		block b = slice (bS * b) bS xs
		cat = catalan bS bS
		off b (IP cum mi) = (cum, mi + bS * b)
		!lastCat = off mm (catalanIndex lastBlock bS)
		catIxs0 :: PV.Vector Int
		!(!catIxs0, !minIxs0) = F.unzip 
			((F.generate (m-1) (\ b -> off b (catalanIndex (block b) bS)) `F.snoc` lastCat) :: UV.Vector (Int, Int))
		!n = PV.length xs
		!m = (n + bS - 1) `div'` bS
		!mm = m - 1
		rmAlgo	| not forceBlockN2 && bS > n2Cross
				= Nlogn.rangeMin
			| otherwise
				= N2.rangeMin