{-# 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 qualified Data.Vector.Primitive as UV

import Prelude hiding (drop)

rangeMin :: UV.Vector Int -> RM
rangeMin !xs = let
	!multiBlockRM0 = Nlogn.rangeMin (F.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 = F.generate (m-1) (\ b -> rM (b * bS) bS) `F.snoc` lastMin
		!lastMin = let !z = mm * bS in rM z (n-z)
		!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 + case F.ifoldl suc (IP 0 (split ! 0)) split of
		IP j _ -> j 
 where	!split = slice i m xs
 	suc (IP j xj) k xk
	  | xj <= xk	= IP j xj
	  | otherwise	= IP k xk