{-# LANGUAGE DerivingStrategies #-}

-- | The 35 weights of FSRS-7, and typed views onto the blocks they form.
--
-- FSRS-7 groups its weights like this:
--
-- +-----------+------------------------------------------------------------+
-- | @w0..w3@  | initial stability, indexed by rating                       |
-- +-----------+------------------------------------------------------------+
-- | @w4..w6@  | difficulty                                                 |
-- +-----------+------------------------------------------------------------+
-- | @w7..w15@ | stability update, long-term block                          |
-- +-----------+------------------------------------------------------------+
-- | @w16..w24@| stability update, short-term (same-day) block              |
-- +-----------+------------------------------------------------------------+
-- | @w25,w26@ | the long-\/short-term transition function                   |
-- +-----------+------------------------------------------------------------+
-- | @w27..w34@| the two-component forgetting curve                         |
-- +-----------+------------------------------------------------------------+
--
-- The two stability blocks have identical shapes, which is why
-- 'longTermWeights' and 'shortTermWeights' both produce a t'StabilityWeights'.
module FSRS.Parameters
  ( -- * Parameters
    Parameters
  , parameterCount
  , defaultParameters
  , mkParameters
  , clampParameters
  , parametersToList
  , parameterAt

    -- * Validation
  , ParameterError (..)
  , parameterBounds
  , validateParameters

    -- * Weight blocks
  , initialStabilityWeight
  , initialDifficultyBase
  , initialDifficultyRate
  , difficultyDelta
  , transitionRate
  , transitionAmplitude
  , StabilityWeights (..)
  , longTermWeights
  , shortTermWeights
  , CurveWeights (..)
  , curveWeights
  ) where

import Data.Array.Unboxed (UArray, bounds, elems, listArray, (!))
import Data.Maybe (mapMaybe)

import FSRS.Types (Rating, ratingToInt)

-- | An FSRS-7 parameter vector: exactly 'parameterCount' weights.
--
-- Build one with 'mkParameters' or 'clampParameters'; the constructor is
-- hidden so that the length invariant cannot be broken.
newtype Parameters = Parameters (UArray Int Double)
  deriving stock (Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
/= :: Parameters -> Parameters -> Bool
Eq, Eq Parameters
Eq Parameters =>
(Parameters -> Parameters -> Ordering)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Parameters)
-> (Parameters -> Parameters -> Parameters)
-> Ord Parameters
Parameters -> Parameters -> Bool
Parameters -> Parameters -> Ordering
Parameters -> Parameters -> Parameters
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Parameters -> Parameters -> Ordering
compare :: Parameters -> Parameters -> Ordering
$c< :: Parameters -> Parameters -> Bool
< :: Parameters -> Parameters -> Bool
$c<= :: Parameters -> Parameters -> Bool
<= :: Parameters -> Parameters -> Bool
$c> :: Parameters -> Parameters -> Bool
> :: Parameters -> Parameters -> Bool
$c>= :: Parameters -> Parameters -> Bool
>= :: Parameters -> Parameters -> Bool
$cmax :: Parameters -> Parameters -> Parameters
max :: Parameters -> Parameters -> Parameters
$cmin :: Parameters -> Parameters -> Parameters
min :: Parameters -> Parameters -> Parameters
Ord)

instance Show Parameters where
  showsPrec :: Int -> Parameters -> ShowS
showsPrec Int
d Parameters
p =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"mkParameters " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Double] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Parameters -> [Double]
parametersToList Parameters
p)

-- | @35@. FSRS-6 had 21 weights; FSRS-7 adds a second stability block, the
-- transition function and the six extra forgetting-curve weights.
parameterCount :: Int
parameterCount :: Int
parameterCount = Int
35

-- | The 0-based weight at the given index. Indices outside
-- @[0, 'parameterCount')@ are a programmer error and raise an exception.
parameterAt :: Parameters -> Int -> Double
parameterAt :: Parameters -> Int -> Double
parameterAt (Parameters UArray Int Double
a) Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lo Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hi = UArray Int Double
a UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
i
  | Bool
otherwise =
      [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$
        [Char]
"FSRS.Parameters.parameterAt: index " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" out of range " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
lo, Int
hi)
  where
    (Int
lo, Int
hi) = UArray Int Double -> (Int, Int)
forall i. Ix i => UArray i Double -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Double
a

