Changes to support correcting geometry

include/cando/geom/vector3.h

@@ -56,6 +56,8 @@ class Vector3 {
   ~Vector3() {};
   Vector3( vecreal x, vecreal y, vecreal z ) : coords{x,y,z} {};
 
+  Vector3( core::SimpleVector_float_sp svf, size_t index );
+
   /*! Return the vector in nanometers */
   Vector3 inNanometers() const;
 

src/geom/vector3.cc

@@ -44,8 +44,19 @@ This is an open source license for the CANDO software from Temple University, bu
 #include <clasp/core/lispStream.h>
 #include <cando/geom/matrix.h>
 #include <clasp/core/wrappers.h>
+#include <clasp/core/array.h>
 
 
+Vector3::Vector3(core::SimpleVector_float_sp svf, size_t index) {
+  if (index+2<svf->length()) {
+    this->coords[0] = (*svf)[index];
+    this->coords[1] = (*svf)[index+1];
+    this->coords[2] = (*svf)[index+2];
+    return;
+  }
+  SIMPLE_ERROR("The index {} is out of range for a 3D vector within the array of length {}",
+               index, svf->length());
+}
 
 Vector3 Vector3::inNanometers() const
 {
@@ -327,6 +338,9 @@ float safe_asin( float d )
 
 
 namespace geom {
+
+
+
 DOCGROUP(cando);
 CL_DEFUN double	calculateDistance( const Vector3& va,
                                    const Vector3& vb)
@@ -361,7 +375,6 @@ CL_DEFUN double calculateAngle( const Vector3& va,
 /*! Return the dihedral in radians
  */
 DOCGROUP(cando);
-__attribute__((optnone))
 CL_DEFUN double calculateDihedral( const Vector3& va,
                                    const Vector3& vb,
                                    const Vector3& vc,
@@ -387,6 +400,26 @@ CL_DEFUN double calculateDihedral( const Vector3& va,
   return dih*sgn;
 }
 
+CL_DEFUN double calculateDihedralArray( size_t iva,
+                                        size_t ivb,
+                                        size_t ivc,
+                                        size_t ivd,
+                                        core::Array_sp array) {
+  size_t len = array->length();
+  int64_t max_index = len-2;
+  if (max_index<=0) {
+    SIMPLE_ERROR("The array does not contain 3D vectors");
+  }
+  if (gc::IsA<core::SimpleVector_float_sp>(array)) {
+    auto sfa = gc::As<core::SimpleVector_float_sp>(array);
+    Vector3 va(sfa,iva);
+    Vector3 vb(sfa,ivb);
+    Vector3 vc(sfa,ivc);
+    Vector3 vd(sfa,ivd);
+    return calculateDihedral(va,vb,vc,vd);
+  }
+  SIMPLE_ERROR("Handle array type {}", _rep_(array));
+}
 
 
 CL_DOCSTRING(R"dx(Return a vector (0 0 0))dx");

src/lisp/cando-serialize/packages.lisp

@@ -28,4 +28,5 @@
   (:export #:make-class-save-load
            #:save-cando
            #:load-cando
-           ))
+           #:skip-slot-names
+           #:serializable))

src/lisp/cando-serialize/print-read.lisp

@@ -25,15 +25,23 @@
 ;; -^-
 (in-package :cando.serialize)
 
-(defun print-object-readably-with-slots (obj stream skip-slot-names)
+(defgeneric skip-slot-names (obj)
+  (:documentation "Specialize this method on classes that have slots that we don't want to serialize.
+Return a list of slot names that shouldn't be serialized."))
+(defmethod skip-slot-names ((obj t))
+  "All slots that can be serialized will be serialized"
+  nil)
+
+(defun print-object-readably-with-slots (obj stream)
   (format stream "#$(~s " (class-name (class-of obj)))
-  (loop for slot in (clos:class-slots (class-of obj))
-        for slot-name = (clos:slot-definition-name slot)
-        for initargs = (clos:slot-definition-initargs slot)
-        if (and (car initargs)
-                (not (position slot-name skip-slot-names))
-                (slot-boundp obj slot-name))
-          do (format stream "~s ~s " (car initargs) (slot-value obj slot-name)))
+  (let ((skip-slot-names (skip-slot-names obj)))
+    (loop for slot in (clos:class-slots (class-of obj))
+          for slot-name = (clos:slot-definition-name slot)
+          for initargs = (clos:slot-definition-initargs slot)
+          if (and (car initargs)
+                  (not (position slot-name skip-slot-names))
+                  (slot-boundp obj slot-name))
+            do (format stream "~s ~s " (car initargs) (slot-value obj slot-name))))
   (format stream ") "))
 
 (export '(print-object-readably-with-slots))
@@ -98,10 +106,19 @@ Save the object to the file PATHNAME as an s-expression."
   `(defmethod print-object ((obj ,class-name) stream)
      (if *print-readably*
          (progn
-           (print-object-readably-with-slots obj stream (quote ,skip-slot-names)))
+           (print-object-readably-with-slots obj stream))
          (funcall ,print-unreadably obj stream))))
 
 
+(defclass serializable ()
+  ())
+
+(defmethod print-object ((obj serializable) stream)
+  (if *print-readably*
+      (progn
+        (print-object-readably-with-slots obj stream))
+      (print-unreadable-object (obj stream :type t))))
+
 #+use-mpi
 (eval-when (:load-toplevel :execute)
   (setf mpi:*decode-object-hook*
@@ -121,3 +138,4 @@ Save the object to the file PATHNAME as an s-expression."
               (cl:print obj fout))
             (copy-seq str))))))
 
+

src/lisp/cando/fortran.lisp

@@ -173,7 +173,7 @@
                                        1.0s0)))
            (expt 10.0d0 exponent))))))
 
-(defun parse-vec-real-line (line result width)
+(defun parse-vecreal-line (line result width)
   (loop for start = 0 then end
      for end = (+ start width)
      until (< (length line) end)

src/lisp/cando/packages.lisp

@@ -213,7 +213,8 @@
            #:make-rapid-starting-geometry
            #:next-rapid-starting-geometry
            #:stereochemistry-from-structure
-           #:superpose-all))
+           #:superpose-all
+           #:skip-slot-names))
 
 (defpackage #:dynamics
   (:use #:common-lisp)

src/lisp/cando/print-read.lisp

@@ -77,13 +77,17 @@ Save the object to the file PATHNAME as an s-expression."
   "Create a serializer for class-name. Slots that have :initarg defined and do not appear in
   skip-slot-names will be serialized."
   (unless (and (listp skip-slot-names)
-               (every #'symbolp skip-slot-names))
+               (every #'symbolp skip-slot-names)
     (error "The skip-slot-names must be a list of symbols - instead it is ~s" skip-slot-names))
+  (append
+   (when skip-slot-names
+     `(defmethod skip-slot-names ((obj ,class-name))
+        ',@skip-slot-names))
   `(defmethod print-object ((obj ,class-name) stream)
      (if *print-readably*
          (progn
-           (cando.serialize:print-object-readably-with-slots obj stream (quote ,skip-slot-names)))
-         (funcall ,print-unreadably obj stream))))
+           (cando.serialize:print-object-readably-with-slots obj stream))
+         (funcall ,print-unreadably obj stream)))))
 
 
 #+use-mpi

src/lisp/tirun-jupyter/tirun-jupyter.lisp

@@ -108,8 +108,11 @@
   (all-edges *workspace*))
 
 
-(cando.serialize:make-class-save-load workspace :skip-slot-names (jupyter-widgets:on-trait-change))
-
+(defmethod cando.serialize:skip-slot-names ((obj workspace))
+  '(jupyter-widgets:on-trait-change))
+
+(cando.serialize:make-class-save-load workspace)
+
 (defvar *workspace* nil)