branch: externals/org-mathsheet
commit 83f43fcc8ab3d80f10891eee0e69992fcf4d59b5
Author: Ian Martins <ia...@jhu.edu>
Commit: Ian Martins <ia...@jhu.edu>
Add .el file
---
mathsheet.el | 607 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 607 insertions(+)
diff --git a/mathsheet.el b/mathsheet.el
new file mode 100644
index 0000000000..ef545a2607
--- /dev/null
+++ b/mathsheet.el
@@ -0,0 +1,607 @@
+;;; mathsheet.el --- Generate dynamic math worksheets -*- lexical-binding:t
-*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Author: Ian Martins <ia...@jhu.edu>
+;; Keywords: tools, education, math
+;; Homepage: https://gitlab.com/ianxm/mathsheet
+;; Version: 1.0
+;; Package-Requires: ((peg "1.0")
+;; (emacs "28.1")
+;; calc)
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package generates dynamic math worksheets. The types and
+;; distribution of problems is highly customizable. Problem sets are
+;; defined using templates and exported to PDF for printing.
+
+;;; Code:
+
+(require 'forms)
+(require 'peg)
+(require 'calc)
+
+(declare-function math-read-expr "calc-ext")
+
+(defgroup mathsheet nil
+ "Options for customizing Mathsheet."
+ :prefix "mathsheet-"
+ :group 'applications
+ :tag "mathsheet")
+
+(defcustom mathsheet-data-file
+ (expand-file-name "mathsheet.dat" user-emacs-directory)
+ "Where to store saved mathsheet configurations.
+
+The default is to save them to a file in the private emacs
+configuration directory."
+ :type 'file
+ :group 'mathsheet)
+
+(defcustom mathsheet-output-directory
+ (expand-file-name "~")
+ "Where to write generated worksheets.
+
+The default is to write the to the home directory."
+ :type 'directory
+ :group 'mathsheet)
+
+(let ((page '"\\documentclass[12pt]{exam}
+\\usepackage[top=1in, bottom=0.5in, left=0.8in, right=0.8in]{geometry}
+\\usepackage{multicol}
+\\usepackage{rotating}
+\\usepackage{xcolor}
+
+\\pagestyle{head}
+\\header{Name:\\enspace\\makebox[2.2in]{\\hrulefill}}{}{Date:\\enspace\\makebox[2.2in]{\\hrulefill}}
+
+\\begin{document}
+
+ \\noindent <<instruction>>
+
+ \\begin{questions}
+ <<problems>>
+ \\end{questions}
+
+ \\vspace*{\\fill}
+
+ \\vspace*{0.1cm}
+ \\noindent\\rule{\\linewidth}{0.4pt}
+ \\vspace*{0.1cm}
+
+ \\begin{turn}{180}
+ \\begin{minipage}{\\linewidth}
+ \\color{gray}
+ \\footnotesize
+ \\begin{questions}
+ <<answers>>
+ \\end{questions}
+ \\end{minipage}
+ \\end{turn}
+
+\\end{document}"))
+(defvar mathsheet--var-list '()
+ "List of variables used within a problem.")
+
+(defconst mathsheet--worksheet-template page
+ "LaTeX template for the worksheet.")
+
+(defconst mathsheet--num-pat (rx string-start (+ num) string-end)
+ "Pattern for integers.")
+
+(defvar mathsheet--field-sheet-name nil
+ "The form record name field.")
+
+(defvar mathsheet--field-count nil
+ "The form record count field.")
+
+(defvar mathsheet--field-cols nil
+ "The form record cols field.")
+
+(defvar mathsheet--field-instruction nil
+ "The form record instruction field.")
+
+(defvar mathsheet--field-problems nil
+ "The form record problems field.")
+
+)
+
+(setq forms-file mathsheet-data-file)
+
+(setq forms-number-of-fields
+ (forms-enumerate
+ '(mathsheet--field-sheet-name
+ mathsheet--field-count
+ mathsheet--field-cols
+ mathsheet--field-instruction
+ mathsheet--field-problems)))
+
+(setq forms-field-sep "||")
+
+(defun mathsheet--new-record-filter (record)
+ "Set defaults in new RECORD."
+ (aset record 2 "20") ; default
+ (aset record 3 "2") ; default
+ (aset record 4 "Find the answer.") ; default
+ (aset record 5 "1 | 1 | ") ; lay out structure
+ record)
+
+(setq forms-new-record-filter 'mathsheet--new-record-filter)
+
+(defun mathsheet--format-templates (record)
+ "Format the template rows in RECORD to line up with the header."
+ (let ((rows (string-split (aref record 5) "\n"))
+ (pat (rx (* space) (group (+ alnum)) (* space) "|"
+ (* space) (group (+ alnum)) (* space) "|"
+ (* space) (group (+ nonl)))))
+ (setq rows (mapconcat
+ (lambda (row)
+ (string-match pat row)
+ (format "%s | %s | %s"
+ (match-string 1 row)
+ (match-string 2 row)
+ (match-string 3 row)))
+ rows
+ "\n"))
+ (aset record 5 rows))
+ record)
+(setq forms-modified-record-filter 'mathsheet--format-templates)
+
+(setq forms-format-list
+ (list
+ "====== Math Sheet Generator ======"
+ "\nSee https://gitlab.com/ianxm/mathsheet for details."
+
+ "\n\nThe base-name of the mathsheet file to write, not including
extension."
+ "\nName: " mathsheet--field-sheet-name
+
+ "\n\nThe total number of problems to put on the sheet."
+ "\nCount: " mathsheet--field-count
+
+ "\n\nThe number of columns the sheet should have."
+ "\nColumns: " mathsheet--field-cols
+
+ "\n\nThe instruction to give at the top of the sheet."
+ "\nInstruction: " mathsheet--field-instruction
+
+ "\n\nThe problem templates from which to generate problems for the
sheet."
+ "\nOne per line, formatted as \"(w)eight | (o)rder | template\".\n\n"
+
+ "w | o | template\n"
+ "--+---+------------------------------------\n"
+ mathsheet--field-problems
+ "\n"))
+
+(defmacro mathsheet--validate (field-name field-str checks)
+ "Add specified checks to validate field input.
+
+FIELD-NAME is the name of the field. FIELD-STR is the string
+value in the record. CHECKS is a list of symbols specifying
+which validation checks to perform."
+ (let (ret)
+ (dolist (check checks)
+ (pcase check
+ ('not-null-p
+ (push
+ `(when (null ,field-str)
+ (error (format "`%s' cannot be empty" ,field-name)))
+ ret))
+ ('is-num-p
+ (when (not (null field-str))
+ (push
+ `(when (not (string-match-p mathsheet--num-pat ,field-str))
+ (error (format "`%s' must be a number" ,field-name)))
+ ret)))
+ (`(in-range-p ,min ,max)
+ (push
+ `(when
+ (or
+ (< (string-to-number ,field-str) ,min)
+ (> (string-to-number ,field-str) ,max))
+ (error (format "`%s' must be between %s and %s, inclusive"
+ ,field-name ,min ,max)))
+ ret))
+ (_
+ (push
+ `(error (format "Unknown check: %s" ,check))
+ ret))
+ ))
+ (append '(progn) ret)))
+
+(defun mathsheet--parse (record)
+ "Parse all of the fields of the current RECORD into an alist."
+ (let (count cols problems)
+
+ (pcase record
+ (`(,name ,count-str ,cols-str ,instruction ,problems-str)
+
+ ;; validate the form fields
+ (mathsheet--validate "name" name (not-null-p))
+ (mathsheet--validate "count" count-str (not-null-p is-num-p (in-range-p
1 30)))
+ (mathsheet--validate "cols" cols-str (not-null-p is-num-p (in-range-p 1
6)))
+ (mathsheet--validate "problems" problems-str (not-null-p))
+
+ ;; convert the numbers and parse the problems field
+ (setq count (string-to-number count-str)
+ cols (string-to-number cols-str)
+ problems (mapcar ; parse rows
+ #'mathsheet--parse-problem-row
+ (seq-filter ; remove possible trailing empty line
+ (lambda (x) (not (string-empty-p x)))
+ (string-split ; split lines
+ problems-str
+ "\n"))))
+
+ `((:name . ,name)
+ (:count . ,count)
+ (:cols . ,cols)
+ (:instr . ,instruction)
+ (:probs . ,problems)))
+ (_ (error "Invalid form data")))))
+
+(defun mathsheet--parse-problem-row (row)
+ "Parse one ROW of the problem field into a list."
+ (let* ((fields (mapcar ; trim whitespace
+ #'string-trim
+ (split-string ; split fields
+ row
+ "|")))
+ (weight-str (nth 0 fields))
+ (order-str (nth 1 fields))
+ (template (nth 2 fields))
+ weight order)
+ (mathsheet--validate "weight" weight-str (not-null-p is-num-p))
+ (mathsheet--validate "order" order-str (not-null-p is-num-p))
+ (mathsheet--validate "template" template (not-null-p))
+ (setq weight (string-to-number weight-str)
+ order (string-to-number order-str))
+ (list weight order template)))
+
+(defun mathsheet-generate-sheet ()
+ "Generate sheet for current form data."
+ (interactive)
+ (when (not (string= major-mode "forms-mode"))
+ (error "Mathsheet must be open to generate a sheet"))
+ (let ((config (mathsheet--parse forms--the-record-list)))
+ (let ((problems (mathsheet--generate-problems
+ (alist-get :probs config)
+ (alist-get :count config)))
+ ;; absolute path without extension
+ (fname (concat
+ (file-name-as-directory mathsheet-output-directory)
+ (string-replace " " "-" (alist-get :name config)))))
+ (mathsheet--write-worksheet
+ fname
+ (alist-get :instr config)
+ problems
+ (alist-get :cols config))
+ (message "Wrote %s problems to %s.pdf"
+ (alist-get :count config)
+ fname))))
+
+(defun mathsheet--scan-problem ()
+ "Scan a problem.
+
+This parses the problem and produces a list containing info about
+its fields. For each field it returns a list containing:
+1. a symbol for the assigned variable or a unique placeholder
+2. a list of variables this field depends on
+3. a cons containing start and end markers for the field in the current buffer
+4. nil which is used by `dfs-visit' later"
+ (let ((field-index 0)
+ open-fields ; stack
+ closed-fields ; list
+ alg-vars)
+
+ (with-peg-rules
+ ((stuff (* (or asn-var math-func alg-var digit symbol field space)))
+ (field open (opt assignment) stuff close)
+ (space (* [space]))
+ (open (region "[")
+ `(l _ -- (progn
+ (push (list
+ (intern (concat "_" (number-to-string
field-index))) ; asn-var
+ nil ; deps
+ (cons (copy-marker l) nil) ; start and end
markers
+ nil) ; not visited
+ open-fields)
+ (setq field-index (1+ field-index))
+ ".")))
+ (assignment (substring letter) "="
+ `(v -- (progn
+ (setcar
+ (car open-fields)
+ (intern v))
+ ".")))
+ (asn-var "$" (substring letter)
+ `(v -- (progn
+ (push (intern v) (cadar open-fields))
+ ".")))
+ (alg-var (substring letter)
+ `(v -- (progn
+ (push v alg-vars)
+ ".")))
+ (close (region "]")
+ `(l _ -- (progn
+ (setcdr (caddar open-fields) (copy-marker l t))
+ (when (> (length open-fields) 1) ; add parent to
child dependency
+ (push (caar open-fields) (cadadr open-fields)))
+ (push (pop open-fields) closed-fields)
+ ".")))
+ (math-func (or "sqrt" "sin" "cos" "tan" "asin" "acos" "atan" "floor"
"ceil" "round"))
+ (letter [a-z])
+ (digit [0-9])
+ (symbol (or "." "," "+" "-" "*" "/" "^" "(" ")" "=")))
+
+ (peg-run (peg stuff)
+ (lambda (x) (message "Failed %s" x))
+ (lambda (x)
+ (funcall x)
+ `((:fields . ,closed-fields)
+ (:alg-vars . ,alg-vars)))))))
+
+(defun mathsheet--reduce-field ()
+ "Reduce the field to a number.
+
+Parse the field again, replacing spans with random numbers and
+evaluating arithmetic operations. The field shouldn't have any
+internal fields so this should result in a single number. Return
+that number."
+ (with-peg-rules
+ ((field "[" space (or math-func expression sequence assignment value)
space "]")
+ (expression (list value space operation space value (* space operation
space value))
+ `(vals -- (string-to-number
+ (calc-eval
+ (list
+ (mapconcat
+ (lambda (x) (if (numberp x) (number-to-string
x) x))
+ vals
+ " "))
+ calc-prefer-frac nil))))
+ (operation (substring (or "+" "-" "*" "/")))
+ (assignment var-lhs space "=" space (or range sequence)
+ `(v r -- (progn
+ (push (cons (intern v) r) mathsheet--var-list)
+ r)))
+ (sequence (list (or range value) (* "," space (or range value)))
+ `(vals -- (seq-random-elt vals)))
+ (range value ".." value
+ `(min max -- (if (>= min max)
+ (error "Range bounds must be increasing")
+ (+ (random (- max min)) min))))
+ (value (or (substring (opt "-") (+ digit)) var-rhs parenthetical)
+ `(v -- (if (stringp v) (string-to-number v) v)))
+ (parenthetical "(" (or expression value) ")")
+ (var-lhs (substring letter)) ; var for assignment
+ (var-rhs "$" (substring letter) ; var for use
+ `(v -- (let ((val (alist-get (intern v) mathsheet--var-list)))
+ (or val (error "Var %s not set" v)))))
+ (math-func (substring (or "sqrt" "sin" "cos" "tan" "asin" "acos" "atan"
"floor" "ceil" "round"))
+ parenthetical
+ `(f v -- (string-to-number (calc-eval (format "%s(%s)" f
v)))))
+ (space (* [space]))
+ (letter [a-z])
+ (digit [0-9]))
+
+ (peg-run (peg field)
+ (lambda (x) (message "Failed %s" x))
+ (lambda (x) (car (funcall x))))))
+
+(defun mathsheet--replace-field (node)
+ "Replace a field in NODE with the number to which it reduces.
+
+Update the current buffer by replacing the field at point in the
+current buffer with the number it reduces to. NODE contains the
+info for the current field."
+ (let ((start (caaddr node))
+ (end (1+ (cdaddr node)))
+ val)
+ (goto-char start)
+ (when (looking-at "\\[")
+ (setq val (mathsheet--reduce-field))
+ (goto-char start)
+ (delete-char (- end start) t)
+ (insert (number-to-string val)))))
+
+(defun mathsheet--dfs-visit (node fields)
+ "Visit NODE as part of a DFS of the problem.
+
+Traverse the fields of a problem using depth first search to
+ensure that field replacement happens in dependency order.
+FIELDS is a list of all fields in the problem."
+ (pcase (cadddr node)
+ (1 (error "Cycle detected")) ; cycle
+ (2) ; skip
+ (_ ; process
+ (setcar (cdddr node) 1) ; started
+ (dolist (dep (cadr node))
+ (mathsheet--dfs-visit
+ (assq dep fields)
+ fields))
+ (mathsheet--replace-field node) ; visit
+ (setcar (cdddr node) 2)))) ; mark done
+
+(defun mathsheet--fill-problem (full-problem)
+ "Replace all fields in FULL-PROBLEM.
+
+Goes through all fields in the given problem in dependency order
+and replaces fields with numbers. When this completes the problem
+will be ready to solve."
+ (with-temp-buffer
+ ;; stage problem in temp buffer
+ (insert full-problem)
+ (goto-char (point-min))
+
+ ;; find fields, assignment variables, algebraic variables, dependencies
+ (let* ((scan-ret (mathsheet--scan-problem))
+ (fields (alist-get :fields scan-ret))
+ (alg-vars (alist-get :alg-vars scan-ret)))
+
+ ;; visit fields ordered according to dependencies
+ (dolist (node fields)
+ (mathsheet--dfs-visit node fields))
+ (setq mathsheet--var-list '())
+
+ ;; return filled problem
+ `((:problem . ,(buffer-string))
+ (:alg-vars . ,alg-vars)))))
+
+(defun mathsheet--generate-problems (templates count)
+ "Use TEMPLATES to generate COUNT problems.
+
+Generate problems and answers based on what is defined in the
+given template table. The template table defines problem
+templates as well as relative weights and how they should be
+ordered."
+ (let (total-weight problems)
+ ;; sort by weight (low to high)
+ (setq templates (sort templates #'car-less-than-car)
+ ;; calc total weight
+ total-weight (seq-reduce (lambda (total item) (+ total (car item)))
+ templates
+ 0.0))
+
+ ;; calculate number for each row
+ (dotimes (ii (length templates))
+ (let* ((item (nth ii templates))
+ (weight (car item))
+ (needed (cond ; number of problems to add for this template
+ ((= weight 0)
+ 0)
+ ((= ii (1- (length templates)))
+ (- count (length problems)))
+ (t
+ (max (round (* (/ weight total-weight) count) ) 1))))
+ (added 0)
+ (dup-count 0)
+ problem-set)
+ (while (< added needed) ; add until "needed" are kept
+ (let* ((fill-ret (mathsheet--fill-problem (caddr item)))
+ (problem (alist-get :problem fill-ret))
+ (alg-vars (alist-get :alg-vars fill-ret))
+ (calc-string (if (not alg-vars)
+ problem
+ (format "solve(%s,[%s])"
+ problem
+ (string-join (seq-uniq alg-vars)
","))))
+ (solution
+ (replace-regexp-in-string (rx (or "[" ".]" "]"))
+ ""
+ (calc-eval `(,calc-string
+ calc-prefer-frac t
+ calc-frac-format ("/"
nil))))))
+ (cond
+ ((member problem problem-set) ; dedup problems
+ (setq dup-count (1+ dup-count))
+ (when (> dup-count 100)
+ ;; high number of dups indicates a narrow problem space
relative to problem count
+ (error "Giving up, too many dups")))
+ (t
+ (push problem problem-set)
+ (push (list problem ; problem
+ solution ; solution
+ (cadr item) ; order
+ (not (null alg-vars))) ; true if algebraic variables
exist
+ problems)
+ (setq added (1+ added))))))))
+
+ ;; shuffle
+ (dotimes (ii (- (length problems) 1))
+ (let ((jj (+ (random (- (length problems) ii)) ii)))
+ (cl-psetf (elt problems ii) (elt problems jj)
+ (elt problems jj) (elt problems ii))))
+
+ ;; sort by order
+ (setq problems (sort problems (lambda (a b) (< (caddr a) (caddr b)))))
+
+ ;; return problems and answers, drop header
+ problems))
+
+(defun mathsheet--convert-to-latex (expr)
+ "Format the given calc expression EXPR for LaTeX.
+
+EXPR should be in normal calc format. The result is the same
+expression (not simplified) but in LaTeX format."
+ (let* ((calc-language 'latex)
+ (calc-expr (math-read-expr expr))
+ (latex-expr (math-format-stack-value (list calc-expr 1 nil)))
+ (latex-expr-cleaned (replace-regexp-in-string (rx "1:" (* space)) ""
latex-expr)))
+ (concat "\\(" latex-expr-cleaned "\\)")))
+
+(defun mathsheet--write-worksheet (fname instruction problems prob-cols)
+ "Write a worksheet to FNAME with INSTRUCTION and PROBLEMS.
+
+Write a file named FNAME. Include the INSTRUCTION line at the
+top. The problems will be arranged in PROB-COLS columns. The
+answers will be in 5 columns."
+ (with-temp-file (concat fname ".tex")
+ (insert mathsheet--worksheet-template)
+
+ (goto-char (point-min))
+ (search-forward "<<instruction>>")
+ (replace-match "")
+ (insert instruction)
+
+ (let ((answ-cols 5))
+ (goto-char (point-min))
+ (search-forward "<<problems>>")
+ (replace-match "")
+ (dolist (group (seq-partition problems prob-cols))
+ (insert (format "\\begin{multicols}{%d}\n" prob-cols))
+ (dolist (row group)
+ (insert (format (if (nth 3 row)
+ "\\question %s\n"
+ "\\question %s =
\\rule[-.2\\baselineskip]{2cm}{0.4pt}\n")
+ (mathsheet--convert-to-latex (car row)))))
+ (insert "\\end{multicols}\n")
+ (insert "\\vspace{\\stretch{1}}\n"))
+
+ (goto-char (point-min))
+ (search-forward "<<answers>>")
+ (replace-match "")
+ (dolist (group (seq-partition problems answ-cols))
+ (insert (format "\\begin{multicols}{%s}\n" answ-cols))
+ (dolist (row group)
+ (insert (format "\\question %s\n"
+ (mathsheet--convert-to-latex (cadr row)))))
+ (insert "\\end{multicols}\n"))))
+
+ (let* ((default-directory mathsheet-output-directory)
+ (ret (call-process
+ "texi2pdf" nil (get-buffer-create "*Standard output*") nil
+ (concat fname ".tex"))))
+ (unless (eq ret 0)
+ (error "PDF generation failed"))))
+
+(when (null forms-mode-map)
+ (add-to-list
+ 'forms-mode-hook
+ (lambda ()
+ (when (string= "mathsheet.el" (buffer-name))
+ (define-key forms-mode-map "\C-r" #'mathsheet-generate-sheet)))))
+
+;;;###autoload
+(defun mathsheet-open ()
+ "Open mathsheet."
+ (interactive)
+ (forms-find-file (locate-file "mathsheet.el" load-path)))
+
+(provide 'mathsheet)
+
+;;; mathsheet.el ends here
