Changes to support kinematics improvements

include/cando/kinematics/xyzJoint.h

@@ -111,7 +111,7 @@ class XyzJoint_O : public Joint_O
   void updateXyzCoord(chem::NVector_sp coords);
 
   virtual Stub getInputStub(chem::NVector_sp coords) const;
-  virtual bool definedp() const;
+  CL_DEFMETHOD virtual bool definedp() const;
 
 	/*! Geta the value of the DOF */
   double dof(DofType const& dof) const;

scando-apptainer-install

@@ -15,7 +15,7 @@ fi
 
 echo "Updating Quicklisp..."
 clasp --non-interactive --eval "(unless (ql-dist:find-dist \"quickclasp\") (ql-dist:install-dist \"http://quickclasp.thirdlaw.tech/quickclasp.txt\" :prompt nil))" \
-      --eval "(ql:update-all-dists :prompt nil)"
+  --eval "(ql:update-all-dists :prompt nil)"
 
 if ! [ -f ~/.config/common-lisp/source-registry.conf.d/apptainer.conf ]; then
     echo "The file ~/.config/common-lisp/source-registry.conf.d/apptainer.conf is missing - creating it"
@@ -29,13 +29,14 @@ fi
 echo "Installing CANDO user features..."
 cando --eval "(ql:quickload :cando-jupyter)" \
       --eval "(ql:quickload :spiros)" \
-      --eval "(leap:source \"leaprc.protein.ff14SB\")" \
-      --eval "(foldamer:load-force-field t)" \
-      --eval "(spiros:load-rotamers)" \
+      --eval "(topology:foldamer-rotamers-database spiros:*foldamer*)"\
       --eval "(ql:quickload :amber-protein)" \
+      --eval "(leap:source \"leaprc.protein.ff14SB\")" \
       --eval "(amber-protein:transfer-amber-atom-types-to-foldamer amber-protein:*foldamer*)" \
-      --eval "(amber-protein:load-rotamers)" \
-      --eval "(cando-jupyter:install :implementation \"apptainer\" :image t)"
+      --eval "(topology:foldamer-rotamers-database amber-protein:*foldamer*)" \
+      --eval "(ql:quickload :plan)" \
+      --eval "(ql:quickload :cando-user-install)" \
+      --eval "(cando-user-install:install)"
 
 echo "HOME = " $HOME
 echo "pwd ~ = " `pwd ~`

src/kinematics/xyzJoint.cc

@@ -38,6 +38,7 @@ This is an open source license for the CANDO software from Temple University, bu
 #include <clasp/core/symbolTable.h>
 #include <cando/chem/atomId.h>
 #include <clasp/core/numerics.h>
+#include <cando/kinematics/joint.h>
 #include <cando/kinematics/stub.h>
 #include <cando/kinematics/jumpJoint.h>
 #include <cando/kinematics/xyzJoint.h>
@@ -193,12 +194,15 @@ void XyzJoint_O::_updateChildrenXyzCoords(chem::NVector_sp coords) {
   }
 }
 
