sicmutils · sritchie · Mar 25, 2022 · Mar 25, 2022 · Mar 25, 2022
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,8 @@
 
 ## unreleased
 
+- #508 adds `sicmutils.mechanics.noether` namespace, with `Noether-integral`.
+
 - #502 begins the port of the remaining items in the scmutils `mechanics`
   package over the Clojure. This PR focuses on `sicmutils.mechanics.lagrange`,
   which contains functions from many files in the original `mechanics` folder.

diff --git a/src/sicmutils/mechanics/noether.cljc b/src/sicmutils/mechanics/noether.cljc
@@ -0,0 +1,23 @@
+#_"SPDX-License-Identifier: GPL-3.0"
+
+(ns sicmutils.mechanics.noether
+  (:refer-clojure :exclude [partial])
+  (:require [sicmutils.calculus.derivative :refer [D partial]]
+            [sicmutils.function :as f]
+            [sicmutils.generic :as g]))
+
+;; ## Noether Theorem Support
+
+;; F-tilde is a parametric coordinate transformation that given parameters takes
+;; a state and returns transformed coordinates. F-tilde may take an arbitrary
+;; number of real-valued parameters. F-tilde applied to zeros is the coordinate
+;; selector: It takes a state and returns the coordinates. The hypothesis of
+;; Noether's theorem is that the Lagrangian is invariant under the
+;; transformation for all values of the parameters.
+
+;; (D (lambda parms (compose L (F->C (apply F-tilde parms))))) = 0
+
+(defn Noether-integral [L F-tilde]
+  (let [min-arity (second (f/arity F-tilde))
+        zeros     (repeat min-arity 0)]
+    (g/* ((partial 2) L) (apply (D F-tilde) zeros))))
diff --git a/test/sicmutils/mechanics/noether_test.cljc b/test/sicmutils/mechanics/noether_test.cljc
@@ -0,0 +1,30 @@
+#_"SPDX-License-Identifier: GPL-3.0"
+
+(ns sicmutils.mechanics.noether-test
+  (:require [clojure.test :refer [is deftest]]
+            [sicmutils.abstract.function :as f :include-macros true]
+            [sicmutils.generic :as g]
+            [sicmutils.mechanics.lagrange :as l]
+            [sicmutils.mechanics.noether :as n]
+            [sicmutils.mechanics.rotation :as r]
+            [sicmutils.structure :as s :refer [up]]
+            [sicmutils.value :as v]))
+
+(defn F-tilde [theta phi psi]
+  (comp (r/Rx theta)
+        (r/Ry phi)
+        (r/Rz psi)
+        l/coordinate))
+
+(deftest noether-tests
+  (is (= '(down (+ (* -1 m vy z) (* m vz y))
+                (+ (* m vx z) (* -1 m vz x))
+                (+ (* -1 m vx y) (* m vy x)))
+         (v/freeze
+          (g/simplify
+           ((n/Noether-integral
+             (l/L-central-rectangular 'm (f/literal-function 'Vr))
+             F-tilde)
+            (up 't
+                (up 'x 'y 'z)
+                (up 'vx 'vy 'vz))))))))