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

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

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

-- | There are @'catalan' n n@ distinct binary trees of size @n@.
-- A value of type 'CatType' is the index of a particular binary
-- tree in the range @0..'catalan' n n - 1@.
type CatType = Int

data C = C {-# UNPACK #-} !CatType {-# UNPACK #-} !Index {-# UNPACK #-} !Value

catalanIndexer :: PVector Value -> Length -> (PVector CatType, VVector RM, PVector Index, PVector Value)
catalanIndexer !xs !bS = (catIxs0, typeRMs0, minIxs0, minVals0)
  where	!n = vlength xs
	!m = (n + bS - 1) `div'` bS
	!mm = m - 1
	rmAlgo	= if forceBlockN2 || bS <= n2Cross then N2.rangeMin else Nlogn.rangeMin
	lastBlock = drop (bS * mm) xs
	block b = slice (b * bS) bS xs
	!(!catIxs0, !minIxs0, !minVals0) = catalans `seq`
	  let off b (C cum mi vmi) = (cum, mi + bS * b, vmi)
	      !lastCat = off mm (catalanIndex lastBlock) 
	      catalanIndex !vec = scan 0 (bS-1) bS 0 0 maxBound Nil where
		    !n = vlength vec
		    scan !y !p !q !cum !mi !vmi !ys
		      | y < n	= 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 vmi (vy :< xs0)
			    scan' !q !cum ys
				    = scan (y+1) (p-1) q cum y vy (vy :< ys)
			    in scan' q cum ys
		      | otherwise = C cum mi vmi
	  in F.unzip3 (F.generate mm (\ b -> off b (catalanIndex (block b))) `F.snoc` lastCat)
	!typeRMs0 =
	  let !lastMin = (catIxs0 ! mm, rmAlgo lastBlock) in 
	    equivClasses (catalan bS bS) (F.generate (m-1) (\ b -> (catIxs0 ! b, rmAlgo (block b))) `F.snoc` lastMin)