{-# LANGUAGE DataKinds #-}
{-# LANGUAGE Strict #-}

module RL.Callbacks where

import Common
import GreedyParser (Action, ActionDouble (ActionDouble), ActionSingle (ActionSingle), DoubleParent (DoubleParent), GreedyState, SingleParent (SingleParent), gsOps, opGoesLeft)
import PVGrammar
import PVGrammar.Prob.Simple

import RL.ModelTypes

import Inference.Conjugate (Hyper, Prior (expectedProbs), evalTraceLogP, sampleProbs)
import Musicology.Pitch (SPitch, fifths)

import Control.Monad.Primitive (RealWorld)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Maybe (listToMaybe)
import System.Random.MWC.Probability qualified as MWC

-- Reward
-- ======

pvRewardSample
  :: MWC.Gen RealWorld
  -> Hyper PVParams
  -> PVRewardFn label
-- -> PVAnalysis SPitch
-- -> IO QType
pvRewardSample :: forall label. Gen RealWorld -> Hyper PVParams -> PVRewardFn label
pvRewardSample Gen RealWorld
_ Hyper PVParams
_ (Left PVState
_) (Just NonEmpty PVAction
_) PVAction
_ label
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QType
0
pvRewardSample Gen RealWorld
_ Hyper PVParams
_ (Left PVState
_) Maybe (NonEmpty PVAction)
Nothing PVAction
_ label
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
pvRewardSample Gen RealWorld
gen Hyper PVParams
hyper (Right (Edges SPitch
top, [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv)) Maybe (NonEmpty PVAction)
_ PVAction
_ label
_ = do
  let trace :: Either String (Trace PVParams)
trace = [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
-> Path (Edges SPitch) (Notes SPitch)
-> Either String (Trace PVParams)
observeDerivation [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv (Edges SPitch -> Path (Edges SPitch) (Notes SPitch)
forall around between. around -> Path around between
PathEnd Edges SPitch
top)
  probs <- Prob IO (PVParams ProbsRep)
-> Gen (PrimState IO) -> IO (PVParams ProbsRep)
forall (m :: * -> *) a. Prob m a -> Gen (PrimState m) -> m a
MWC.sample (forall {k} (a :: k) (m :: * -> *).
(Prior a, PrimMonad m) =>
Hyper a -> Prob m (Probs a)
forall (a :: (* -> *) -> *) (m :: * -> *).
(Prior a, PrimMonad m) =>
Hyper a -> Prob m (Probs a)
sampleProbs @PVParams Hyper PVParams
hyper) Gen RealWorld
Gen (PrimState IO)
gen
  case trace of
    Left String
error -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"error giving reward: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
error
      QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
    Right Trace PVParams
trace -> case PVParams ProbsRep
-> Trace PVParams
-> EvalTraceI
     PVParams
     (Either
        String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
-> Maybe
     (Either
        String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)],
      QType)
forall (r :: (* -> *) -> *) a.
r ProbsRep -> Trace r -> EvalTraceI r a -> Maybe (a, QType)
evalTraceLogP PVParams ProbsRep
probs Trace PVParams
trace EvalTraceI
  PVParams
  (Either
     String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
forall (m :: * -> *).
(SampleCtx m Bernoulli, SampleCtx m Geometric1,
 SampleCtx m Geometric0, SampleCtx m MagicalOctaves,
 SampleCtx m MagicalID, SampleCtx m (Categorical 3),
 RandomInterpreter m PVParams) =>
m (Either
     String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
sampleDerivation' of
      Maybe
  (Either
     String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)],
   QType)
Nothing -> do
        String -> IO ()
putStrLn String
"Couldn't evaluate trace while giving reward"
        QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
      Just (Either
  String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
_, QType
logprob) -> QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QType
logprob

pvRewardExp :: Hyper PVParams -> PVRewardFn label -- PVAnalysis SPitch -> IO QType
pvRewardExp :: forall label. Hyper PVParams -> PVRewardFn label
pvRewardExp Hyper PVParams
_ (Left PVState
_) (Just NonEmpty PVAction
_) PVAction
_ label
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QType
0
pvRewardExp Hyper PVParams
_ (Left PVState
_) Maybe (NonEmpty PVAction)
Nothing PVAction
_ label
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
pvRewardExp Hyper PVParams
hyper (Right (Edges SPitch
top, [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv)) Maybe (NonEmpty PVAction)
_ PVAction
_ label
_ =
  Hyper PVParams -> PVAnalysis SPitch -> IO QType
pvRewardExp' Hyper PVParams
hyper ([Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
-> Path (Edges SPitch) (Notes SPitch) -> PVAnalysis SPitch
forall s f h tr slc.
[Leftmost s f h] -> Path tr slc -> Analysis s f h tr slc
Analysis [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv (Edges SPitch -> Path (Edges SPitch) (Notes SPitch)
forall around between. around -> Path around between
PathEnd Edges SPitch
top))

pvRewardExp' :: Hyper PVParams -> PVAnalysis SPitch -> IO QType
pvRewardExp' :: Hyper PVParams -> PVAnalysis SPitch -> IO QType
pvRewardExp' Hyper PVParams
hyper (Analysis [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv Path (Edges SPitch) (Notes SPitch)
top) =
  case Either String (Trace PVParams)
trace of
    Left String
err -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"error giving reward: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
      [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)] -> IO ()
forall a. Show a => a -> IO ()
print [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv
      String -> IO (ZonkAny 0)
forall a. HasCallStack => String -> a
error String
"error"
      QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
    Right Trace PVParams
trace -> do
      case PVParams ProbsRep
-> Trace PVParams
-> EvalTraceI
     PVParams
     (Either
        String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
-> Maybe
     (Either
        String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)],
      QType)
forall (r :: (* -> *) -> *) a.
r ProbsRep -> Trace r -> EvalTraceI r a -> Maybe (a, QType)
evalTraceLogP PVParams ProbsRep
probs Trace PVParams
trace EvalTraceI
  PVParams
  (Either
     String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
forall (m :: * -> *).
(SampleCtx m Bernoulli, SampleCtx m Geometric1,
 SampleCtx m Geometric0, SampleCtx m MagicalOctaves,
 SampleCtx m MagicalID, SampleCtx m (Categorical 3),
 RandomInterpreter m PVParams) =>
m (Either
     String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
sampleDerivation' of
        Maybe
  (Either
     String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)],
   QType)
Nothing -> do
          String -> IO ()
putStrLn String
"Couldn't evaluate trace while giving reward"
          QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
        Just (Either
  String [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
_, QType
logprob) -> QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QType -> IO QType) -> QType -> IO QType
forall a b. (a -> b) -> a -> b
$ QType
logprob QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ Int -> QType
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv)
 where
  probs :: Probs PVParams
probs = forall {k} (a :: k). Prior a => Hyper a -> Probs a
forall (a :: (* -> *) -> *). Prior a => Hyper a -> Probs a
expectedProbs @PVParams Hyper PVParams
hyper
  trace :: Either String (Trace PVParams)
trace = [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
-> Path (Edges SPitch) (Notes SPitch)
-> Either String (Trace PVParams)
observeDerivation [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv Path (Edges SPitch) (Notes SPitch)
top

pvRewardActionByLen
  :: Hyper PVParams -> PVRewardFn Int
-- -> PVAction
-- -> Maybe Bool
-- -> Int
-- -> IO QType
pvRewardActionByLen :: Hyper PVParams -> PVRewardFn Int
pvRewardActionByLen Hyper PVParams
_ (Left PVState
_) Maybe (NonEmpty PVAction)
Nothing PVAction
_ Int
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
10)
pvRewardActionByLen Hyper PVParams
hyper Either
  PVState
  (Edges SPitch,
   [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
state Maybe (NonEmpty PVAction)
_ PVAction
action Int
len = do
  case Either String (Maybe ((), QType))
result of
    Left String
err -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"error giving reward: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
      QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
    Right Maybe ((), QType)
Nothing -> do
      String -> IO ()
putStrLn String
"Couldn't evaluate trace while giving reward"
      QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
inf)
    Right (Just (()
_, QType
logprob)) -> QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QType -> IO QType) -> QType -> IO QType
forall a b. (a -> b) -> a -> b
$ QType
logprob QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ Int -> QType
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
 where
  probs :: Probs PVParams
probs = forall {k} (a :: k). Prior a => Hyper a -> Probs a
forall (a :: (* -> *) -> *). Prior a => Hyper a -> Probs a
expectedProbs @PVParams Hyper PVParams
hyper
  singleTop :: SingleParent slc b -> (StartStop slc, b, StartStop slc)
singleTop (SingleParent StartStop slc
sl b
t StartStop slc
sr) = (StartStop slc
sl, b
t, StartStop slc
sr)
  doubleTop :: DoubleParent c d -> (StartStop c, d, c, d, StartStop c)
doubleTop (DoubleParent StartStop c
sl d
tl c
sm d
tr StartStop c
sr) = (StartStop c
sl, d
tl, c
sm, d
tr, StartStop c
sr)
  ops :: [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
ops = case Either
  PVState
  (Edges SPitch,
   [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
state of
    Left PVState
gs -> PVState
-> [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
forall tr tr' slc op. GreedyState tr tr' slc op -> [op]
gsOps PVState
gs
    Right (Edges SPitch
_, [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv) -> [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv
  decision :: Maybe Bool
decision = Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)
-> Maybe Bool
forall s f h. Leftmost s f h -> Maybe Bool
opGoesLeft (Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)
 -> Maybe Bool)
-> Maybe (Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch))
-> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
-> Maybe (Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch))
forall a. [a] -> Maybe a
listToMaybe (Int
-> [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
-> [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
forall a. Int -> [a] -> [a]
drop Int
1 [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
ops)
  result :: Either String (Maybe ((), QType))
result = case PVAction
action of
    Left (ActionSingle SingleParent (Notes SPitch) (Edges SPitch)
top LeftmostSingle (Split SPitch) (Freeze SPitch)
op) -> Probs PVParams
-> ContextSingle SPitch
-> LeftmostSingle (Split SPitch) (Freeze SPitch)
-> Maybe Bool
-> Either String (Maybe ((), QType))
evalSingleStep Probs PVParams
PVParams ProbsRep
probs (SingleParent (Notes SPitch) (Edges SPitch) -> ContextSingle SPitch
forall {slc} {b}.
SingleParent slc b -> (StartStop slc, b, StartStop slc)
singleTop SingleParent (Notes SPitch) (Edges SPitch)
top) LeftmostSingle (Split SPitch) (Freeze SPitch)
op Maybe Bool
decision
    Right (ActionDouble DoubleParent (Notes SPitch) (Edges SPitch)
top LeftmostDouble (Split SPitch) (Freeze SPitch) (Spread SPitch)
op) -> Probs PVParams
-> ContextDouble SPitch
-> LeftmostDouble (Split SPitch) (Freeze SPitch) (Spread SPitch)
-> Maybe Bool
-> Either String (Maybe ((), QType))
evalDoubleStep Probs PVParams
PVParams ProbsRep
probs (DoubleParent (Notes SPitch) (Edges SPitch) -> ContextDouble SPitch
forall {c} {d}.
DoubleParent c d -> (StartStop c, d, c, d, StartStop c)
doubleTop DoubleParent (Notes SPitch) (Edges SPitch)
top) LeftmostDouble (Split SPitch) (Freeze SPitch) (Spread SPitch)
op Maybe Bool
decision

pvRewardChord :: PVRewardFn [Int]
pvRewardChord :: PVRewardFn [Int]
pvRewardChord (Left PVState
_) Maybe (NonEmpty PVAction)
Nothing PVAction
_ [Int]
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-QType
10)
pvRewardChord (Left PVState
_) (Just NonEmpty PVAction
_) PVAction
_ [Int]
_ = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QType
0
pvRewardChord Either
  PVState
  (Edges SPitch,
   [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
_ Maybe (NonEmpty PVAction)
_ PVAction
_ [] = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QType
0
pvRewardChord (Right (Edges SPitch
_, [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv)) Maybe (NonEmpty PVAction)
_ PVAction
_ [Int]
expected = QType -> IO QType
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QType -> IO QType) -> QType -> IO QType
forall a b. (a -> b) -> a -> b
$
  case [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
deriv of
    [] -> QType
0
    (Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)
op : [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)]
_) -> case Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)
op of
      LMSplitOnly Split SPitch
splt ->
        let rootNotes :: [Note SPitch]
rootNotes = ((Note SPitch, DoubleOrnament) -> Note SPitch)
-> [(Note SPitch, DoubleOrnament)] -> [Note SPitch]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Note SPitch, DoubleOrnament) -> Note SPitch
forall a b. (a, b) -> a
fst ([(Note SPitch, DoubleOrnament)] -> [Note SPitch])
-> [(Note SPitch, DoubleOrnament)] -> [Note SPitch]
forall a b. (a -> b) -> a -> b
$ [[(Note SPitch, DoubleOrnament)]]
-> [(Note SPitch, DoubleOrnament)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Note SPitch, DoubleOrnament)]]
 -> [(Note SPitch, DoubleOrnament)])
-> [[(Note SPitch, DoubleOrnament)]]
-> [(Note SPitch, DoubleOrnament)]
forall a b. (a -> b) -> a -> b
$ Map (Edge SPitch) [(Note SPitch, DoubleOrnament)]
-> [[(Note SPitch, DoubleOrnament)]]
forall k a. Map k a -> [a]
M.elems (Map (Edge SPitch) [(Note SPitch, DoubleOrnament)]
 -> [[(Note SPitch, DoubleOrnament)]])
-> Map (Edge SPitch) [(Note SPitch, DoubleOrnament)]
-> [[(Note SPitch, DoubleOrnament)]]
forall a b. (a -> b) -> a -> b
$ Split SPitch -> Map (Edge SPitch) [(Note SPitch, DoubleOrnament)]
forall n. Split n -> Map (Edge n) [(Note n, DoubleOrnament)]
splitReg Split SPitch
splt
            correctRoots :: [Int]
correctRoots = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
expected) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (SPitch -> Int
forall i. Spelled i => i -> Int
fifths (SPitch -> Int) -> (Note SPitch -> SPitch) -> Note SPitch -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note SPitch -> SPitch
forall n. Note n -> n
notePitch) (Note SPitch -> Int) -> [Note SPitch] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Note SPitch]
rootNotes
         in Int -> QType
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
correctRoots) QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ Int -> QType
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Note SPitch] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Note SPitch]
rootNotes)
      Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)
