{-# LANGUAGE BangPatterns #-}

-- | The FSRS-7 memory model.
--
-- This module is a direct transcription of the reference implementation in
-- <https://github.com/open-spaced-repetition/srs-benchmark srs-benchmark>
-- (@models\/fsrs_v7.py@ and @models\/fsrs_v7_interval_penalty.py@). Every
-- function here is pure and total.
--
-- What changed in FSRS-7 relative to FSRS-6:
--
-- * The forgetting curve is a stability-weighted mixture of /two/ power laws
--   instead of one, which is why it has eight weights and no closed-form
--   inverse (see 'nextIntervalDays').
-- * The stability update is computed twice — once with a long-term weight
--   block and once with a short-term one — and the two are blended by
--   'transitionCoefficient', a smooth function of the elapsed time. FSRS-6
--   switched between two separate formulas on a same-day\/not-same-day flag.
-- * Intervals are genuinely continuous. Ten minutes is @10 \/ 1440@ days and
--   the model is meant to be evaluated at such values, not at whole days.
module FSRS.Algorithm
  ( -- * Forgetting curve
    retrievability
  , retrievabilityDerivative
  , nextIntervalDays

    -- * Difficulty
  , initialDifficulty
  , nextDifficulty

    -- * Stability
  , initialStability
  , stabilityAfterReview
  , transitionCoefficient
  , nextStability

    -- * State transition
  , nextMemoryState
  , replayReviews

    -- * Bounds
  , stabilityMin
  , stabilityMax
  , difficultyMin
  , difficultyMax
  , minimumIntervalDays
  , maximumIntervalDays
  ) where

import FSRS.Parameters
  ( CurveWeights (..)
  , Parameters
  , StabilityWeights (..)
  , curveWeights
  , difficultyDelta
  , initialDifficultyBase
  , initialDifficultyRate
  , initialStabilityWeight
  , longTermWeights
  , shortTermWeights
  , transitionAmplitude
  , transitionRate
  )
import FSRS.Types
  ( Days
  , Difficulty
  , MemoryState (..)
  , Rating (..)
  , Retrievability
  , Stability
  , ratingToInt
  )

-- | The smallest stability the model will report, @1e-4@ days (about nine
-- seconds). This is the @s_min@ the upstream configuration uses for FSRS-7,
-- which is always run with second-precision intervals.
stabilityMin :: Stability
stabilityMin :: Double
stabilityMin = Double
1.0e-4

-- | The largest stability the model will report: @36500@ days, a century.
stabilityMax :: Stability
stabilityMax :: Double
stabilityMax = Double
36500.0

-- | @1@.
difficultyMin :: Difficulty
difficultyMin :: Double
difficultyMin = Double
1.0

-- | @10@.
difficultyMax :: Difficulty
difficultyMax :: Double
difficultyMax = Double
10.0

-- | One second, expressed in days — the shortest interval 'nextIntervalDays'
-- will return.
minimumIntervalDays :: Days
minimumIntervalDays :: Double
minimumIntervalDays = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
86400.0

-- | A century in days — the longest interval 'nextIntervalDays' will return.
maximumIntervalDays :: Days
maximumIntervalDays :: Double
maximumIntervalDays = Double
36500.0

clampTo :: Double -> Double -> Double -> Double
clampTo :: Double -> Double -> Double -> Double
clampTo Double
lo Double
hi Double
x = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
hi (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
lo Double
x)

-- ---------------------------------------------------------------------------
-- Forgetting curve
-- ---------------------------------------------------------------------------

-- | The probability of recalling a card @t@ days after the last review, given
-- its stability.
--
-- FSRS-7 mixes two power laws whose relative weight depends on the stability
-- itself, so — unlike every earlier version — the retrievability at @t == s@
-- is not a fixed @0.9@ but drifts with @s@.
--
-- @t@ must be non-negative and @s@ strictly positive.
retrievability :: Parameters -> Days -> Stability -> Retrievability
retrievability :: Parameters -> Double -> Double -> Double
retrievability Parameters
params Double
t Double
s = (Double
weight1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
weight1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight2)
  where
    cw :: CurveWeights
cw = Parameters -> CurveWeights
curveWeights Parameters
params
    tOverS :: Double
tOverS = Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s
    powerLaw :: Double -> Double -> Double
powerLaw Double
base Double
decay = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tOverS) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
decay
      where
        factor :: Double
