{-# LANGUAGE ScopedTypeVariables #-}
-- | This module implements the composition of a Majority Judgment
-- from a tree of Majority Judgments: for the same question,
-- the same choices, the same judges and the same grades.
-- In that tree, a parent judgment is formed by the aggregation of its children judgments,
-- where a child judgment contributes only for a percentage of the parent judgment.
module Majurity.Judgment.Section where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Bool
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..), any)
import Data.Function (($), (.))
import Data.Functor ((<$>), (<$))
import Data.Hashable (Hashable(..))
import Data.Maybe (Maybe(..), isNothing, maybe, fromMaybe)
import Data.Ord (Ord(..))
import Data.Traversable (Traversable(..))
import Data.Tree as Tree
import Prelude (Num(..), Fractional(..), toRational)
import Text.Show (Show(..))
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.List as List
import qualified Data.Map.Strict as Map

import Majurity.Judgment.Merit

-- * Type 'Section'
-- | An opinion of a 'judge' about a 'choice' at a specific section 'Tree.Node'.
data Section grade
 =   Section
 {   Section grade -> Maybe Share
sectionShare :: Maybe Share
     -- ^ A 'Share' within the parent 'Tree.Node'
     --   (defaulting to a 'Share' computed as the remaining 'Share' to reach 1
     --   divided by the number of defaulted 'Share's).
 ,   Section grade -> Maybe grade
sectionGrade :: Maybe grade
     -- ^ A 'grade' attributed to the current 'Tree.Node'
     --   (defaulting to the 'grade' set on an ancestor 'Tree.Node' if any,
     --   or the @judge@'s default grade).
 } deriving (Section grade -> Section grade -> Bool
(Section grade -> Section grade -> Bool)
-> (Section grade -> Section grade -> Bool) -> Eq (Section grade)
forall grade. Eq grade => Section grade -> Section grade -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section grade -> Section grade -> Bool
$c/= :: forall grade. Eq grade => Section grade -> Section grade -> Bool
== :: Section grade -> Section grade -> Bool
$c== :: forall grade. Eq grade => Section grade -> Section grade -> Bool
Eq,Int -> Section grade -> ShowS
[Section grade] -> ShowS
Section grade -> String
(Int -> Section grade -> ShowS)
-> (Section grade -> String)
-> ([Section grade] -> ShowS)
-> Show (Section grade)
forall grade. Show grade => Int -> Section grade -> ShowS
forall grade. Show grade => [Section grade] -> ShowS
forall grade. Show grade => Section grade -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section grade] -> ShowS
$cshowList :: forall grade. Show grade => [Section grade] -> ShowS
show :: Section grade -> String
$cshow :: forall grade. Show grade => Section grade -> String
showsPrec :: Int -> Section grade -> ShowS
$cshowsPrec :: forall grade. Show grade => Int -> Section grade -> ShowS
Show)

-- ** Type 'SectionByJudge'
type SectionByJudge judge grade = HM.HashMap judge (Section grade)