+SYMBOL_EXPORT_SC_(KinPkg,undefined_internal_coordinates);
+SYMBOL_EXPORT_SC_(KeywordPkg,joint);
+
 void XyzJoint_O::_updateXyzCoord(chem::NVector_sp coords, Stub& stub)
 {
       // https://math.stackexchange.com/questions/133177/finding-a-unit-vector-perpendicular-to-another-vector
   Vector3 d2 = this->_Pos;
   if (!this->_Pos.isDefined()) {
-    SIMPLE_ERROR("Internal coordinates for {} is NaN", _rep_(this->asSmartPtr()));
+    ERROR(kinematics::_sym_undefined_internal_coordinates,core::lisp_createList(kw::_sym_joint,this->asSmartPtr()));
   }
   ASSERT(this->_Pos.isDefined());
   this->setPosition(coords,d2);

src/lisp/cando/cando.asd

@@ -3,7 +3,7 @@
   :version "0.0.1"
   :author "Christian Schafmeister <[email protected]>"
   :licence "LGPL-3.0"
-  :depends-on (#:smarts #:chem-extras #:cando-serialize #:topology)
+  :depends-on (#:smarts #:kinematics-extras #:chem-extras #:cando-serialize #:topology)
   :serial t
   :components ((:file "packages")
                (:file "basic")

src/lisp/chem-extras/packages.lisp

@@ -6,7 +6,3 @@
   (:export
    ))
 
-(defpackage #:kin.extras
-  (:use #:common-lisp)
-  (:export
-   ))

src/lisp/kinematics-extras/kinematics.lisp

@@ -1,10 +1,10 @@
 
 (in-package :kin)
 
-(define-condition kin:kinematics-error (error)
+(define-condition kinematics-error (error)
   ()
   (:report (lambda (condition stream)
              (format stream "~a ~a" (class-name (class-of condition))))))
 
-(define-condition kin:undefined-internal-coordinates (kin:kinematics-error)
+(define-condition undefined-internal-coordinates (kinematics-error)
   ((joint :initarg :joint :reader joint)))

src/lisp/kinematics-extras/packages.lisp

@@ -1,4 +1,6 @@
 (defpackage #:kin.extras
   (:use #:common-lisp)
   (:export
+   #:kinematics-error
+   #:undefined-internal-coordinates
    ))

src/lisp/topology/internals.lisp

@@ -292,7 +292,9 @@
   (if *print-readably*
       (call-next-method)
       (print-unreadable-object (object stream :type t)
-        (format stream "~s" (monomer-context object)))))
+        (format stream "~s" (if (slot-boundp object 'monomer-context)
+                                (monomer-context object)
+                                "no monomer-context")))))
 
 
 (defclass sidechain-rotamers (rotamers)
@@ -773,10 +775,13 @@ No checking is done to make sure that the list of clusterable-context-rotamers a
   "Do nothing with xyz-joints"
   )
 
+(defun fill-joint-phi (joint phi)
+  (kin:bonded-joint/set-phi joint phi))
+
 (defmethod fill-joint-internals ((joint kin:bonded-joint) bond angle-rad dihedral-rad)
   (kin:set-distance joint bond)
   (kin:set-theta joint angle-rad)
-  (kin:set-phi joint dihedral-rad)
+  (fill-joint-phi joint dihedral-rad)
   )
 
 (defun extract-bond-angle-rad-dihedral-rad (rotamer index)
@@ -824,14 +829,19 @@ No checking is done to make sure that the list of clusterable-context-rotamers a
 |#
 
 (defun write-internals (atresidue internals)
-  (loop for joint in (joints atresidue)
+  (loop for joint across (joints atresidue)
         for index3 from 0 by 3
-        when (typep joint 'kin:bonded-joint)
-          do (progn
-               (kin:bonded-joint/set-distance joint (aref internals index3))
-               (kin:bonded-joint/set-theta joint (aref internals (+ 1 index3)))
-               (kin:bonded-joint/set-phi joint (aref internals (+ 2 index3)))
-               )))
+        do (typecase joint
+             (kin:bonded-joint
+              (fill-joint-internals joint (aref internals index3)
+                                    (aref internals (+ 1 index3))
+                                    (aref internals (+ 2 index3))))
+             (kin:xyz-joint
+              (if (kin:xyz-joint/definedp joint)
+                  (warn "Skipping defining xyz-joint")
+                  (break "What do we do with an undefined xyz-joint?")))
+             (t (error "Add support for ~s~%" joint))
+             )))
 
 (defgeneric write-internals-to-vector (joint index3 internals joint-mask))
 
@@ -858,6 +868,11 @@ No checking is done to make sure that the list of clusterable-context-rotamers a
     (loop for joint across (joints atresidue)
           for index from 0
           for index3 from 0 by 3
+          do (format t "extracting-internals for ~s -> defined: ~s phi: ~s~%" joint (kin:definedp joint)
+                     (typecase joint
+                       (kin:bonded-joint
+                        (kin:bonded-joint/get-phi joint))
+                       (t "OTHER-NODE-PHI")))
           when (kin:definedp joint)
             do (write-internals-to-vector joint index3 internals joint-mask))
     (values internals joint-mask)))
@@ -868,7 +883,7 @@ No checking is done to make sure that the list of clusterable-context-rotamers a
             (position joint (topology:joints atresidue)))
           joints))
 