-- | The weights as a plain list, in index order.
parametersToList :: Parameters -> [Double]
parametersToList :: Parameters -> [Double]
parametersToList (Parameters UArray Int Double
a) = UArray Int Double -> [Double]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Double
a

-- | The default FSRS-7 parameters, obtained by the upstream authors through
-- multi-user optimisation.
--
-- These match @models\/fsrs_v7.py@ in
-- <https://github.com/open-spaced-repetition/srs-benchmark srs-benchmark>.
-- Note that the @Default Parameters@ section of that repository's README still
-- lists @1.15@ for @w15@ and @w24@; that block of the README has not been
-- updated since 2026-03-18, while the model was changed to @1.3@ three days
-- later. The values below follow the model.
defaultParameters :: Parameters
defaultParameters :: Parameters
defaultParameters = UArray Int Double -> Parameters
Parameters ((Int, Int) -> [Double] -> UArray Int Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
parameterCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Double]
ws)
  where
    ws :: [Double]
ws =
      [ -- Initial stability, indexed by rating - 1
        Double
0.041
      , Double
2.4175
      , Double
4.1283
      , Double
11.9709
      , -- Difficulty
        Double
5.6385
      , Double
0.4468
      , Double
3.262
      , -- Stability, long-term block
        Double
2.3054
      , Double
0.1688
      , Double
1.3325
      , Double
0.3524
      , Double
0.0049
      , Double
0.7503
      , Double
0.0896
      , Double
0.6625
      , Double
1.3
      , -- Stability, short-term block
        Double
0.882
      , Double
0.3072
      , Double
3.5875
      , Double
0.303
      , Double
0.0107
      , Double
0.2279
      , Double
2.6413
      , Double
0.5594
      , Double
1.3
      , -- Long-/short-term transition function
        Double
2.5
      , Double
1.0
      , -- Forgetting curve
        Double
0.0723
      , Double
0.1634
      , Double
0.5
      , Double
0.9555
      , Double
0.2245
      , Double
0.6232
      , Double
0.1362
      , Double
0.3862
      ]

-- | Why a list of weights is not a valid parameter vector.
data ParameterError
  = -- | Got this many weights instead of 'parameterCount'.
    WrongParameterCount !Int
  | -- | @index@, @value@, @lower bound@, @upper bound@.
    ParameterOutOfBounds !Int !Double !Double !Double
  | -- | @w[i] <= w[j]@ is required but was violated: @i@, @j@, @w[i]@, @w[j]@.
    ParameterOutOfOrder !Int !Int !Double !Double
  | -- | @index@, the offending @NaN@ or infinity.
    ParameterNotFinite !Int !Double
  deriving stock (ParameterError -> ParameterError -> Bool
(ParameterError -> ParameterError -> Bool)
-> (ParameterError -> ParameterError -> Bool) -> Eq ParameterError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParameterError -> ParameterError -> Bool
== :: ParameterError -> ParameterError -> Bool
$c/= :: ParameterError -> ParameterError -> Bool
/= :: ParameterError -> ParameterError -> Bool
Eq, Int -> ParameterError -> ShowS
[ParameterError] -> ShowS
ParameterError -> [Char]
(Int -> ParameterError -> ShowS)
-> (ParameterError -> [Char])
-> ([ParameterError] -> ShowS)
-> Show ParameterError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParameterError -> ShowS
showsPrec :: Int -> ParameterError -> ShowS
$cshow :: ParameterError -> [Char]
show :: ParameterError -> [Char]
$cshowList :: [ParameterError] -> ShowS
showList :: [ParameterError] -> ShowS
Show)