-- ** Type 'SectionNode'
-- | Node value of a 'Tree' holding a 'Section', per 'judge', per 'choice'.
data SectionNode choice judge grade
 =   SectionNode
 {   SectionNode choice judge grade -> Maybe Share
sectionNodeShare       :: Maybe Share
     -- ^ A default 'sectionShare' for judges not specifying their own.
 ,   SectionNode choice judge grade
-> HashMap choice (SectionByJudge judge grade)
sectionByJudgeByChoice :: HM.HashMap choice (SectionByJudge judge grade)
 } deriving (SectionNode choice judge grade
-> SectionNode choice judge grade -> Bool
(SectionNode choice judge grade
 -> SectionNode choice judge grade -> Bool)
-> (SectionNode choice judge grade
    -> SectionNode choice judge grade -> Bool)
-> Eq (SectionNode choice judge grade)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall choice judge grade.
(Eq choice, Eq judge, Eq grade) =>
SectionNode choice judge grade
-> SectionNode choice judge grade -> Bool
/= :: SectionNode choice judge grade
-> SectionNode choice judge grade -> Bool
$c/= :: forall choice judge grade.
(Eq choice, Eq judge, Eq grade) =>
SectionNode choice judge grade
-> SectionNode choice judge grade -> Bool
== :: SectionNode choice judge grade
-> SectionNode choice judge grade -> Bool
$c== :: forall choice judge grade.
(Eq choice, Eq judge, Eq grade) =>
SectionNode choice judge grade
-> SectionNode choice judge grade -> Bool
Eq,Int -> SectionNode choice judge grade -> ShowS
[SectionNode choice judge grade] -> ShowS
SectionNode choice judge grade -> String
(Int -> SectionNode choice judge grade -> ShowS)
-> (SectionNode choice judge grade -> String)
-> ([SectionNode choice judge grade] -> ShowS)
-> Show (SectionNode choice judge grade)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall choice judge grade.
(Show choice, Show judge, Show grade) =>
Int -> SectionNode choice judge grade -> ShowS
forall choice judge grade.
(Show choice, Show judge, Show grade) =>
[SectionNode choice judge grade] -> ShowS
forall choice judge grade.
(Show choice, Show judge, Show grade) =>
SectionNode choice judge grade -> String
showList :: [SectionNode choice judge grade] -> ShowS
$cshowList :: forall choice judge grade.
(Show choice, Show judge, Show grade) =>
[SectionNode choice judge grade] -> ShowS
show :: SectionNode choice judge grade -> String
$cshow :: forall choice judge grade.
(Show choice, Show judge, Show grade) =>
SectionNode choice judge grade -> String
showsPrec :: Int -> SectionNode choice judge grade -> ShowS
$cshowsPrec :: forall choice judge grade.
(Show choice, Show judge, Show grade) =>
Int -> SectionNode choice judge grade -> ShowS
Show)

-- * Type 'ErrorSection'
data ErrorSection choice judge grade
 =   ErrorSection_unknown_choices (HS.HashSet choice)
     -- ^ When some 'choice's are not known.
 |   ErrorSection_unknown_judges (HM.HashMap choice (HS.HashSet judge))
     -- ^ When some 'judge's are not known.
 |   ErrorSection_invalid_shares (HM.HashMap choice (HM.HashMap judge [Share]))
     -- ^ When at least one of the 'Share's is not positive, or when their sum is not 1.
 deriving (ErrorSection choice judge grade
-> ErrorSection choice judge grade -> Bool
(ErrorSection choice judge grade
 -> ErrorSection choice judge grade -> Bool)
-> (ErrorSection choice judge grade
    -> ErrorSection choice judge grade -> Bool)
-> Eq (ErrorSection choice judge grade)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall choice judge grade.
(Eq choice, Eq judge) =>
ErrorSection choice judge grade
-> ErrorSection choice judge grade -> Bool
/= :: ErrorSection choice judge grade
-> ErrorSection choice judge grade -> Bool
$c/= :: forall choice judge grade.
(Eq choice, Eq judge) =>
ErrorSection choice judge grade
-> ErrorSection choice judge grade -> Bool
== :: ErrorSection choice judge grade
-> ErrorSection choice judge grade -> Bool
$c== :: forall choice judge grade.
(Eq choice, Eq judge) =>
ErrorSection choice judge grade
-> ErrorSection choice judge grade -> Bool
Eq,Int -> ErrorSection choice judge grade -> ShowS
[ErrorSection choice judge grade] -> ShowS
ErrorSection choice judge grade -> String
(Int -> ErrorSection choice judge grade -> ShowS)
-> (ErrorSection choice judge grade -> String)
-> ([ErrorSection choice judge grade] -> ShowS)
-> Show (ErrorSection choice judge grade)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall choice judge grade.
(Show choice, Show judge) =>
Int -> ErrorSection choice judge grade -> ShowS
forall choice judge grade.
(Show choice, Show judge) =>
[ErrorSection choice judge grade] -> ShowS
forall choice judge grade.
(Show choice, Show judge) =>
ErrorSection choice judge grade -> String
showList :: [ErrorSection choice judge grade] -> ShowS
$cshowList :: forall choice judge grade.
(Show choice, Show judge) =>
[ErrorSection choice judge grade] -> ShowS
show :: ErrorSection choice judge grade -> String
$cshow :: forall choice judge grade.
(Show choice, Show judge) =>
ErrorSection choice judge grade -> String
showsPrec :: Int -> ErrorSection choice judge grade -> ShowS
$cshowsPrec :: forall choice judge grade.
(Show choice, Show judge) =>
Int -> ErrorSection choice judge grade -> ShowS
Show)

