{-# LANGUAGE CPP #-}
{-
	Copyright (C) 2011 Dr. Alistair Ward

	This program is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Describes a /bounded/ range of, typically integral, quantities.

	* Operations have been defined, on the list of /consecutive/ quantities delimited by these two bounds.

	* The point is that if the list is composed from /consecutive/ quantities, the intermediate values can be inferred, rather than physically represented.

 [@CAVEATS@]

	* The API was driven top-down by its caller's requirements, rather than a bottom-up attempt to provide a complete interface.
	consequently there may be omissions from the view point of future callers.
-}

module Factory.Data.Bounds (
-- * Types
-- ** Type-synonyms
	Bounds,
-- * Functions
--	divideAndConquer,
	elem',
	length',
	normalise,
	product',
	splitAt',
	toList,
-- ** Accessors
	minBound',
	maxBound'
-- ** Predicates
--	isReversed
) where

import			Control.Arrow((***))
import qualified	Data.Monoid
import qualified	Data.Ratio

#if MIN_VERSION_parallel(3,0,0)
import qualified	Control.Parallel.Strategies
#endif

#if MIN_VERSION_base(4,3,0)
import	Data.Tuple(swap)
#else
-- | Swap the components of a pair.
swap :: (a, b) -> (b, a)
swap (a, b)	= (b, a)
#endif

-- | Defines a range of consecutive values, bracketed by /inclusive/ bounds.
type Bounds limit	= (limit, limit)

-- | Accessor.
{-# INLINE minBound' #-}
minBound' :: Bounds a -> a
minBound'	= fst

-- | Accessor.
{-# INLINE maxBound' #-}
maxBound' :: Bounds a -> a
maxBound'	= snd

-- | 'True' if the specified value is within the inclusive 'Bounds'.
elem' :: Ord limit => limit -> Bounds limit -> Bool
elem' x	= uncurry (&&) . ((<= x) *** (x <=))

-- | 'True' if /minBound'/ exceeds /maxBound'/ extent.
isReversed :: Ord limit => Bounds limit -> Bool
isReversed	= uncurry (>)

-- | Swap the limits where they were originally reversed, but otherwise do nothing.
normalise :: Ord limit => Bounds limit -> Bounds limit
normalise b
	| isReversed b	= swap b
	| otherwise	= b

-- | Bisect the bounds at the specified limit; which should be between the two existing limits.
splitAt' :: (Num limit, Ord limit) => limit -> Bounds limit -> (Bounds limit, Bounds limit)
splitAt' i bounds@(l, r)
	| any ($ i) [(< l), (>= r)]	= error $ "Factory.Data.Bounds.splitAt':\tunsuitable index=" ++ show i ++ " for bounds=" ++ show bounds ++ "."
	| otherwise			= ((l, i), (i + 1, r))

-- | The length of 'toList'.
{-# INLINE length' #-}
length' :: (Num limit, Ord limit) => Bounds limit -> limit
length' (l, r)	= r + 1 - l

-- | Converts 'Bounds' to a list by enumerating the values.
{-# INLINE toList #-}
toList :: Enum limit => Bounds limit -> [limit]
toList	= uncurry enumFromTo

{- |
	* Reduces 'Bounds' to a single integral value encapsulated in a 'Data.Monoid.Monoid',
	using a /divide-and-conquer/ strategy,
	bisecting the /bounds/ and recursively evaluating each part; <http://en.wikipedia.org/wiki/Divide_and_conquer_algorithm>.

	* By choosing a 'ratio' other than @(1 % 2)@, the bisection can be made asymmetrical.
	The specified ratio represents the length of the left-hand portion over the original list-length;
	eg. @(1 % 3)@ results in the first part, half the length of the second.

	* This process of recursive bisection, is terminated beneath the specified minimum length,
	after which the 'Bounds' are expanded into the corresponding list, and the /monoid/'s binary operator is directly /folded/ over it.

	* One can view this as a <http://en.wikipedia.org/wiki/Hylomorphism_%28computer_science%29>,
	in which 'Bounds' is exploded into a binary tree-structure
	(each leaf of which contains a list of up to 'minLength' integers, and each node of which contains an associative binary operator),
	and then collapsed to a scalar, by application of the operators.
-}
divideAndConquer :: (Integral i, Data.Monoid.Monoid monoid)
	=> (i -> monoid)	-- ^ The monoid's constructor.
	-> Data.Ratio.Ratio i	-- ^ The ratio of the original span, at which to bisect the 'Bounds'.
	-> i			-- ^ For efficiency, the bounds will not be bisected, when it's length has been reduced to this value.
	-> Bounds i
	-> monoid		-- ^ The resulting scalar.
divideAndConquer monoidConstructor ratio minLength
	| any ($ ratio) [
		(< 0),
		(>= 1)
	]		= error $ "Factory.Data.Bounds.divideAndConquer:\tunsuitable ratio='" ++ show ratio ++ "'."
	| minLength < 1	= error $ "Factory.Data.Bounds.divideAndConquer:\tunsuitable minLength=" ++ show minLength ++ "."
	| otherwise	= slave
	where
		slave bounds@(l, r)
			| length' bounds <= minLength	= Data.Monoid.mconcat . map monoidConstructor $ toList bounds	--Fold the monoid's binary operator over the delimited list.
			| otherwise			= uncurry Data.Monoid.mappend .
#if MIN_VERSION_parallel(3,0,0)
			Control.Parallel.Strategies.withStrategy (
				Control.Parallel.Strategies.parTuple2 Control.Parallel.Strategies.rseq Control.Parallel.Strategies.rseq
			) .
#endif
			(slave *** slave) $ splitAt' (
				l + (r - l) * Data.Ratio.numerator ratio `div` Data.Ratio.denominator ratio	--Use the ratio to generate the split-index.
			) bounds	--Apply the monoid's binary operator to the two operands resulting from bisection.

{- |
	* Multiplies the consecutive sequence of integers within 'Bounds'.

	* Since the result can be large, 'divideAndConquer' is used to form operands of a similar order of magnitude,
	thus improving the efficiency of the big-number multiplication.
-}
product' :: Integral i
	=> Data.Ratio.Ratio i	-- ^ The ratio at which to bisect the 'Bounds'.
	-> i			-- ^ For efficiency, the bounds will not be bisected, when it's length has been reduced to this value.
	-> Bounds i
	-> i			-- ^ The resulting product.
product' ratio minLength bounds
	| elem' 0 bounds	= 0
	| otherwise		= Data.Monoid.getProduct $ divideAndConquer Data.Monoid.Product ratio minLength bounds