acbb1860ce62

--- a/euler.asd	Sat Nov 04 12:47:10 2017 -0400
+++ b/euler.asd	Tue Nov 28 18:19:38 2017 -0500
@@ -27,6 +27,7 @@
                (:file "package")
                (:module "src" :serial t
                 :components ((:file "primes")
+                             (:file "math")
                              (:file "utils")
                              (:file "hungarian")
                              (:file "problems")

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/math.lisp	Tue Nov 28 18:19:38 2017 -0500
@@ -0,0 +1,102 @@
+(in-package :euler)
+
+;;;; Operator Protocol
+(defgeneric operatorp (object)
+  (:method ((object t)) nil))
+
+(defun operandp (object)
+  (not (operatorp object)))
+
+(defgeneric operator-arity (operator))
+(defgeneric operator-function (operator))
+(defgeneric operator-weight (operator))
+
+(defmacro define-operator (symbol function arity weight)
+  `(progn
+     (defmethod operatorp ((symbol (eql ',symbol)))
+       t)
+     (defmethod operator-arity ((symbol (eql ',symbol)))
+       ,arity)
+     (defmethod operator-function ((symbol (eql ',symbol)))
+       ,function)
+     (defmethod operator-weight ((symbol (eql ',symbol)))
+       ,weight)))
+
+
+;;;; Binary
+(define-operator = '= 2 0)
+(define-operator < '> 2 0)
+(define-operator > '< 2 0)
+(define-operator <= '>= 2 0)
+(define-operator >= '<= 2 0)
+(define-operator - '- 2 1)
+(define-operator + '+ 2 1)
+(define-operator * '* 2 2)
+(define-operator / '/ 2 2)
+(define-operator % 'rem 2 2)
+(define-operator ^ 'expt 2 3)
+
+
+;;;; Unary
+(define-operator sqrt 'sqrt 1 10)
+(define-operator sin 'sin 1 10)
+(define-operator cos 'cos 1 10)
+(define-operator tan 'tan 1 10)
+(define-operator abs 'abs 1 10)
+
+
+;;;; Parsing
+(defun shunting-yard (tokens &aux operators output)
+  (labels ((precedence>= (a b)
+             (unless (null a)
+               (>= (operator-weight a)
+                   (operator-weight b))))
+           (pop-unary-operator ()
+             (push (list (operator-function (pop operators))
+                         (pop output))
+                   output))
+           (pop-binary-operator ()
+             (push (list (operator-function (pop operators))
+                         (pop output)
+                         (pop output))
+                   output))
+           (pop-operator ()
+             (ecase (operator-arity (first operators))
+               (1 (pop-unary-operator))
+               (2 (pop-binary-operator))))
+           (lisp-expression-p (expr)
+             (or (vectorp expr)
+                 (and (consp expr)
+                      (eq (first expr) 'lisp))))
+           (lisp-expression (expr)
+             (etypecase expr
+               (vector (coerce expr 'list))
+               (cons (second expr)))))
+    (do* ((tokens (reverse tokens) (rest tokens))
+          (prev nil token)
+          (token (first tokens) (first tokens)))
+        ((null tokens))
+      (cond
+        ((lisp-expression-p token)
+         (push (lisp-expression token) output))
+        ((consp token)
+         (push (shunting-yard token) output))
+        ((operatorp token)
+         (iterate (while (precedence>= (first operators)
+                                       token))
+                  (pop-operator)
+                  (finally (push token operators))))
+        ((and prev (not (operatorp prev))) ; implicit multiplication
+         (setf token prev)
+         (push '* tokens)
+         (push prev tokens))
+        (t (push token output))))
+    (iterate (while operators)
+             (pop-operator)))
+  (first output))
+
+
+;;;; API
+(defmacro math (&rest expr)
+  (shunting-yard expr))
+

--- a/src/problems.lisp	Sat Nov 04 12:47:10 2017 -0400
+++ b/src/problems.lisp	Tue Nov 28 18:19:38 2017 -0500
@@ -599,7 +599,8 @@
   ;; starting with n=0.
   (flet ((primes-produced (a b)
            (iterate (for n :from 0)
-                    (while (primep (+ (square n) (* a n) b)))
+                    (while (primep
+                             (math n ^ 2 + a n + b)))
                     (counting t))))
     (iterate (for-nested ((a :from -999 :to 999)
                           (b :from -1000 :to 1000)))
@@ -787,8 +788,7 @@
   (labels ((rotate (n distance)
              (multiple-value-bind (hi lo)
                  (truncate n (expt 10 distance))
-               (+ (* (expt 10 (digits-length hi)) lo)
-                  hi)))
+               (math lo * 10 ^ #(digits-length hi) + hi)))
            (rotations (n)
              (mapcar (curry #'rotate n) (range 1 (digits-length n))))
            (circular-prime-p (n)

--- a/src/utils.lisp	Sat Nov 04 12:47:10 2017 -0400
+++ b/src/utils.lisp	Tue Nov 28 18:19:38 2017 -0500
@@ -366,8 +366,7 @@
   "Return `n` choose `k`."
   ;; https://en.wikipedia.org/wiki/Binomial_coefficient#Multiplicative_formula
   (iterate (for i :from 1 :to k)
-           (multiplying (/ (+ n 1 (- i))
-                           i))))
+           (multiplying (math (n + 1 - i) / i))))
 
 
 (defun factorial% (n)
@@ -575,8 +574,7 @@
 
 
 (defun pythagorean-triplet-p (a b c)
-  (= (+ (square a) (square b))
-     (square c)))
+  (math a ^ 2 + b ^ 2 = c ^ 2))
 
 (defun pythagorean-triplets-of-perimeter (p)
   (iterate
@@ -644,7 +642,7 @@
 
 (defun triangle (n)
   "Return the `n`th triangle number (1-indexed because mathematicians are silly)."
-  (* 1/2 n (1+ n)))
+  (math n (n + 1) / 2))
 
 (defun trianglep (n)
   "Return whether `n` is a triangle number."
@@ -657,16 +655,18 @@
 
 
 (defun pentagon (n)
+  (math (3 n ^ 2 - n) / 2)
   (* n (- (* 3 n) 1) 1/2))
 
 (defun pentagonp (n)
   ;; We can ignore the - branch of the quadratic equation because negative
   ;; numbers aren't indexes.
-  (dividesp (+ 1 (sqrt (1+ (* 24.0d0 n)))) 6))
+  (dividesp (math (sqrt (24.0d0 n + 1) + 1))
+            6))
 
 
 (defun hexagon (n)
-  (* n (1- (* 2 n))))
+  (math (2 n - 1) * n))
 
 (defun hexagonp (n)
   ;; We can ignore the - branch of the quadratic equation because negative
@@ -675,10 +675,11 @@
 
 
 (defun heptagon (n)
-  (* n (- (* 5 n) 3) 1/2))
+  (math (5 n ^ 2 - 3 n) / 2))
+
 
 (defun octagon (n)
-  (* n (- (* 3 n) 2)))
+  (math 3 n ^ 2 - 2 n))
 
 
 (defun parse-strings-file (filename)