-- | @'opinionsBySection' cs js ss@ computes the 'Opinions' of the given 'Judges' @js@ about the given 'choice's @cs@,
-- from the 'grade' (specified or omitted) attributed to 'choice's
-- and the 'Share's (specified or omitted) attributed to 'Tree.Node'
-- in given 'Tree' @ss@.
opinionsBySection ::
 forall choice judge grade.
 Eq choice =>
 Eq judge =>
 Hashable choice =>
 Hashable judge =>
 Ord grade =>
 Choices choice ->
 Judges judge grade ->
 Tree (SectionNode choice judge grade) ->
 Either (ErrorSection choice judge grade)
        (Tree (OpinionsByChoice choice judge grade))
opinionsBySection :: Choices choice
-> Judges judge grade
-> Tree (SectionNode choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
opinionsBySection Choices choice
cs Judges judge grade
js = OpinionsByChoice choice judge grade
-> Tree (SectionNode choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
go ((grade -> Distribution grade
forall grade. grade -> Distribution grade
singleGrade (grade -> Distribution grade)
-> Judges judge grade -> HashMap judge (Distribution grade)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Judges judge grade
js) HashMap judge (Distribution grade)
-> HashMap choice () -> OpinionsByChoice choice judge grade
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Choices choice -> HashMap choice ()
forall a. HashSet a -> HashMap a ()
HS.toMap Choices choice
cs)
	where
	go :: HM.HashMap choice (HM.HashMap judge (Distribution grade)) ->
	      Tree (SectionNode choice judge grade) ->
	      Either (ErrorSection choice judge grade)
	             (Tree (OpinionsByChoice choice judge grade))
	go :: OpinionsByChoice choice judge grade
-> Tree (SectionNode choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
go OpinionsByChoice choice judge grade
defaultDistJC (Tree.Node (SectionNode Maybe Share
_sectionNodeShare HashMap choice (SectionByJudge judge grade)
currOpinJC) Forest (SectionNode choice judge grade)
childOpinJCS) =
		-- From current 'Tree.Node''s value.
			let OpinionsByChoice choice judge grade
currDistJC :: HM.HashMap choice (HM.HashMap judge (Distribution grade)) =
				-- Collect the 'Distribution' of current 'Tree.Node',
				-- and insert default 'Distribution'
				-- for each unspecified 'judge'
				-- of each (specified or unspecified) 'choice'.
				let specifiedDistJC :: OpinionsByChoice choice judge grade
specifiedDistJC =
					(choice
 -> SectionByJudge judge grade
 -> HashMap judge (Distribution grade))
-> HashMap choice (SectionByJudge judge grade)
-> OpinionsByChoice choice judge grade
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\choice
choice ->
						let defaultDistJ :: HashMap judge (Distribution grade)
defaultDistJ = OpinionsByChoice choice judge grade
defaultDistJC OpinionsByChoice choice judge grade
-> choice -> HashMap judge (Distribution grade)
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!choice
choice in
						(judge -> Section grade -> Distribution grade)
-> SectionByJudge judge grade -> HashMap judge (Distribution grade)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\judge
judge ->
							Distribution grade
-> (grade -> Distribution grade)
-> Maybe grade
-> Distribution grade
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HashMap judge (Distribution grade)
defaultDistJ HashMap judge (Distribution grade) -> judge -> Distribution grade
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!judge
judge) grade -> Distribution grade
forall grade. grade -> Distribution grade
singleGrade (Maybe grade -> Distribution grade)
-> (Section grade -> Maybe grade)
-> Section grade
-> Distribution grade
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
							Section grade -> Maybe grade
forall grade. Section grade -> Maybe grade
sectionGrade))
					 HashMap choice (SectionByJudge judge grade)
currOpinJC
				in
				(HashMap judge (Distribution grade)
 -> HashMap judge (Distribution grade)
 -> HashMap judge (Distribution grade))
