{-# LANGUAGE BangPatterns #-}

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

import Data.RangeMin.Common
import qualified Data.RangeMin.Int.Linearithmic as Nlogn
import qualified Data.Vector.Primitive as UV

import Prelude hiding (drop)

rangeMin :: UV.Vector Int -> RM
rangeMin !xs = let
	!multiBlockRM0 = Nlogn.rangeMin (unsafeBackpermute' xs blockMins)
	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
		explicit = rM i m
		leftMin = rM i (bS - xI)
		rightMin = rM (j - xJ) xJ
		in case (xI, xJ) of
		 	(0, 0)	-> multiBlockRM bI bD
			(0, _)	| m < bS	-> explicit
				| otherwise	-> multiBlockRM bI bD `mix` rightMin
			(_, 0)	| m < bS	-> explicit
				| otherwise	-> multiBlockRM (bI+1) (bD-1) `mix` leftMin
			(_, _)	| bD <= 1	-> explicit
				| otherwise	-> leftMin `mix` rightMin `mix` multiBlockRM (bI + 1) (bD - 1)
	where	!bS = ceilLog n `div'` 2 + 1
		blockMins :: UV.Vector Int
		!blockMins = UV.generate m (\ b -> let !z = b * bS in rM z (if b == mm then n-z else bS))
		!n = UV.length xs
		!m = (n + bS - 1) `div'` bS
		!mm = m - 1
		rM = explicitRM xs
		mix = minIndex xs

explicitRM :: UV.Vector Int -> Int -> Int -> Int
explicitRM !xs !i !m = i + explicit 0 (split ! 0) 1 where
	!split = drop i xs
	explicit !j !xj !k
	  | k == m	= j
	  | otherwise	= let xk = split ! k in
		     if xj <= xk then explicit j xj (k+1) else explicit k xk (k+1)