-(defun write-merged-internals (target-internals joint-mask children-indexes old-internals new-internals)
+(defun write-merged-internals (joint target-internals joint-mask children-indexes old-internals new-internals)
   (multiple-value-bind (set-child-indexes unset-child-indexes)
       (loop for child-index in children-indexes
             if (= (aref joint-mask child-index) 1)
@@ -886,7 +901,7 @@ No checking is done to make sure that the list of clusterable-context-rotamers a
               )
         (progn
           (when (> (length set-child-indexes) 2)
-            (error "set-child-indexes is ~s - it should never be more than 2 elements long" set-child-indexes))
+            (error "set-child-indexes is ~s - it should never be more than 2 elements long: children -> ~s~% Perhaps you need to rebuild the assembler because you may have already setup all the internals for this one" set-child-indexes (topology:children joint)))
           (let ((delta-dihedrals (loop for child-index in set-child-indexes
                                        for ref-index = (first set-child-indexes) ; index into joint-mask
                                        for ref-index3 = (* 3 ref-index) ; get the index into the internals
@@ -923,7 +938,7 @@ No checking is done to make sure that the list of clusterable-context-rotamers a
              children-indexes (indexes-of-internals atresidue children)
              )
        (when (null children) (go next-iteration))
-       (write-merged-internals temp-internals joint-mask children-indexes old-internals new-internals)
+       (write-merged-internals joint temp-internals joint-mask children-indexes old-internals new-internals)
        (progn
          (format t "dihedral3 atom ~s in atresidue: ~s~%" joint (name atresidue))
          (format t "  children: ~s~%" children)

src/lisp/topology/joint-templates.lisp

@@ -80,7 +80,8 @@
               (topology:rad-to-deg phi-original) (topology:rad-to-deg phi-adjust))
       #+(or)(kin:bonded-joint/set-distance joint 1.47)
       #+(or)(kin:bonded-joint/set-theta joint (topology:deg-to-rad 120.0))
-      (kin:bonded-joint/set-phi joint phi-adjust))))
+      (fill-joint-phi joint phi-adjust)
+      )))
 
 (defun make-bonded-joint-template (constitution-atoms-index &key atom-name parent)
   (make-instance 'bonded-joint-template

src/lisp/topology/jupyter.lisp

@@ -151,12 +151,10 @@
   (let ((elements (generate-elements object)))
     (build-cytoscape elements)))
 
+(defmethod cando-widgets::show-on-pane (pane-instance (object topology:topology) &rest rest &key &allow-other-keys)
+  (apply 'cando-widgets::show-on-pane pane-instance (topology-jupyter:sketch-svg object) rest))
 
-
-(defmethod show-on-pane (pane-instance (object topology:topology) &rest rest &key &allow-other-keys)
-  (apply 'show-on-pane pane-instance (topology-jupyter:sketch-svg object) rest))
-
-(defmethod show-on-pane (pane-instance (object symbol) &rest rest &key &allow-other-keys)
-(let ((top (chem:find-topology object)))
-  (apply 'show-on-pane pane-instance (topology-jupyter:sketch-svg top) rest)))
+(defmethod cando-widgets::show-on-pane (pane-instance (object symbol) &rest rest &key &allow-other-keys)
+  (let ((top (chem:find-topology object)))
+    (apply 'cando-widgets::show-on-pane pane-instance (topology-jupyter:sketch-svg top) rest)))
 

src/lisp/topology/packages.lisp

@@ -433,7 +433,9 @@
    #:plug1
    #:plug2
    #:monomer1
-   #:monomer2))
+   #:monomer2
+   #:allowed-rotamer-indexes
+   #:copy-joint-positions-into-atoms))
 
 (defpackage #:topology.dag
   (:use #:common-lisp)

src/lisp/topology/topology-classes.lisp

@@ -437,7 +437,8 @@ that is not avoid-out-coupling-plug-name.  Otherwise signal an error"
              :initarg :monomers :accessor monomers)
    (couplings :initform (make-array 16 :adjustable t :fill-pointer 0)
               :initarg :couplings :accessor couplings)
-   (labeled-monomers :initform (make-hash-table) :accessor labeled-monomers)
+   (labeled-monomers :initarg :labeled-monomers
+                     :initform (make-hash-table) :accessor labeled-monomers)
    (%number-of-sequences :initform nil
                         :initarg :number-of-sequences
                         :accessor %number-of-sequences)))

src/lisp/topology/topology.asd

@@ -5,7 +5,7 @@
   :version "0.0.1"
   :author "Christian Schafmeister <[email protected]>"
   :licence "LGPL-3.0"
-  :depends-on (:chem-extras :cando-serialize :cl-conspack :netcdf :named-readtables)
+  :depends-on (:kinematics-extras :chem-extras :cando-serialize :cl-conspack :netcdf :named-readtables)
   :serial t
   :components ((:file "packages")
                (:file "readtable")