-> OpinionsByChoice choice judge grade
-> OpinionsByChoice choice judge grade
-> OpinionsByChoice choice judge grade
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith HashMap judge (Distribution grade)
-> HashMap judge (Distribution grade)
-> HashMap judge (Distribution grade)
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union
				 OpinionsByChoice choice judge grade
specifiedDistJC
				 OpinionsByChoice choice judge grade
defaultDistJC
			in
		-- From children 'Tree.Node's.
			let HashMap choice (HashMap judge [Maybe Share])
maybeChildShareSJC :: HM.HashMap choice (HM.HashMap judge [Maybe Share]) =
				-- Collect the (specified or explicitely (with 'Nothing') unspecified) 'Share's by section,
				-- and insert all unspecified 'Share's when a 'choice' or a 'judge' is unspecified.
				(Tree (SectionNode choice judge grade)
 -> HashMap choice (HashMap judge [Maybe Share])
 -> HashMap choice (HashMap judge [Maybe Share]))
-> HashMap choice (HashMap judge [Maybe Share])
-> Forest (SectionNode choice judge grade)
-> HashMap choice (HashMap judge [Maybe Share])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Tree.Node SectionNode{Maybe Share
sectionNodeShare :: Maybe Share
sectionNodeShare :: forall choice judge grade.
SectionNode choice judge grade -> Maybe Share
sectionNodeShare, HashMap choice (SectionByJudge judge grade)
sectionByJudgeByChoice :: HashMap choice (SectionByJudge judge grade)
sectionByJudgeByChoice :: forall choice judge grade.
SectionNode choice judge grade
-> HashMap choice (SectionByJudge judge grade)
sectionByJudgeByChoice} Forest (SectionNode choice judge grade)
_) ->
					let defaultChildShareSJC :: HashMap choice (HashMap judge [Maybe Share])
defaultChildShareSJC = ([Maybe Share
sectionNodeShare] [Maybe Share] -> Judges judge grade -> HashMap judge [Maybe Share]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Judges judge grade
js) HashMap judge [Maybe Share]
-> OpinionsByChoice choice judge grade
-> HashMap choice (HashMap judge [Maybe Share])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ OpinionsByChoice choice judge grade
defaultDistJC in
					let specifiedChildShareSJC :: HashMap choice (HashMap judge [Maybe Share])
specifiedChildShareSJC =
						((SectionByJudge judge grade -> HashMap judge [Maybe Share])
-> HashMap choice (SectionByJudge judge grade)
-> HashMap choice (HashMap judge [Maybe Share])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap choice (SectionByJudge judge grade)
sectionByJudgeByChoice) ((SectionByJudge judge grade -> HashMap judge [Maybe Share])
 -> HashMap choice (HashMap judge [Maybe Share]))
-> (SectionByJudge judge grade -> HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
forall a b. (a -> b) -> a -> b
$
						(Maybe Share -> [Maybe Share]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Share -> [Maybe Share])
-> (Section grade -> Maybe Share) -> Section grade -> [Maybe Share]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Share -> Maybe Share -> Maybe Share
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Share
sectionNodeShare) (Maybe Share -> Maybe Share)
-> (Section grade -> Maybe Share) -> Section grade -> Maybe Share
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section grade -> Maybe Share
forall grade. Section grade -> Maybe Share
sectionShare (Section grade -> [Maybe Share])
-> SectionByJudge judge grade -> HashMap judge [Maybe Share]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) in
					-- Fusion specified 'choice's into accum.
					(HashMap judge [Maybe Share]
 -> HashMap judge [Maybe Share] -> HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith (([Maybe Share] -> [Maybe Share] -> [Maybe Share])
-> HashMap judge [Maybe Share]
-> HashMap judge [Maybe Share]
-> HashMap judge [Maybe Share]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith [Maybe Share] -> [Maybe Share] -> [Maybe Share]
forall a. [a] -> [a] -> [a]
(List.++)) (HashMap choice (HashMap judge [Maybe Share])
 -> HashMap choice (HashMap judge [Maybe Share])
 -> HashMap choice (HashMap judge [Maybe Share]))
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
forall a b. (a -> b) -> a -> b
$
						-- Add default 'Share' for this 'Tree.Node',
						-- for each unspecified 'judge' of specified and unspecified 'choice'.
						(HashMap judge [Maybe Share]
 -> HashMap judge [Maybe Share] -> HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Maybe Share])
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith HashMap judge [Maybe Share]
-> HashMap judge [Maybe Share] -> HashMap judge [Maybe Share]
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union
						 HashMap choice (HashMap judge [Maybe Share])