_ -> QType
0

addRewards :: QType -> PVRewardFn a -> PVRewardFn b -> PVRewardFn (a, b)
addRewards :: forall a b.
QType -> PVRewardFn a -> PVRewardFn b -> PVRewardFn (a, b)
addRewards QType
beta PVRewardFn a
f1 PVRewardFn b
f2 Either
  PVState
  (Edges SPitch,
   [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
st Maybe (NonEmpty PVAction)
acs PVAction
ac (a
labela, b
labelb) = do
  r1 <- PVRewardFn a
f1 Either
  PVState
  (Edges SPitch,
   [Leftmost (Split SPitch) (Freeze SPitch) (Spread SPitch)])
st Maybe (NonEmpty PVAction)
acs PVAction
ac a
labela
  r2 <- f2 st acs ac labelb
  pure $ r1 + beta * r2

pvRewardChordAndActionByLen :: QType -> Hyper PVParams -> PVRewardFn (Int, [Int])
pvRewardChordAndActionByLen :: QType -> Hyper PVParams -> PVRewardFn (Int, [Int])
pvRewardChordAndActionByLen QType
beta Hyper PVParams
hyper =
  QType
-> PVRewardFn Int -> PVRewardFn [Int] -> PVRewardFn (Int, [Int])
forall a b.
QType -> PVRewardFn a -> PVRewardFn b -> PVRewardFn (a, b)
addRewards QType
beta (Hyper PVParams -> PVRewardFn Int
pvRewardActionByLen Hyper PVParams
hyper) PVRewardFn [Int]
pvRewardChord

-- Schedules
-- =========

cosSchedule :: QType -> QType -> QType
cosSchedule :: QType -> QType -> QType
cosSchedule QType
total QType
i = (QType -> QType
forall a. Floating a => a -> a
cos (QType
t QType -> QType -> QType
forall a. Num a => a -> a -> a
* QType
forall a. Floating a => a
pi) QType -> QType -> QType
forall a. Num a => a -> a -> a
+ QType
1) QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ QType
2
 where
  t :: QType
t = QType
i QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ QType
total

expSchedule :: QType -> QType -> QType -> QType -> QType
expSchedule :: QType -> QType -> QType -> QType -> QType
expSchedule QType
start QType
end QType
total QType
i = QType
start QType -> QType -> QType
forall a. Num a => a -> a -> a
* QType -> QType
forall a. Floating a => a -> a
exp (QType -> QType
forall a. Floating a => a -> a
log (QType
end QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ QType
start) QType -> QType -> QType
forall a. Num a => a -> a -> a
* QType
i QType -> QType -> QType
forall a. Fractional a => a -> a -> a
/ QType
total)