{-
	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@]

	* Provides a polymorphic algorithm, to /unfold/ a list into a tree, to which an /associative binary operator/ is then applied to re-/fold/ the tree to a /scalar/.

	* Implementations of this strategy have been provided for /addition/ and /multiplication/,
	though other associative binary operators, like 'gcd' or 'lcm' could also be used.

	* Where the contents of the list are consecutive, a more efficient implementation is available in /Factory.Data.Interval/.
-}

module Factory.Math.DivideAndConquer(
-- * Types
-- ** Type-synonyms
	BisectionRatio,
	MinLength,
-- * Functions
	divideAndConquer,
	product',
	sum'
) where

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

{- |
	* The ratio of the original list-length at which to bisect.

	* CAVEAT: the value can overflow.
-}
type BisectionRatio	= Data.Ratio.Ratio Int

-- | The list-length beneath which to terminate bisection.
type MinLength	= Int

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

	* By choosing a 'bisectionRatio' 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 list-length,
	after which the /monoid/'s binary operator is directly /folded/ over the list.

	* One can view this as a <https://en.wikipedia.org/wiki/Hylomorphism_%28computer_science%29>,
	in which the list 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 :: Data.Monoid.Monoid monoid
	=> BisectionRatio	-- ^ The ratio of the original list-length at which to bisect.
	-> MinLength		-- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value.
	-> [monoid]		-- ^ The list on which to operate.
	-> monoid		-- ^ The resulting scalar.