specifiedChildShareSJC
						 HashMap choice (HashMap judge [Maybe Share])
defaultChildShareSJC)
				 HashMap choice (HashMap judge [Maybe Share])
forall k v. HashMap k v
HM.empty
				 Forest (SectionNode choice judge grade)
childOpinJCS
			in
			let HashMap choice (HashMap judge [Share])
childShareSJC :: HM.HashMap choice (HM.HashMap judge [Share]) =
				-- Replace unspecified shares of each child 'Tree.Node'
				-- by an even default: the total remaining 'Share'
				-- divided by the number of unspecified 'Share's.
				((HashMap judge [Maybe Share] -> HashMap judge [Share])
-> HashMap choice (HashMap judge [Maybe Share])
-> HashMap choice (HashMap judge [Share])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap choice (HashMap judge [Maybe Share])
maybeChildShareSJC) ((HashMap judge [Maybe Share] -> HashMap judge [Share])
 -> HashMap choice (HashMap judge [Share]))
-> (HashMap judge [Maybe Share] -> HashMap judge [Share])
-> HashMap choice (HashMap judge [Share])
forall a b. (a -> b) -> a -> b
$ \HashMap judge [Maybe Share]
maybeShareSJ ->
					(([Maybe Share] -> [Share])
-> HashMap judge [Maybe Share] -> HashMap judge [Share]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap judge [Maybe Share]
maybeShareSJ) (([Maybe Share] -> [Share]) -> HashMap judge [Share])
-> ([Maybe Share] -> [Share]) -> HashMap judge [Share]
forall a b. (a -> b) -> a -> b
$ \[Maybe Share]
maybeShareS ->
						let specifiedShare :: Share
specifiedShare    = [Share] -> Share
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Share] -> Share) -> [Share] -> Share
forall a b. (a -> b) -> a -> b
$ Share -> Maybe Share -> Share
forall a. a -> Maybe a -> a
fromMaybe Share
0 (Maybe Share -> Share) -> [Maybe Share] -> [Share]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Share]
maybeShareS in
						let unspecifiedShares :: Share
unspecifiedShares = Int -> Share
forall a. Real a => a -> Share
toRational (Int -> Share) -> Int -> Share
forall a b. (a -> b) -> a -> b
$ [Maybe Share] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length ([Maybe Share] -> Int) -> [Maybe Share] -> Int
forall a b. (a -> b) -> a -> b
$ (Maybe Share -> Bool) -> [Maybe Share] -> [Maybe Share]
forall a. (a -> Bool) -> [a] -> [a]
List.filter Maybe Share -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Share]
maybeShareS in
						let defaultShare :: Share
defaultShare      = (Share
1 Share -> Share -> Share
forall a. Num a => a -> a -> a
- Share
specifiedShare) Share -> Share -> Share
forall a. Fractional a => a -> a -> a
/ Share
unspecifiedShares in
						Share -> Maybe Share -> Share
forall a. a -> Maybe a -> a
fromMaybe Share
defaultShare (Maybe Share -> Share) -> [Maybe Share] -> [Share]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Share]
maybeShareS
			in
		case Forest (SectionNode choice judge grade)
childOpinJCS of
		-- Test for unknown choices.
		 Forest (SectionNode choice judge grade)
_ | HashMap choice (SectionByJudge judge grade)
unknownChoices <- HashMap choice (SectionByJudge judge grade)
currOpinJCHashMap choice (SectionByJudge judge grade)
-> OpinionsByChoice choice judge grade
-> HashMap choice (SectionByJudge judge grade)
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
`HM.difference`OpinionsByChoice choice judge grade
defaultDistJC
		   , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HashMap choice (SectionByJudge judge grade) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap choice (SectionByJudge judge grade)