-- | The inclusive @(lower, upper)@ bound of every weight, in index order.
--
-- Taken from the parameter clipper the upstream optimiser applies after each
-- gradient step, so any parameter set produced by a real optimiser satisfies
-- them.
parameterBounds :: [(Double, Double)]
parameterBounds :: [(Double, Double)]
parameterBounds =
  [ -- Initial stability
    (Double
1.0e-4, Double
50.0)
  , (Double
1.0e-4, Double
100.0)
  , (Double
1.0e-4, Double
100.0)
  , (Double
1.0e-4, Double
100.0)
  , -- Difficulty
    (Double
1.0, Double
10.0)
  , (Double
0.001, Double
4.0)
  , (Double
0.1, Double
4.0)
  , -- Stability, long-term block
    (Double
0.0, Double
4.0)
  , (Double
0.0, Double
1.2)
  , (Double
0.3, Double
3.0)
  , (Double
0.01, Double
1.5)
  , (Double
0.001, Double
0.9)
  , (Double
0.1, Double
1.0)
  , (Double
0.0, Double
3.5)
  , (Double
0.0, Double
1.0)
  , (Double
1.0, Double
7.0)
  , -- Stability, short-term block
    (Double
0.0, Double
4.0)
  , (Double
0.0, Double
2.0)
  , (Double
0.5, Double
6.0)
  , (Double
0.001, Double
1.5)
  , (Double
0.001, Double
2.0)
  , (Double
0.001, Double
1.0)
  , (Double
0.0, Double
5.0)
  , (Double
0.0, Double
1.0)
  , (Double
1.0, Double
7.0)
  , -- Transition function
    (Double
2.5, Double
15.0)
  , (Double
0.0, Double
1.0)
  , -- Forgetting curve
    (Double
0.01, Double
0.25)
  , (Double
0.01, Double
0.95)
  , (Double
0.5, Double
0.85)
  , (Double
0.5, Double
0.99)
  , (Double
0.01, Double
1.0)
  , (Double
0.1, Double
1.0)
  , (Double
0.0, Double
0.9)
  , (Double
0.1, Double
1.1)
  ]

-- | Pairs @(i, j)@ for which @w[i] <= w[j]@ must hold.
orderingConstraints :: [(Int, Int)]
orderingConstraints :: [(Int, Int)]
orderingConstraints = [(Int
0, Int
1), (Int
1, Int
2), (Int
2, Int
3), (Int
27, Int
28), (Int
29, Int
30)]

-- | Every problem with a candidate weight list, or @[]@ if there is none.
validateParameters :: [Double] -> [ParameterError]
validateParameters :: [Double] -> [ParameterError]
validateParameters [Double]
ws
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
parameterCount = [Int -> ParameterError
WrongParameterCount Int
n]
  | Bool
otherwise = [ParameterError]
boundErrors [ParameterError] -> [ParameterError] -> [ParameterError]
forall a. Semigroup a => a -> a -> a
<> [ParameterError]
orderErrors
  where
    n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ws
    boundErrors :: [ParameterError]
boundErrors = [[ParameterError]] -> [ParameterError]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> Double -> (Double, Double) -> [ParameterError])
-> [Int] -> [Double] -> [(Double, Double)] -> [[ParameterError]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Int -> Double -> (Double, Double) -> [ParameterError]
check [Int
0 ..] [Double]
ws [(Double, Double)]
parameterBounds)
    check :: Int -> Double -> (Double, Double) -> [ParameterError]
check Int
i Double
w (Double
lo, Double
hi)
      | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
w Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
w = [Int -> Double -> ParameterError
ParameterNotFinite Int
i Double
w]
      | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
lo Bool -> Bool -> Bool
|| Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
hi = [Int -> Double -> Double -> Double -> ParameterError
ParameterOutOfBounds Int
i Double
w Double
lo Double
hi]
      | Bool
otherwise = []
    orderErrors :: [ParameterError]
orderErrors = ((Int, Int) -> Maybe ParameterError)
-> [(Int, Int)] -> [ParameterError]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, Int) -> Maybe ParameterError
checkOrder [(Int, Int)]
orderingConstraints
    checkOrder :: (Int, Int) -> Maybe ParameterError
checkOrder (Int
i, Int
j)
      | Double
wi Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
wj = Maybe ParameterError
forall a. Maybe a
Nothing
      | Bool
otherwise = ParameterError -> Maybe ParameterError
forall a. a -> Maybe a
Just (Int -> Int -> Double -> Double -> ParameterError
ParameterOutOfOrder Int
i Int
j Double
wi Double
wj)
      where
        wi :: Double
