cdo/ham
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Avoid using already-updated values in update

Browse Source
This commit is contained in:
Camden Dixie O'Brien 2025-05-29 17:52:16 +01:00
parent 76a61e4477
commit d2c9ff77f6
1 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
physics-compiler.lisp
View File

@ -38,12 +38,6 @@
,(enmaxima-lagrangian lagrangian)
,(enmaxima-coords coords))))
(defun momentum-symbol (q)
(intern (format nil "P_~a" (symbol-name q))))
(defun flatten (l)
(apply #'append l))
(defun unmaxima-expression (expr)
(defun unmaxima-symbol (sym)
(let ((name (symbol-name sym)))
@ -56,17 +50,24 @@
((listp expr) (mapcar #'unmaxima-expression expr))
(t expr)))
(defun momentum-symbol (q)
(intern (format nil "P_~a" (symbol-name q))))
(defun next-symbol (s)
(intern (format nil "NEXT-~a" (symbol-name s))))
(defun update-logic (result coords)
(defun coord-updates (exprs q)
(let ((p (momentum-symbol q))
(q-dot-expr (cadr exprs))
(p-dot-expr (caddr exprs)))
`((incf ,p (* dt ,(unmaxima-expression p-dot-expr)))
(incf ,q (* dt ,(unmaxima-expression q-dot-expr))))))
(flatten (loop for coord-expressions
in (cdr (maxima-interface::maxima-to-lisp result))
for q in coords
collect (coord-updates coord-expressions q))))
(defun coord-update (q exprs)
`(,(next-symbol q)
(+ ,q (* dt ,(unmaxima-expression (cadr exprs))))))
(defun momentum-update (q exprs)
(let ((p (momentum-symbol q)))
`(,(next-symbol p)
(+ ,p (* dt ,(unmaxima-expression (caddr exprs)))))))
(loop for exprs in (cdr (maxima-interface::maxima-to-lisp result))
for q in coords
collect (coord-update q exprs)
collect (momentum-update q exprs)))
(defun keys (plist)
(loop for key in plist by #'cddr collect key))
@ -75,7 +76,7 @@
(let ((vars (append coords (mapcar #'momentum-symbol coords))))
`(let (,@(mapcar (lambda (s) `(,s (getf params ',s))) (keys params))
,@(mapcar (lambda (s) `(,s (getf state ',s))) vars))
,@(update-logic result coords)
(list ,@(flatten
(mapcar (lambda (s) (list `',s s))
vars))))))
(let ,(update-logic result coords)
(list ,@(loop for s in vars
collect `',s
collect (next-symbol s)))))))