unknownChoices ->
			ErrorSection choice judge grade
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. a -> Either a b
Left (ErrorSection choice judge grade
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> ErrorSection choice judge grade
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. (a -> b) -> a -> b
$ Choices choice -> ErrorSection choice judge grade
forall choice judge grade.
HashSet choice -> ErrorSection choice judge grade
ErrorSection_unknown_choices (Choices choice -> ErrorSection choice judge grade)
-> Choices choice -> ErrorSection choice judge grade
forall a b. (a -> b) -> a -> b
$
				HashMap choice () -> Choices choice
forall a. HashMap a () -> HashSet a
HS.fromMap (HashMap choice () -> Choices choice)
-> HashMap choice () -> Choices choice
forall a b. (a -> b) -> a -> b
$ (() ()
-> HashMap choice (SectionByJudge judge grade) -> HashMap choice ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (HashMap choice (SectionByJudge judge grade) -> HashMap choice ())
-> HashMap choice (SectionByJudge judge grade) -> HashMap choice ()
forall a b. (a -> b) -> a -> b
$ HashMap choice (SectionByJudge judge grade)
unknownChoices
		-- Test for unknown judges.
		 Forest (SectionNode choice judge grade)
_ | HashMap choice (SectionByJudge judge grade)
unknownJudgesC <- (SectionByJudge judge grade -> Bool)
-> HashMap choice (SectionByJudge judge grade)
-> HashMap choice (SectionByJudge judge grade)
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (Bool -> Bool
not (Bool -> Bool)
-> (SectionByJudge judge grade -> Bool)
-> SectionByJudge judge grade
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionByJudge judge grade -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (HashMap choice (SectionByJudge judge grade)
 -> HashMap choice (SectionByJudge judge grade))
-> HashMap choice (SectionByJudge judge grade)
-> HashMap choice (SectionByJudge judge grade)
forall a b. (a -> b) -> a -> b
$
		                       (SectionByJudge judge grade
 -> HashMap judge (Distribution grade)
 -> SectionByJudge judge grade)
-> HashMap choice (SectionByJudge judge grade)
-> OpinionsByChoice choice judge grade
-> HashMap choice (SectionByJudge judge grade)
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith SectionByJudge judge grade
-> HashMap judge (Distribution grade) -> SectionByJudge judge grade
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference
		                        HashMap choice (SectionByJudge judge grade)
currOpinJC
		                        OpinionsByChoice choice judge grade
defaultDistJC
		   , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HashMap choice (SectionByJudge judge grade) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap choice (SectionByJudge judge grade)
unknownJudgesC ->
			ErrorSection choice judge grade
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. a -> Either a b
Left (ErrorSection choice judge grade
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> ErrorSection choice judge grade
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. (a -> b) -> a -> b
$ HashMap choice (HashSet judge) -> ErrorSection choice judge grade
forall choice judge grade.
HashMap choice (HashSet judge) -> ErrorSection choice judge grade
ErrorSection_unknown_judges (HashMap choice (HashSet judge) -> ErrorSection choice judge grade)
-> HashMap choice (HashSet judge)
-> ErrorSection choice judge grade
forall a b. (a -> b) -> a -> b
$
				HashMap judge () -> HashSet judge
forall a. HashMap a () -> HashSet a
HS.fromMap (HashMap judge () -> HashSet judge)
-> (SectionByJudge judge grade -> HashMap judge ())
-> SectionByJudge judge grade
-> HashSet judge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() () -> SectionByJudge judge grade -> HashMap judge ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (SectionByJudge judge grade -> HashSet judge)
-> HashMap choice (SectionByJudge judge grade)
-> HashMap choice (HashSet judge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap choice (SectionByJudge judge grade)
unknownJudgesC
		-- Handle no child 'Tree.Node':
		-- current 'Distribution' is computed from current 'Tree.Node''s value ('currOpinJC')
		-- and inherited default 'Distribution' ('defaultDistJC').
		 [] -> Tree (OpinionsByChoice choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. b -> Either a b
Right (Tree (OpinionsByChoice choice judge grade)
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> Tree (OpinionsByChoice choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. (a -> b) -> a -> b
$ OpinionsByChoice choice judge grade
-> Forest (OpinionsByChoice choice judge grade)
-> Tree (OpinionsByChoice choice judge grade)
forall a. a -> Forest a -> Tree a
Tree.Node OpinionsByChoice choice judge grade
currDistJC []
		-- Test for invalid shares.
		 Forest (SectionNode choice judge grade)
_ | HashMap choice (HashMap judge [Share])
invalidSharesJC <-
		       (HashMap judge [Share] -> Bool)
-> HashMap choice (HashMap judge [Share])
-> HashMap choice (HashMap judge [Share])
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (Bool -> Bool
not (Bool -> Bool)
-> (HashMap judge [Share] -> Bool) -> HashMap judge [Share] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap judge [Share] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (HashMap choice (HashMap judge [Share])
 -> HashMap choice (HashMap judge [Share]))
-> HashMap choice (HashMap judge [Share])
-> HashMap choice (HashMap judge [Share])
forall a b. (a -> b) -> a -> b
$
		       ([Share] -> Bool) -> HashMap judge [Share] -> HashMap judge [Share]
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (\[Share]
ss -> (Share -> Bool) -> [Share] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Share -> Share -> Bool
forall a. Ord a => a -> a -> Bool
< Share
0) [Share]
ss Bool -> Bool -> Bool
|| [Share] -> Share
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Share]
ss Share -> Share -> Bool
forall a. Eq a => a -> a -> Bool
/= Share
1)
		       (HashMap judge [Share] -> HashMap judge [Share])
-> HashMap choice (HashMap judge [Share])
-> HashMap choice (HashMap judge [Share])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap choice (HashMap judge [Share])
childShareSJC
		   , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HashMap choice (HashMap judge [Share]) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap choice (HashMap judge [Share])
invalidSharesJC ->
			ErrorSection choice judge grade
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. a -> Either a b
Left (ErrorSection choice judge grade
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> ErrorSection choice judge grade
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. (a -> b) -> a -> b
$ HashMap choice (HashMap judge [Share])
-> ErrorSection choice judge grade
forall choice judge grade.
HashMap choice (HashMap judge [Share])
-> ErrorSection choice judge grade
ErrorSection_invalid_shares HashMap choice (HashMap judge [Share])
invalidSharesJC
		-- Handle children 'Tree.Node's:
		-- current 'Opinions' is computed from the 'Opinions' of the children 'Tree.Node's.
		 Forest (SectionNode choice judge grade)
_ -> do
			Forest (OpinionsByChoice choice judge grade)
distJCS :: [Tree (HM.HashMap choice (HM.HashMap judge (Distribution grade)))] <-
				(Tree (SectionNode choice judge grade)
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> Forest (SectionNode choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Forest (OpinionsByChoice choice judge grade))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (OpinionsByChoice choice judge grade
-> Tree (SectionNode choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
go (OpinionsByChoice choice judge grade
 -> Tree (SectionNode choice judge grade)
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> OpinionsByChoice choice judge grade
-> Tree (SectionNode choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. (a -> b) -> a -> b
$ OpinionsByChoice choice judge grade
currDistJC) Forest (SectionNode choice judge grade)
childOpinJCS
				-- 'grade's set at current 'Tree.Node' ('currDistJC')
				-- become the new default 'grade's ('defaultDistJC')
				-- within its children 'Tree.Node's.
			let HashMap choice (HashMap judge [Distribution grade])
distSJC :: HM.HashMap choice (HM.HashMap judge [Distribution grade]) =
				-- Collect the 'Distribution's by section.
				(Tree (OpinionsByChoice choice judge grade)
 -> HashMap choice (HashMap judge [Distribution grade])
 -> HashMap choice (HashMap judge [Distribution grade]))
-> HashMap choice (HashMap judge [Distribution grade])
-> Forest (OpinionsByChoice choice judge grade)
-> HashMap choice (HashMap judge [Distribution grade])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Tree (OpinionsByChoice choice judge grade)
distJC ->
					let newDistSJC :: HashMap choice (HashMap judge [Distribution grade])
newDistSJC = (Distribution grade -> [Distribution grade]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Distribution grade -> [Distribution grade])
-> HashMap judge (Distribution grade)
-> HashMap judge [Distribution grade]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (HashMap judge (Distribution grade)
 -> HashMap judge [Distribution grade])
-> OpinionsByChoice choice judge grade
-> HashMap choice (HashMap judge [Distribution grade])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree (OpinionsByChoice choice judge grade)
-> OpinionsByChoice choice judge grade
forall a. Tree a -> a
rootLabel Tree (OpinionsByChoice choice judge grade)
distJC in
					(HashMap judge [Distribution grade]
 -> HashMap judge [Distribution grade]
 -> HashMap judge [Distribution grade])
-> HashMap choice (HashMap judge [Distribution grade])
-> HashMap choice (HashMap judge [Distribution grade])
-> HashMap choice (HashMap judge [Distribution grade])
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith (([Distribution grade]
 -> [Distribution grade] -> [Distribution grade])
-> HashMap judge [Distribution grade]
-> HashMap judge [Distribution grade]
-> HashMap judge [Distribution grade]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith [Distribution grade]
-> [Distribution grade] -> [Distribution grade]
forall a. [a] -> [a] -> [a]
(List.++)) HashMap choice (HashMap judge [Distribution grade])
newDistSJC)
				 HashMap choice (HashMap judge [Distribution grade])
forall k v. HashMap k v
HM.empty
				 Forest (OpinionsByChoice choice judge grade)
distJCS
			let OpinionsByChoice choice judge grade
distJC :: HM.HashMap choice (HM.HashMap judge (Distribution grade)) =
				-- Compute the current 'Distribution' by scaling (share *) and merging (+)
				-- the children 'Distribution's.
				(choice
 -> HashMap judge [Distribution grade]
 -> HashMap judge (Distribution grade))
-> HashMap choice (HashMap judge [Distribution grade])
-> OpinionsByChoice choice judge grade
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\choice
choice ->
					let childShareSJ :: HashMap judge [Share]
childShareSJ = HashMap choice (HashMap judge [Share])
childShareSJC HashMap choice (HashMap judge [Share])
-> choice -> HashMap judge [Share]
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!choice
choice in
					(judge -> [Distribution grade] -> Distribution grade)
-> HashMap judge [Distribution grade]
-> HashMap judge (Distribution grade)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.mapWithKey (\judge
judge ->
						let childShareS :: [Share]
childShareS = HashMap judge [Share]
childShareSJ HashMap judge [Share] -> judge -> [Share]
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!judge
judge in
						(Share -> Share -> Share)
-> [Distribution grade] -> Distribution grade
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Share -> Share -> Share
forall a. Num a => a -> a -> a
(+) ([Distribution grade] -> Distribution grade)
-> ([Distribution grade] -> [Distribution grade])
-> [Distribution grade]
-> Distribution grade
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
						(Share -> Distribution grade -> Distribution grade)
-> [Share] -> [Distribution grade] -> [Distribution grade]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith
						 (\Share
share Distribution grade
dist -> (Share
share Share -> Share -> Share
forall a. Num a => a -> a -> a
*) (Share -> Share) -> Distribution grade -> Distribution grade
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Distribution grade
dist)
						 [Share]
childShareS))
				 HashMap choice (HashMap judge [Distribution grade])
distSJC
			Tree (OpinionsByChoice choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. b -> Either a b
Right (Tree (OpinionsByChoice choice judge grade)
 -> Either
      (ErrorSection choice judge grade)
      (Tree (OpinionsByChoice choice judge grade)))
-> Tree (OpinionsByChoice choice judge grade)
-> Either
     (ErrorSection choice judge grade)
     (Tree (OpinionsByChoice choice judge grade))
forall a b. (a -> b) -> a -> b
$ OpinionsByChoice choice judge grade
-> Forest (OpinionsByChoice choice judge grade)
-> Tree (OpinionsByChoice choice judge grade)
forall a. a -> Forest a -> Tree a
Tree.Node OpinionsByChoice choice judge grade
distJC Forest (OpinionsByChoice choice judge grade)
distJCS