Skip to content

Commit 4fd0283

Browse files
kloimhardtkloimhardt
authored
Fdg ch03 (#314)
1 parent 7fa3e74 commit 4fd0283

File tree

5 files changed

+334
-3
lines changed

5 files changed

+334
-3
lines changed

‎site/_quarto.yml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ website:
4141
text: "SICM Chapter 1"
4242
- href: mentat_collective/emmy/fdg_ch02.qmd
4343
text: "FDG Chapter 2"
44+
- href: mentat_collective/emmy/fdg_ch03.qmd
45+
text: "FDG Chapter 3"
4446
- href: mentat_collective/emmy/fdg_ch01_ys.qmd
4547
text: "FDG Ch01 Infix"
4648
- href: mentat_collective/emmy/sicm_ch01.qmd

‎src/mentat_collective/emmy/fdg_ch01.clj‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -437,6 +437,14 @@
437437
(coordinate-system->basis R2-rect))))
438438
;; :::
439439

440+
^:kindly/hide-code
441+
(kind/scittle
442+
'(define Cartan
443+
(Christoffel->Cartan
444+
(metric->Christoffel-2
445+
the-metric
446+
(coordinate-system->basis R2-rect)))))
447+
440448
(define geodesic-equation-residuals
441449
(((((covariant-derivative Cartan gamma) d:dt)
442450
((differential gamma) d:dt))

‎src/mentat_collective/emmy/fdg_ch02.clj‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -130,7 +130,8 @@
130130
(define R2-polar (coordinate-system-at R2 :polar-cylindrical :origin))
131131

132132
(define R2-rect-chi (chart R2-rect))
133-
(define R2-rect-chi-inverse (point R2-rect)) (define R2-polar-chi (chart R2-polar))
133+
(define R2-rect-chi-inverse (point R2-rect))
134+
(define R2-polar-chi (chart R2-polar))
134135
(define R2-polar-chi-inverse (point R2-polar))
135136

136137
(print-expression

‎src/mentat_collective/emmy/fdg_ch03.clj‎

Lines changed: 264 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,264 @@
1+
^{:kindly/hide-code true
2+
:clay {:title "Emmy, the Algebra System: Differential Geometry Chapter Three"
3+
:quarto {:author :kloimhardt
4+
:type :draft
5+
:description "Functional Differential Geometry: Chapter 3"
6+
:sidebar "emmy-fdg"
7+
:date "2026-01-29"
8+
:image "sicm_ch01.png"
9+
:category :libs
10+
:tags [:emmy :physics]}}}
11+
12+
(ns mentat-collective.emmy.fdg-ch03
13+
(:refer-clojure :exclude [+ - * / zero? compare divide numerator denominator
14+
time infinite? abs ref partial =])
15+
(:require [scicloj.kindly.v4.api :as kindly]
16+
[scicloj.kindly.v4.kind :as kind]
17+
[mentat-collective.emmy.scheme :refer [define-1 let-scheme lambda] :as scheme]
18+
[civitas.repl :as repl]))
19+
20+
;; ## 3 Vector Fields and One-Form Fields
21+
;; We want a way to think about how a function varies on a manifold.
22+
23+
^:kindly/hide-code
24+
(def prod true) #_"used to check Emmy in Scittle kitchen"
25+
26+
^:kindly/hide-code
27+
(kind/hiccup scheme/scittle-kitchen-hiccup)
28+
29+
^:kindly/hide-code
30+
(defmacro define [& b]
31+
(list 'do
32+
(cons 'mentat-collective.emmy.scheme/define b)
33+
(list 'kind/scittle (list 'quote (cons 'define b)))))
34+
35+
^:kindly/hide-code
36+
(define emmy-env
37+
'[emmy.env :as e :refer :all :exclude [print-expression Lagrangian-action find-path
38+
Lagrange-equations r->p
39+
R2 define-coordinates]])
40+
41+
^:kindly/hide-code
42+
(define emmy-vector-field
43+
'[emmy.calculus.vector-field :as vf])
44+
45+
^{:kindly/hide-code true :kindly/kind kind/hidden}
46+
(do
47+
(require emmy-env)
48+
(require emmy-vector-field))
49+
50+
^:kindly/hide-code
51+
(kind/scittle
52+
'(do
53+
(require emmy-env)
54+
(require emmy-vector-field)))
55+
56+
^:kindly/hide-code
57+
(defmacro define-coordinates [& b]
58+
(list 'do
59+
(cons 'emmy.env/define-coordinates b)
60+
(list 'kind/scittle (list 'quote (cons 'emmy.env/define-coordinates b)))))
61+
62+
^:kindly/hide-code
63+
(define string-exp (comp str simplify))
64+
65+
^:kindly/hide-code
66+
(defn reag-comp [b]
67+
(let [server-erg (string-exp (eval b))]
68+
(list 'kind/reagent
69+
[:div (list 'quote
70+
(list 'let ['a (list 'string-exp b)]
71+
[:div
72+
(when (not prod)
73+
[:div
74+
[:tt 'a]
75+
[:p (list 'str (list '= server-erg 'a))]])
76+
[:tt server-erg]]))])))
77+
78+
^:kindly/hide-code
79+
(defmacro print-expression [e]
80+
(if prod
81+
e
82+
(reag-comp e)))
83+
84+
^:kindly/hide-code
85+
(kind/scittle
86+
'(def print-expression identity))
87+
88+
^:kindly/hide-code
89+
(def show-tex-fn (comp kind/tex emmy.expression.render/->TeX))
90+
91+
^:kindly/hide-code
92+
(defmacro show-tex [e]
93+
(if prod
94+
(list 'show-tex-fn e)
95+
(reag-comp e)))
96+
97+
^:kindly/hide-code
98+
(kind/scittle
99+
'(defn show-tex [e]
100+
(->infix e)))
101+
102+
^:kindly/hide-code
103+
(defn show-expression-fn [e]
104+
(kind/tex (str "\\boxed{" (emmy.expression.render/->TeX e) "}")))
105+
106+
^:kindly/hide-code
107+
(defmacro show-expression [e]
108+
(if prod
109+
(list 'show-tex-expression-fn e)
110+
(reag-comp e)))
111+
112+
^:kindly/hide-code
113+
(kind/scittle
114+
'(defn show-expression [e]
115+
(->infix (simplify e))))
116+
117+
^:kindly/hide-code
118+
(define R2->R '(-> (UP Real Real) Real))
119+
120+
^:kindly/hide-code
121+
(define R2-rect-chi-inverse (point R2-rect))
122+
123+
^:kindly/hide-code
124+
(define R2-rect-point (R2-rect-chi-inverse (up 'x0 'y0)))
125+
126+
;; ## 3.1 Vector Fields
127+
128+
(define v
129+
(components->vector-field
130+
(up (literal-function 'b0 R2->R)
131+
(literal-function 'b1 R2->R))
132+
R2-rect))
133+
134+
(print-expression
135+
((v (literal-manifold-function 'f-rect R2-rect)) R2-rect-point))
136+
137+
(print-expression
138+
((v (chart R2-rect)) R2-rect-point))
139+
140+
;; #### [Comment MAK concerning components->vector-field]
141+
142+
;; The function `procedure->vector-field` seems to be missing in Scittle
143+
144+
;; Clojure interns has `procedure->vector-field`
145+
(comment
146+
(ns-interns 'emmy.calculus.vector-field))
147+
148+
;; ClojureScript interns lack `procedure->vector-field`
149+
(comment
150+
(kind/reagent
151+
['(fn []
152+
[:tt (str (ns-interns 'emmy.calculus.vector-field))])]))
153+
154+
;; The function `components->vector-field` exists as a standard, so we can
155+
;; leave it here as merely a comment
156+
157+
(comment
158+
(define (components->vector-field components coordsys)
159+
(define (v f)
160+
(compose (* (D (compose f (point coordsys)))
161+
components)
162+
(chart coordsys)))
163+
(vf/procedure->vector-field v)))
164+
165+
166+
;; ### Coordinate Representation
167+
168+
;; need to check the form below, fortunately `coordinatize` is also standard
169+
170+
(comment
171+
(define (coordinatize v coordsys)
172+
(define ((coordinatized-v f) x)
173+
(let ((b (compose (v (chart coordsys)) (point coordsys))))
174+
(* ((D f) x) (b x))))
175+
(make-operator coordinatized-v)))
176+
177+
(print-expression
178+
(((e/coordinatize v R2-rect) (literal-function 'f-rect R2->R))
179+
(up 'x0 'y0)))
180+
181+
;; ## 3.2 Coordinate-Basis Vector Fields
182+
183+
(define-coordinates (up x y) R2-rect)
184+
185+
(define-coordinates (up r theta) R2-polar)
186+
187+
(print-expression
188+
((d:dx (square r)) R2-rect-point))
189+
190+
(print-expression
191+
(((+ d:dx (* 2 d:dy)) (+ (square r) (* 3 x))) R2-rect-point))
192+
193+
;; ## 3.3 Integral Curves
194+
195+
(define circular (- (* x d:dy) (* y d:dx)))
196+
197+
(print-expression
198+
(take 6
199+
(seq
200+
(((exp (* 't circular)) (chart R2-rect))
201+
((point R2-rect) (up 1 0))))))
202+
203+
(print-expression
204+
((((e/evolution 6) 'delta-t circular) (chart R2-rect))
205+
((point R2-rect) (up 1 0))))
206+
207+
;; ## 3.5 Coordinate-Basis One-Form Fields
208+
209+
(define omega
210+
(e/components->oneform-field
211+
(down (literal-function 'a_0 R2->R)
212+
(literal-function 'a_1 R2->R))
213+
R2-rect))
214+
215+
(print-expression
216+
((omega (down d:dx d:dy)) R2-rect-point))
217+
218+
(define omega-alt (e/literal-oneform-field 'a R2-rect))
219+
220+
(print-expression
221+
(((d (literal-manifold-function 'f-rect R2-rect))
222+
(coordinate-system->vector-basis R2-rect))
223+
R2-rect-point))
224+
225+
(print-expression
226+
(((d (literal-manifold-function 'f-polar R2-polar))
227+
(coordinate-system->vector-basis R2-rect))
228+
((point R2-polar) (up 'r 'theta))))
229+
230+
(define-coordinates (up x y) R2-rect)
231+
232+
(print-expression
233+
((dx d:dy) R2-rect-point))
234+
235+
(print-expression
236+
((dx d:dx) R2-rect-point))
237+
238+
(print-expression
239+
((dx circular) R2-rect-point))
240+
241+
(print-expression
242+
((dy circular) R2-rect-point))
243+
244+
(print-expression
245+
((dr circular) R2-rect-point))
246+
247+
(print-expression
248+
((dtheta circular) R2-rect-point))
249+
250+
(define f (literal-manifold-function 'f-rect R2-rect))
251+
252+
(print-expression
253+
(((- circular d:dtheta) f) R2-rect-point))
254+
255+
;; ### Coordinate Transformations
256+
257+
(define omega (literal-oneform-field 'a R2-rect))
258+
259+
(define v (literal-vector-field 'b R2-rect))
260+
261+
(print-expression
262+
((omega v) R2-rect-point))
263+
264+
(repl/scittle-sidebar)

‎src/mentat_collective/emmy/scheme.cljc‎

Lines changed: 58 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,11 +13,28 @@
1313
(defn postwalk-replace [smap form]
1414
(postwalk (fn [x] (if (contains? smap x) (smap x) x)) form))
1515

16+
(defn define->let [h b1 b2]
17+
(list 'let
18+
(vector (first h)
19+
(list 'fn (into [] (rest h))
20+
(last b1)))
21+
b2))
22+
23+
(defn embrace-define [b]
24+
(if (and (coll? b) (coll? (first b)) (= (ffirst b) 'define))
25+
[(define->let (second (first b))
26+
(embrace-define (rest (rest (first b))))
27+
(last b))]
28+
b))
29+
1630
(defmacro let-scheme [b & e]
17-
(concat (list 'let (into [] (apply concat b))) e))
31+
(concat (list 'let (into [] (apply concat b)))
32+
(embrace-define e)))
1833

1934
(defmacro define-1 [h & b]
20-
(let [body (postwalk-replace {'let 'let-scheme} b)]
35+
(let [body (->> b
36+
(postwalk-replace {'let 'let-scheme})
37+
(embrace-define))]
2138
(if (coll? h)
2239
(if (coll? (first h))
2340
(list 'defn (ffirst h) (into [] (rest (first h)))
@@ -45,3 +62,42 @@
4562
[:script {:src "https://cdn.jsdelivr.net/npm/react-dom@18/umd/react-dom.production.min.js", :crossorigin ""}]
4663
[:script {:src "https://cdn.jsdelivr.net/npm/scittle-kitchen@0.7.30-64/dist/scittle.reagent.js"}]
4764
[:script {:type "application/x-scittle" :src "scheme.cljc"}]])
65+
66+
(comment
67+
(define (f a b)
68+
(define (h i j)
69+
(define (g n m)
70+
(+ n m))
71+
(+ (g i j) j))
72+
(+ (h a b) b))
73+
74+
(f 1 2)
75+
76+
(define (fu a b)
77+
(define (h i j)
78+
(let ((u 1))
79+
(define (g n m)
80+
(+ n m))
81+
(+ (g i j) u)))
82+
(+ (h a b) b))
83+
84+
(fu 1 2)
85+
86+
87+
(define (g x y)
88+
(+ 3 4))
89+
90+
(g 4 5)
91+
92+
(embrace-define
93+
['(define (g i j)
94+
(define (h n m)
95+
(+ n m))
96+
(+ (h i j) 7))
97+
'(+ (g a b) c d)])
98+
99+
(define emmy-env 3)
100+
101+
emmy-env
102+
103+
:end-comment)

0 commit comments

Comments
 (0)