wi = [Double]
ws [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
        wj :: Double
wj = [Double]
ws [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
j

-- | Build a parameter vector, rejecting anything out of bounds.
mkParameters :: [Double] -> Either [ParameterError] Parameters
mkParameters :: [Double] -> Either [ParameterError] Parameters
mkParameters [Double]
ws = case [Double] -> [ParameterError]
validateParameters [Double]
ws of
  [] -> Parameters -> Either [ParameterError] Parameters
forall a b. b -> Either a b
Right (UArray Int Double -> Parameters
Parameters ((Int, Int) -> [Double] -> UArray Int Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
parameterCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Double]
ws))
  [ParameterError]
errs -> [ParameterError] -> Either [ParameterError] Parameters
forall a b. a -> Either a b
Left [ParameterError]
errs

-- | Build a parameter vector by pulling every weight into its valid range,
-- exactly as the upstream optimiser's clipper does: bounds first, in index
-- order, so that the ordering constraints are resolved against already-clamped
-- neighbours. Only a wrong number of weights can still fail.
clampParameters :: [Double] -> Either [ParameterError] Parameters
clampParameters :: [Double] -> Either [ParameterError] Parameters
clampParameters [Double]
ws
  | [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ws Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
parameterCount = [ParameterError] -> Either [ParameterError] Parameters
forall a b. a -> Either a b
Left [Int -> ParameterError
WrongParameterCount ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
ws)]
  | Bool
otherwise = Parameters -> Either [ParameterError] Parameters
forall a b. b -> Either a b
Right (UArray Int Double -> Parameters
Parameters ((Int, Int) -> [Double] -> UArray Int Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
parameterCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Double]
clamped))
  where
    clamped :: [Double]
clamped = ([Double] -> (Int, Double, (Double, Double)) -> [Double])
-> [Double] -> [(Int, Double, (Double, Double))] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Double] -> (Int, Double, (Double, Double)) -> [Double]
forall {a}. RealFloat a => [a] -> (Int, a, (a, a)) -> [a]
step [] ([Int]
-> [Double]
-> [(Double, Double)]
-> [(Int, Double, (Double, Double))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 :: Int ..] [Double]
ws [(Double, Double)]
parameterBounds)
    -- `acc` is the already-clamped prefix, in order.
    step :: [a] -> (Int, a, (a, a)) -> [a]
step [a]
acc (Int
i, a
w, (a
lo, a
hi)) = [a]
acc [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a -> a -> a -> a
forall {p}. RealFloat p => p -> p -> p -> p
clamp a
lo' a
hi' a
w]
      where
        lo' :: a
lo' = [a] -> a
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (a
lo a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]
acc [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
j | (Int
j, Int
k) <- [(Int, Int)]
orderingConstraints, Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i])
        hi' :: a
hi' = a -> a -> a
forall a. Ord a => a -> a -> a
max a
lo' a
hi
    clamp :: p -> p -> p -> p
clamp p
lo p
hi p
x
      | p -> Bool
forall a. RealFloat a => a -> Bool
isNaN p
x = p
lo
      | Bool
otherwise = p -> p -> p
forall a. Ord a => a -> a -> a
min p
hi (p -> p -> p
forall a. Ord a => a -> a -> a
max p
lo p
x)

