{-
	Copyright (C) 2018 Dr. Alistair Ward

	This file is part of BishBosh.

	BishBosh 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.

	BishBosh 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 BishBosh.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]

	* Defines the value of a single /criterion/, which quantifies the significance of some concept;
	many such criteria may exist, & their weighted-mean drives automated selection of /move/s.

	* Each /criterion-value/ is normalised into the /signed closed unit-interval/.

 [@CAVEAT@]

	* While this data-type could implement the classes 'Num', 'Fractional' & 'Real', these interfaces would allow one to construct invalid instances.
-}

module BishBosh.Attribute.CriterionValue(
-- * Types
-- ** Data-types
	CriterionValue(),
-- * Constants
	zero,
-- * Functions
	calculateWeightedMean,
-- ** Constructor
	mkCriterionValue
) where

import			Control.Arrow((&&&))
import qualified	BishBosh.Attribute.CriterionWeight			as Attribute.CriterionWeight
import qualified	BishBosh.Attribute.WeightedMeanAndCriterionValues	as Attribute.WeightedMeanAndCriterionValues
import qualified	BishBosh.Types						as T
import qualified	Control.Exception
import qualified	Factory.Math.Statistics

-- | Quantifies some criterion; the larger the signed value, the better.
newtype CriterionValue criterionValue	= MkCriterionValue criterionValue deriving (CriterionValue criterionValue
-> CriterionValue criterionValue -> Bool
(CriterionValue criterionValue
 -> CriterionValue criterionValue -> Bool)
-> (CriterionValue criterionValue
    -> CriterionValue criterionValue -> Bool)
-> Eq (CriterionValue criterionValue)
forall criterionValue.
Eq criterionValue =>
CriterionValue criterionValue
-> CriterionValue criterionValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CriterionValue criterionValue
-> CriterionValue criterionValue -> Bool
$c/= :: forall criterionValue.
Eq criterionValue =>
CriterionValue criterionValue
-> CriterionValue criterionValue -> Bool
== :: CriterionValue criterionValue
-> CriterionValue criterionValue -> Bool
$c== :: forall criterionValue.
Eq criterionValue =>
CriterionValue criterionValue
-> CriterionValue criterionValue -> Bool
Eq, Int -> CriterionValue criterionValue -> ShowS
[CriterionValue criterionValue] -> ShowS
CriterionValue criterionValue -> String
(Int -> CriterionValue criterionValue -> ShowS)
-> (CriterionValue criterionValue -> String)
-> ([CriterionValue criterionValue] -> ShowS)
-> Show (CriterionValue criterionValue)
forall criterionValue.
Show criterionValue =>
Int -> CriterionValue criterionValue -> ShowS
forall criterionValue.
Show criterionValue =>
[CriterionValue criterionValue] -> ShowS
forall criterionValue.
Show criterionValue =>
CriterionValue criterionValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CriterionValue criterionValue] -> ShowS
$cshowList :: forall criterionValue.
Show criterionValue =>
[CriterionValue criterionValue] -> ShowS
show :: CriterionValue criterionValue -> String
$cshow :: forall criterionValue.
Show criterionValue =>
CriterionValue criterionValue -> String
showsPrec :: Int -> CriterionValue criterionValue -> ShowS
$cshowsPrec :: forall criterionValue.
Show criterionValue =>
Int -> CriterionValue criterionValue -> ShowS
Show)

instance Num criterionValue => Bounded (CriterionValue criterionValue) where
	minBound :: CriterionValue criterionValue
minBound	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
criterionValue -> CriterionValue criterionValue
MkCriterionValue (criterionValue -> CriterionValue criterionValue)
-> criterionValue -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ criterionValue -> criterionValue
forall a. Num a => a -> a
negate criterionValue
1
	maxBound :: CriterionValue criterionValue
maxBound	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
criterionValue -> CriterionValue criterionValue
MkCriterionValue criterionValue
1

-- | Smart constructor.
mkCriterionValue :: (
	Num	criterionValue,
	Ord	criterionValue
 ) => criterionValue -> CriterionValue criterionValue
