first batch

.github/workflows/coverage.yml

@@ -36,7 +36,8 @@ jobs:
             CLOVERAGE_VERSION=1.2.4 clojure -M:test:coverage --codecov || :
 
       - name: Upload coverage to Codecov
-        uses: codecov/codecov-action@v1
+        uses: codecov/codecov-action@v3
         with:
           fail_ci_if_error: true
           file: ./target/coverage/codecov.json
+          token: ${{ secrets.CODECOV_TOKEN }}

CHANGELOG.md

@@ -2,6 +2,28 @@
 
 ## [unreleased]
 
+- #159:
+
+  - Fixes `Differential`'s implementation of `emmy.value/numerical?` to always
+    return `false`. The reason is that `numerical?` is used by `g/*` and friends
+    to decide on simplifications like `(* <dx-with-1> x) => x`, which would lose
+    the structure of `dx-with-1`. By returning false we avoid these
+    simplifications.
+
+  - Converts a number of `emmy.value/numerical?` calls to `emmy.value/scalar?`.
+    The `numerical?` protocol method is used only in generic functions like
+    `g/*` for deciding whether or not to apply numerical simplifications, like
+    `(* x 1) => x`.
+
+    Guarding on `v/scalar?` instead allows us to let in numbers, tapes and
+    differentials, since these latter two are meant to WRAP numbers, but should
+    not be subject to numerical simplifications.
+
+
+  - Adds `emmy.structure/fold-chain` for performing a tree-like fold on
+    structures, saving us work over the alternate pattern of `s/mapr`, `flatten`
+    and `reduce`.
+
 - #155
 
   - Replace the implementation of arbitrary-precision rational arithmetic

src/emmy/abstract/function.cljc

@@ -10,7 +10,8 @@
   The namespace also contains an implementation of a small language for
   declaring the input and output types of [[literal-function]] instances."
   (:refer-clojure :exclude [name])
