{-# LANGUAGE BangPatterns #-}

module Data.RangeMin.Int.NearLinear (rangeMin) where

import Data.RangeMin.Common
import qualified Data.RangeMin.Fusion as F
import qualified Data.RangeMin.Int.Linearithmic as Nlogn

import Prelude hiding (drop)

-- | This implements the /O(n)/ precomputation, /O(log n)/ query algorithm.
-- It precomputes block-mins for blocks of size /log n \/ 2/, uses the
-- /O(n log n)/ algorithm for multi-block queries, and explicitly computes
-- internal block queries.
rangeMin :: PVector Value -> RM
rangeMin !xs = let
	!multiBlockRM0 = Nlogn.rangeMin blockMinVals
	multiBlockRM !bI !bM = blockMins ! runRM multiBlockRM0 bI bM
	in toRM $ \ i m -> let
		j = i + m
		bI = i `div'` bS
		bD = (j `div'` bS) - bI
		xI = i `mod'` bS
		xJ = j `mod'` bS
		in case (xI, xJ) of
		 	(0, 0)	-> multiBlockRM bI bD
			(0, _)	| m < bS	-> rM' i m
				| otherwise	-> multiBlockRM bI bD `mix` rM' (j - xJ) xJ
			(_, 0)	| m < bS	-> rM' i m
				| otherwise	-> multiBlockRM (bI+1) (bD-1) `mix` rM' i (bS - xI)
			(_, _)	| bD <= 1	-> rM' i m
				| otherwise	-> rM' i (bS - xI) `mix` rM' (j - xJ) xJ `mix` multiBlockRM (bI + 1) (bD - 1)
	where	!bS = ceilLog n `div'` 2 + 1
		blockMins :: PVector Index
		!(!blockMins, !blockMinVals) = F.unzip (F.map (\ (P i xi) -> (i, xi)) 
			(F.generate mm (\ b -> rM (b * bS) bS) `F.snoc'` (let !z = mm * bS in rM z (n-z))))
		!n = vlength xs
		!m = (n + bS - 1) `div'` bS
		!mm = m - 1
		rM = explicitRM xs
		rM' = pIx .: explicitRM xs
		mix = minIndex xs

data P = P {pIx :: {-# UNPACK #-} !Index, _pVal :: {-# UNPACK #-} !Value}

explicitRM :: PVector Value -> Index -> Index -> P
explicitRM !xs !i !m = case F.ifoldl suc (P 0 (split ! 0)) split of
		P j xj -> P (i + j) xj
 where	!split = slice i m xs
 	suc (P j xj) k xk
	  | xj <= xk	= P j xj
	  | otherwise	= P k xk