mkCriterionValue :: criterionValue -> CriterionValue criterionValue
mkCriterionValue criterionValue
criterionValue	= Bool
-> CriterionValue criterionValue -> CriterionValue criterionValue
forall a. (?callStack::CallStack) => Bool -> a -> a
Control.Exception.assert (criterionValue -> criterionValue
forall a. Num a => a -> a
abs criterionValue
criterionValue criterionValue -> criterionValue -> Bool
forall a. Ord a => a -> a -> Bool
<= criterionValue
1) (CriterionValue criterionValue -> CriterionValue criterionValue)
-> CriterionValue criterionValue -> CriterionValue criterionValue
forall a b. (a -> b) -> a -> b
$ criterionValue -> CriterionValue criterionValue
forall criterionValue.
criterionValue -> CriterionValue criterionValue
MkCriterionValue criterionValue
criterionValue

-- | Constant.
zero :: Num criterionValue => CriterionValue criterionValue
zero :: CriterionValue criterionValue
zero	= criterionValue -> CriterionValue criterionValue
forall criterionValue.
criterionValue -> CriterionValue criterionValue
MkCriterionValue criterionValue
0

{- |
	* Calculates the /weighted mean/ of the specified 'CriterionValue's using the corresponding /criterion-weight/s.

	* Also writes individual unweighted 'CriterionValue's, to facilitate post-analysis;
	if the corresponding weight is @0@, evaluation of the criterion is, for efficiency, avoided.

	* CAVEAT: if all weights are @0@, then the result is indeterminate.
-}
calculateWeightedMean :: (
	Fractional	weightedMean,
	Real		criterionValue,
	Real		criterionWeight
 ) => [(CriterionValue criterionValue, Attribute.CriterionWeight.CriterionWeight criterionWeight)] -> Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues weightedMean criterionValue
{-# SPECIALISE calculateWeightedMean :: [(CriterionValue T.CriterionValue, Attribute.CriterionWeight.CriterionWeight T.CriterionWeight)] -> Attribute.WeightedMeanAndCriterionValues.WeightedMeanAndCriterionValues T.WeightedMean T.CriterionValue #-}
calculateWeightedMean :: [(CriterionValue criterionValue, CriterionWeight criterionWeight)]
-> WeightedMeanAndCriterionValues weightedMean criterionValue
calculateWeightedMean [(CriterionValue criterionValue, CriterionWeight criterionWeight)]
assocs	= (weightedMean
 -> [criterionValue]
 -> WeightedMeanAndCriterionValues weightedMean criterionValue)
-> (weightedMean, [criterionValue])
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry weightedMean
-> [criterionValue]
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall weightedMean criterionValue.
weightedMean
-> [criterionValue]
-> WeightedMeanAndCriterionValues weightedMean criterionValue
Attribute.WeightedMeanAndCriterionValues.mkWeightedMeanAndCriterionValues ((weightedMean, [criterionValue])
 -> WeightedMeanAndCriterionValues weightedMean criterionValue)
-> (weightedMean, [criterionValue])
-> WeightedMeanAndCriterionValues weightedMean criterionValue
forall a b. (a -> b) -> a -> b
$ (
	[(criterionValue, criterionWeight)] -> weightedMean
forall (foldable :: * -> *) result value weight.
(Foldable foldable, Fractional result, Real value, Real weight) =>
foldable (value, weight) -> result
Factory.Math.Statistics.getWeightedMean ([(criterionValue, criterionWeight)] -> weightedMean)
-> ([(criterionValue, criterionWeight)] -> [criterionValue])
-> [(criterionValue, criterionWeight)]
-> (weightedMean, [criterionValue])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((criterionValue, criterionWeight) -> criterionValue)
-> [(criterionValue, criterionWeight)] -> [criterionValue]
forall a b. (a -> b) -> [a] -> [b]
map (criterionValue, criterionWeight) -> criterionValue
forall a b. (a, b) -> a
fst
 ) [
	(criterionValue
bareCriterionValue, criterionWeight
bareCriterionWeight) |
		(MkCriterionValue criterionValue
bareCriterionValue, CriterionWeight criterionWeight
criterionWeight)	<- [(CriterionValue criterionValue, CriterionWeight criterionWeight)]
assocs,
		let bareCriterionWeight :: criterionWeight
bareCriterionWeight	= CriterionWeight criterionWeight -> criterionWeight
forall criterionWeight.
CriterionWeight criterionWeight -> criterionWeight
Attribute.CriterionWeight.deconstruct CriterionWeight criterionWeight
criterionWeight,
		criterionWeight
bareCriterionWeight criterionWeight -> criterionWeight -> Bool
forall a. Eq a => a -> a -> Bool
/= criterionWeight
0
 ] -- List-comprehension.