divideAndConquer :: BisectionRatio -> MinLength -> [monoid] -> monoid
divideAndConquer BisectionRatio
bisectionRatio MinLength
minLength [monoid]
l
	| ((MinLength -> Bool) -> Bool) -> [MinLength -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((MinLength -> Bool) -> MinLength -> Bool
forall a b. (a -> b) -> a -> b
$ MinLength -> MinLength
apportion MinLength
minLength) [
		(MinLength -> MinLength -> Bool
forall a. Ord a => a -> a -> Bool
< MinLength
1),			-- The left-hand list may be null.
		(MinLength -> MinLength -> Bool
forall a. Ord a => a -> a -> Bool
> MinLength -> MinLength
forall a. Enum a => a -> a
pred MinLength
minLength)	-- The right-hand list may be null.
	]		= [Char] -> monoid
forall a. HasCallStack => [Char] -> a
error ([Char] -> monoid) -> [Char] -> monoid
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Math.DivideAndConquer.divideAndConquer:\tbisectionRatio='" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BisectionRatio -> [Char]
forall a. Show a => a -> [Char]
show BisectionRatio
bisectionRatio [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' is incompatible with minLength=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ MinLength -> [Char]
forall a. Show a => a -> [Char]
show MinLength
minLength [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
	| Bool
otherwise	= MinLength -> [monoid] -> monoid
forall a. Monoid a => MinLength -> [a] -> a
slave ([monoid] -> MinLength
forall (t :: * -> *) a. Foldable t => t a -> MinLength
length [monoid]
l) [monoid]
l
	where
		apportion :: Int -> Int
		apportion :: MinLength -> MinLength
apportion MinLength
list	= (MinLength
list MinLength -> MinLength -> MinLength
forall a. Num a => a -> a -> a
* BisectionRatio -> MinLength
forall a. Ratio a -> a
Data.Ratio.numerator BisectionRatio
bisectionRatio) MinLength -> MinLength -> MinLength
forall a. Integral a => a -> a -> a
`div` BisectionRatio -> MinLength
forall a. Ratio a -> a
Data.Ratio.denominator BisectionRatio
bisectionRatio

		slave :: MinLength -> [a] -> a
slave MinLength
len [a]
list
			| MinLength
len MinLength -> MinLength -> Bool
forall a. Ord a => a -> a -> Bool
<= MinLength
minLength	= [a] -> a
forall a. Monoid a => [a] -> a
Data.Monoid.mconcat [a]
list	-- Fold the monoid's binary operator over the list.
			| Bool
otherwise		= (a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> a
forall a. Monoid a => a -> a -> a
Data.Monoid.mappend ((a, a) -> a) -> (([a], [a]) -> (a, a)) -> ([a], [a]) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy (a, a) -> (a, a) -> (a, a)
forall a. Strategy a -> a -> a
Control.Parallel.Strategies.withStrategy (
				Strategy a -> Strategy a -> Strategy (a, a)
forall a b. Strategy a -> Strategy b -> Strategy (a, b)
Control.Parallel.Strategies.parTuple2 Strategy a
forall a. Strategy a
Control.Parallel.Strategies.rseq Strategy a
forall a. Strategy a
Control.Parallel.Strategies.rseq
			) ((a, a) -> (a, a))
-> (([a], [a]) -> (a, a)) -> ([a], [a]) -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MinLength -> [a] -> a
slave MinLength
cut ([a] -> a) -> ([a] -> a) -> ([a], [a]) -> (a, a)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** MinLength -> [a] -> a
slave (MinLength
len MinLength -> MinLength -> MinLength
forall a. Num a => a -> a -> a
- MinLength
cut)) (([a], [a]) -> a) -> ([a], [a]) -> a
forall a b. (a -> b) -> a -> b
$ MinLength -> [a] -> ([a], [a])
forall a. MinLength -> [a] -> ([a], [a])
splitAt MinLength
cut [a]
list	where	-- Apply the monoid's binary operator to the two operands resulting from bisection.
				cut :: MinLength
cut	= MinLength -> MinLength
apportion MinLength
len

{- |
	* Multiplies the specified list of numbers.

	* Since the result can be large, 'divideAndConquer' is used in an attempt to form operands of a similar order of magnitude,
	which creates scope for the use of more efficient multiplication-algorithms.
-}
product' :: Num n
	=> BisectionRatio	-- ^ The ratio of the original list-length at which to bisect.
	-> MinLength		-- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value.
	-> [n]			-- ^ The numbers whose product is required.
	-> n			-- ^ The resulting product.
product' :: BisectionRatio -> MinLength -> [n] -> n
product' BisectionRatio
bisectionRatio MinLength
minLength	= Product n -> n
forall a. Product a -> a
Data.Monoid.getProduct (Product n -> n) -> ([n] -> Product n) -> [n] -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BisectionRatio -> MinLength -> [Product n] -> Product n
forall monoid.
Monoid monoid =>
BisectionRatio -> MinLength -> [monoid] -> monoid
divideAndConquer BisectionRatio
bisectionRatio MinLength
minLength ([Product n] -> Product n)
-> ([n] -> [Product n]) -> [n] -> Product n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Product n) -> [n] -> [Product n]
forall a b. (a -> b) -> [a] -> [b]
map n -> Product n
forall a. a -> Product a
Data.Monoid.Product

{- |
	* Sums the specified list of numbers.

	* Since the result can be large, 'divideAndConquer' is used in an attempt to form operands of a similar order of magnitude,
	which creates scope for the use of more efficient multiplication-algorithms.
	/Multiplication/ is required for the /addition/ of 'Rational' numbers by cross-multiplication;
	this function is unlikely to be useful for other numbers.
-}
sum' :: Num n
	=> BisectionRatio	-- ^ The ratio of the original list-length at which to bisect.
	-> MinLength		-- ^ For efficiency, the list will not be bisected, when it's length has been reduced to this value.
	-> [n]			-- ^ The numbers whose sum is required.
	-> n			-- ^ The resulting sum.
sum' :: BisectionRatio -> MinLength -> [n] -> n
sum' BisectionRatio
bisectionRatio MinLength
minLength	= Sum n -> n
forall a. Sum a -> a
Data.Monoid.getSum (Sum n -> n) -> ([n] -> Sum n) -> [n] -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BisectionRatio -> MinLength -> [Sum n] -> Sum n
forall monoid.
Monoid monoid =>
BisectionRatio -> MinLength -> [monoid] -> monoid
divideAndConquer BisectionRatio
bisectionRatio MinLength
minLength ([Sum n] -> Sum n) -> ([n] -> [Sum n]) -> [n] -> Sum n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Sum n) -> [n] -> [Sum n]
forall a b. (a -> b) -> [a] -> [b]
map n -> Sum n
forall a. a -> Sum a
Data.Monoid.Sum