-  (:require [emmy.abstract.number :as an]
+  (:require #?(:clj [clojure.pprint :as pprint])
+            [emmy.abstract.number :as an]
             [emmy.differential :as d]
             [emmy.function :as f]
             [emmy.generic :as g]
@@ -139,6 +140,13 @@
    (defmethod print-method Function [^Function f ^java.io.Writer w]
      (.write w (.toString f))))
 
+#?(:clj
+   ;; NOTE that this override only works in Clojure. In cljs, `simple-dispatch`
+   ;; isn't extensible.
+   (defmethod pprint/simple-dispatch Function [f]
+     (pprint/simple-dispatch
+      (.-f-name ^Function f))))
+
 (derive Function ::function)
 
 (defn literal-function?
@@ -267,10 +275,11 @@
   the exemplar expected."
   [f provided expected indexes]
   (cond (number? expected)
-        (when-not (v/numerical? provided)
+        (when-not (v/scalar? provided)
           (u/illegal (str "expected numerical quantity in argument " indexes
                           " of function call " f
                           " but got " provided)))
+
         (s/structure? expected)
         (do (when-not (and (or (s/structure? provided) (sequential? provided))
                            (= (s/orientation provided) (s/orientation expected))
@@ -279,6 +288,7 @@
                               " but got " provided)))
             (doseq [[provided expected sub-index] (map list provided expected (range))]
               (check-argument-type f provided expected (conj indexes sub-index))))
+
         (keyword? expected) ;; a keyword has to match the argument's kind
         (when-not (= (v/kind provided) expected)
           (u/illegal (str "expected argument of type " expected " but got " (v/kind provided)

src/emmy/differential.cljc

@@ -565,15 +565,12 @@
 (declare compare equiv finite-term from-terms)
 
 (deftype Differential [terms]
-  ;; A [[Differential]] as implemented can act as a chain-rule accounting device
-  ;; for all sorts of types, not just numbers. A [[Differential]] is
-  ;; only [[v/numerical?]] if its coefficients are numerical (or if `terms` is
-  ;; empty, interpreted as a [[Differential]] equal to `0`.)
+  ;; A [[Differential]] has to respond `false` to all [[emmy.value/numerical?]]
+  ;; inquiries; if we didn't do this, then [[emmy.generic/*]] and friends would
+  ;; attempt to apply shortcuts like `(* x <dx-with-1>) => x`, stripping off
+  ;; the [[Differential]] identity of the result and ruining the derivative.
   v/Numerical
-  (numerical? [_]
-    (or (empty? terms)
-        (v/numerical?
-         (coefficient (nth terms 0)))))
+  (numerical? [_] false)
 
   IPerturbed
   (perturbed? [_] true)
@@ -835,10 +832,10 @@
   `tag` defaults to a side-effecting call to [[fresh-tag]]; you can retrieve
   this unknown tag by calling [[max-order-tag]]."
   ([primal]
-   {:pre [(v/numerical? primal)]}
+   {:pre [(v/scalar? primal)]}
    (bundle-element primal 1 (fresh-tag)))
   ([primal tag]
-   {:pre [(v/numerical? primal)]}
+   {:pre [(v/scalar? primal)]}
    (bundle-element primal 1 tag))
   ([primal tangent tag]
    (let [term (make-term (uv/make [tag]) 1)]

src/emmy/function.cljc

@@ -403,12 +403,12 @@
       (with-arity [:exactly 1])))
 
 (defn coerce-to-fn
-  "Given a [[value/numerical?]] input `x`, returns a function of arity `arity`
+  "Given an [[emmy.value/scalar?]] input `x`, returns a function of arity `arity`
   that always returns `x` no matter what input it receives.
 
   For non-numerical `x`, returns `x`."
   ([x arity]
-   (if (v/numerical? x)
+   (if (v/scalar? x)
      (-> (constantly x)
          (with-arity arity))
      x)))
@@ -426,8 +426,8 @@
   ```"
   [op]
   (letfn [(h [f g]
-            (let [f-arity (if (v/numerical? f) (arity g) (arity f))
-                  g-arity (if (v/numerical? g) f-arity   (arity g))
+            (let [f-arity (if (v/scalar? f) (arity g) (arity f))
+                  g-arity (if (v/scalar? g) f-arity   (arity g))
                   f1      (coerce-to-fn f f-arity)
                   g1      (coerce-to-fn g g-arity)
                   arity   (joint-arity [f-arity g-arity])]

src/emmy/matrix.cljc

@@ -631,7 +631,7 @@
      (s->m ls ms rs)))
   ([ls ms rs]
    (when *careful-conversion*
-     (assert (v/numerical? (g/* ls (g/* ms rs)))))
+     (assert (v/scalar? (g/* ls (g/* ms rs)))))
    (let [ndowns (s/dimension ls)
          nups   (s/dimension rs)]
      (generate ndowns nups
@@ -720,7 +720,7 @@
                           (s/unflatten (nth-col m j) col-shape))
                         (s/compatible-shape rs))]
     (when *careful-conversion*
-      (assert (v/numerical? (g/* ls (g/* ms rs)))
+      (assert (v/scalar? (g/* ls (g/* ms rs)))
               (str "product is not numerical: " ls ms rs)))
     ms))
 

src/emmy/mechanics/hamilton.cljc

@@ -53,9 +53,9 @@
   (and (s/up? s)
        (= (count s) 3)
        (let [[t q v] s]
-         (and (v/numerical? t)
-              (or (and (v/numerical? q)
-                       (v/numerical? v))
+         (and (v/scalar? t)
+              (or (and (v/scalar? q)
+                       (v/scalar? v))
                   (and (s/up? q)
                        (s/down? v)
                        (= (s/dimension q)

src/emmy/numerical/derivative.cljc

@@ -49,15 +49,15 @@
 ;; First, a function that will print nicely rendered infix versions
 ;; of (simplified) symbolic expressions:
 
-(->clerk
+(->clerk-only
  (defn- show [e]
    (nextjournal.clerk/tex
     (->TeX
      (g/simplify e)))))
 
 ;; And a function to play with:
 
-(->clerk
+(->clerk-only
  (def func
    (af/literal-function 'f)))
 
@@ -70,7 +70,7 @@
 
 ;; Here's the taylor series expansions of $f(x + h)$:
 
-(->clerk
+(->clerk-only
  (def fx+h
    (-> ((d/taylor-series func 'x) 'h)
        (series/sum 4))))
@@ -110,7 +110,7 @@
 
 ;; We could also expand $f(x - h)$:
 
-(->clerk
+(->clerk-only
  (def fx-h
    (-> ((d/taylor-series func 'x) (g/negate 'h))
        (series/sum 4))))

src/emmy/structure.cljc

@@ -694,6 +694,63 @@
   [f & structures]
   (sum:r:l f structures))
 
+(defn fold-chain
+  "Returns the result of accumulating all non-structural entries in `s` using the
+  supplied fold function `f` into the optional accumulator `init` (defaults
+  to `(f)`).
+
+  `f` must be a 2-argument fn of type `(accumulator, [x chain orientations]) =>
+  accumulator` responsible for merging some value `x` into the ongoing
+  accumulation. The second argument is a 3-vector containing
+
+  - the entry in the structure
+  - a vector of its 'access chain', i.e., the path you'd pass
+    to [[clojure.core/get-in]] to access the entry
+  - a vector of orientations associated with each index in the access chain
+
+  `f` should return a new instance of the accumulator.
+
+  Additional arities allow you to supply
+
+  - `init`, the initial (empty) accumulator (defaults to `(f)`)
+  - `present`, a function that will be applied to the final, aggregated
+    result (defaults to `f`)
+
+  For example:
+
+  ```clojure
+  (fold-chain
+    (fn ([] [])
+     ([acc] acc)
+     ([acc [s chain orientations]]
+      (conj acc {:s s
+                 :chain chain
+                 :orientations orientations})))
+    (s/down (s/up 1 2) (s/up 3 4)))
+
+  [{:s 1, :chain [0 0], :orientations [::s/down ::s/up]}
+   {:s 2, :chain [0 1], :orientations [::s/down ::s/up]}
+   {:s 3, :chain [1 0], :orientations [::s/down ::s/up]}
+   {:s 4, :chain [1 1], :orientations [::s/down ::s/up]}]
+  ```"
+  ([f s] (fold-chain f (f) f s))
+  ([f init s] (fold-chain f init f s))
+  ([f init present s]
+   (letfn [(walk [acc s chain orientations]
+             (if (structure? s)
+               (let [o (orientation s)]
+                 (reduce
+                  (fn [acc i]
+                    (walk acc
+                          (s:nth s i)
+                          (conj chain i)
+                          (conj orientations o)))
+                  acc
+                  (range (count s))))
+               (f acc [s chain orientations])))]
+     (present
+      (walk init s [] [])))))
+
 (defn- map:l
   "Returns a new structure generated by mapping `f` across the same-indexed
   entries of all supplied structures, one level deep."
@@ -737,10 +794,10 @@
   ```clojure
   (dorun (map-chain println (s/down (s/up 1 2) (s/up 3 4))))
 
-  1 [0 0] [:s/down :s/up]
-  2 [0 1] [:s/down :s/up]
-  3 [1 0] [:s/down :s/up]
-  4 [1 1] [:s/down :s/up]
+  1 [0 0] [::s/down ::s/up]
+  2 [0 1] [::s/down ::s/up]
+  3 [1 0] [::s/down ::s/up]
+  4 [1 1] [::s/down ::s/up]
   ```"
   [f s]
   (letfn [(walk [s chain orientations]

src/emmy/value.cljc

@@ -226,7 +226,7 @@
        number
        (-equiv [this other]
          (cond (core/number? other) (identical? this other)
-               (numerical? other)   (= this (.valueOf other))
+               (scalar? other)      (= this (.valueOf other))
                :else false))
 
        goog.math.Integer

test/emmy/differential_test.cljc

@@ -82,7 +82,7 @@
   (defmethod g/zero? [#?(:clj String :cljs js/String)] [_] false)
   (testing "v/numerical? special cases"
     (is (not (v/numerical? (d/from-terms {[] "face"}))))
-    (is (v/numerical? (d/->Differential []))
+    (is (v/scalar? (d/->Differential []))
         "An empty term list is interpreted as a 0-valued [[Differential]]."))
 
   (checking "native comparison operators work with differential" 100
@@ -112,9 +112,13 @@
                            (zero? compare-bit) (is (and (<= l r) (= l r) (>= l r)))
                            :else (is (> l r))))))))
 
-  (checking "v/numerical?" 100 [diff (sg/differential sg/real)]
-            (is (v/numerical? diff)
-                "True for all differentials populated by v/numerical? things"))
+  (checking "v/numerical?, v/scalar?" 100 [diff (sg/differential sg/real)]
+            (is (v/scalar? diff)
+                "True for all differentials")
+
+            (is (not (v/numerical? diff))
+                "False for all differentials, even wrapping numerical things...
+                we don't want g/* and friends to simplify us away."))
 
   (testing "value protocol implementation"
     (let [zero (d/->Differential [])

test/emmy/structure_test.cljc

@@ -510,10 +510,10 @@
         about the entries.")))
 
 (deftest mapper-tests
-  (testing "sumr"
+  (testing "sumr, fold-chain"
     (with-comparator (v/within 1e-7)
       (checking "sumr sums all entries when passed a single structure" 100
-                [s (-> (gen/fmap #(g/modulo % 100) sg/real)
+                [s (-> (sg/reasonable-real 100)
                        (sg/structure 3))]
                 (is (ish? (reduce g/+ (flatten s))
                           (s/sumr identity s)))))
@@ -542,6 +542,20 @@
                           (s/down 'g 'h)))))
         "sumr uses g/+, so symbols etc can be added too."))
 
+  (testing "fold-chain"
+    (is (= [{:s 1, :chain [0 0], :orientations [::s/down ::s/up]}
+            {:s 2, :chain [0 1], :orientations [::s/down ::s/up]}
+            {:s 3, :chain [1 0], :orientations [::s/down ::s/up]}
+            {:s 4, :chain [1 1], :orientations [::s/down ::s/up]}]
+           (s/fold-chain
+            (fn ([] [])
+              ([acc] acc)
+              ([acc [s chain orientations]]
+               (conj acc {:s s
+                          :chain chain
+                          :orientations orientations})))
+            (s/down (s/up 1 2) (s/up 3 4))))))
+
   (testing "mapr"
     (is (= (s/up (s/down 1  4  9)
                  (s/down 16 25 36)