{-# LANGUAGE GADTs, FlexibleContexts, PostfixOperators #-}
{-# OPTIONS_HADDOCK show-extensions, prune #-}
----------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Atom.Prob
-- Copyright   :  (c) George Ungureanu, 2020
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  ugeorge@kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module defines the Probability layer, and is concerned in modeling aspects of
-- uncertainty in values. For a brief presentation of the theoretical background of
-- this layer, the atom approach, but also an incentive to use this layer in CPS
-- design, please consult <ForSyDe-Atom.html#ungureanu20a [Ungureanu20a]>.
--
-- The idea of this layer is wrapping certain values in a 'Dist' type which represents
-- a probabilistic distribution of values, and lift any function operatin on values in
-- the Probability layer. As a practical implementation, the 'Dist' type contains a
-- recipe to obtain a distributed value \(\in\alpha\) from a random experiment
-- \(\in\mathbf{1}\), i.e. a function \(\mathbf{1}\rightarrow\alpha\), using numerical
-- methods. As such any layered system involves lazy propagation (i.e. functional
-- compositions) of recipes which get evaluated once we need to plot/trace the "final"
-- behavior. In this respect it is very similar to the "ForSyDe.Atom.MoC.CT" DSL.
--
-- Currently the Probability layer exports the following types of distributions, each
-- defined in its own submodule:
--
-- * "ForSyDe.Atom.Prob.Uniform" defines the uniform (i.e. random, square)
--   distribution.
--
-- * "ForSyDe.Atom.Prob.Normal" defines the normal (i.e. Gaussian) distribution.
--
-- Useful links:
--
-- * "ForSyDe.Atom" contains general guidelines for using the API
--
-- * the <ForSyDe-Atom.html#naming_conv naming convention> rules on how to interpret
--   the function names based on their number of inputs and outputs.
----------------------------------------------------------------------
module ForSyDe.Atom.Prob (
  -- * Distribution type
  Dist(..),
  
  -- * Atoms

  -- | Since the layer's type is unique, atoms are presented as regular functions, not
  -- as type class methods.
  (%.), (%*), samples,
  
  -- * Patterns
  sample, samplesn,
  
  trans11, trans21, trans31, trans41, trans51, trans61, trans71, trans81,
  trans12, trans22, trans32, trans42, trans52, trans62, trans72, trans82,
  trans13, trans23, trans33, trans43, trans53, trans63, trans73, trans83,
  trans14, trans24, trans34, trans44, trans54, trans64, trans74, trans84,
  -- * Utilities
  Histogram(..), histogram, getStdGen
  ) where

import ForSyDe.Atom.Utility.Tuple
import System.Random

-- | Unlike all the other layers, all the subdomains of the Probability layer share
-- the same enabling type 'Dist', the only thing differing being the numerical recipe
-- to obtain a distributed value.
--
-- To make full advantage of Haskell's lazyness and its native libraries for random
-- number generation (e.g. "System.Random") we represent recipes in the most generic
-- form as functions \(\mathbf{1}\rightarrow[\alpha]\) from a seed (here 'StdGen') to
-- an /infinite list/ containing all possible values in a random sequence. Any
-- practical simulation/tracing thus needs to limit this list to a finite number of
-- experiments.
data Dist a where
  Dist :: {Dist a -> StdGen -> [a]
recipe :: StdGen -> [a]} -> Dist a

-- | Ensures functional composition of recipes
instance Functor Dist where
  fmap :: (a -> b) -> Dist a -> Dist b
fmap f :: a -> b
f (Dist g :: StdGen -> [a]
g) = (StdGen -> [b]) -> Dist b
forall a. (StdGen -> [a]) -> Dist a
Dist ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> [b]) -> (StdGen -> [a]) -> StdGen -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [a]
g)

-------------- ATOMS -------------

-- | The @map@ atom. It lifts an abitrary function \(f\) from a layer below and
-- creates a random variable \(\mathbf{y}=f(\mathbf{x})\) by mapping every point from
-- the original random variable according to \(f\).
(%.) :: (a -> b) -> Dist a -> Dist b
f :: a -> b
f %. :: (a -> b) -> Dist a -> Dist b
%. (Dist g :: StdGen -> [a]
g)          = (StdGen -> [b]) -> Dist b
forall a. (StdGen -> [a]) -> Dist a
Dist ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> [b]) -> (StdGen -> [a]) -> StdGen -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> [a]
g)