-- | @w[rating - 1]@: the stability a card is born with after its first review.
initialStabilityWeight :: Parameters -> Rating -> Double
initialStabilityWeight :: Parameters -> Rating -> Double
initialStabilityWeight Parameters
p Rating
r = Parameters -> Int -> Double
parameterAt Parameters
p (Rating -> Int
ratingToInt Rating
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | @w4@.
initialDifficultyBase :: Parameters -> Double
initialDifficultyBase :: Parameters -> Double
initialDifficultyBase Parameters
p = Parameters -> Int -> Double
parameterAt Parameters
p Int
4

-- | @w5@.
initialDifficultyRate :: Parameters -> Double
initialDifficultyRate :: Parameters -> Double
initialDifficultyRate Parameters
p = Parameters -> Int -> Double
parameterAt Parameters
p Int
5

-- | @w6@.
difficultyDelta :: Parameters -> Double
difficultyDelta :: Parameters -> Double
difficultyDelta Parameters
p = Parameters -> Int -> Double
parameterAt Parameters
p Int
6

-- | @w25@: how fast a review stops counting as same-day.
transitionRate :: Parameters -> Double
transitionRate :: Parameters -> Double
transitionRate Parameters
p = Parameters -> Int -> Double
parameterAt Parameters
p Int
25

-- | @w26@: how much of the short-term behaviour applies at zero elapsed time.
transitionAmplitude :: Parameters -> Double
transitionAmplitude :: Parameters -> Double
transitionAmplitude Parameters
p = Parameters -> Int -> Double
parameterAt Parameters
p Int
26

-- | One of the two nine-weight blocks that drive the stability update.
data StabilityWeights = StabilityWeights
  { StabilityWeights -> Double
swIncreaseBase :: !Double
  -- ^ @w7@ \/ @w16@, used as @exp (base - 1.5)@.
  , StabilityWeights -> Double
swIncreaseStabilityExponent :: !Double
  -- ^ @w8@ \/ @w17@.
  , StabilityWeights -> Double
swIncreaseRetrievabilityFactor :: !Double
  -- ^ @w9@ \/ @w18@.
  , StabilityWeights -> Double
swFailureFactor :: !Double
  -- ^ @w10@ \/ @w19@.
  , StabilityWeights -> Double
swFailureDifficultyExponent :: !Double
  -- ^ @w11@ \/ @w20@.
  , StabilityWeights -> Double
swFailureStabilityExponent :: !Double
  -- ^ @w12@ \/ @w21@.
  , StabilityWeights -> Double
swFailureRetrievabilityFactor :: !Double
  -- ^ @w13@ \/ @w22@.
  , StabilityWeights -> Double
swHardPenalty :: !Double
  -- ^ @w14@ \/ @w23@.
  , StabilityWeights -> Double
swEasyBonus :: !Double
  -- ^ @w15@ \/ @w24@.
  }
  deriving stock (StabilityWeights -> StabilityWeights -> Bool
(StabilityWeights -> StabilityWeights -> Bool)
-> (StabilityWeights -> StabilityWeights -> Bool)
-> Eq StabilityWeights
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StabilityWeights -> StabilityWeights -> Bool
== :: StabilityWeights -> StabilityWeights -> Bool
$c/= :: StabilityWeights -> StabilityWeights -> Bool
/= :: StabilityWeights -> StabilityWeights -> Bool
Eq, Int -> StabilityWeights -> ShowS
[StabilityWeights] -> ShowS
StabilityWeights -> [Char]
(Int -> StabilityWeights -> ShowS)
-> (StabilityWeights -> [Char])
-> ([StabilityWeights] -> ShowS)
-> Show StabilityWeights
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StabilityWeights -> ShowS
showsPrec :: Int -> StabilityWeights -> ShowS
$cshow :: StabilityWeights -> [Char]
show :: StabilityWeights -> [Char]
$cshowList :: [StabilityWeights] -> ShowS
showList :: [StabilityWeights] -> ShowS
Show)

stabilityWeightsAt :: Int -> Parameters -> StabilityWeights
stabilityWeightsAt :: Int -> Parameters -> StabilityWeights
stabilityWeightsAt Int
base Parameters
p =
  StabilityWeights
    { swIncreaseBase :: Double
swIncreaseBase = Int -> Double
at Int
0
    , swIncreaseStabilityExponent :: Double
swIncreaseStabilityExponent = Int -> Double
at Int
1
    , swIncreaseRetrievabilityFactor :: Double
swIncreaseRetrievabilityFactor = Int -> Double
at Int
2
    , swFailureFactor :: Double
swFailureFactor = Int -> Double
at Int
3
    , swFailureDifficultyExponent :: Double
swFailureDifficultyExponent = Int -> Double
at Int
4
    , swFailureStabilityExponent :: Double
swFailureStabilityExponent = Int -> Double
at Int
5
    , swFailureRetrievabilityFactor :: Double
swFailureRetrievabilityFactor = Int -> Double
at Int
6
    , swHardPenalty :: Double
swHardPenalty = Int -> Double
at Int
7
    , swEasyBonus :: Double
swEasyBonus = Int -> Double
at Int
8
    }
  where
    at :: Int -> Double
at Int
k = Parameters -> Int -> Double
parameterAt Parameters
p (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k)

-- | @w7..w15@: the block used for reviews separated by a real interval.
longTermWeights :: Parameters -> StabilityWeights
longTermWeights :: Parameters -> StabilityWeights
longTermWeights = Int -> Parameters -> StabilityWeights
stabilityWeightsAt Int
7

-- | @w16..w24@: the block used for same-day reviews.
shortTermWeights :: Parameters -> StabilityWeights
shortTermWeights :: Parameters -> StabilityWeights
shortTermWeights = Int -> Parameters -> StabilityWeights
stabilityWeightsAt Int
16

-- | @w27..w34@: the mixture of two power laws that makes up the FSRS-7
-- forgetting curve.
data CurveWeights = CurveWeights
  { CurveWeights -> Double
cwDecay1 :: !Double
  -- ^ @negate w27@ — already carries the minus sign the formula wants.
  , CurveWeights -> Double
cwDecay2 :: !Double
  -- ^ @negate w28@.
  , CurveWeights -> Double
cwBase1 :: !Double
  -- ^ @w29@: the recall probability of the first component at @t == s@.
  , CurveWeights -> Double
cwBase2 :: !Double
  -- ^ @w30@: likewise for the second component.
  , CurveWeights -> Double
cwWeight1 :: !Double
  -- ^ @w31@.
  , CurveWeights -> Double
cwWeight2 :: !Double
  -- ^ @w32@.
  , CurveWeights -> Double
cwStabilityPower1 :: !Double
  -- ^ @w33@; applied as @s ** negate cwStabilityPower1@.
  , CurveWeights -> Double
cwStabilityPower2 :: !Double
  -- ^ @w34@; applied as @s ** cwStabilityPower2@.
  }
  deriving stock (CurveWeights -> CurveWeights -> Bool
(CurveWeights -> CurveWeights -> Bool)
-> (CurveWeights -> CurveWeights -> Bool) -> Eq CurveWeights
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurveWeights -> CurveWeights -> Bool
== :: CurveWeights -> CurveWeights -> Bool
$c/= :: CurveWeights -> CurveWeights -> Bool
/= :: CurveWeights -> CurveWeights -> Bool
Eq, Int -> CurveWeights -> ShowS
[CurveWeights] -> ShowS
CurveWeights -> [Char]
(Int -> CurveWeights -> ShowS)
-> (CurveWeights -> [Char])
-> ([CurveWeights] -> ShowS)
-> Show CurveWeights
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurveWeights -> ShowS
showsPrec :: Int -> CurveWeights -> ShowS
$cshow :: CurveWeights -> [Char]
show :: CurveWeights -> [Char]
$cshowList :: [CurveWeights] -> ShowS
showList :: [CurveWeights] -> ShowS
Show)

-- | Read the forgetting-curve block out of a parameter vector.
curveWeights :: Parameters -> CurveWeights
curveWeights :: Parameters -> CurveWeights
curveWeights Parameters
p =
  CurveWeights
    { cwDecay1 :: Double
cwDecay1 = Double -> Double
forall a. Num a => a -> a
negate (Parameters -> Int -> Double
parameterAt Parameters
p Int
27)
    , cwDecay2 :: Double
cwDecay2 = Double -> Double
forall a. Num a => a -> a
negate (Parameters -> Int -> Double
parameterAt Parameters
p Int
28)
    , cwBase1 :: Double
cwBase1 = Parameters -> Int -> Double
parameterAt Parameters
p Int
29
    , cwBase2 :: Double
cwBase2 = Parameters -> Int -> Double
parameterAt Parameters
p Int
30
    , cwWeight1 :: Double
cwWeight1 = Parameters -> Int -> Double
parameterAt Parameters
p Int
31
    , cwWeight2 :: Double
cwWeight2 = Parameters -> Int -> Double
parameterAt Parameters
p Int
32
    , cwStabilityPower1 :: Double
cwStabilityPower1 = Parameters -> Int -> Double
parameterAt Parameters
p Int
33
    , cwStabilityPower2 :: Double
cwStabilityPower2 = Parameters -> Int -> Double
parameterAt Parameters
p Int
34
    }