{-
	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 an alternative algorithm for the summation of /rational/ numbers.
-}

module Factory.Math.Summation(
-- * Functions
	sum',
	sumR',
	sumR
) where

import qualified	Control.DeepSeq
import qualified	Control.Parallel.Strategies
import qualified	Data.List
import qualified	Data.Ratio
import			Data.Ratio((%))
import qualified	ToolShed.Data.List

{- |
	* Sums a list of numbers of arbitrary type.

	* Sparks the summation of @(list-length / chunk-size)@ chunks from the list, each of the specified size (thought the last chunk may be smaller),
	then recursively sums the list of results from each spark.

	* CAVEAT: unless the numbers are large, 'Rational' (requiring /cross-multiplication/), or the list long,
	'sum' is too light-weight for sparking to be productive,
	therefore it is more likely to be the parallelised deep /evaluation/ of list-elements which saves time.
-}
sum' :: (Num n, Control.DeepSeq.NFData n)
	=> ToolShed.Data.List.ChunkLength
	-> [n]
	-> n
sum' :: ChunkLength -> [n] -> n
sum' ChunkLength
chunkLength
	| ChunkLength
chunkLength ChunkLength -> ChunkLength -> Bool
forall a. Ord a => a -> a -> Bool
<= ChunkLength
1	= [Char] -> [n] -> n
forall a. HasCallStack => [Char] -> a
error ([Char] -> [n] -> n) -> [Char] -> [n] -> n
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Math.Summation.sum':\tinvalid chunk-size; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ChunkLength -> [Char]
forall a. Show a => a -> [Char]
show ChunkLength
chunkLength
	| Bool
otherwise		= [n] -> n
forall n. (Num n, NFData n) => [n] -> n
slave
	where
		slave :: (Num n, Control.DeepSeq.NFData n) => [n] -> n
		slave :: [n] -> n
slave []	= n
0
		slave [n
x]	= n
x
		slave [n]
l		= [n] -> n
forall n. (Num n, NFData n) => [n] -> n
slave {-recurse-} ([n] -> n) -> ([[n]] -> [n]) -> [[n]] -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy n -> ([n] -> n) -> [[n]] -> [n]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
Control.Parallel.Strategies.parMap Strategy n
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq [n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([[n]] -> n) -> [[n]] -> n
forall a b. (a -> b) -> a -> b
$ ChunkLength -> [n] -> [[n]]
forall a. ChunkLength -> [a] -> [[a]]
ToolShed.Data.List.chunk ChunkLength
chunkLength [n]
l

{- |
	* Sums a list of /rational/ type numbers.

	* CAVEAT: though faster than 'Data.List.sum', this algorithm has poor space-complexity, making it unsuitable for unrestricted use.
-}
{-# INLINE sumR' #-}	-- This makes a staggering difference.
sumR' :: Integral i => [Data.Ratio.Ratio i] -> Data.Ratio.Ratio i
sumR' :: [Ratio i] -> Ratio i
sumR' [Ratio i]
l	= (Ratio i -> i -> i) -> i -> [Ratio i] -> i
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Ratio i
ratio -> ((Ratio i -> i
forall a. Ratio a -> a
Data.Ratio.numerator Ratio i
ratio i -> i -> i
forall a. Num a => a -> a -> a
* (i
commonDenominator i -> i -> i
forall a. Integral a => a -> a -> a
`div` Ratio i -> i
forall a. Ratio a -> a
Data.Ratio.denominator Ratio i
ratio)) i -> i -> i
forall a. Num a => a -> a -> a
+)) i
0 [Ratio i]
l i -> i -> Ratio i
forall a. Integral a => a -> a -> Ratio a
% i
commonDenominator	where
--	commonDenominator	= foldr (lcm . Data.Ratio.denominator) 1 l
	commonDenominator :: i
commonDenominator	= (i -> Ratio i -> i) -> i -> [Ratio i] -> i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl' (\i
multiple -> i -> i -> i
forall a. Integral a => a -> a -> a
lcm i
multiple (i -> i) -> (Ratio i -> i) -> Ratio i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio i -> i
forall a. Ratio a -> a
Data.Ratio.denominator) i
1 [Ratio i]
l	-- Slightly faster.

{- |
	* Sums a list of /rational/ numbers.

	* Sparks the summation of @(list-length / chunk-length)@ chunks from the list, each of the specified size (thought the last chunk may be smaller),
	then recursively sums the list of results from each spark.

	* CAVEAT: memory-use is proportional to chunk-size.
-}
{-# INLINE sumR #-}	-- This makes a staggering difference to calls from other modules.
sumR :: (Integral i, Control.DeepSeq.NFData i)
	=> ToolShed.Data.List.ChunkLength
	-> [Data.Ratio.Ratio i]
	-> Data.Ratio.Ratio i
sumR :: ChunkLength -> [Ratio i] -> Ratio i
sumR ChunkLength
chunkLength
	| ChunkLength
chunkLength ChunkLength -> ChunkLength -> Bool
forall a. Ord a => a -> a -> Bool
<= ChunkLength
1	= [Char] -> [Ratio i] -> Ratio i
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Ratio i] -> Ratio i) -> [Char] -> [Ratio i] -> Ratio i
forall a b. (a -> b) -> a -> b
$ [Char]
"Factory.Math.Summation.sumR:\tinvalid chunk-size; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ChunkLength -> [Char]
forall a. Show a => a -> [Char]
show ChunkLength
chunkLength
	| Bool
otherwise		= [Ratio i] -> Ratio i
forall i. (Integral i, NFData i) => [Ratio i] -> Ratio i
slave
	where
		slave :: (Integral i, Control.DeepSeq.NFData i) => [Data.Ratio.Ratio i] -> Data.Ratio.Ratio i
		slave :: [Ratio i] -> Ratio i
slave [Ratio i]
l
			| [Ratio i] -> ChunkLength
forall (t :: * -> *) a. Foldable t => t a -> ChunkLength
length [Ratio i]
l ChunkLength -> ChunkLength -> Bool
forall a. Ord a => a -> a -> Bool
<= ChunkLength
chunkLength	= [Ratio i] -> Ratio i
forall i. Integral i => [Ratio i] -> Ratio i
sumR' [Ratio i]
l
			| Bool
otherwise			= [Ratio i] -> Ratio i
forall i. (Integral i, NFData i) => [Ratio i] -> Ratio i
slave {-recurse-} ([Ratio i] -> Ratio i)
-> ([[Ratio i]] -> [Ratio i]) -> [[Ratio i]] -> Ratio i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Strategy (Ratio i)
-> ([Ratio i] -> Ratio i) -> [[Ratio i]] -> [Ratio i]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
Control.Parallel.Strategies.parMap Strategy (Ratio i)
forall a. NFData a => Strategy a
Control.Parallel.Strategies.rdeepseq [Ratio i] -> Ratio i
forall i. Integral i => [Ratio i] -> Ratio i
sumR' ([[Ratio i]] -> Ratio i) -> [[Ratio i]] -> Ratio i
forall a b. (a -> b) -> a -> b
$ ChunkLength -> [Ratio i] -> [[Ratio i]]
forall a. ChunkLength -> [a] -> [[a]]
ToolShed.Data.List.chunk ChunkLength
chunkLength [Ratio i]
l