-- | The applicative atom. Transforms one random variable distribution to another by
-- mapping samples.
(%*) :: Dist (a -> b) -> Dist a -> Dist b
(Dist f :: StdGen -> [a -> b]
f) %* :: Dist (a -> b) -> Dist a -> Dist b
%* (Dist g :: StdGen -> [a]
g) = (StdGen -> [b]) -> Dist b
forall a. (StdGen -> [a]) -> Dist a
Dist (\a :: StdGen
a -> StdGen -> [a -> b]
f StdGen
a [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StdGen -> [a]
g StdGen
a)

-- | Returns all possible values of a random variable as an infinite list of values.
samples :: StdGen -> Dist a -> [a]
samples :: StdGen -> Dist a -> [a]
samples g :: StdGen
g (Dist r :: StdGen -> [a]
r) = StdGen -> [a]
r StdGen
g

------------ PATTERNS ------------

-- | Samples a random variable by running /one/ experiment trial defined by a certain distribution.
sample :: StdGen -> Dist c -> c
sample gen :: StdGen
gen = [c] -> c
forall a. [a] -> a
head ([c] -> c) -> (Dist c -> [c]) -> Dist c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> Dist c -> [c]
forall a. StdGen -> Dist a -> [a]
samples StdGen
gen

-- | Samples a random variable by running /n/ experiment trials defined by a certain distribution. This is equivalent to running a Monte Calro experiment on /n/ samples.
samplesn :: StdGen -> Int -> Dist a -> [a]
samplesn gen :: StdGen
gen n :: Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (Dist a -> [a]) -> Dist a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdGen -> Dist a -> [a]
forall a. StdGen -> Dist a -> [a]
samples StdGen
gen


trans11 :: (a -> b) -> Dist a -> Dist b
trans11 p :: a -> b
p v1 :: Dist a
v1                      = (a -> b
p (a -> b) -> Dist a -> Dist b
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1)
trans21 :: (a -> a -> b) -> Dist a -> Dist a -> Dist b
trans21 p :: a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2                   = (a -> a -> b
p (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2)
trans31 :: (a -> a -> a -> b) -> Dist a -> Dist a -> Dist a -> Dist b
trans31 p :: a -> a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3                = (a -> a -> a -> b
p (a -> a -> a -> b) -> Dist a -> Dist (a -> a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3)
trans41 :: (a -> a -> a -> a -> b)
-> Dist a -> Dist a -> Dist a -> Dist a -> Dist b
trans41 p :: a -> a -> a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4             = (a -> a -> a -> a -> b
p (a -> a -> a -> a -> b) -> Dist a -> Dist (a -> a -> a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> b) -> Dist a -> Dist (a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4)
trans51 :: (a -> a -> a -> a -> a -> b)
-> Dist a -> Dist a -> Dist a -> Dist a -> Dist a -> Dist b
trans51 p :: a -> a -> a -> a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5          = (a -> a -> a -> a -> a -> b
p (a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> b) -> Dist a -> Dist (a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> b) -> Dist a -> Dist (a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5)
trans61 :: (a -> a -> a -> a -> a -> a -> b)
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist b
trans61 p :: a -> a -> a -> a -> a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6       = (a -> a -> a -> a -> a -> a -> b
p (a -> a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> b) -> Dist a -> Dist (a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> b) -> Dist a -> Dist (a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6)
trans71 :: (a -> a -> a -> a -> a -> a -> a -> b)
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist b
trans71 p :: a -> a -> a -> a -> a -> a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: Dist a
v7    = (a -> a -> a -> a -> a -> a -> a -> b
p (a -> a -> a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> b) -> Dist a -> Dist (a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> b) -> Dist a -> Dist (a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v7)
trans81 :: (a -> a -> a -> a -> a -> a -> a -> a -> b)
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist b
trans81 p :: a -> a -> a -> a -> a -> a -> a -> a -> b
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: Dist a
v7 v8 :: Dist a
v8 = (a -> a -> a -> a -> a -> a -> a -> a -> b
p (a -> a -> a -> a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> a -> b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> a -> b)
-> Dist a -> Dist (a -> a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> a -> b) -> Dist a -> Dist (a -> a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> a -> b) -> Dist a -> Dist (a -> a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> a -> b) -> Dist a -> Dist (a -> b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v7 Dist (a -> b) -> Dist a -> Dist b
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v8)
trans12 :: (a -> (a1, b)) -> Dist a -> (Dist a1, Dist b)
trans12 p :: a -> (a1, b)
p v1 :: Dist a
v1                      = (a -> (a1, b)
p (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
-- | This pattern transforms a (set of) random distribution(s) into another (set) by
-- composing their recipes with an arbitrary function. In other words it lifts an
-- arbitrary function to the Probability layer.
--
-- Constructors: @trans[1-8][1-4]@
trans22 :: (a -> a -> (a1, b)) -> Dist a -> Dist a -> (Dist a1, Dist b)
trans22 p :: a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2                   = (a -> a -> (a1, b)
p (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans32 :: (a -> a -> a -> (a1, b))
-> Dist a -> Dist a -> Dist a -> (Dist a1, Dist b)
trans32 p :: a -> a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3                = (a -> a -> a -> (a1, b)
p (a -> a -> a -> (a1, b)) -> Dist a -> Dist (a -> a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans42 :: (a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist a -> Dist a -> Dist a -> (Dist a1, Dist b)
trans42 p :: a -> a -> a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4             = (a -> a -> a -> a -> (a1, b)
p (a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> (a1, b)) -> Dist a -> Dist (a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans52 :: (a -> a -> a -> a -> a -> (a1, b))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a1, Dist b)
trans52 p :: a -> a -> a -> a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5          = (a -> a -> a -> a -> a -> (a1, b)
p (a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> (a1, b)) -> Dist a -> Dist (a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans62 :: (a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a1, Dist b)
trans62 p :: a -> a -> a -> a -> a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6       = (a -> a -> a -> a -> a -> a -> (a1, b)
p (a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> (a1, b)) -> Dist a -> Dist (a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans72 :: (a -> a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a1, Dist b)
trans72 p :: a -> a -> a -> a -> a -> a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: Dist a
v7    = (a -> a -> a -> a -> a -> a -> a -> (a1, b)
p (a -> a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> (a1, b)) -> Dist a -> Dist (a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v7 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans82 :: (a -> a -> a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> p
-> Dist a
-> (Dist a1, Dist b)
trans82 p :: a -> a -> a -> a -> a -> a -> a -> a -> (a1, b)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: p
v7 v8 :: Dist a
v8 = (a -> a -> a -> a -> a -> a -> a -> a -> (a1, b)
p (a -> a -> a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> a -> (a1, b))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> a -> (a1, b))
-> Dist a -> Dist (a -> a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> a -> (a1, b)) -> Dist a -> Dist (a -> a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> a -> (a1, b)) -> Dist a -> Dist (a -> (a1, b))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> (a1, b)) -> Dist a -> Dist (a1, b)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v8 Dist (a1, b) -> (Dist a1, Dist b)
forall (f :: * -> *) a1 b. Functor f => f (a1, b) -> (f a1, f b)
|<)
trans13 :: (a -> (a, b1, b2)) -> Dist a -> (Dist a, Dist b1, Dist b2)
trans13 p :: a -> (a, b1, b2)
p v1 :: Dist a
v1                      = (a -> (a, b1, b2)
p (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans23 :: (a -> a -> (a, b1, b2))
-> Dist a -> Dist a -> (Dist a, Dist b1, Dist b2)
trans23 p :: a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2                   = (a -> a -> (a, b1, b2)
p (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans33 :: (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist a -> Dist a -> (Dist a, Dist b1, Dist b2)
trans33 p :: a -> a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3                = (a -> a -> a -> (a, b1, b2)
p (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans43 :: (a -> a -> a -> a -> (a, b1, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist b2)
trans43 p :: a -> a -> a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4             = (a -> a -> a -> a -> (a, b1, b2)
p (a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans53 :: (a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist b2)
trans53 p :: a -> a -> a -> a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5          = (a -> a -> a -> a -> a -> (a, b1, b2)
p (a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans63 :: (a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist b2)
trans63 p :: a -> a -> a -> a -> a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6       = (a -> a -> a -> a -> a -> a -> (a, b1, b2)
p (a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans73 :: (a -> a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist b2)
trans73 p :: a -> a -> a -> a -> a -> a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: Dist a
v7    = (a -> a -> a -> a -> a -> a -> a -> (a, b1, b2)
p (a -> a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v7 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans83 :: (a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> p
-> Dist a
-> (Dist a, Dist b1, Dist b2)
trans83 p :: a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: p
v7 v8 :: Dist a
v8 = (a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, b2)
p (a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> a -> (a, b1, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> a -> (a, b1, b2))
-> Dist a -> Dist (a -> a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> a -> (a, b1, b2)) -> Dist a -> Dist (a -> (a, b1, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> (a, b1, b2)) -> Dist a -> Dist (a, b1, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v8 Dist (a, b1, b2) -> (Dist a, Dist b1, Dist b2)
forall (f :: * -> *) a b1 b2.
Functor f =>
f (a, b1, b2) -> (f a, f b1, f b2)
|<<)
trans14 :: (a -> (a, b1, c, b2))
-> Dist a -> (Dist a, Dist b1, Dist c, Dist b2)
trans14 p :: a -> (a, b1, c, b2)
p v1 :: Dist a
v1                      = (a -> (a, b1, c, b2)
p (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans24 :: (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist a -> (Dist a, Dist b1, Dist c, Dist b2)
trans24 p :: a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2                   = (a -> a -> (a, b1, c, b2)
p (a -> a -> (a, b1, c, b2)) -> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans34 :: (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist a -> Dist a -> (Dist a, Dist b1, Dist c, Dist b2)
trans34 p :: a -> a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3                = (a -> a -> a -> (a, b1, c, b2)
p (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans44 :: (a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist c, Dist b2)
trans44 p :: a -> a -> a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4             = (a -> a -> a -> a -> (a, b1, c, b2)
p (a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans54 :: (a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist c, Dist b2)
trans54 p :: a -> a -> a -> a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5          = (a -> a -> a -> a -> a -> (a, b1, c, b2)
p (a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans64 :: (a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist c, Dist b2)
trans64 p :: a -> a -> a -> a -> a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6       = (a -> a -> a -> a -> a -> a -> (a, b1, c, b2)
p (a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans74 :: (a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist c, Dist b2)
trans74 p :: a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: Dist a
v7    = (a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2)
p (a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v7 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)
trans84 :: (a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> Dist a
-> (Dist a, Dist b1, Dist c, Dist b2)
trans84 p :: a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2)
p v1 :: Dist a
v1 v2 :: Dist a
v2 v3 :: Dist a
v3 v4 :: Dist a
v4 v5 :: Dist a
v5 v6 :: Dist a
v6 v7 :: Dist a
v7 v8 :: Dist a
v8 = (a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2)
p (a -> a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a
-> Dist (a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
forall a b. (a -> b) -> Dist a -> Dist b
%. Dist a
v1 Dist (a -> a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v2 Dist (a -> a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v3 Dist (a -> a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v4 Dist (a -> a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v5 Dist (a -> a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v6 Dist (a -> a -> (a, b1, c, b2))
-> Dist a -> Dist (a -> (a, b1, c, b2))
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v7 Dist (a -> (a, b1, c, b2)) -> Dist a -> Dist (a, b1, c, b2)
forall a b. Dist (a -> b) -> Dist a -> Dist b
%* Dist a
v8 Dist (a, b1, c, b2) -> (Dist a, Dist b1, Dist c, Dist b2)
forall (f :: * -> *) a b1 c b2.
Functor f =>
f (a, b1, c, b2) -> (f a, f b1, f c, f b2)
|<<<)

------------ UTILITIES ------------



-- | Histogram representation as a zipped list of bins, each bin paired with its
-- center value.
newtype Histogram = Hist { Histogram -> [(Rational, Int)]
getBins :: [(Rational,Int)] }

instance Show Histogram where
  showsPrec :: Int -> Histogram -> ShowS
showsPrec p :: Int
p = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>1) (ShowS -> ShowS) -> (Histogram -> ShowS) -> Histogram -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Rational, Int)] -> ShowS
forall a. Show a => [(Rational, a)] -> ShowS
showBins ([(Rational, Int)] -> ShowS)
-> (Histogram -> [(Rational, Int)]) -> Histogram -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Histogram -> [(Rational, Int)]
getBins
    where
      showBins :: [(Rational, a)] -> ShowS
showBins (x :: (Rational, a)
x:xs :: [(Rational, a)]
xs)  = Char -> ShowS
showChar '{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, a) -> ShowS
forall a. Show a => (Rational, a) -> ShowS
showBin (Rational, a)
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Rational, a)] -> ShowS
forall a. Show a => [(Rational, a)] -> ShowS
showBins' [(Rational, a)]
xs
      showBins []      = Char -> ShowS
showChar '{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '}'
      showBins' :: [(Rational, a)] -> ShowS
showBins' (x :: (Rational, a)
x:xs :: [(Rational, a)]
xs) = Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, a) -> ShowS
forall a. Show a => (Rational, a) -> ShowS
showBin (Rational, a)
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Rational, a)] -> ShowS
showBins' [(Rational, a)]
xs
      showBins' []     = Char -> ShowS
showChar '}'
      showBin :: (Rational, a) -> ShowS
showBin (a :: Rational
a,b :: a
b)    = Char -> ShowS
showChar '(' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> ShowS
forall a. Show a => a -> ShowS
shows (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
a :: Float) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         Char -> ShowS
showChar ',' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ')'

-- | Returns the histogram of (a list of) experiments.
--
-- >>> let xs = [1..10] ++ [4..7]
-- >>> histogram 1 10 2 xs
-- {(1.0,1) (3.0,2) (5.0,4) (7.0,4) (9.0,2)}
histogram :: (Ord a, Num a, Real a)
          => a         -- ^ value of leftmost bin (minimum covered) 
          -> a         -- ^ value of rightmost bin (maximum covered)
          -> Rational  -- ^ step
          -> [a]       -- ^ set of experiments
          -> Histogram -- ^ histogram
histogram :: a -> a -> Rational -> [a] -> Histogram
histogram l :: a
l r :: a
r step :: Rational
step xs :: [a]
xs =  [(Rational, Int)] -> Histogram
Hist ([(Rational, Int)] -> Histogram) -> [(Rational, Int)] -> Histogram
forall a b. (a -> b) -> a -> b
$ ((Rational, Rational) -> Int -> (Rational, Int))
-> [(Rational, Rational)] -> [Int] -> [(Rational, Int)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(x :: Rational
x,_) h :: Int
h->(Rational
xRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
halfstep,Int
h)) [(Rational, Rational)]
range [Int]
bins
  where
    halfstep :: Rational
halfstep = Rational
step Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ 2
    bins :: [Int]
bins     = (Rational, Rational) -> [a] -> Int
forall a a a.
(Real a, Fractional a, Fractional a, Ord a, Ord a) =>
(a, a) -> [a] -> Int
count ((Rational, Rational) -> [a] -> Int)
-> [(Rational, Rational)] -> [[a] -> Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rational, Rational)]
range [[a] -> Int] -> [[a]] -> [Int]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> [[a]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs
    range :: [(Rational, Rational)]
range    = let l' :: Rational
l' = a -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
l
                   r' :: Rational
r' = a -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
r
                   ix :: [Rational]
ix = (Int -> Rational) -> [Int] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac [(0::Int)..]
               in ((Rational, Rational) -> Bool)
-> [(Rational, Rational)] -> [(Rational, Rational)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(x :: Rational
x,_) -> Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
r')
                  [(Rational
l' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
kRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
step Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
halfstep , Rational
l' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
kRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
step Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
halfstep ) | Rational
k <- [Rational]
ix]
    count :: (a, a) -> [a] -> Int
count (x :: a
x,y :: a
y) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a :: a
a -> a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
a Bool -> Bool -> Bool
&& a -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y)