factor = Double
base Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
decay) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
    r1 :: Double
r1 = Double -> Double -> Double
powerLaw (CurveWeights -> Double
cwBase1 CurveWeights
cw) (CurveWeights -> Double
cwDecay1 CurveWeights
cw)
    r2 :: Double
r2 = Double -> Double -> Double
powerLaw (CurveWeights -> Double
cwBase2 CurveWeights
cw) (CurveWeights -> Double
cwDecay2 CurveWeights
cw)
    weight1 :: Double
weight1 = CurveWeights -> Double
cwWeight1 CurveWeights
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double -> Double
forall a. Num a => a -> a
negate (CurveWeights -> Double
cwStabilityPower1 CurveWeights
cw)
    weight2 :: Double
weight2 = CurveWeights -> Double
cwWeight2 CurveWeights
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Floating a => a -> a -> a
** CurveWeights -> Double
cwStabilityPower2 CurveWeights
cw

-- | @d\/dt@ of 'retrievability'. Never positive for in-bounds parameters.
retrievabilityDerivative :: Parameters -> Days -> Stability -> Double
retrievabilityDerivative :: Parameters -> Double -> Double -> Double
retrievabilityDerivative Parameters
params Double
t Double
s =
  (Double
weight1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d2) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
weight1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight2)
  where
    cw :: CurveWeights
cw = Parameters -> CurveWeights
curveWeights Parameters
params
    tOverS :: Double
tOverS = Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s
    slope :: Double -> Double -> Double
slope Double
base Double
decay = Double
decay Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
inner Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
decay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
factor Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s)
      where
        factor :: Double
factor = Double
base Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
decay) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
        inner :: Double
inner = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
factor Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
tOverS
    d1 :: Double
d1 = Double -> Double -> Double
slope (CurveWeights -> Double
cwBase1 CurveWeights
cw) (CurveWeights -> Double
cwDecay1 CurveWeights
cw)
    d2 :: Double
d2 = Double -> Double -> Double
slope (CurveWeights -> Double
cwBase2 CurveWeights
cw) (CurveWeights -> Double
cwDecay2 CurveWeights
cw)
    weight1 :: Double
weight1 = CurveWeights -> Double
cwWeight1 CurveWeights
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double -> Double
forall a. Num a => a -> a
negate (CurveWeights -> Double
cwStabilityPower1 CurveWeights
cw)
    weight2 :: Double
weight2 = CurveWeights -> Double
cwWeight2 CurveWeights
cw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Floating a => a -> a -> a
** CurveWeights -> Double
cwStabilityPower2 CurveWeights
cw

-- | The interval, in days, after which a card of the given stability will have
-- decayed to exactly the desired retention.
--
-- The FSRS-7 forgetting curve has no closed-form inverse, so this is a
-- root-find: Newton's method in @log t@ (which is what makes the problem
-- well-conditioned — see the upstream @fsrs_v7_interval_penalty@ module),
-- safeguarded by a bracketing bisection so that it cannot diverge.
--
-- The result is always within @['minimumIntervalDays', 'maximumIntervalDays']@;
-- a desired retention that is unreachable within that window saturates at the
-- nearer end.
nextIntervalDays :: Parameters -> Retrievability -> Stability -> Days
nextIntervalDays :: Parameters -> Double -> Double -> Double
nextIntervalDays Parameters
params Double
target Double
s
  | Bool -> Bool
not (Double
target Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) = Double
maximumIntervalDays -- also catches NaN
  | Double
target Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Double
minimumIntervalDays
  | Parameters -> Double -> Double -> Double
retrievability Parameters
params Double
lo Double
s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
target = Double
lo
  | Parameters -> Double -> Double -> Double
retrievability Parameters
params Double
hi Double
s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
target = Double
hi
  | Bool
otherwise = Double -> Double
forall a. Floating a => a -> a
exp (Int -> Double -> Double -> Double -> Double
search (Int
0 :: Int) (Double -> Double
forall a. Floating a => a -> a
log Double
lo) (Double -> Double
forall a. Floating a => a -> a
log Double
hi) Double
u0)
  where
    lo :: Double
