Improve assembler

src/lisp/topology/assembler.lisp

@@ -852,3 +852,25 @@ Some specialized methods will need coordinates for the assembler"))
         do (format t "oligomer-shape ~s~%" oligomer-shape)
         do (loop for monomer-shape across (topology:monomer-shape-vector oligomer-shape)
                  do (format t "monomer-shape ~s~%" monomer-shape))))
+
+(defun monomer-center (assembler monomer coords)
+  "Return the geometric center of the MONOMER in the ASSEMBLER with COORDS."
+  (let* ((pos (alexandria:ensure-gethash monomer (monomer-positions assembler)
+                                         (error "Could not find ~s in ~s"
+                                                monomer
+                                                (alexandria:hash-table-keys (monomer-positions assembler)))))
+         (atres (at-position (ataggregate assembler) pos))
+         (centerx 0.0s0)
+         (centery 0.0s0)
+         (centerz 0.0s0)
+         (num 0))
+    (loop for atatm across (joints atres)
+          for index3 = (kin:position-index-x3 atatm)
+          for x = (aref coords index3)
+          for y = (aref coords (+ 1 index3))
+          for z = (aref coords (+ 2 index3))
+          do (incf centerx x)
+          do (incf centery y)
+          do (incf centerz z)
+          do (incf num))
+    (geom:vec (/ centerx num) (/ centery num) (/ centerz num))))

src/lisp/topology/packages.lisp

@@ -482,6 +482,7 @@
    #:add-to-cache
    #:make-backbone-dihedral-cache
    #:backbone-dihedral-cache
+   #:monomer-center
    ))
 
 (defpackage #:topology.dag