├── lisp-fsrs.asd ├── LICENSE ├── README.org ├── emacs.lisp ├── test └── package.lisp ├── package.lisp └── fsrs.el /lisp-fsrs.asd: -------------------------------------------------------------------------------- 1 | (defsystem lisp-fsrs 2 | :version "6.0" 3 | :author "Bohong Huang " 4 | :maintainer "Bohong Huang " 5 | :license "MIT" 6 | :homepage "https://github.com/open-spaced-repetition/lisp-fsrs" 7 | :bug-tracker "https://github.com/open-spaced-repetition/lisp-fsrs/issues" 8 | :source-control (:git "https://github.com/open-spaced-repetition/lisp-fsrs.git") 9 | :depends-on (#:alexandria #:local-time) 10 | :components ((:file "package")) 11 | :in-order-to ((test-op (test-op #:lisp-fsrs/test)))) 12 | 13 | (defsystem lisp-fsrs/emacs 14 | :depends-on (#:asdf #:uiop #:alexandria #:local-time #:slynk #:introspect-environment #:str #:lisp-fsrs) 15 | :components ((:file "emacs"))) 16 | 17 | (defsystem lisp-fsrs/test 18 | :depends-on (#:parachute #:closer-mop #:lisp-fsrs) 19 | :perform (test-op (op c) (symbol-call '#:parachute '#:test (find-symbol (symbol-name '#:test-lisp-fsrs) '#:lisp-fsrs.test))) 20 | :pathname "test/" 21 | :components ((:file "package"))) 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022-2024 Open Spaced Repetition 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: LISP-FSRS 2 | 3 | [[https://melpa.org/#/fsrs][file:https://melpa.org/packages/fsrs-badge.svg]] 4 | 5 | Implementation of the FSRS algorithm in Common Lisp and auto-transpiled to Emacs Lisp. 6 | * Usage 7 | ** Common Lisp 8 | #+BEGIN_SRC lisp 9 | CL-USER> (ql:quickload :lisp-fsrs) ; Ensure you have cloned this repository into the `local-projects' directory under your Quicklisp installation root. 10 | To load "lisp-fsrs": 11 | Load 1 ASDF system: 12 | lisp-fsrs 13 | ; Loading "lisp-fsrs" 14 | (:LISP-FSRS) 15 | CL-USER> (defparameter *parameters* (coerce '(0.2172 1.1771 3.2602 16.1507 7.0114 0.57 2.0966 0.0069 1.5261 0.112 1.0178 1.849 0.1133 0.3127 2.2934 0.2191 3.0004 0.7536 0.3332 0.1437 0.2) 'fsrs:parameters)) 16 | ,*PARAMETERS* 17 | CL-USER> (defparameter *scheduler* (fsrs:make-scheduler :parameters *parameters*)) 18 | ,*SCHEDULER* 19 | CL-USER> (defparameter *card* (fsrs:make-card)) 20 | ,*CARD* 21 | CL-USER> *card* 22 | #S(LISP-FSRS:CARD 23 | :CARD-ID 0 24 | :STATE :LEARNING 25 | :STEP 0 26 | :STABILITY NIL 27 | :DIFFICULTY NIL 28 | :DUE @2025-06-08T13:39:42.230941+08:00 29 | :LAST-REVIEW NIL) 30 | CL-USER> (setf *card* (fsrs:scheduler-review-card *scheduler* *card* :good)) 31 | #S(LISP-FSRS:CARD 32 | :CARD-ID 0 33 | :STATE :LEARNING 34 | :STEP 1 35 | :STABILITY 3.2602 36 | :DIFFICULTY 4.884632 37 | :DUE @2025-06-08T13:49:49.476969+08:00 38 | :LAST-REVIEW @2025-06-08T13:39:49.476969+08:00) 39 | CL-USER> (setf *card* (fsrs:scheduler-review-card *scheduler* *card* :good)) 40 | #S(LISP-FSRS:CARD 41 | :CARD-ID 0 42 | :STATE :REVIEW 43 | :STEP NIL 44 | :STABILITY 3.5362437 45 | :DIFFICULTY 4.8680573 46 | :DUE @2025-06-12T13:39:50.242969+08:00 47 | :LAST-REVIEW @2025-06-08T13:39:50.242969+08:00) 48 | #+END_SRC 49 | 50 | To generate the ~fsrs~ package for Emacs after changing the code, ensure 51 | you are running the current Lisp session using ~sly~ in Emacs, then: 52 | 53 | #+BEGIN_SRC lisp 54 | CL-USER> (ql:quickload :lisp-fsrs/emacs) 55 | To load "lisp-fsrs/emacs": 56 | Load 1 ASDF system: 57 | lisp-fsrs/emacs 58 | ; Loading "lisp-fsrs/emacs" 59 | [package lisp-fsrs.emacs].. 60 | (:LISP-FSRS/EMACS) 61 | CL-USER> (fsrs.emacs:translate-system) 62 | NIL 63 | #+END_SRC 64 | ** Emacs Lisp 65 | #+BEGIN_SRC emacs-lisp 66 | ELISP> (package-vc-install "https://github.com/open-spaced-repetition/lisp-fsrs.git") 67 | t 68 | ELISP> (setq fsrs-parameters [0.2172 1.1771 3.2602 16.1507 7.0114 0.57 2.0966 0.0069 1.5261 0.112 1.0178 1.849 0.1133 0.3127 2.2934 0.2191 3.0004 0.7536 0.3332 0.1437 0.2]) 69 | [0.2172 1.1771 3.2602 16.1507 7.0114 0.57 2.0966 0.0069 1.5261 0.112 70 | 1.0178 1.849 0.1133 0.3127 2.2934 0.2191 3.0004 0.7536 0.3332 71 | 0.1437 0.2] 72 | 73 | ELISP> (setq fsrs-scheduler (fsrs-make-scheduler)) 74 | #s(fsrs-scheduler :parameters 75 | [0.2172 1.1771 3.2602 16.1507 7.0114 0.57 2.0966 76 | 0.0069 1.5261 0.112 1.0178 1.849 0.1133 77 | 0.3127 2.2934 0.2191 3.0004 0.7536 0.3332 78 | 0.1437 0.2] 79 | :desired-retention 0.9 :learning-steps 80 | ((1 :minute) (10 :minute)) :relearning-steps 81 | ((10 :minute)) :maximum-interval (36500 :day) 82 | :enable-fuzzing-p t) 83 | 84 | ELISP> (setq fsrs-card (fsrs-make-card)) 85 | #s(fsrs-card :card-id 0 :state :learning :step 0 :stability nil 86 | :difficulty nil :due "2025-06-08T05:38:50Z" :last-review 87 | nil) 88 | 89 | ELISP> (setq fsrs-card (cl-nth-value 0 (fsrs-scheduler-review-card fsrs-scheduler fsrs-card :good))) 90 | #s(fsrs-card :card-id 0 :state :learning :step 1 :stability 3.2602 91 | :difficulty 4.884631634813845 :due "2025-06-08T05:48:52Z" 92 | :last-review "2025-06-08T05:38:52Z") 93 | 94 | ELISP> (setq fsrs-card (cl-nth-value 0 (fsrs-scheduler-review-card fsrs-scheduler fsrs-card :good))) 95 | #s(fsrs-card :card-id 0 :state :review :step nil :stability 96 | 3.536243655619573 :difficulty 4.868056502338024 :due 97 | "2025-06-10T05:38:53Z" :last-review 98 | "2025-06-08T05:38:53Z") 99 | #+END_SRC 100 | -------------------------------------------------------------------------------- /emacs.lisp: -------------------------------------------------------------------------------- 1 | (defpackage lisp-fsrs.emacs 2 | (:use #:cl #:alexandria) 3 | (:import-from #:uiop #:string-prefix-p) 4 | (:nicknames #:fsrs.emacs) 5 | (:export #:translate-system)) 6 | 7 | (in-package #:lisp-fsrs.emacs) 8 | 9 | (defparameter *prelude* 10 | '((require 'cl-lib) 11 | (require 'cl-generic) 12 | (require 'parse-time) 13 | (deftype timestamp () 14 | "ISO 8601 UTC timestamp string type. 15 | 16 | Represents time values in `YYYY-MM-DDTHH:MM:SSZ' format. Used 17 | throughout FSRS for all date/time tracking related to card scheduling 18 | and review logging." 19 | 'string) 20 | (defun now (&optional time) 21 | "Get current UTC time as TIMESTAMP string. 22 | 23 | When TIME is non-nil (accepts time value or nil), format that instead 24 | of current time. Returns string formatted according to ISO 8601 with 25 | UTC timezone." 26 | (format-time-string "%FT%TZ" time "UTC0")) 27 | (defun timestamp-difference (time-a time-b) 28 | "Calculate difference between two timestamps in seconds. 29 | 30 | TIME-A and TIME-B must both be TIMESTAMP strings. Returns 31 | floating-point number representing TIME-A minus TIME-B in seconds. 32 | Handles ISO 8601 parsing." 33 | (- (time-to-seconds (parse-iso8601-time-string time-a)) 34 | (time-to-seconds (parse-iso8601-time-string time-b)))) 35 | (defun timestamp+ (time amount unit) 36 | "Create new TIMESTAMP by adding time units. 37 | 38 | TIME is base TIMESTAMP string. AMOUNT is number of units to add. UNIT 39 | is one of :sec/:minute/:hour/:day keyword specifying time unit. 40 | Returns new ISO 8601 string calculated by adding AMOUNT × UNIT's 41 | seconds to TIME." 42 | (now 43 | (+ (time-to-seconds (parse-iso8601-time-string time)) 44 | (* amount 45 | (ecase unit 46 | (:sec 1) 47 | (:minute #.local-time::+seconds-per-minute+) 48 | (:hour #.local-time::+seconds-per-hour+) 49 | (:day #.local-time::+seconds-per-day+)))))))) 50 | 51 | (defparameter *postlude* 52 | '((provide 'fsrs))) 53 | 54 | (defvar *mappings* 55 | (let (mappings) 56 | (flet ((map-symbol (symbol) 57 | (when (fboundp symbol) 58 | (let ((cl-symbol (symbolicate '#:cl- symbol))) 59 | (if (slynk:eval-in-emacs `(or (fboundp ',cl-symbol) (macrop ',cl-symbol))) 60 | (push (cons symbol cl-symbol) mappings) 61 | (unless (slynk:eval-in-emacs `(or (fboundp ',symbol) (macrop ',symbol))) 62 | (warn "Function/macro ~A is not available in Emacs Lisp." symbol))))))) 63 | (do-external-symbols (symbol :cl mappings) 64 | (map-symbol symbol)) 65 | (do-external-symbols (symbol :alexandria mappings) 66 | (map-symbol symbol))))) 67 | 68 | (defun translate-docstring (docstring) 69 | (str:replace-using 70 | (loop :for (from . to) :in *mappings* 71 | :nconc (list (format nil "(?<=\\s)~A(?=[\\s,.?!:;\\(\\)])" (ppcre:quote-meta-chars (symbol-name from))) (symbol-name to))) 72 | docstring :regex t)) 73 | 74 | (defgeneric translate-form (car cdr)) 75 | 76 | (defun translate (object) 77 | (typecase object 78 | (null object) 79 | (proper-list (translate-form (car object) (cdr object))) 80 | (symbol (or (assoc-value *mappings* object) object)) 81 | (t object))) 82 | 83 | (defmethod translate-form ((car symbol) cdr) 84 | (when-let ((macro (and (string-prefix-p (symbol-name 'define) (symbol-name car)) 85 | (find-symbol (symbol-name car) #.(find-package '#:fsrs))))) 86 | (let ((expanded (macroexpand-1 (cons macro cdr)))) 87 | (when (eq (car expanded) 'defun) 88 | (translate expanded)))) 89 | (cons (or (assoc-value *mappings* car) car) (mapcar #'translate cdr))) 90 | 91 | (defmethod translate-form (car cdr) 92 | (mapcar #'translate (cons car cdr))) 93 | 94 | (defmethod translate-form ((car (eql 'defpackage)) cdr) 95 | (throw 'skip nil)) 96 | 97 | (defmethod translate-form ((car (eql 'in-package)) cdr) 98 | (throw 'skip nil)) 99 | 100 | (defmethod translate-form ((car (eql 'function)) cdr) 101 | (cons car (mapcar #'translate cdr))) 102 | 103 | (defun translate-definition (args &optional var) 104 | (let* ((name (car args)) 105 | (translated-name 106 | (if-let ((translated-name (assoc-value (symbol-value var) name))) 107 | translated-name 108 | (let* ((name (symbol-name name)) 109 | (name (if (string-prefix-p "+" name) (string-trim "+" name) name)) 110 | (prefix (string '#:fsrs))) 111 | (intern 112 | (if (string-prefix-p prefix name) 113 | name (format nil "~A-~A" prefix name))))))) 114 | (when var 115 | (unless (eq name translated-name) 116 | (setf (assoc-value (symbol-value var) name) translated-name))) 117 | (cons translated-name (cdr args)))) 118 | 119 | (defmethod translate-form ((car (eql 'defun)) cdr) 120 | (destructuring-bind (name lambda-list &rest body) cdr 121 | (setf name (first (translate-definition cdr '*mappings*))) 122 | (let ((*mappings* (set-difference 123 | *mappings* 124 | (mapcar (compose #'nreverse #'first) 125 | (nth-value 3 (parse-ordinary-lambda-list lambda-list :allow-specializers t))) 126 | :key #'car))) 127 | (when (stringp (car body)) 128 | (setf (car body) (translate-docstring (car body)))) 129 | (call-next-method car (list* name lambda-list body))))) 130 | 131 | (defmethod translate-form ((car (eql 'defmacro)) cdr) 132 | (cons 'cl-defmacro (cdr (translate-form 'defun cdr)))) 133 | 134 | (defmethod translate-form ((car (eql 'defgeneric)) cdr) 135 | (when-let ((documentation (assoc-value (cddr cdr) :documentation))) 136 | (setf (car documentation) (translate-docstring (car documentation)))) 137 | (cons 'cl-defgeneric (cdr (translate-form 'defun cdr)))) 138 | 139 | (defmethod translate-form ((car (eql 'defmethod)) cdr) 140 | (cons 'cl-defmethod (cdr (translate-form 'defun cdr)))) 141 | 142 | (defmethod translate-form ((car (eql 'deftype)) cdr) 143 | (let ((cdr (translate-definition cdr '*mappings*)) 144 | (*mappings* (remove 'member *mappings* :key #'car))) 145 | (call-next-method car cdr))) 146 | 147 | (defmethod translate-form ((car (eql 'defconstant)) cdr) 148 | (let ((form `(eval-when (:compile-toplevel :load-toplevel :execute) 149 | (defconst . ,(translate-definition cdr '*mappings*))))) 150 | (translate-form (car form) (cdr form)))) 151 | 152 | (defmethod translate-form ((car (eql 'define-constant)) cdr) 153 | (destructuring-bind (name initial-value &key documentation &allow-other-keys) cdr 154 | (translate-form 'defconstant (list* name initial-value (ensure-list documentation))))) 155 | 156 | (defmethod translate-form ((car (eql 'defstruct)) cdr) 157 | (destructuring-bind (name-and-options &rest slots) cdr 158 | (let* ((name-and-options (ensure-cons name-and-options)) 159 | (name (car name-and-options)) 160 | (name-and-options (translate-definition name-and-options)) 161 | (translated-name (car name-and-options)) 162 | (documentation (when (stringp (car slots)) (pop slots)))) 163 | (loop :for keyword :in '(:constructor :copier) 164 | :for prefix :in '(#:make- #:copy-) 165 | :for symbol-cons := (assoc-value (cdr name-and-options) keyword) 166 | :for function := (symbolicate '#:fsrs- prefix name) 167 | :if symbol-cons 168 | :when (car symbol-cons) 169 | :do (setf (car symbol-cons) 170 | (setf (assoc-value *mappings* (car symbol-cons)) 171 | (symbolicate '#:fsrs- (substitute #\- #\% (symbol-name (car symbol-cons)))))) 172 | :end 173 | :else 174 | :do (push (list keyword function) (cdr name-and-options)) 175 | :do (setf (assoc-value *mappings* (symbolicate prefix name)) function)) 176 | `(cl-defstruct 177 | ,(translate name-and-options) 178 | ,@(when documentation (list documentation)) 179 | ,@(loop :for slot :in slots 180 | :for (slot-name . slot-options) := (ensure-cons slot) 181 | :do (setf (assoc-value *mappings* (symbolicate name '#:- slot-name)) (symbolicate translated-name '#:- slot-name)) 182 | :collect (cons slot-name (translate slot-options)) 183 | :finally 184 | (setf (assoc-value *mappings* name) translated-name 185 | (assoc-value *mappings* (symbolicate name '#:-p)) (symbolicate translated-name '#:-p))))))) 186 | 187 | (defmethod translate-form ((car (eql 'coerce)) args) 188 | (destructuring-bind (object type) args 189 | `(cl-coerce 190 | ,(translate object) 191 | ,(translate 192 | (if (constantp type) 193 | (multiple-value-bind (expansion expandedp) 194 | (introspect-environment:typexpand 195 | (mapcar 196 | (compose (rcurry #'find-symbol #.(find-package '#:lisp-fsrs)) #'symbol-name) 197 | (ensure-list (eval type)))) 198 | (if expandedp 199 | `',(if (and (listp expansion) (null (cdr expansion))) (car expansion) expansion) 200 | type)) 201 | type))))) 202 | 203 | (defmethod translate-form ((car (eql 'simple-array)) cdr) 204 | 'vector) 205 | 206 | (defmethod translate-form ((car (eql 'values)) cdr) 207 | (case (length cdr) 208 | (0 nil) 209 | (1 (translate (first cdr))) 210 | (t (call-next-method)))) 211 | 212 | (defmethod translate-form ((car (eql 'declare)) cdr) 213 | (translate-form 214 | 'cl-declare 215 | (case (length cdr) 216 | (0 nil) 217 | (1 (let ((clause (first cdr))) 218 | (if (eq (car clause) 'ignore) 219 | (return-from translate-form (translate clause)) 220 | (list clause)))) 221 | (t cdr)))) 222 | 223 | (defmethod translate-form ((car (eql 'loop)) cdr) 224 | (cons 225 | 'cl-loop 226 | (loop :for (keyword form) :on cdr :by #'cddr 227 | :when (keywordp keyword) 228 | :do (setf keyword (intern (symbol-name keyword))) 229 | :nconc (list keyword (translate form))))) 230 | 231 | (defmethod translate-form ((car (eql 'assoc-value)) cdr) 232 | (destructuring-bind (alist key &key (test '(function eql))) cdr 233 | (list 'alist-get (translate key) (translate alist) nil nil (translate test)))) 234 | 235 | (setf (assoc-value *mappings* 'single-float) 'float 236 | (assoc-value *mappings* 'double-float) 'float 237 | (assoc-value *mappings* 'non-negative-single-float) 'float 238 | (assoc-value *mappings* 'non-negative-fixnum) 'fixnum) 239 | 240 | (defun write-toplevel (form output) 241 | (let ((form (translate form))) 242 | (write-char #\Newline output) 243 | (write form :stream output :pretty t :readably t :case :downcase) 244 | (write-char #\Newline output))) 245 | 246 | (defun translate-file (input output) 247 | (handler-case 248 | (loop 249 | (catch 'skip 250 | (write-toplevel (read input) output))) 251 | (end-of-file ()))) 252 | 253 | (defun translate-component (component output) 254 | (loop :for form :in *prelude* 255 | :do (write-toplevel (translate-form (car form) (cdr form)) output)) 256 | (loop :for file :in (asdf:component-children component) 257 | :do (with-open-file (input (asdf:component-pathname file)) (translate-file input output))) 258 | (loop :for form :in *postlude* 259 | :do (write-toplevel (translate-form (car form) (cdr form)) output))) 260 | 261 | (defun pathname-filename (pathname) 262 | (format nil "~A~@[.~A~]" (pathname-name pathname) (pathname-type pathname))) 263 | 264 | (defun translate-system (&optional 265 | (system (asdf:find-system '#:lisp-fsrs)) 266 | (file (merge-pathnames #P"fsrs.el" (asdf:system-source-directory system))) 267 | &aux 268 | (*package* #.*package*)) 269 | (translate-component system (make-string-output-stream)) 270 | (with-open-file (output file :direction :output :if-exists :supersede) 271 | (format output ";;; fsrs.el --- Free Spaced Repetition Scheduler -*- lexical-binding: t -*- 272 | 273 | ;; Copyright (C) 2025 Open Spaced Repetition 274 | 275 | ;; Author: Open Spaced Repetition 276 | ;; Maintainer: Open Spaced Repetition 277 | ;; Version: ~A 278 | ;; Package-Requires: ((emacs \"25.1\")) 279 | ;; URL: https://github.com/open-spaced-repetition/lisp-fsrs 280 | ;; Keywords: tools 281 | 282 | ;; This file is not part of GNU Emacs. 283 | 284 | ;; Permission is hereby granted, free of charge, to any person obtaining a copy of 285 | ;; this software and associated documentation files (the \"Software\"), to deal in 286 | ;; the Software without restriction, including without limitation the rights to 287 | ;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 288 | ;; of the Software, and to permit persons to whom the Software is furnished to do 289 | ;; so, subject to the following conditions: 290 | ;; 291 | ;; The above copyright notice and this permission notice shall be included in all 292 | ;; copies or substantial portions of the Software. 293 | ;; 294 | ;; THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 295 | ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 296 | ;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 297 | ;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 298 | ;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 299 | ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 300 | ;; SOFTWARE. 301 | 302 | ;;; Commentary: 303 | 304 | ;; FSRS (Free Spaced Repetition Scheduler) is a spaced repetition 305 | ;; algorithm that optimizes review scheduling by adapting to individual 306 | ;; memory patterns, outperforming traditional algorithms like SM-2. 307 | 308 | ;;; Code: 309 | " (asdf:component-version (asdf:find-system '#:lisp-fsrs))) 310 | (translate-component system output) 311 | (format output ";;; ~A.~A ends here~%" (pathname-name file) (pathname-type file)))) 312 | -------------------------------------------------------------------------------- /test/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage lisp-fsrs.test 2 | (:use #:c2cl #:parachute #:local-time #:fsrs) 3 | (:import-from #:alexandria #:define-constant) 4 | (:import-from #:fsrs #:seconds-days #:scheduler-maximum-interval-days #:+minimum-stability+) 5 | (:nicknames #:fsrs.test)) 6 | 7 | (in-package #:lisp-fsrs.test) 8 | 9 | (define-constant +default-parameters+ 10 | (coerce 11 | '(0.2172 1.1771 3.2602 16.1507 7.0114 0.57 2.0966 0.0069 1.5261 12 | 0.112 1.0178 1.849 0.1133 0.3127 2.2934 0.2191 3.0004 0.7536 13 | 0.3332 0.1437 0.2) 14 | 'parameters) 15 | :test #'equalp) 16 | 17 | (define-constant +test-ratings+ '(:good :good :good :good :good :good :again :again :good :good :good :good :good) :test #'equal) 18 | 19 | (declaim (ftype (function (single-float single-float) (values boolean)) float=)) 20 | (defun float= (a b) 21 | (< (abs (- a b)) 0.001)) 22 | 23 | (defun float-list-equal (a b) 24 | (when (= (length a) (length b)) 25 | (every #'float= a b))) 26 | 27 | (define-test test-lisp-fsrs) 28 | 29 | (define-test test-review-card :parent test-lisp-fsrs 30 | (loop :with scheduler := (make-scheduler :parameters +default-parameters+ :enable-fuzzing-p nil) 31 | :for now := (encode-timestamp 0 0 30 12 29 11 2022 :timezone +utc-zone+) :then (card-due card) 32 | :for rating :in +test-ratings+ 33 | :for card := (nth-value 0 (scheduler-review-card scheduler (or card (make-card)) rating now)) 34 | :for ivl := (seconds-days (timestamp-difference (card-due card) now)) 35 | :collect ivl :into ivl-history 36 | :finally (is equal '(0 4 14 45 135 372 0 0 2 5 10 20 40) ivl-history))) 37 | 38 | (define-test test-memo-state :parent test-lisp-fsrs 39 | (loop :with scheduler := (make-scheduler :parameters +default-parameters+) 40 | :for ivl :in '(0 0 1 3 8 21) 41 | :for now := (timestamp+ (or now (encode-timestamp 0 0 30 12 29 11 2022 :timezone +utc-zone+)) ivl :day) 42 | :for rating :in '(:again :good :good :good :good :good) 43 | :for card := (nth-value 0 (scheduler-review-card scheduler (or card (make-card)) rating now)) 44 | :finally 45 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good now))) 46 | (is float= 49.4472 (card-stability card)) 47 | (is float= 6.8271 (card-difficulty card)))) 48 | 49 | (defgeneric equals (a b) (:method (a b) (cl:equalp a b))) 50 | 51 | (defmethod equals ((a timestamp) (b timestamp)) (timestamp= a b)) 52 | 53 | (defmethod equals ((a structure-object) (b structure-object)) 54 | (let ((class (class-of a))) 55 | (when (eq class (class-of b)) 56 | (loop :for slot :in (class-slots class) 57 | :for slot-name := (slot-definition-name slot) 58 | :always (equals (slot-value a slot-name) (slot-value b slot-name)))))) 59 | 60 | (define-test test-custom-scheduler-args :parent test-lisp-fsrs 61 | (loop :with scheduler := (make-scheduler :desired-retention 0.9 62 | :maximum-interval '(36500 :day) 63 | :enable-fuzzing-p nil 64 | :parameters +default-parameters+) 65 | :for rating :in +test-ratings+ 66 | :for now := (encode-timestamp 0 0 30 12 29 11 2022 :timezone +utc-zone+) :then (card-due card) 67 | :for card := (nth-value 0 (scheduler-review-card scheduler (or card (make-card)) rating now)) 68 | :collect (seconds-days (timestamp-difference (card-due card) (card-last-review card))) :into ivl-history 69 | :finally (is equal '(0 4 14 45 135 372 0 0 2 5 10 20 40) ivl-history)) 70 | (let* ((parameters2 (coerce '(0.1456 0.4186 1.1104 4.1315 5.2417 1.3098 0.8975 0.0010 1.5674 0.0567 0.9661 2.0275 0.1592 0.2446 1.5071 0.2272 2.8755 1.234 0.56789 0.1437 0.2) 'parameters)) 71 | (desired-retention2 0.85) 72 | (maximum-interval2 3650) 73 | (scheduler2 (make-scheduler :parameters parameters2 :desired-retention desired-retention2 :maximum-interval (list maximum-interval2 :day)))) 74 | (is equalp parameters2 (scheduler-parameters scheduler2)) 75 | (is = desired-retention2 (scheduler-desired-retention scheduler2)) 76 | (is = maximum-interval2 (scheduler-maximum-interval-days scheduler2)))) 77 | 78 | (define-test test-retrievability :parent test-lisp-fsrs 79 | (let ((scheduler (make-scheduler)) (card (make-card))) 80 | (is eq :learning (card-state card)) 81 | (is = 0.0 (scheduler-card-retrievability scheduler card)) 82 | 83 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good))) 84 | (is eq :learning (card-state card)) 85 | (is >= 0.0 (scheduler-card-retrievability scheduler card)) 86 | (is <= 1.0 (scheduler-card-retrievability scheduler card)) 87 | 88 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good))) 89 | (is eq :review (card-state card)) 90 | (is >= 0.0 (scheduler-card-retrievability scheduler card)) 91 | (is <= 1.0 (scheduler-card-retrievability scheduler card)) 92 | 93 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again))) 94 | (is eq :relearning (card-state card)) 95 | (is >= 0.0 (scheduler-card-retrievability scheduler card)) 96 | (is <= 1.0 (scheduler-card-retrievability scheduler card)))) 97 | 98 | (define-test test-good-learning-steps :parent test-lisp-fsrs 99 | (let ((scheduler (make-scheduler)) 100 | (created-at (now)) 101 | (card (make-card))) 102 | (is eq :learning (card-state card)) 103 | (is = 0 (card-step card)) 104 | 105 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 106 | (is eq :learning (card-state card)) 107 | (is = 1 (card-step card)) 108 | (is = 6 (round (timestamp-difference (card-due card) created-at) 100)) 109 | 110 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 111 | (is eq :review (card-state card)) 112 | (true (null (card-step card))) 113 | (is >= 24 (round (timestamp-difference (card-due card) created-at) 3600)))) 114 | 115 | (define-test test-again-learning-steps :parent test-lisp-fsrs 116 | (let* ((scheduler (make-scheduler)) 117 | (created-at (now)) 118 | (card (make-card))) 119 | (is eq :learning (card-state card)) 120 | (is = 0 (card-step card)) 121 | 122 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again (card-due card)))) 123 | (is eq :learning (card-state card)) 124 | (is = 0 (card-step card)) 125 | (is = 6 (round (timestamp-difference (card-due card) created-at) 10)))) 126 | 127 | (define-test test-hard-learning-steps :parent test-lisp-fsrs 128 | (let* ((scheduler (make-scheduler)) 129 | (created-at (now)) 130 | (card (make-card))) 131 | (is eq :learning (card-state card)) 132 | (is = 0 (card-step card)) 133 | 134 | (setf card (nth-value 0 (scheduler-review-card scheduler card :hard (card-due card)))) 135 | (is eq :learning (card-state card)) 136 | (is = 0 (card-step card)) 137 | (is = 33 (round (timestamp-difference (card-due card) created-at) 10)))) 138 | 139 | (define-test test-easy-learning-steps :parent test-lisp-fsrs 140 | (let* ((scheduler (make-scheduler)) 141 | (created-at (now)) 142 | (card (make-card))) 143 | (is eq :learning (card-state card)) 144 | (is = 0 (card-step card)) 145 | 146 | (setf card (nth-value 0 (scheduler-review-card scheduler card :easy (card-due card)))) 147 | (is eq :review (card-state card)) 148 | (true (null (card-step card))) 149 | (is >= 1 (round (timestamp-difference (card-due card) created-at) 86400)))) 150 | 151 | (define-test test-review-state :parent test-lisp-fsrs 152 | (let* ((scheduler (make-scheduler :enable-fuzzing-p nil)) 153 | (card (make-card))) 154 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 155 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 156 | (is eq :review (card-state card)) 157 | (true (null (card-step card))) 158 | 159 | (let ((prev-due (card-due card))) 160 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 161 | (is eq :review (card-state card)) 162 | (is >= 24 (round (timestamp-difference (card-due card) prev-due) 3600))) 163 | 164 | (let ((prev-due (card-due card))) 165 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again (card-due card)))) 166 | (is eq :relearning (card-state card)) 167 | (is = 10 (round (timestamp-difference (card-due card) prev-due) 60))))) 168 | 169 | (define-test test-relearning :parent test-lisp-fsrs 170 | (let* ((scheduler (make-scheduler :enable-fuzzing-p nil)) 171 | (card (make-card))) 172 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 173 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 174 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 175 | (let ((prev-due (card-due card))) 176 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again (card-due card)))) 177 | (is eq :relearning (card-state card)) 178 | (is = 0 (card-step card)) 179 | (is = 10 (round (timestamp-difference (card-due card) prev-due) 60))) 180 | 181 | (let ((prev-due (card-due card))) 182 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again (card-due card)))) 183 | (is eq :relearning (card-state card)) 184 | (is = 0 (card-step card)) 185 | (is = 10 (round (timestamp-difference (card-due card) prev-due) 60))) 186 | 187 | (let ((prev-due (card-due card))) 188 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 189 | (is eq :review (card-state card)) 190 | (true (null (card-step card))) 191 | (is >= 24 (round (timestamp-difference (card-due card) prev-due) 3600))))) 192 | 193 | (define-test test-no-learning-steps :parent test-lisp-fsrs 194 | (let ((scheduler (make-scheduler :learning-steps nil))) 195 | (true (null (scheduler-learning-steps scheduler))) 196 | (let ((card (make-card))) 197 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again))) 198 | (is eq :review (card-state card)) 199 | (is >= 1 (seconds-days (timestamp-difference (card-due card) (card-last-review card))))))) 200 | 201 | (define-test test-no-relearning-steps :parent test-lisp-fsrs 202 | (let ((scheduler (make-scheduler :relearning-steps nil))) 203 | (true (null (scheduler-relearning-steps scheduler))) 204 | (let ((card (make-card))) 205 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good))) 206 | (is eq :learning (card-state card)) 207 | (setf card (nth-value 0 (scheduler-review-card scheduler card :good (card-due card)))) 208 | (is eq :review (card-state card)) 209 | (setf card (nth-value 0 (scheduler-review-card scheduler card :again (card-due card)))) 210 | (is eq :review (card-state card)) 211 | (is >= 1 (seconds-days (timestamp-difference (card-due card) (card-last-review card))))))) 212 | 213 | (define-test test-one-card-multiple-schedulers :parent test-lisp-fsrs 214 | (let* ((scheduler-two-learning (make-scheduler :learning-steps '((1 :minute) (10 :minute)))) 215 | (scheduler-one-learning (make-scheduler :learning-steps '((1 :minute)))) 216 | (scheduler-no-learning (make-scheduler :learning-steps nil)) 217 | (scheduler-two-relearning (make-scheduler :relearning-steps '((1 :minute) (10 :minute)))) 218 | (scheduler-one-relearning (make-scheduler :relearning-steps '((1 :minute)))) 219 | (scheduler-no-relearning (make-scheduler :relearning-steps nil)) 220 | (card (make-card))) 221 | (is = 2 (length (scheduler-learning-steps scheduler-two-learning))) 222 | (setf card (nth-value 0 (scheduler-review-card scheduler-two-learning card :good))) 223 | (is eq :learning (card-state card)) 224 | (is = 1 (card-step card)) 225 | 226 | (is = 1 (length (scheduler-learning-steps scheduler-one-learning))) 227 | (setf card (nth-value 0 (scheduler-review-card scheduler-one-learning card :again))) 228 | (is eq :learning (card-state card)) 229 | (is = 0 (card-step card)) 230 | 231 | (true (null (scheduler-learning-steps scheduler-no-learning))) 232 | (setf card (nth-value 0 (scheduler-review-card scheduler-no-learning card :hard))) 233 | (is eq :review (card-state card)) 234 | (true (null (card-step card))) 235 | 236 | (is = 2 (length (scheduler-relearning-steps scheduler-two-relearning))) 237 | (setf card (nth-value 0 (scheduler-review-card scheduler-two-relearning card :again))) 238 | (is eq :relearning (card-state card)) 239 | (is = 0 (card-step card)) 240 | 241 | (setf card (nth-value 0 (scheduler-review-card scheduler-two-relearning card :good))) 242 | (is eq :relearning (card-state card)) 243 | (is = 1 (card-step card)) 244 | 245 | (is = 1 (length (scheduler-relearning-steps scheduler-one-relearning))) 246 | (setf card (nth-value 0 (scheduler-review-card scheduler-one-relearning card :again))) 247 | (is eq :relearning (card-state card)) 248 | (is = 0 (card-step card)) 249 | 250 | (true (null (scheduler-relearning-steps scheduler-no-relearning))) 251 | (setf card (nth-value 0 (scheduler-review-card scheduler-no-relearning card :hard))) 252 | (is eq :review (card-state card)) 253 | (true (null (card-step card))))) 254 | 255 | (define-test test-maximum-interval :parent test-lisp-fsrs 256 | (loop :with scheduler := (make-scheduler :maximum-interval '(100 :day)) 257 | :repeat 10 258 | :for now := (now) :then (card-due card) 259 | :for card := (nth-value 0 (scheduler-review-card scheduler (or card (make-card)) :easy now)) 260 | :do (is <= 100 (seconds-days (timestamp-difference (card-due card) (card-last-review card)))))) 261 | 262 | (define-test test-stability-lower-bound :parent test-lisp-fsrs 263 | (loop :with scheduler := (make-scheduler) 264 | :repeat 1000 265 | :for now := (now) :then (timestamp+ (card-due card) 1 :day) 266 | :for card := (nth-value 0 (scheduler-review-card scheduler (or card (make-card)) :again now)) 267 | :do (is >= +minimum-stability+ (card-stability card)))) 268 | 269 | (define-test test-scheduler-parameter-validation :parent test-lisp-fsrs 270 | (of-type scheduler (make-scheduler :parameters +default-parameters+)) 271 | 272 | (let ((params (copy-seq +default-parameters+))) 273 | (setf (aref params 6) 100.0) 274 | (fail (make-scheduler :parameters params))) 275 | 276 | (let ((params (copy-seq +default-parameters+))) 277 | (setf (aref params 10) -42.0) 278 | (fail (make-scheduler :parameters params))) 279 | 280 | (let ((params (copy-seq +default-parameters+))) 281 | (setf (aref params 0) 0.0) 282 | (setf (aref params 3) 101.0) 283 | (fail (make-scheduler :parameters params))) 284 | 285 | (fail (make-scheduler :parameters #())) 286 | 287 | (let ((params (make-array (1- (length +default-parameters+)) 288 | :element-type 'single-float))) 289 | (fail (make-scheduler :parameters params))) 290 | 291 | (let ((params (make-array (+ (length +default-parameters+) 3) 292 | :element-type 'single-float))) 293 | (fail (make-scheduler :parameters params)))) 294 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage lisp-fsrs 2 | (:use #:cl #:alexandria #:local-time) 3 | (:nicknames #:fsrs) 4 | (:export 5 | #:state 6 | #:rating 7 | #:parameters 8 | #:card 9 | #:make-card 10 | #:card-p 11 | #:copy-card 12 | #:card-card-id 13 | #:card-state 14 | #:card-step 15 | #:card-stability 16 | #:card-difficulty 17 | #:card-due 18 | #:card-last-review 19 | #:review-log 20 | #:make-review-log 21 | #:review-log-p 22 | #:copy-review-log 23 | #:review-log-card-id 24 | #:review-log-rating 25 | #:review-log-review-datetime 26 | #:review-log-review-duration 27 | #:scheduler 28 | #:make-scheduler 29 | #:scheduler-p 30 | #:copy-scheduler 31 | #:scheduler-parameters 32 | #:scheduler-desired-retention 33 | #:scheduler-learning-steps 34 | #:scheduler-relearning-steps 35 | #:scheduler-maximum-interval 36 | #:scheduler-enable-fuzzing-p 37 | #:scheduler-review-card 38 | #:scheduler-card-retrievability)) 39 | 40 | (in-package #:lisp-fsrs) 41 | 42 | (deftype state () 43 | "Learning phase progression state." 44 | '(member :learning :review :relearning)) 45 | 46 | (declaim (ftype (function (state) (integer 0 3)) state-integer) 47 | (inline state-integer)) 48 | (defun state-integer (state) 49 | "Convert STATE to an integer (0-3)." 50 | (ecase state 51 | (:new 0) 52 | (:learning 1) 53 | (:review 2) 54 | (:relearning 3))) 55 | 56 | (deftype rating () 57 | "User response rating for memory recall success." 58 | '(member :again :hard :good :easy)) 59 | 60 | (declaim (ftype (function (rating) (integer 1 4)) rating-integer) 61 | (inline rating-integer)) 62 | (defun rating-integer (rating) 63 | "Convert RATING to an integer (1-4). 64 | 65 | RATING is the user's response quality (:again/:hard/:good/:easy)." 66 | (ecase rating 67 | (:again 1) 68 | (:hard 2) 69 | (:good 3) 70 | (:easy 4))) 71 | 72 | (deftype parameters () 73 | "Array type containing 21 single-floats for FSRS parameters." 74 | '(simple-array single-float (21))) 75 | 76 | (define-constant +default-parameters+ 77 | (coerce 78 | '(0.212 1.2931 2.3065 8.2956 6.4133 0.8334 3.0194 0.001 1.8722 79 | 0.1666 0.796 1.4835 0.0614 0.2629 1.6483 0.6014 1.8729 0.5425 80 | 0.0912 0.0658 0.1542) 81 | 'parameters) 82 | :test #'equalp 83 | :documentation "Default weight values for FSRS parameters.") 84 | 85 | (define-constant +lower-bounds-parameters+ 86 | (coerce 87 | '(0.001 0.001 0.001 0.001 1.0 0.001 0.001 0.001 0.0 0.0 0.001 88 | 0.001 0.001 0.001 0.0 0.0 1.0 0.0 0.0 0.0 0.1) 89 | 'parameters) 90 | :test #'equalp 91 | :documentation "Lower bounds for FSRS parameter values.") 92 | 93 | (define-constant +upper-bounds-parameters+ 94 | (coerce 95 | '(100.0 100.0 100.0 100.0 10.0 4.0 4.0 0.75 4.5 0.8 3.5 5.0 0.25 96 | 0.9 4.0 1.0 6.0 2.0 2.0 0.8 0.8) 97 | 'parameters) 98 | :test #'equalp 99 | :documentation "Upper bounds for FSRS parameter values.") 100 | 101 | (defconstant +minimum-difficulty+ 1.0 102 | "Minimum allowed difficulty value (1.0).") 103 | 104 | (defconstant +maximum-difficulty+ 10.0 105 | "Maximum allowed difficulty value (10.0).") 106 | 107 | (defconstant +minimum-stability+ 0.001 108 | "Minimum allowed stability value (0.001).") 109 | 110 | (define-constant +fuzz-ranges+ 111 | '(((2.5 :day) (7.0 :day) 0.15) 112 | ((7.0 :day) (20.0 :day) 0.1) 113 | ((20.0 :day) nil 0.05)) 114 | :test #'equal 115 | :documentation "Fuzz factor ranges for interval randomization.") 116 | 117 | (deftype difficulty () 118 | "Single-float type representing item difficulty (1.0-10.0)." 119 | (list 'single-float +minimum-difficulty+ +maximum-difficulty+)) 120 | 121 | (deftype stability () 122 | "Single-float type representing memory stability (>= 0.001)." 123 | (list 'single-float +minimum-stability+)) 124 | 125 | (deftype retrievability () 126 | "Single-float type representing recall probability (0.0-1.0)." 127 | '(single-float 0.0 1.0)) 128 | 129 | (defstruct card 130 | "Represents a memorization item with scheduling state and memory metrics. 131 | 132 | CARD-ID is the unique identifier for the card. 133 | STATE is the current learning phase (:learning/:review/:relearning). 134 | STEP is the current position in learning/relearning steps. 135 | STABILITY is the memory retention strength (higher = more stable). 136 | DIFFICULTY is the item complexity (1.0-10.0 scale). 137 | DUE is the timestamp for next review. 138 | LAST-REVIEW is the timestamp of most recent review or NIL if new." 139 | (card-id 0 :type fixnum) 140 | (state :learning :type state) 141 | (step 0 :type (or fixnum null)) 142 | (stability nil :type (or single-float null)) 143 | (difficulty nil :type (or single-float null)) 144 | (due (now) :type timestamp) 145 | (last-review nil :type (or timestamp null))) 146 | 147 | (defstruct review-log 148 | "Record of individual review event. 149 | 150 | CARD-ID is the identifier of the reviewed card. 151 | RATING is the user's response quality (:again/:hard/:good/:easy). 152 | REVIEW-DATETIME is the timestamp when review occurred. 153 | REVIEW-DURATION is the time spent reviewing in seconds or NIL." 154 | (card-id 0 :type fixnum) 155 | (rating :again :type rating) 156 | (review-datetime (now) :type timestamp) 157 | (review-duration nil :type (or fixnum null))) 158 | 159 | (define-constant +time-units+ '((:sec . 1) (:minute . 60) (:hour . 3600) (:day . 86400)) 160 | :test #'equal 161 | :documentation "Time unit conversion factors in seconds.") 162 | 163 | (deftype timespan () 164 | "Cons type representing a duration with multiple time units." 165 | 'cons) 166 | 167 | (declaim (ftype (function (timespan) (values (or fixnum single-float))) timespan-seconds)) 168 | (defun timespan-seconds (timespan) 169 | "Convert TIMESPAN to total seconds. 170 | 171 | TIMESPAN is a cons list of (AMOUNT UNIT) pairs." 172 | (loop :for (amount unit) :on timespan by #'cddr 173 | :sum (* amount (assoc-value +time-units+ unit)))) 174 | 175 | (declaim (ftype (function (timespan) (values single-float)) timespan-days)) 176 | (defun timespan-days (timespan) 177 | "Convert TIMESPAN to total days. 178 | 179 | TIMESPAN is a cons list of (AMOUNT UNIT) pairs." 180 | (/ (timespan-seconds timespan) #.(coerce local-time::+seconds-per-day+ 'single-float))) 181 | 182 | (declaim (ftype (function (fixnum) (values timespan)) seconds-timespan)) 183 | (defun seconds-timespan (seconds) 184 | "Convert SECONDS to timespan with multiple units. 185 | 186 | SECONDS is the total duration to convert." 187 | (loop for (unit . amount) in (reverse +time-units+) 188 | for (part remainder) = (multiple-value-list (truncate (or remainder seconds) amount)) 189 | unless (zerop part) 190 | nconc (list part unit) 191 | until (zerop remainder))) 192 | 193 | (declaim (ftype (function (&rest t) (values timespan)) make-timespan)) 194 | (defun make-timespan (&rest args) 195 | "Create timespan from alternating UNIT AMOUNT pairs. 196 | 197 | ARGS is a plist of time units and amounts." 198 | (loop for (unit amount) on args by #'cddr 199 | nconc (list amount unit))) 200 | 201 | (declaim (ftype (function (timespan (or single-float fixnum)) (values timespan)) timespan*)) 202 | (defun timespan* (timespan factor) 203 | "Multiply TIMESPAN by FACTOR. 204 | 205 | TIMESPAN is the duration to scale. FACTOR is the multiplier." 206 | (seconds-timespan (nth-value 0 (truncate (* (timespan-seconds timespan) factor))))) 207 | 208 | (declaim (ftype (function (timespan &optional timestamp) (values timestamp)) timespan-apply)) 209 | (defun timespan-apply (timespan &optional (timestamp (now))) 210 | "Apply TIMESPAN to TIMESTAMP. 211 | 212 | TIMESPAN is the duration to add. TIMESTAMP is the base time." 213 | (loop :with result := timestamp 214 | :for (amount unit) :on timespan :by #'cddr 215 | :do (setf result (timestamp+ result amount unit)) 216 | :finally (return result))) 217 | 218 | (defmacro define-timespan-operator (operator) 219 | "Define a timespan operator function that applying OPERATOR to timespans. 220 | 221 | OPERATOR is the arithmetic function to apply to timespan values. The generated 222 | function will convert timespans to seconds, apply OPERATOR, then convert back to 223 | timespan format." 224 | (let ((args (make-symbol (symbol-name 'args)))) 225 | (list 'defun (intern (concatenate 'string 226 | (symbol-name 'timespan) 227 | (if (> (length (symbol-name operator)) 2) "-" "") 228 | (symbol-name operator))) 229 | (list '&rest args) 230 | (concatenate 'string "Apply " (symbol-name operator) " to TIMESPANs. 231 | 232 | ARGS is the list of timespan values to operate on. Each timespan is converted to 233 | seconds before applying the operation, with the result converted back to 234 | timespan format.") 235 | (list 'seconds-timespan (list 'apply (list 'function operator) 236 | (list 'mapcar (list 'function 'timespan-seconds) args)))))) 237 | 238 | (define-timespan-operator +) 239 | (define-timespan-operator -) 240 | (define-timespan-operator min) 241 | (define-timespan-operator max) 242 | 243 | (declaim (ftype (function ((or fixnum double-float)) (values fixnum)) seconds-days)) 244 | (defun seconds-days (secs) 245 | "Convert SECS to integer days by truncating fractional part. 246 | 247 | SECS can be fixnum or double-float." 248 | (nth-value 0 (truncate secs #.local-time::+seconds-per-day+))) 249 | 250 | (defstruct (scheduler (:constructor %make-scheduler)) 251 | "Container for FSRS scheduling configuration and parameters. 252 | 253 | PARAMETERS is the array of FSRS algorithm weights and coefficients. 254 | DESIRED-RETENTION is the target probability of successful recall (0.0-1.0). 255 | LEARNING-STEPS is the list of time intervals for initial learning phase. 256 | RELEARNING-STEPS is the list of time intervals for relearning phase. 257 | MAXIMUM-INTERVAL is the upper bound for scheduling intervals. 258 | ENABLE-FUZZING-P is the flag to randomize intervals within bounds." 259 | (parameters +default-parameters+ :type parameters) 260 | (desired-retention 0.9 :type single-float) 261 | (learning-steps '((1 :minute) (10 :minute)) :type list) 262 | (relearning-steps '((10 :minute)) :type list) 263 | (maximum-interval '(36500 :day) :type timespan) 264 | (enable-fuzzing-p t :type boolean)) 265 | 266 | (declaim (ftype (function (scheduler) (values positive-fixnum)) scheduler-maximum-interval-days)) 267 | (defun scheduler-maximum-interval-days (scheduler) 268 | "Get maximum interval in days from SCHEDULER. 269 | 270 | SCHEDULER is the FSRS scheduler instance." 271 | (destructuring-bind (n day) (scheduler-maximum-interval scheduler) 272 | (assert (eq day :day)) 273 | n)) 274 | 275 | (declaim (ftype (function (scheduler) (values single-float single-float)) scheduler-factor-decay)) 276 | (defun scheduler-factor-decay (scheduler) 277 | "Calculate decay and factor from scheduler parameters. 278 | 279 | SCHEDULER is the FSRS scheduler instance containing parameter weights. 280 | Returns two values as single-floats: factor and decay." 281 | (let ((decay (- (aref (scheduler-parameters scheduler) 20)))) 282 | (values (1- (expt 0.9 (/ decay))) decay))) 283 | 284 | (declaim (ftype (function (parameters)) scheduler-validate-parameters)) 285 | (defun scheduler-validate-parameters (parameters) 286 | "Validate PARAMETERS against bounds. 287 | 288 | PARAMETERS is the FSRS parameter array to check." 289 | (loop :for p :across parameters 290 | :for lower :across +lower-bounds-parameters+ 291 | :for upper :across +upper-bounds-parameters+ 292 | :do (assert (<= lower p upper)))) 293 | 294 | (declaim (ftype (function (&rest t) (values scheduler)) make-scheduler)) 295 | (defun make-scheduler (&rest args) 296 | "Create scheduler instance with specified configuration. 297 | 298 | ARGS can override default parameters and settings." 299 | (let ((scheduler (apply #'%make-scheduler args))) 300 | (scheduler-validate-parameters (scheduler-parameters scheduler)) 301 | scheduler)) 302 | 303 | (declaim (ftype (function (scheduler card &optional timestamp) (values retrievability)) scheduler-card-retrievability)) 304 | (defun scheduler-card-retrievability (scheduler card &optional (current-time (now))) 305 | "Calculate current recall probability for CARD. 306 | 307 | SCHEDULER is the scheduling configuration. CARD is the item 308 | to evaluate. CURRENT-TIME is the optional timestamp to use as now." 309 | (unless (card-last-review card) (return-from scheduler-card-retrievability 0.0)) 310 | (let ((elapsed-days (max 0 (seconds-days (timestamp-difference current-time (card-last-review card)))))) 311 | (multiple-value-bind (factor decay) (scheduler-factor-decay scheduler) 312 | (expt (1+ (/ (* factor elapsed-days) (card-stability card))) decay)))) 313 | 314 | (declaim (ftype (function (scheduler single-float) (values difficulty)) scheduler-clamp-difficulty)) 315 | (defun scheduler-clamp-difficulty (scheduler difficulty) 316 | "Clamp DIFFICULTY to valid range (1.0-10.0). 317 | 318 | SCHEDULER is unused. DIFFICULTY is the value to clamp." 319 | (declare (ignore scheduler)) 320 | (max +minimum-difficulty+ (min +maximum-difficulty+ difficulty))) 321 | 322 | (declaim (ftype (function (scheduler single-float) (values stability)) scheduler-clamp-stability)) 323 | (defun scheduler-clamp-stability (scheduler stability) 324 | "Clamp STABILITY to minimum value (0.001). 325 | 326 | SCHEDULER is unused. STABILITY is the value to clamp." 327 | (declare (ignore scheduler)) 328 | (max +minimum-stability+ stability)) 329 | 330 | (declaim (ftype (function (scheduler rating) (values stability)) scheduler-initial-stability)) 331 | (defun scheduler-initial-stability (scheduler rating) 332 | "Compute initial stability after first review. 333 | 334 | SCHEDULER contains the parameter weights. RATING is the user's 335 | response." 336 | (let ((stability (aref (scheduler-parameters scheduler) (1- (rating-integer rating))))) 337 | (scheduler-clamp-stability scheduler stability))) 338 | 339 | (declaim (ftype (function (scheduler rating) (values difficulty)) scheduler-initial-difficulty)) 340 | (defun scheduler-initial-difficulty (scheduler rating) 341 | "Compute initial difficulty after first review for RATING. 342 | 343 | SCHEDULER contains the parameter weights. RATING is the user's 344 | response quality." 345 | (let ((difficulty (1+ (- (aref (scheduler-parameters scheduler) 4) 346 | (exp (* (aref (scheduler-parameters scheduler) 5) 347 | (1- (rating-integer rating)))))))) 348 | (scheduler-clamp-difficulty scheduler difficulty))) 349 | 350 | (declaim (ftype (function (scheduler stability) (values fixnum)) scheduler-next-interval)) 351 | (defun scheduler-next-interval (scheduler stability) 352 | "Calculate next review interval in days for given STABILITY. 353 | 354 | SCHEDULER contains scheduling parameters. STABILITY is the memory 355 | strength." 356 | (multiple-value-bind (factor decay) (scheduler-factor-decay scheduler) 357 | (let ((interval (* (/ stability factor) (1- (expt (scheduler-desired-retention scheduler) (/ decay)))))) 358 | (min (max (nth-value 0 (round interval)) 1) (scheduler-maximum-interval-days scheduler))))) 359 | 360 | (declaim (ftype (function (scheduler stability rating) (values stability)) scheduler-short-term-stability)) 361 | (defun scheduler-short-term-stability (scheduler stability rating) 362 | "Calculate short-term stability adjustment after reviewing with RATING. 363 | 364 | SCHEDULER contains model parameters. STABILITY is the current memory 365 | strength. RATING is the user's response quality (:again/:hard/:good/:easy)." 366 | (let* ((increase (* (exp (* (aref (scheduler-parameters scheduler) 17) 367 | (+ (- (rating-integer rating) 3) 368 | (aref (scheduler-parameters scheduler) 18)))) 369 | (expt stability (- (aref (scheduler-parameters scheduler) 19))))) 370 | (new-stability (* stability (if (member rating '(:good :easy)) (max increase 1.0) increase)))) 371 | (scheduler-clamp-stability scheduler new-stability))) 372 | 373 | (declaim (ftype (function (scheduler difficulty rating) (values difficulty)) scheduler-next-difficulty)) 374 | (defun scheduler-next-difficulty (scheduler difficulty rating) 375 | "Calculate next difficulty level after reviewing with RATING. 376 | 377 | SCHEDULER contains model parameters. DIFFICULTY is the current item 378 | complexity. RATING is the user's response quality 379 | (:again/:hard/:good/:easy)." 380 | (let* ((linear-damping (* (/ (- 10.0 difficulty) 9.0) 381 | (- (* (aref (scheduler-parameters scheduler) 6) 382 | (- (rating-integer rating) 3))))) 383 | (mean-reversion (+ (* (aref (scheduler-parameters scheduler) 7) 384 | (scheduler-initial-difficulty scheduler :easy)) 385 | (* (- 1 (aref (scheduler-parameters scheduler) 7)) 386 | (+ difficulty linear-damping))))) 387 | (scheduler-clamp-difficulty scheduler mean-reversion))) 388 | 389 | (declaim (ftype (function (scheduler difficulty stability retrievability) (values stability)) scheduler-next-forget-stability)) 390 | (defun scheduler-next-forget-stability (scheduler difficulty stability retrievability) 391 | "Calculate stability after forgetting during review. 392 | 393 | SCHEDULER contains model parameters. DIFFICULTY is the item 394 | complexity. STABILITY is the current memory strength. 395 | RETRIEVABILITY is the recall probability." 396 | (let ((long-term (* (aref (scheduler-parameters scheduler) 11) 397 | (expt difficulty (- (aref (scheduler-parameters scheduler) 12))) 398 | (1- (expt (1+ stability) (aref (scheduler-parameters scheduler) 13))) 399 | (exp (* (- 1 retrievability) (aref (scheduler-parameters scheduler) 14))))) 400 | (short-term (/ stability (exp (* (aref (scheduler-parameters scheduler) 17) 401 | (aref (scheduler-parameters scheduler) 18)))))) 402 | (min long-term short-term))) 403 | 404 | (declaim (ftype (function (scheduler difficulty stability retrievability rating) (values stability)) scheduler-next-recall-stability)) 405 | (defun scheduler-next-recall-stability (scheduler difficulty stability retrievability rating) 406 | "Calculate stability after successful recall with RATING. 407 | 408 | SCHEDULER contains model parameters. DIFFICULTY is the item 409 | complexity. STABILITY is the current memory strength. 410 | RETRIEVABILITY is the recall probability. RATING is the user's 411 | response quality (:again/:hard/:good/:easy)." 412 | (let* ((hard-penalty (if (eq rating :hard) (aref (scheduler-parameters scheduler) 15) 1.0)) 413 | (easy-bonus (if (eq rating :easy) (aref (scheduler-parameters scheduler) 16) 1.0)) 414 | (new-stability (* stability 415 | (1+ (* (exp (aref (scheduler-parameters scheduler) 8)) 416 | (- 11.0 difficulty) 417 | (expt stability (- (aref (scheduler-parameters scheduler) 9))) 418 | (1- (exp (* (- 1.0 retrievability) (aref (scheduler-parameters scheduler) 10)))) 419 | hard-penalty easy-bonus))))) 420 | (scheduler-clamp-stability scheduler new-stability))) 421 | 422 | (declaim (ftype (function (scheduler timespan) (values timespan)) scheduler-fuzzed-interval)) 423 | (defun scheduler-fuzzed-interval (scheduler interval) 424 | "Apply random fuzzing to INTERVAL based on fuzz ranges. 425 | 426 | SCHEDULER contains fuzzing configuration. INTERVAL is the base timespan." 427 | (let ((days (timespan-days interval))) 428 | (cond 429 | ((< days 2.5) interval) 430 | (t (let* ((delta (loop :for (start end factor) :in +fuzz-ranges+ 431 | :sum (* factor (max 0 (min (or (when end (timespan-days end)) days) days) (timespan-days start))))) 432 | (min-ivl (max 2 (min (nth-value 0 (round (- days delta))) (scheduler-maximum-interval-days scheduler)))) 433 | (max-ivl (min (nth-value 0 (round (+ days delta))) (scheduler-maximum-interval-days scheduler))) 434 | (fuzzed-days (min (nth-value 0 (round (+ min-ivl (random (- max-ivl min-ivl -1))))) 435 | (scheduler-maximum-interval-days scheduler)))) 436 | (make-timespan :day fuzzed-days)))))) 437 | 438 | (declaim (ftype (function (scheduler card rating &optional timestamp (or null fixnum)) (values card review-log)) scheduler-review-card)) 439 | (defun scheduler-review-card (scheduler card rating &optional (review-time (now)) review-duration) 440 | "Process CARD review with RATING and update scheduling state. 441 | 442 | SCHEDULER contains configuration parameters. CARD is the item being 443 | reviewed. RATING is the user's response quality (:again/:hard/:good/:easy). 444 | REVIEW-TIME is the optional timestamp of review. REVIEW-DURATION is the optional 445 | duration." 446 | (let* ((card (copy-card card)) 447 | (days-since-last (when (card-last-review card) (seconds-days (timestamp-difference review-time (card-last-review card))))) 448 | (scheduler-next-interval 449 | (ecase (card-state card) 450 | (:learning 451 | (cond 452 | ((and (null (card-stability card)) (null (card-difficulty card))) 453 | (setf (card-stability card) (scheduler-initial-stability scheduler rating) 454 | (card-difficulty card) (scheduler-initial-difficulty scheduler rating))) 455 | ((and days-since-last (< days-since-last 1)) 456 | (setf (card-stability card) (scheduler-short-term-stability scheduler (card-stability card) rating) 457 | (card-difficulty card) (scheduler-next-difficulty scheduler (card-difficulty card) rating))) 458 | (t (setf (card-stability card) (scheduler-next-recall-stability scheduler (card-difficulty card) (card-stability card) 459 | (scheduler-card-retrievability scheduler card review-time) 460 | rating) 461 | (card-difficulty card) (scheduler-next-difficulty scheduler (card-difficulty card) rating)))) 462 | (cond 463 | ((or (null (scheduler-learning-steps scheduler)) 464 | (and (>= (card-step card) (length (scheduler-learning-steps scheduler))) 465 | (member rating '(:hard :good :easy)))) 466 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 467 | (setf (card-state card) :review 468 | (card-step card) nil) 469 | (make-timespan :day days))) 470 | (t (ecase rating 471 | (:again 472 | (nth (setf (card-step card) 0) (scheduler-learning-steps scheduler))) 473 | (:hard 474 | (cond 475 | ((and (= (card-step card) 0) (= (length (scheduler-learning-steps scheduler)) 1)) 476 | (timespan* (nth 0 (scheduler-learning-steps scheduler)) 1.5)) 477 | ((and (= (card-step card) 0) (>= (length (scheduler-learning-steps scheduler)) 2)) 478 | (timespan* (timespan+ (nth 0 (scheduler-learning-steps scheduler)) 479 | (nth 1 (scheduler-learning-steps scheduler))) 480 | (/ 2.0))) 481 | (t (nth (card-step card) (scheduler-learning-steps scheduler))))) 482 | (:good 483 | (if (= (1+ (card-step card)) (length (scheduler-learning-steps scheduler))) 484 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 485 | (setf (card-state card) :review 486 | (card-step card) nil) 487 | (make-timespan :day days)) 488 | (nth (incf (card-step card)) (scheduler-learning-steps scheduler)))) 489 | (:easy 490 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 491 | (setf (card-state card) :review 492 | (card-step card) nil) 493 | (make-timespan :day days))))))) 494 | (:review 495 | (if (and days-since-last (< days-since-last 1)) 496 | (setf (card-stability card) (scheduler-short-term-stability scheduler (card-stability card) rating) 497 | (card-difficulty card) (scheduler-next-difficulty scheduler (card-difficulty card) rating)) 498 | (setf (card-stability card) (if (eq rating :again) 499 | (scheduler-next-forget-stability scheduler (card-difficulty card) (card-stability card) 500 | (scheduler-card-retrievability scheduler card review-time)) 501 | (scheduler-next-recall-stability scheduler (card-difficulty card) (card-stability card) 502 | (scheduler-card-retrievability scheduler card review-time) 503 | rating)) 504 | (card-difficulty card) (scheduler-next-difficulty scheduler (card-difficulty card) rating))) 505 | (ecase rating 506 | (:again 507 | (if (null (scheduler-relearning-steps scheduler)) 508 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 509 | (make-timespan :day days)) 510 | (nth (setf (card-state card) :relearning (card-step card) 0) 511 | (scheduler-relearning-steps scheduler)))) 512 | 513 | ((:hard :good :easy) 514 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 515 | (make-timespan :day days))))) 516 | (:relearning 517 | (if (and days-since-last (< days-since-last 1)) 518 | (setf (card-stability card) (scheduler-short-term-stability scheduler (card-stability card) rating) 519 | (card-difficulty card) (scheduler-next-difficulty scheduler (card-difficulty card) rating)) 520 | (setf (card-stability card) (scheduler-next-recall-stability scheduler (card-difficulty card) (card-stability card) 521 | (scheduler-card-retrievability scheduler card review-time) 522 | rating) 523 | (card-difficulty card) (scheduler-next-difficulty scheduler (card-difficulty card) rating))) 524 | (cond 525 | ((or (null (scheduler-relearning-steps scheduler)) 526 | (and (>= (card-step card) (length (scheduler-relearning-steps scheduler))) 527 | (member rating '(:hard :good :easy)))) 528 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 529 | (setf (card-state card) :review 530 | (card-step card) nil) 531 | (make-timespan :day days))) 532 | (t 533 | (ecase rating 534 | (:again 535 | (nth (setf (card-step card) 0) (scheduler-relearning-steps scheduler))) 536 | (:hard 537 | (cond 538 | ((and (= (card-step card) 0) (= (length (scheduler-relearning-steps scheduler)) 1)) 539 | (timespan* (nth 0 (scheduler-relearning-steps scheduler)) 1.5)) 540 | ((and (= (card-step card) 0) (>= (length (scheduler-relearning-steps scheduler)) 2)) 541 | (timespan* (timespan+ (nth 0 (scheduler-relearning-steps scheduler)) 542 | (nth 1 (scheduler-relearning-steps scheduler))) 543 | (/ 2.0))) 544 | (t (nth (card-step card) (scheduler-relearning-steps scheduler))))) 545 | 546 | (:good 547 | (if (= (1+ (card-step card)) (length (scheduler-relearning-steps scheduler))) 548 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 549 | (setf (card-state card) :review 550 | (card-step card) nil) 551 | (make-timespan :day days)) 552 | (nth (incf (card-step card)) (scheduler-relearning-steps scheduler)))) 553 | (:easy 554 | (let ((days (scheduler-next-interval scheduler (card-stability card)))) 555 | (setf (card-state card) :review 556 | (card-step card) nil) 557 | (make-timespan :day days)))))))))) 558 | (when (and (scheduler-enable-fuzzing-p scheduler) (eq (card-state card) :review)) 559 | (setf scheduler-next-interval (scheduler-fuzzed-interval scheduler scheduler-next-interval))) 560 | (setf (card-due card) (timespan-apply scheduler-next-interval review-time) 561 | (card-last-review card) review-time) 562 | (values card (make-review-log :card-id (card-card-id card) 563 | :rating rating 564 | :review-datetime review-time 565 | :review-duration review-duration)))) 566 | -------------------------------------------------------------------------------- /fsrs.el: -------------------------------------------------------------------------------- 1 | ;;; fsrs.el --- Free Spaced Repetition Scheduler -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2025 Open Spaced Repetition 4 | 5 | ;; Author: Open Spaced Repetition 6 | ;; Maintainer: Open Spaced Repetition 7 | ;; Version: 6.0 8 | ;; Package-Requires: ((emacs "25.1")) 9 | ;; URL: https://github.com/open-spaced-repetition/lisp-fsrs 10 | ;; Keywords: tools 11 | 12 | ;; This file is not part of GNU Emacs. 13 | 14 | ;; Permission is hereby granted, free of charge, to any person obtaining a copy of 15 | ;; this software and associated documentation files (the "Software"), to deal in 16 | ;; the Software without restriction, including without limitation the rights to 17 | ;; use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 18 | ;; of the Software, and to permit persons to whom the Software is furnished to do 19 | ;; so, subject to the following conditions: 20 | ;; 21 | ;; The above copyright notice and this permission notice shall be included in all 22 | ;; copies or substantial portions of the Software. 23 | ;; 24 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 25 | ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 26 | ;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 27 | ;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 28 | ;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 29 | ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 30 | ;; SOFTWARE. 31 | 32 | ;;; Commentary: 33 | 34 | ;; FSRS (Free Spaced Repetition Scheduler) is a spaced repetition 35 | ;; algorithm that optimizes review scheduling by adapting to individual 36 | ;; memory patterns, outperforming traditional algorithms like SM-2. 37 | 38 | ;;; Code: 39 | 40 | (require 'cl-lib) 41 | 42 | (require 'cl-generic) 43 | 44 | (require 'parse-time) 45 | 46 | (cl-deftype fsrs-timestamp nil "ISO 8601 UTC timestamp string type. 47 | 48 | Represents time values in `YYYY-MM-DDTHH:MM:SSZ' format. Used 49 | throughout FSRS for all date/time tracking related to card scheduling 50 | and review logging." 51 | 'string) 52 | 53 | (cl-defun fsrs-now (&optional time) 54 | "Get current UTC time as FSRS-TIMESTAMP string. 55 | 56 | When TIME is non-nil (accepts time value or nil), format that instead 57 | of current time. Returns string formatted according to ISO 8601 with 58 | UTC timezone." 59 | (format-time-string "%FT%TZ" time "UTC0")) 60 | 61 | (cl-defun fsrs-timestamp-difference (time-a time-b) 62 | "Calculate difference between two timestamps in seconds. 63 | 64 | TIME-A and TIME-B must both be FSRS-TIMESTAMP strings. Returns 65 | floating-point number representing TIME-A minus TIME-B in seconds. 66 | Handles ISO 8601 parsing." 67 | (- (time-to-seconds (parse-iso8601-time-string time-a)) 68 | (time-to-seconds (parse-iso8601-time-string time-b)))) 69 | 70 | (cl-defun fsrs-timestamp+ (time amount unit) 71 | "Create new FSRS-TIMESTAMP by adding time units. 72 | 73 | TIME is base FSRS-TIMESTAMP string. AMOUNT is number of units to add. UNIT 74 | is one of :sec/:minute/:hour/:day keyword specifying time unit. 75 | Returns new ISO 8601 string calculated by adding AMOUNT × UNIT's 76 | seconds to TIME." 77 | (fsrs-now 78 | (+ (time-to-seconds (parse-iso8601-time-string time)) 79 | (* amount 80 | (cl-ecase unit (:sec 1) (:minute 60) (:hour 3600) (:day 86400)))))) 81 | 82 | (cl-deftype fsrs-state nil "Learning phase progression state." 83 | '(member :learning :review :relearning)) 84 | 85 | (cl-declaim (ftype (function (fsrs-state) (integer 0 3)) fsrs-state-integer) 86 | (inline fsrs-state-integer)) 87 | 88 | (cl-defun fsrs-state-integer (fsrs-state) 89 | "Convert FSRS-STATE to an integer (0-3)." 90 | (cl-ecase fsrs-state (:new 0) (:learning 1) (:review 2) (:relearning 3))) 91 | 92 | (cl-deftype fsrs-rating nil "User response rating for memory recall success." 93 | '(member :again :hard :good :easy)) 94 | 95 | (cl-declaim (ftype (function (fsrs-rating) (integer 1 4)) fsrs-rating-integer) 96 | (inline fsrs-rating-integer)) 97 | 98 | (cl-defun fsrs-rating-integer (fsrs-rating) 99 | "Convert FSRS-RATING to an integer (1-4). 100 | 101 | FSRS-RATING is the user's response quality (:again/:hard/:good/:easy)." 102 | (cl-ecase fsrs-rating (:again 1) (:hard 2) (:good 3) (:easy 4))) 103 | 104 | (cl-deftype fsrs-parameters nil 105 | "Array type containing 21 single-floats for FSRS parameters." 'vector) 106 | 107 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 108 | (defconst fsrs-default-parameters 109 | (cl-coerce 110 | '(0.212 1.2931 2.3065 8.2956 6.4133 0.8334 3.0194 0.001 1.8722 0.1666 0.796 111 | 1.4835 0.0614 0.2629 1.6483 0.6014 1.8729 0.5425 0.0912 0.0658 0.1542) 112 | 'vector) 113 | "Default weight values for FSRS parameters.")) 114 | 115 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 116 | (defconst fsrs-lower-bounds-parameters 117 | (cl-coerce 118 | '(0.001 0.001 0.001 0.001 1.0 0.001 0.001 0.001 0.0 0.0 0.001 0.001 0.001 119 | 0.001 0.0 0.0 1.0 0.0 0.0 0.0 0.1) 120 | 'vector) 121 | "Lower bounds for FSRS parameter values.")) 122 | 123 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 124 | (defconst fsrs-upper-bounds-parameters 125 | (cl-coerce 126 | '(100.0 100.0 100.0 100.0 10.0 4.0 4.0 0.75 4.5 0.8 3.5 5.0 0.25 0.9 4.0 1.0 127 | 6.0 2.0 2.0 0.8 0.8) 128 | 'vector) 129 | "Upper bounds for FSRS parameter values.")) 130 | 131 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 132 | (defconst fsrs-minimum-difficulty 1.0 133 | "Minimum allowed difficulty value (1.0).")) 134 | 135 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 136 | (defconst fsrs-maximum-difficulty 10.0 137 | "Maximum allowed difficulty value (10.0).")) 138 | 139 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 140 | (defconst fsrs-minimum-stability 0.001 141 | "Minimum allowed stability value (0.001).")) 142 | 143 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 144 | (defconst fsrs-fuzz-ranges 145 | '(((2.5 :day) (7.0 :day) 0.15) ((7.0 :day) (20.0 :day) 0.1) 146 | ((20.0 :day) nil 0.05)) 147 | "Fuzz factor ranges for interval randomization.")) 148 | 149 | (cl-deftype fsrs-difficulty nil 150 | "Single-float type representing item difficulty (1.0-10.0)." 151 | (list 'float fsrs-minimum-difficulty fsrs-maximum-difficulty)) 152 | 153 | (cl-deftype fsrs-stability nil 154 | "Single-float type representing memory stability (>= 0.001)." 155 | (list 'float fsrs-minimum-stability)) 156 | 157 | (cl-deftype fsrs-retrievability nil 158 | "Single-float type representing recall probability (0.0-1.0)." 159 | '(float 0.0 1.0)) 160 | 161 | (cl-defstruct 162 | (fsrs-card (:copier fsrs-copy-card) (:constructor fsrs-make-card)) 163 | "Represents a memorization item with scheduling state and memory metrics. 164 | 165 | CARD-ID is the unique identifier for the card. 166 | STATE is the current learning phase (:learning/:review/:relearning). 167 | STEP is the current position in learning/relearning steps. 168 | STABILITY is the memory retention strength (higher = more stable). 169 | DIFFICULTY is the item complexity (1.0-10.0 scale). 170 | DUE is the timestamp for next review. 171 | LAST-REVIEW is the timestamp of most recent review or NIL if new." 172 | (card-id 0 :type fixnum) (state :learning :type fsrs-state) 173 | (step 0 :type (or fixnum null)) (stability nil :type (or float null)) 174 | (difficulty nil :type (or float null)) (due (fsrs-now) :type fsrs-timestamp) 175 | (last-review nil :type (or fsrs-timestamp null))) 176 | 177 | (cl-defstruct 178 | (fsrs-review-log (:copier fsrs-copy-review-log) 179 | (:constructor fsrs-make-review-log)) 180 | "Record of individual review event. 181 | 182 | CARD-ID is the identifier of the reviewed card. 183 | RATING is the user's response quality (:again/:hard/:good/:easy). 184 | REVIEW-DATETIME is the timestamp when review occurred. 185 | REVIEW-DURATION is the time spent reviewing in seconds or NIL." 186 | (card-id 0 :type fixnum) (rating :again :type fsrs-rating) 187 | (review-datetime (fsrs-now) :type fsrs-timestamp) 188 | (review-duration nil :type (or fixnum null))) 189 | 190 | (cl-eval-when (:compile-toplevel :load-toplevel :execute) 191 | (defconst fsrs-time-units 192 | '((:sec . 1) (:minute . 60) (:hour . 3600) (:day . 86400)) 193 | "Time unit conversion factors in seconds.")) 194 | 195 | (cl-deftype fsrs-timespan nil 196 | "Cons type representing a duration with multiple time units." 'cons) 197 | 198 | (cl-declaim 199 | (ftype (function (fsrs-timespan) (or fixnum float)) fsrs-timespan-seconds)) 200 | 201 | (cl-defun fsrs-timespan-seconds (fsrs-timespan) 202 | "Convert FSRS-TIMESPAN to total seconds. 203 | 204 | FSRS-TIMESPAN is a cons list of (AMOUNT UNIT) pairs." 205 | (cl-loop for (amount unit) on fsrs-timespan by #'cddr sum 206 | (* amount (alist-get unit fsrs-time-units nil nil #'eql)))) 207 | 208 | (cl-declaim (ftype (function (fsrs-timespan) float) fsrs-timespan-days)) 209 | 210 | (cl-defun fsrs-timespan-days (fsrs-timespan) 211 | "Convert FSRS-TIMESPAN to total days. 212 | 213 | FSRS-TIMESPAN is a cons list of (AMOUNT UNIT) pairs." 214 | (/ (fsrs-timespan-seconds fsrs-timespan) 86400.0)) 215 | 216 | (cl-declaim (ftype (function (fixnum) fsrs-timespan) fsrs-seconds-timespan)) 217 | 218 | (cl-defun fsrs-seconds-timespan (seconds) 219 | "Convert SECONDS to timespan with multiple units. 220 | 221 | SECONDS is the total duration to convert." 222 | (cl-loop for (unit . amount) in (reverse fsrs-time-units) for (part remainder) 223 | = (cl-multiple-value-list (cl-truncate (or remainder seconds) amount)) unless 224 | (zerop part) nconc (list part unit) until (zerop remainder))) 225 | 226 | (cl-declaim (ftype (function (&rest t) fsrs-timespan) fsrs-make-timespan)) 227 | 228 | (cl-defun fsrs-make-timespan (&rest args) 229 | "Create timespan from alternating UNIT AMOUNT pairs. 230 | 231 | ARGS is a plist of time units and amounts." 232 | (cl-loop for (unit amount) on args by #'cddr nconc (list amount unit))) 233 | 234 | (cl-declaim 235 | (ftype (function (fsrs-timespan (or float fixnum)) fsrs-timespan) 236 | fsrs-timespan*)) 237 | 238 | (cl-defun fsrs-timespan* (fsrs-timespan factor) 239 | "Multiply FSRS-TIMESPAN by FACTOR. 240 | 241 | FSRS-TIMESPAN is the duration to scale. FACTOR is the multiplier." 242 | (fsrs-seconds-timespan 243 | (cl-nth-value 0 244 | (cl-truncate (* (fsrs-timespan-seconds fsrs-timespan) factor))))) 245 | 246 | (cl-declaim 247 | (ftype (function (fsrs-timespan &optional fsrs-timestamp) fsrs-timestamp) 248 | fsrs-timespan-apply)) 249 | 250 | (cl-defun fsrs-timespan-apply 251 | (fsrs-timespan &optional (fsrs-timestamp (fsrs-now))) 252 | "Apply FSRS-TIMESPAN to FSRS-TIMESTAMP. 253 | 254 | FSRS-TIMESPAN is the duration to add. FSRS-TIMESTAMP is the base time." 255 | (cl-loop with result = fsrs-timestamp for (amount unit) on fsrs-timespan by 256 | #'cddr do (setf result (fsrs-timestamp+ result amount unit)) finally 257 | (cl-return result))) 258 | 259 | (cl-defmacro fsrs-define-timespan-operator (operator) 260 | "Define a timespan operator function that applying OPERATOR to timespans. 261 | 262 | OPERATOR is the arithmetic function to apply to timespan values. The generated 263 | function will convert timespans to seconds, apply OPERATOR, then convert back to 264 | timespan format." 265 | (let ((args (make-symbol (symbol-name 'args)))) 266 | (list 'cl-defun 267 | (intern 268 | (cl-concatenate 'string (symbol-name 'fsrs-timespan) 269 | (if (> (length (symbol-name operator)) 2) 270 | "-" 271 | "") 272 | (symbol-name operator))) 273 | (list '&rest args) 274 | (cl-concatenate 'string "Apply " (symbol-name operator) " to TIMESPANs. 275 | 276 | ARGS is the list of timespan values to operate on. Each timespan is converted to 277 | seconds before applying the operation, with the result converted back to 278 | timespan format.") 279 | (list 'fsrs-seconds-timespan 280 | (list 'apply (list 'cl-function operator) 281 | (list 'cl-mapcar 282 | (list 'cl-function 'fsrs-timespan-seconds) args)))))) 283 | 284 | (fsrs-define-timespan-operator +) 285 | 286 | (fsrs-define-timespan-operator -) 287 | 288 | (fsrs-define-timespan-operator min) 289 | 290 | (fsrs-define-timespan-operator max) 291 | 292 | (cl-declaim (ftype (function ((or fixnum float)) fixnum) fsrs-seconds-days)) 293 | 294 | (cl-defun fsrs-seconds-days (secs) 295 | "Convert SECS to integer days by truncating fractional part. 296 | 297 | SECS can be fixnum or double-float." 298 | (cl-nth-value 0 (cl-truncate secs 86400))) 299 | 300 | (cl-defstruct 301 | (fsrs-scheduler (:copier fsrs-copy-scheduler) 302 | (:constructor fsrs--make-scheduler)) 303 | "Container for FSRS scheduling configuration and parameters. 304 | 305 | PARAMETERS is the array of FSRS algorithm weights and coefficients. 306 | DESIRED-RETENTION is the target probability of successful recall (0.0-1.0). 307 | LEARNING-STEPS is the list of time intervals for initial learning phase. 308 | RELEARNING-STEPS is the list of time intervals for relearning phase. 309 | MAXIMUM-INTERVAL is the upper bound for scheduling intervals. 310 | ENABLE-FUZZING-P is the flag to randomize intervals within bounds." 311 | (parameters fsrs-default-parameters :type fsrs-parameters) 312 | (desired-retention 0.9 :type float) 313 | (learning-steps '((1 :minute) (10 :minute)) :type list) 314 | (relearning-steps '((10 :minute)) :type list) 315 | (maximum-interval '(36500 :day) :type fsrs-timespan) 316 | (enable-fuzzing-p t :type boolean)) 317 | 318 | (cl-declaim 319 | (ftype (function (fsrs-scheduler) positive-fixnum) 320 | fsrs-scheduler-maximum-interval-days)) 321 | 322 | (cl-defun fsrs-scheduler-maximum-interval-days (fsrs-scheduler) 323 | "Get maximum interval in days from FSRS-SCHEDULER. 324 | 325 | FSRS-SCHEDULER is the FSRS scheduler instance." 326 | (cl-destructuring-bind (n day) 327 | (fsrs-scheduler-maximum-interval fsrs-scheduler) (cl-assert (eq day :day)) n)) 328 | 329 | (cl-declaim 330 | (ftype (function (fsrs-scheduler) (cl-values float float)) 331 | fsrs-scheduler-factor-decay)) 332 | 333 | (cl-defun fsrs-scheduler-factor-decay (fsrs-scheduler) 334 | "Calculate decay and factor from scheduler parameters. 335 | 336 | FSRS-SCHEDULER is the FSRS scheduler instance containing parameter weights. 337 | Returns two values as single-floats: factor and decay." 338 | (let ((decay (- (aref (fsrs-scheduler-parameters fsrs-scheduler) 20)))) 339 | (cl-values (1- (expt 0.9 (/ decay))) decay))) 340 | 341 | (cl-declaim (ftype #'(fsrs-parameters) fsrs-scheduler-validate-parameters)) 342 | 343 | (cl-defun fsrs-scheduler-validate-parameters (fsrs-parameters) 344 | "Validate FSRS-PARAMETERS against bounds. 345 | 346 | FSRS-PARAMETERS is the FSRS parameter array to check." 347 | (cl-loop for p across fsrs-parameters for lower across 348 | fsrs-lower-bounds-parameters for upper across fsrs-upper-bounds-parameters do 349 | (cl-assert (<= lower p upper)))) 350 | 351 | (cl-declaim (ftype (function (&rest t) fsrs-scheduler) fsrs-make-scheduler)) 352 | 353 | (cl-defun fsrs-make-scheduler (&rest args) 354 | "Create scheduler instance with specified configuration. 355 | 356 | ARGS can override default parameters and settings." 357 | (let ((fsrs-scheduler (apply #'fsrs--make-scheduler args))) 358 | (fsrs-scheduler-validate-parameters 359 | (fsrs-scheduler-parameters fsrs-scheduler)) 360 | fsrs-scheduler)) 361 | 362 | (cl-declaim 363 | (ftype 364 | (function (fsrs-scheduler fsrs-card &optional fsrs-timestamp) 365 | fsrs-retrievability) 366 | fsrs-scheduler-card-retrievability)) 367 | 368 | (cl-defun fsrs-scheduler-card-retrievability 369 | (fsrs-scheduler fsrs-card &optional (current-time (fsrs-now))) 370 | "Calculate current recall probability for FSRS-CARD. 371 | 372 | FSRS-SCHEDULER is the scheduling configuration. FSRS-CARD is the item 373 | to evaluate. CURRENT-TIME is the optional timestamp to use as now." 374 | (unless (fsrs-card-last-review fsrs-card) 375 | (cl-return-from fsrs-scheduler-card-retrievability 0.0)) 376 | (let ((elapsed-days 377 | (max 0 378 | (fsrs-seconds-days 379 | (fsrs-timestamp-difference current-time 380 | (fsrs-card-last-review fsrs-card)))))) 381 | (cl-multiple-value-bind (factor decay) 382 | (fsrs-scheduler-factor-decay fsrs-scheduler) 383 | (expt (1+ (/ (* factor elapsed-days) (fsrs-card-stability fsrs-card))) 384 | decay)))) 385 | 386 | (cl-declaim 387 | (ftype (function (fsrs-scheduler float) fsrs-difficulty) 388 | fsrs-scheduler-clamp-difficulty)) 389 | 390 | (cl-defun fsrs-scheduler-clamp-difficulty (fsrs-scheduler fsrs-difficulty) 391 | "Clamp FSRS-DIFFICULTY to valid range (1.0-10.0). 392 | 393 | FSRS-SCHEDULER is unused. FSRS-DIFFICULTY is the value to clamp." 394 | (ignore fsrs-scheduler) 395 | (max fsrs-minimum-difficulty (min fsrs-maximum-difficulty fsrs-difficulty))) 396 | 397 | (cl-declaim 398 | (ftype (function (fsrs-scheduler float) fsrs-stability) 399 | fsrs-scheduler-clamp-stability)) 400 | 401 | (cl-defun fsrs-scheduler-clamp-stability (fsrs-scheduler fsrs-stability) 402 | "Clamp FSRS-STABILITY to minimum value (0.001). 403 | 404 | FSRS-SCHEDULER is unused. FSRS-STABILITY is the value to clamp." 405 | (ignore fsrs-scheduler) (max fsrs-minimum-stability fsrs-stability)) 406 | 407 | (cl-declaim 408 | (ftype (function (fsrs-scheduler fsrs-rating) fsrs-stability) 409 | fsrs-scheduler-initial-stability)) 410 | 411 | (cl-defun fsrs-scheduler-initial-stability (fsrs-scheduler fsrs-rating) 412 | "Compute initial stability after first review. 413 | 414 | FSRS-SCHEDULER contains the parameter weights. FSRS-RATING is the user's 415 | response." 416 | (let ((fsrs-stability 417 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 418 | (1- (fsrs-rating-integer fsrs-rating))))) 419 | (fsrs-scheduler-clamp-stability fsrs-scheduler fsrs-stability))) 420 | 421 | (cl-declaim 422 | (ftype (function (fsrs-scheduler fsrs-rating) fsrs-difficulty) 423 | fsrs-scheduler-initial-difficulty)) 424 | 425 | (cl-defun fsrs-scheduler-initial-difficulty (fsrs-scheduler fsrs-rating) 426 | "Compute initial difficulty after first review for FSRS-RATING. 427 | 428 | FSRS-SCHEDULER contains the parameter weights. FSRS-RATING is the user's 429 | response quality." 430 | (let ((fsrs-difficulty 431 | (1+ 432 | (- (aref (fsrs-scheduler-parameters fsrs-scheduler) 4) 433 | (exp 434 | (* (aref (fsrs-scheduler-parameters fsrs-scheduler) 5) 435 | (1- (fsrs-rating-integer fsrs-rating)))))))) 436 | (fsrs-scheduler-clamp-difficulty fsrs-scheduler fsrs-difficulty))) 437 | 438 | (cl-declaim 439 | (ftype (function (fsrs-scheduler fsrs-stability) fixnum) 440 | fsrs-scheduler-next-interval)) 441 | 442 | (cl-defun fsrs-scheduler-next-interval (fsrs-scheduler fsrs-stability) 443 | "Calculate next review interval in days for given FSRS-STABILITY. 444 | 445 | FSRS-SCHEDULER contains scheduling parameters. FSRS-STABILITY is the memory 446 | strength." 447 | (cl-multiple-value-bind (factor decay) 448 | (fsrs-scheduler-factor-decay fsrs-scheduler) 449 | (let ((interval 450 | (* (/ fsrs-stability factor) 451 | (1- 452 | (expt (fsrs-scheduler-desired-retention fsrs-scheduler) 453 | (/ decay)))))) 454 | (min (max (cl-nth-value 0 (cl-round interval)) 1) 455 | (fsrs-scheduler-maximum-interval-days fsrs-scheduler))))) 456 | 457 | (cl-declaim 458 | (ftype (function (fsrs-scheduler fsrs-stability fsrs-rating) fsrs-stability) 459 | fsrs-scheduler-short-term-stability)) 460 | 461 | (cl-defun fsrs-scheduler-short-term-stability 462 | (fsrs-scheduler fsrs-stability fsrs-rating) 463 | "Calculate short-term stability adjustment after reviewing with FSRS-RATING. 464 | 465 | FSRS-SCHEDULER contains model parameters. FSRS-STABILITY is the current memory 466 | strength. FSRS-RATING is the user's response quality (:again/:hard/:good/:easy)." 467 | (let* ((increase 468 | (* 469 | (exp 470 | (* (aref (fsrs-scheduler-parameters fsrs-scheduler) 17) 471 | (+ (- (fsrs-rating-integer fsrs-rating) 3) 472 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 18)))) 473 | (expt fsrs-stability 474 | (- (aref (fsrs-scheduler-parameters fsrs-scheduler) 19))))) 475 | (new-stability 476 | (* fsrs-stability 477 | (if (cl-member fsrs-rating '(:good :easy)) 478 | (max increase 1.0) 479 | increase)))) 480 | (fsrs-scheduler-clamp-stability fsrs-scheduler new-stability))) 481 | 482 | (cl-declaim 483 | (ftype (function (fsrs-scheduler fsrs-difficulty fsrs-rating) fsrs-difficulty) 484 | fsrs-scheduler-next-difficulty)) 485 | 486 | (cl-defun fsrs-scheduler-next-difficulty 487 | (fsrs-scheduler fsrs-difficulty fsrs-rating) 488 | "Calculate next difficulty level after reviewing with FSRS-RATING. 489 | 490 | FSRS-SCHEDULER contains model parameters. FSRS-DIFFICULTY is the current item 491 | complexity. FSRS-RATING is the user's response quality 492 | (:again/:hard/:good/:easy)." 493 | (let* ((linear-damping 494 | (* (/ (- 10.0 fsrs-difficulty) 9.0) 495 | (- 496 | (* (aref (fsrs-scheduler-parameters fsrs-scheduler) 6) 497 | (- (fsrs-rating-integer fsrs-rating) 3))))) 498 | (mean-reversion 499 | (+ 500 | (* (aref (fsrs-scheduler-parameters fsrs-scheduler) 7) 501 | (fsrs-scheduler-initial-difficulty fsrs-scheduler :easy)) 502 | (* (- 1 (aref (fsrs-scheduler-parameters fsrs-scheduler) 7)) 503 | (+ fsrs-difficulty linear-damping))))) 504 | (fsrs-scheduler-clamp-difficulty fsrs-scheduler mean-reversion))) 505 | 506 | (cl-declaim 507 | (ftype 508 | (function (fsrs-scheduler fsrs-difficulty fsrs-stability fsrs-retrievability) 509 | fsrs-stability) 510 | fsrs-scheduler-next-forget-stability)) 511 | 512 | (cl-defun fsrs-scheduler-next-forget-stability 513 | (fsrs-scheduler fsrs-difficulty fsrs-stability fsrs-retrievability) 514 | "Calculate stability after forgetting during review. 515 | 516 | FSRS-SCHEDULER contains model parameters. FSRS-DIFFICULTY is the item 517 | complexity. FSRS-STABILITY is the current memory strength. 518 | FSRS-RETRIEVABILITY is the recall probability." 519 | (let ((long-term 520 | (* (aref (fsrs-scheduler-parameters fsrs-scheduler) 11) 521 | (expt fsrs-difficulty 522 | (- (aref (fsrs-scheduler-parameters fsrs-scheduler) 12))) 523 | (1- 524 | (expt (1+ fsrs-stability) 525 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 13))) 526 | (exp 527 | (* (- 1 fsrs-retrievability) 528 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 14))))) 529 | (short-term 530 | (/ fsrs-stability 531 | (exp 532 | (* (aref (fsrs-scheduler-parameters fsrs-scheduler) 17) 533 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 18)))))) 534 | (min long-term short-term))) 535 | 536 | (cl-declaim 537 | (ftype 538 | (function 539 | (fsrs-scheduler fsrs-difficulty fsrs-stability fsrs-retrievability 540 | fsrs-rating) 541 | fsrs-stability) 542 | fsrs-scheduler-next-recall-stability)) 543 | 544 | (cl-defun fsrs-scheduler-next-recall-stability 545 | (fsrs-scheduler fsrs-difficulty fsrs-stability fsrs-retrievability 546 | fsrs-rating) 547 | "Calculate stability after successful recall with FSRS-RATING. 548 | 549 | FSRS-SCHEDULER contains model parameters. FSRS-DIFFICULTY is the item 550 | complexity. FSRS-STABILITY is the current memory strength. 551 | FSRS-RETRIEVABILITY is the recall probability. FSRS-RATING is the user's 552 | response quality (:again/:hard/:good/:easy)." 553 | (let* ((hard-penalty 554 | (if (eq fsrs-rating :hard) 555 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 15) 556 | 1.0)) 557 | (easy-bonus 558 | (if (eq fsrs-rating :easy) 559 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 16) 560 | 1.0)) 561 | (new-stability 562 | (* fsrs-stability 563 | (1+ 564 | (* (exp (aref (fsrs-scheduler-parameters fsrs-scheduler) 8)) 565 | (- 11.0 fsrs-difficulty) 566 | (expt fsrs-stability 567 | (- (aref (fsrs-scheduler-parameters fsrs-scheduler) 9))) 568 | (1- 569 | (exp 570 | (* (- 1.0 fsrs-retrievability) 571 | (aref (fsrs-scheduler-parameters fsrs-scheduler) 10)))) 572 | hard-penalty easy-bonus))))) 573 | (fsrs-scheduler-clamp-stability fsrs-scheduler new-stability))) 574 | 575 | (cl-declaim 576 | (ftype (function (fsrs-scheduler fsrs-timespan) fsrs-timespan) 577 | fsrs-scheduler-fuzzed-interval)) 578 | 579 | (cl-defun fsrs-scheduler-fuzzed-interval (fsrs-scheduler interval) 580 | "Apply random fuzzing to INTERVAL based on fuzz ranges. 581 | 582 | FSRS-SCHEDULER contains fuzzing configuration. INTERVAL is the base timespan." 583 | (let ((days (fsrs-timespan-days interval))) 584 | (cond ((< days 2.5) interval) 585 | (t 586 | (let* ((delta 587 | (cl-loop for (start end factor) in fsrs-fuzz-ranges sum 588 | (* factor 589 | (max 0 590 | (min (or (when end (fsrs-timespan-days end)) days) 591 | days) 592 | (fsrs-timespan-days start))))) 593 | (min-ivl 594 | (max 2 595 | (min (cl-nth-value 0 (cl-round (- days delta))) 596 | (fsrs-scheduler-maximum-interval-days 597 | fsrs-scheduler)))) 598 | (max-ivl 599 | (min (cl-nth-value 0 (cl-round (+ days delta))) 600 | (fsrs-scheduler-maximum-interval-days fsrs-scheduler))) 601 | (fuzzed-days 602 | (min 603 | (cl-nth-value 0 604 | (cl-round (+ min-ivl (cl-random (- max-ivl min-ivl -1))))) 605 | (fsrs-scheduler-maximum-interval-days fsrs-scheduler)))) 606 | (fsrs-make-timespan :day fuzzed-days)))))) 607 | 608 | (cl-declaim 609 | (ftype 610 | (function 611 | (fsrs-scheduler fsrs-card fsrs-rating &optional fsrs-timestamp 612 | (or null fixnum)) 613 | (cl-values fsrs-card fsrs-review-log)) 614 | fsrs-scheduler-review-card)) 615 | 616 | (cl-defun fsrs-scheduler-review-card 617 | (fsrs-scheduler fsrs-card fsrs-rating &optional (review-time (fsrs-now)) 618 | review-duration) 619 | "Process FSRS-CARD review with FSRS-RATING and update scheduling state. 620 | 621 | FSRS-SCHEDULER contains configuration parameters. FSRS-CARD is the item being 622 | reviewed. FSRS-RATING is the user's response quality (:again/:hard/:good/:easy). 623 | REVIEW-TIME is the optional timestamp of review. REVIEW-DURATION is the optional 624 | duration." 625 | (let* ((fsrs-card (fsrs-copy-card fsrs-card)) 626 | (days-since-last 627 | (when (fsrs-card-last-review fsrs-card) 628 | (fsrs-seconds-days 629 | (fsrs-timestamp-difference review-time 630 | (fsrs-card-last-review fsrs-card))))) 631 | (fsrs-scheduler-next-interval 632 | (cl-ecase (fsrs-card-state fsrs-card) 633 | (:learning 634 | (cond 635 | ((and (null (fsrs-card-stability fsrs-card)) 636 | (null (fsrs-card-difficulty fsrs-card))) 637 | (setf (fsrs-card-stability fsrs-card) 638 | (fsrs-scheduler-initial-stability fsrs-scheduler 639 | fsrs-rating) 640 | (fsrs-card-difficulty fsrs-card) 641 | (fsrs-scheduler-initial-difficulty fsrs-scheduler 642 | fsrs-rating))) 643 | ((and days-since-last (< days-since-last 1)) 644 | (setf (fsrs-card-stability fsrs-card) 645 | (fsrs-scheduler-short-term-stability fsrs-scheduler 646 | (fsrs-card-stability fsrs-card) fsrs-rating) 647 | (fsrs-card-difficulty fsrs-card) 648 | (fsrs-scheduler-next-difficulty fsrs-scheduler 649 | (fsrs-card-difficulty fsrs-card) fsrs-rating))) 650 | (t 651 | (setf (fsrs-card-stability fsrs-card) 652 | (fsrs-scheduler-next-recall-stability fsrs-scheduler 653 | (fsrs-card-difficulty fsrs-card) 654 | (fsrs-card-stability fsrs-card) 655 | (fsrs-scheduler-card-retrievability fsrs-scheduler 656 | fsrs-card review-time) 657 | fsrs-rating) 658 | (fsrs-card-difficulty fsrs-card) 659 | (fsrs-scheduler-next-difficulty fsrs-scheduler 660 | (fsrs-card-difficulty fsrs-card) fsrs-rating)))) 661 | (cond 662 | ((or (null (fsrs-scheduler-learning-steps fsrs-scheduler)) 663 | (and 664 | (>= (fsrs-card-step fsrs-card) 665 | (length (fsrs-scheduler-learning-steps fsrs-scheduler))) 666 | (cl-member fsrs-rating '(:hard :good :easy)))) 667 | (let ((days 668 | (fsrs-scheduler-next-interval fsrs-scheduler 669 | (fsrs-card-stability fsrs-card)))) 670 | (setf (fsrs-card-state fsrs-card) :review 671 | (fsrs-card-step fsrs-card) nil) 672 | (fsrs-make-timespan :day days))) 673 | (t 674 | (cl-ecase fsrs-rating 675 | (:again 676 | (nth (setf (fsrs-card-step fsrs-card) 0) 677 | (fsrs-scheduler-learning-steps fsrs-scheduler))) 678 | (:hard 679 | (cond 680 | ((and (= (fsrs-card-step fsrs-card) 0) 681 | (= 682 | (length (fsrs-scheduler-learning-steps fsrs-scheduler)) 683 | 1)) 684 | (fsrs-timespan* 685 | (nth 0 (fsrs-scheduler-learning-steps fsrs-scheduler)) 1.5)) 686 | ((and (= (fsrs-card-step fsrs-card) 0) 687 | (>= 688 | (length (fsrs-scheduler-learning-steps fsrs-scheduler)) 689 | 2)) 690 | (fsrs-timespan* 691 | (fsrs-timespan+ 692 | (nth 0 (fsrs-scheduler-learning-steps fsrs-scheduler)) 693 | (nth 1 (fsrs-scheduler-learning-steps fsrs-scheduler))) 694 | (/ 2.0))) 695 | (t 696 | (nth (fsrs-card-step fsrs-card) 697 | (fsrs-scheduler-learning-steps fsrs-scheduler))))) 698 | (:good 699 | (if (= (1+ (fsrs-card-step fsrs-card)) 700 | (length (fsrs-scheduler-learning-steps fsrs-scheduler))) 701 | (let ((days 702 | (fsrs-scheduler-next-interval fsrs-scheduler 703 | (fsrs-card-stability fsrs-card)))) 704 | (setf (fsrs-card-state fsrs-card) :review 705 | (fsrs-card-step fsrs-card) nil) 706 | (fsrs-make-timespan :day days)) 707 | (nth (cl-incf (fsrs-card-step fsrs-card)) 708 | (fsrs-scheduler-learning-steps fsrs-scheduler)))) 709 | (:easy 710 | (let ((days 711 | (fsrs-scheduler-next-interval fsrs-scheduler 712 | (fsrs-card-stability fsrs-card)))) 713 | (setf (fsrs-card-state fsrs-card) :review 714 | (fsrs-card-step fsrs-card) nil) 715 | (fsrs-make-timespan :day days))))))) 716 | (:review 717 | (if (and days-since-last (< days-since-last 1)) 718 | (setf (fsrs-card-stability fsrs-card) 719 | (fsrs-scheduler-short-term-stability fsrs-scheduler 720 | (fsrs-card-stability fsrs-card) fsrs-rating) 721 | (fsrs-card-difficulty fsrs-card) 722 | (fsrs-scheduler-next-difficulty fsrs-scheduler 723 | (fsrs-card-difficulty fsrs-card) fsrs-rating)) 724 | (setf (fsrs-card-stability fsrs-card) 725 | (if (eq fsrs-rating :again) 726 | (fsrs-scheduler-next-forget-stability fsrs-scheduler 727 | (fsrs-card-difficulty fsrs-card) 728 | (fsrs-card-stability fsrs-card) 729 | (fsrs-scheduler-card-retrievability fsrs-scheduler 730 | fsrs-card review-time)) 731 | (fsrs-scheduler-next-recall-stability fsrs-scheduler 732 | (fsrs-card-difficulty fsrs-card) 733 | (fsrs-card-stability fsrs-card) 734 | (fsrs-scheduler-card-retrievability fsrs-scheduler 735 | fsrs-card review-time) 736 | fsrs-rating)) 737 | (fsrs-card-difficulty fsrs-card) 738 | (fsrs-scheduler-next-difficulty fsrs-scheduler 739 | (fsrs-card-difficulty fsrs-card) fsrs-rating))) 740 | (cl-ecase fsrs-rating 741 | (:again 742 | (if (null (fsrs-scheduler-relearning-steps fsrs-scheduler)) 743 | (let ((days 744 | (fsrs-scheduler-next-interval fsrs-scheduler 745 | (fsrs-card-stability fsrs-card)))) 746 | (fsrs-make-timespan :day days)) 747 | (nth 748 | (setf (fsrs-card-state fsrs-card) :relearning 749 | (fsrs-card-step fsrs-card) 0) 750 | (fsrs-scheduler-relearning-steps fsrs-scheduler)))) 751 | ((:hard :good :easy) 752 | (let ((days 753 | (fsrs-scheduler-next-interval fsrs-scheduler 754 | (fsrs-card-stability fsrs-card)))) 755 | (fsrs-make-timespan :day days))))) 756 | (:relearning 757 | (if (and days-since-last (< days-since-last 1)) 758 | (setf (fsrs-card-stability fsrs-card) 759 | (fsrs-scheduler-short-term-stability fsrs-scheduler 760 | (fsrs-card-stability fsrs-card) fsrs-rating) 761 | (fsrs-card-difficulty fsrs-card) 762 | (fsrs-scheduler-next-difficulty fsrs-scheduler 763 | (fsrs-card-difficulty fsrs-card) fsrs-rating)) 764 | (setf (fsrs-card-stability fsrs-card) 765 | (fsrs-scheduler-next-recall-stability fsrs-scheduler 766 | (fsrs-card-difficulty fsrs-card) 767 | (fsrs-card-stability fsrs-card) 768 | (fsrs-scheduler-card-retrievability fsrs-scheduler 769 | fsrs-card review-time) 770 | fsrs-rating) 771 | (fsrs-card-difficulty fsrs-card) 772 | (fsrs-scheduler-next-difficulty fsrs-scheduler 773 | (fsrs-card-difficulty fsrs-card) fsrs-rating))) 774 | (cond 775 | ((or (null (fsrs-scheduler-relearning-steps fsrs-scheduler)) 776 | (and 777 | (>= (fsrs-card-step fsrs-card) 778 | (length 779 | (fsrs-scheduler-relearning-steps fsrs-scheduler))) 780 | (cl-member fsrs-rating '(:hard :good :easy)))) 781 | (let ((days 782 | (fsrs-scheduler-next-interval fsrs-scheduler 783 | (fsrs-card-stability fsrs-card)))) 784 | (setf (fsrs-card-state fsrs-card) :review 785 | (fsrs-card-step fsrs-card) nil) 786 | (fsrs-make-timespan :day days))) 787 | (t 788 | (cl-ecase fsrs-rating 789 | (:again 790 | (nth (setf (fsrs-card-step fsrs-card) 0) 791 | (fsrs-scheduler-relearning-steps fsrs-scheduler))) 792 | (:hard 793 | (cond 794 | ((and (= (fsrs-card-step fsrs-card) 0) 795 | (= 796 | (length 797 | (fsrs-scheduler-relearning-steps fsrs-scheduler)) 798 | 1)) 799 | (fsrs-timespan* 800 | (nth 0 (fsrs-scheduler-relearning-steps fsrs-scheduler)) 801 | 1.5)) 802 | ((and (= (fsrs-card-step fsrs-card) 0) 803 | (>= 804 | (length 805 | (fsrs-scheduler-relearning-steps fsrs-scheduler)) 806 | 2)) 807 | (fsrs-timespan* 808 | (fsrs-timespan+ 809 | (nth 0 (fsrs-scheduler-relearning-steps fsrs-scheduler)) 810 | (nth 1 (fsrs-scheduler-relearning-steps fsrs-scheduler))) 811 | (/ 2.0))) 812 | (t 813 | (nth (fsrs-card-step fsrs-card) 814 | (fsrs-scheduler-relearning-steps fsrs-scheduler))))) 815 | (:good 816 | (if (= (1+ (fsrs-card-step fsrs-card)) 817 | (length 818 | (fsrs-scheduler-relearning-steps fsrs-scheduler))) 819 | (let ((days 820 | (fsrs-scheduler-next-interval fsrs-scheduler 821 | (fsrs-card-stability fsrs-card)))) 822 | (setf (fsrs-card-state fsrs-card) :review 823 | (fsrs-card-step fsrs-card) nil) 824 | (fsrs-make-timespan :day days)) 825 | (nth (cl-incf (fsrs-card-step fsrs-card)) 826 | (fsrs-scheduler-relearning-steps fsrs-scheduler)))) 827 | (:easy 828 | (let ((days 829 | (fsrs-scheduler-next-interval fsrs-scheduler 830 | (fsrs-card-stability fsrs-card)))) 831 | (setf (fsrs-card-state fsrs-card) :review 832 | (fsrs-card-step fsrs-card) nil) 833 | (fsrs-make-timespan :day days)))))))))) 834 | (when 835 | (and (fsrs-scheduler-enable-fuzzing-p fsrs-scheduler) 836 | (eq (fsrs-card-state fsrs-card) :review)) 837 | (setf fsrs-scheduler-next-interval 838 | (fsrs-scheduler-fuzzed-interval fsrs-scheduler 839 | fsrs-scheduler-next-interval))) 840 | (setf (fsrs-card-due fsrs-card) 841 | (fsrs-timespan-apply fsrs-scheduler-next-interval review-time) 842 | (fsrs-card-last-review fsrs-card) review-time) 843 | (cl-values fsrs-card 844 | (fsrs-make-review-log :card-id (fsrs-card-card-id fsrs-card) :rating 845 | fsrs-rating :review-datetime review-time :review-duration 846 | review-duration)))) 847 | 848 | (provide 'fsrs) 849 | ;;; fsrs.el ends here 850 | --------------------------------------------------------------------------------