lo = Double
minimumIntervalDays
    hi :: Double
hi = Double
maximumIntervalDays
    -- R(s, s) is near the interesting range, so start there.
    u0 :: Double
u0 = Double -> Double -> Double -> Double
clampTo (Double -> Double
forall a. Floating a => a -> a
log Double
lo) (Double -> Double
forall a. Floating a => a -> a
log Double
hi) (Double -> Double
forall a. Floating a => a -> a
log Double
s)

    maxIterations :: Int
maxIterations = Int
200 :: Int
    -- Full double precision in log space.
    tolerance :: Double
tolerance = Double
1.0e-15

    search :: Int -> Double -> Double -> Double -> Double
search !Int
n !Double
a !Double
b !Double
u
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxIterations = Double
u
      | Double
fu Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Double
u
      | Bool
converged = Double
next
      | Bool
otherwise = Int -> Double -> Double -> Double -> Double
search (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Double
a' Double
b' Double
next
      where
        t :: Double
t = Double -> Double
forall a. Floating a => a -> a
exp Double
u
        fu :: Double
fu = Parameters -> Double -> Double -> Double
retrievability Parameters
params Double
t Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
target
        -- R is strictly decreasing in t, so the sign of `fu` says which side
        -- of the root `u` is on.
        (Double
a', Double
b') = if Double
fu Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then (Double
u, Double
b) else (Double
a, Double
u)
        slope :: Double
slope = Parameters -> Double -> Double -> Double
retrievabilityDerivative Parameters
params Double
t Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t
        newton :: Double
newton = Double
u Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fu Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
slope
        next :: Double
next
          | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
newton Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
newton Bool -> Bool -> Bool
|| Double
newton Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
a' Bool -> Bool -> Bool
|| Double
newton Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
b' =
              Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
a' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
b')
          | Bool
otherwise = Double
newton
        converged :: Bool
converged = Double -> Double
forall a. Num a => a -> a
abs (Double
next Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
u) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
tolerance Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Double -> Double
forall a. Num a => a -> a
abs Double
u)

-- ---------------------------------------------------------------------------
-- Difficulty
-- ---------------------------------------------------------------------------

-- | Difficulty before clamping. The mean reversion in 'nextDifficulty' pulls
-- towards the /unclamped/ value for 'Easy', which is why this is kept
-- separate.
rawInitialDifficulty :: Parameters -> Rating -> Double
rawInitialDifficulty :: Parameters -> Rating -> Double
rawInitialDifficulty Parameters
params Rating
rating =
  Parameters -> Double
initialDifficultyBase Parameters
params
    Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
exp (Parameters -> Double
initialDifficultyRate Parameters
params Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rating -> Int
ratingToInt Rating
rating Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
    Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1

-- | The difficulty a card is born with, given the rating of its first review.
initialDifficulty :: Parameters -> Rating -> Difficulty
initialDifficulty :: Parameters -> Rating -> Double
initialDifficulty Parameters
params =
  Double -> Double -> Double -> Double
clampTo Double
difficultyMin Double
difficultyMax (Double -> Double) -> (Rating -> Double) -> Rating -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameters -> Rating -> Double
rawInitialDifficulty Parameters
params

-- | Difficulty after a review: a rating-driven step, damped so that it slows
-- down as difficulty approaches its maximum, then reverted 1% of the way
-- towards the difficulty an 'Easy' first review would have produced.
nextDifficulty :: Parameters -> Difficulty -> Rating -> Difficulty
nextDifficulty :: Parameters -> Double -> Rating -> Double
nextDifficulty Parameters
params Double
d Rating
rating =
  Double -> Double -> Double -> Double
clampTo Double
difficultyMin Double
difficultyMax (Double -> Double
meanReversion Double
damped)
  where
    delta :: Double
delta = Double -> Double
forall a. Num a => a -> a
negate (Parameters -> Double
difficultyDelta Parameters
params) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rating -> Int
ratingToInt Rating
rating Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)
    damped :: Double
damped = Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
delta Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
10 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
9
    meanReversion :: Double -> Double
meanReversion Double
current = Double
0.01 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Parameters -> Rating -> Double
rawInitialDifficulty Parameters
params Rating
Easy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.99 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
current

-- ---------------------------------------------------------------------------
-- Stability
-- ---------------------------------------------------------------------------

-- | The stability a card is born with, given the rating of its first review.
initialStability :: Parameters -> Rating -> Stability
initialStability :: Parameters -> Rating -> Double
initialStability = Parameters -> Rating -> Double
initialStabilityWeight

-- | One half of the stability update.
--
-- Called twice per review — once with 'FSRS.Parameters.longTermWeights' and
-- once with 'FSRS.Parameters.shortTermWeights' — and the two results are
-- blended by 'nextStability'.
--
-- On a lapse the new stability is the post-lapse stability, which can never
-- exceed the old one. On a success it is the old stability scaled by a factor
-- that grows with how overdue the card was, shrinks as the card gets easier
-- and more stable, and is scaled again by the hard penalty or the easy bonus.
stabilityAfterReview
  :: StabilityWeights
  -> MemoryState
  -> Retrievability
  -- ^ The retrievability at review time, from 'retrievability'.
  -> Rating
  -> Stability
stabilityAfterReview :: StabilityWeights -> MemoryState -> Double -> Rating -> Double
stabilityAfterReview StabilityWeights
w (MemoryState Double
s Double
d) Double
r Rating
rating
  | Rating
rating Rating -> Rating -> Bool
forall a. Eq a => a -> a -> Bool
== Rating
Again = Double
postLapse
  | Bool
otherwise = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
postLapse (Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
increase)
  where
    postLapse :: Double
postLapse = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
s Double
failureStability
    failureStability :: Double
failureStability =
      StabilityWeights -> Double
swFailureFactor StabilityWeights
w
        Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double -> Double
forall a. Num a => a -> a
negate (StabilityWeights -> Double
swFailureDifficultyExponent StabilityWeights
w)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
* ((Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** StabilityWeights -> Double
swFailureStabilityExponent StabilityWeights
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
        Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp ((Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r) Double -> Double -> Double
forall a. Num a => a -> a -> a
* StabilityWeights -> Double
swFailureRetrievabilityFactor StabilityWeights
w)
    hardPenalty :: Double
hardPenalty = if Rating
rating Rating -> Rating -> Bool
forall a. Eq a => a -> a -> Bool
== Rating
Hard then StabilityWeights -> Double
swHardPenalty StabilityWeights
w else Double
1
    easyBonus :: Double
easyBonus = if Rating
rating Rating -> Rating -> Bool
forall a. Eq a => a -> a -> Bool
== Rating
Easy then StabilityWeights -> Double
swEasyBonus StabilityWeights
w else Double
1
    increase :: Double
increase =
      Double
1
        Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
exp (StabilityWeights -> Double
swIncreaseBase StabilityWeights
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1.5)
          Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
11 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
d)
          Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double -> Double
forall a. Num a => a -> a
negate (StabilityWeights -> Double
swIncreaseStabilityExponent StabilityWeights
w)
          Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Floating a => a -> a
exp ((Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r) Double -> Double -> Double
forall a. Num a => a -> a -> a
* StabilityWeights -> Double
swIncreaseRetrievabilityFactor StabilityWeights
w) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
          Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hardPenalty
          Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
easyBonus

-- | How much of a long-term review this is: @0@ for a review that happens at
-- the same instant as the previous one, tending to @1@ as the gap grows.
--
-- This is the piece that replaces FSRS-6's hard same-day\/not-same-day split.
-- The elapsed time is expected to be non-negative.
transitionCoefficient :: Parameters -> Days -> Double
transitionCoefficient :: Parameters -> Double -> Double
transitionCoefficient Parameters
params Double
deltaT =
  Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Parameters -> Double
transitionAmplitude Parameters
params Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
exp (Double -> Double
forall a. Num a => a -> a
negate (Parameters -> Double
transitionRate Parameters
params) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
deltaT)

-- | Stability after a review, blending the long- and short-term updates.
nextStability
  :: Parameters
  -> MemoryState
  -> Days
  -- ^ Days since the previous review.
  -> Rating
  -> Stability
nextStability :: Parameters -> MemoryState -> Double -> Rating -> Double
nextStability Parameters
params MemoryState
state Double
deltaT Rating
rating =
  Double
coefficient Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
longTerm Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
coefficient) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
shortTerm
  where
    r :: Double
r = Parameters -> Double -> Double -> Double
retrievability Parameters
params Double
deltaT (MemoryState -> Double
memoryStability MemoryState
state)
    longTerm :: Double
longTerm = StabilityWeights -> MemoryState -> Double -> Rating -> Double
stabilityAfterReview (Parameters -> StabilityWeights
longTermWeights Parameters
params) MemoryState
state Double
r Rating
rating
    shortTerm :: Double
shortTerm = StabilityWeights -> MemoryState -> Double -> Rating -> Double
stabilityAfterReview (Parameters -> StabilityWeights
shortTermWeights Parameters
params) MemoryState
state Double
r Rating
rating
    coefficient :: Double
coefficient = Parameters -> Double -> Double
transitionCoefficient Parameters
params Double
deltaT

-- ---------------------------------------------------------------------------
-- State transition
-- ---------------------------------------------------------------------------

-- | Advance a card's memory state by one review.
--
-- Pass 'Nothing' for a card that has never been reviewed; the elapsed time is
-- then ignored and the state is read straight off the initial-stability and
-- initial-difficulty weights.
nextMemoryState
  :: Parameters
  -> Maybe MemoryState
  -- ^ The state before the review, or 'Nothing' for a brand-new card.
  -> Days
  -- ^ Days since the previous review.
  -> Rating
  -> MemoryState
nextMemoryState :: Parameters -> Maybe MemoryState -> Double -> Rating -> MemoryState
nextMemoryState Parameters
params Maybe MemoryState
before Double
deltaT Rating
rating =
  MemoryState
    { memoryStability :: Double
memoryStability = Double -> Double -> Double -> Double
clampTo Double
stabilityMin Double
stabilityMax Double
s
    , memoryDifficulty :: Double
memoryDifficulty = Double -> Double -> Double -> Double
clampTo Double
difficultyMin Double
difficultyMax Double
d
    }
  where
    (Double
s, Double
d) = case Maybe MemoryState
before of
      Maybe MemoryState
Nothing ->
        ( Parameters -> Rating -> Double
initialStability Parameters
params Rating
rating
        , Parameters -> Rating -> Double
initialDifficulty Parameters
params Rating
rating
        )
      Just MemoryState
state ->
        ( Parameters -> MemoryState -> Double -> Rating -> Double
nextStability Parameters
params MemoryState
state Double
deltaT Rating
rating
        , Parameters -> Double -> Rating -> Double
nextDifficulty Parameters
params (MemoryState -> Double
memoryDifficulty MemoryState
state) Rating
rating
        )

-- | Fold a whole review history into a memory state.
--
-- Each element is @(days since the previous review, rating)@; the elapsed time
-- of the first review is ignored. 'Nothing' for an empty history.
replayReviews :: Parameters -> [(Days, Rating)] -> Maybe MemoryState
replayReviews :: Parameters -> [(Double, Rating)] -> Maybe MemoryState
replayReviews Parameters
params = Maybe MemoryState -> [(Double, Rating)] -> Maybe MemoryState
go Maybe MemoryState
forall a. Maybe a
Nothing
  where
    go :: Maybe MemoryState -> [(Double, Rating)] -> Maybe MemoryState
go Maybe MemoryState
before [] = Maybe MemoryState
before
    go Maybe MemoryState
before ((Double
deltaT, Rating
rating) : [(Double, Rating)]
rest) =
      let next :: MemoryState
next = Parameters -> Maybe MemoryState -> Double -> Rating -> MemoryState
nextMemoryState Parameters
params Maybe MemoryState
before Double
deltaT Rating
rating
       in MemoryState
next MemoryState -> Maybe MemoryState -> Maybe MemoryState
forall a b. a -> b -> b
`seq` Maybe MemoryState -> [(Double, Rating)] -> Maybe MemoryState
go (MemoryState -> Maybe MemoryState
forall a. a -> Maybe a
Just MemoryState
next) [(Double, Rating)]
rest