Moved symbols between packages

scando-zeus-install

@@ -29,8 +29,6 @@ cando --eval "(ext:start-autocompilation)" \
       --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 "(ql:quickload :amber-protein)" \
       --eval "(amber-protein:transfer-amber-atom-types-to-foldamer amber-protein:*foldamer*)" \
       --eval "(amber-protein:load-rotamers)" \

src/lisp/cando-widgets/cando-widgets.asd

@@ -16,7 +16,6 @@
                #:quri
                #:resizable-box-clj
                #:sketch2d
-               #:topology-jupyter
                #:static-vectors)
   :serial t
   :components ((:file "packages")

src/lisp/cando-widgets/packages.lisp

@@ -52,5 +52,6 @@
     #:sketch-molecule
     #:sketch-molecules
     #:trajectory
-    #:ngl-pane-stage))
+    #:ngl-pane-stage
+    #:show-on-pane))
 

src/lisp/cando-widgets/show.lisp

@@ -558,12 +558,3 @@
 
 
 
-(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)))
-

src/lisp/topology/conformation.lisp

@@ -145,6 +145,9 @@
   (:documentation "Return a monomer-context for a monomer in the oligomer using the foldamer.
 Specialize the foldamer argument to provide methods"))
 
+(defgeneric foldamer-rotamers-database (foldamer)
+  (:documentation "Return the rotamers-database for the foldamer"))
+
 (defclass monomer-subset ()
   ((monomers :initarg :monomers :reader monomers)))
 

src/lisp/topology/define-topology.lisp

@@ -498,7 +498,17 @@ So if name is \"ALA\" and stereoisomer-index is 1 the name becomes ALA{CA/S}."
     tops))
 
 
-(defun validate-cluster-dihedrals (top cluster-dihedrals dihedrals)
+(defun validate-cluster-dihedrals (top cluster-dihedrals dihedrals constitution)
+  (let ((atom-names (make-hash-table)))
+    (loop for ca across (constitution-atoms constitution)
+          do (setf (gethash (atom-name ca) atom-names) t))
+    (loop for dih in dihedrals
+          when (typep dih 'dihedral-info-atom)
+            do (let ((an (atom-name dih)))
+                 (unless (gethash an atom-names)
+                   (error "When defining topology for ~s could not find dihedral atom name ~s~% in constitution atom names ~s"
+                          (name constitution)
+                          an (alexandria:hash-table-keys atom-names))))))
   (when cluster-dihedrals
     (let ((ht (make-hash-table)))
       (loop for dih in dihedrals
@@ -512,7 +522,7 @@ So if name is \"ALA\" and stereoisomer-index is 1 the name becomes ALA{CA/S}."
       (loop for cd in cluster-dihedrals
             for found = (gethash cd ht)
             unless found
-              do (error "For topology ~s could not find cluster-dihedrals ~s in ~s " top cd dihedrals)))))
+              do (error "For topology ~s could not find cluster-dihedrals ~s in ~s " (name constitution) cd dihedrals)))))
 
 (defun topologies-from-graph (graph group-names restraints
                               &key types xyz-joints dihedrals cluster-dihedrals
@@ -558,7 +568,7 @@ So if name is \"ALA\" and stereoisomer-index is 1 the name becomes ALA{CA/S}."
         (setf (residue-properties constitution)
               (list* :dihedrals dihedral-info (residue-properties constitution)))
         (when cluster-dihedrals
-          (validate-cluster-dihedrals :name cluster-dihedrals dihedral-info)
+          (validate-cluster-dihedrals :name cluster-dihedrals dihedral-info constitution)
           (setf (residue-properties constitution)
                 (list* :cluster-dihedrals cluster-dihedrals (residue-properties constitution)))))
       tops)))

src/lisp/topology/design.lisp

@@ -8,13 +8,13 @@
                          out-plug-name
                          next-topology
                          next-residue
-                         in-plug-name)
+                         in-or-out-plug-name)
   (let* ((out-plug (topology:plug-named prev-topology out-plug-name))
-         (in-plug (topology:plug-named next-topology in-plug-name)))
+         (in-plug (topology:plug-named next-topology in-or-out-plug-name)))
     (unless out-plug
       (error "Could not find out-plug in ~s named ~s - available plugs: ~s" prev-topology out-plug-name (alexandria:hash-table-keys (topology:plugs prev-topology))))
     (unless in-plug
-      (error "Could not find in-plug in ~s named ~s - available plugs: ~s" next-topology in-plug-name (alexandria:hash-table-keys (topology:plugs next-topology))))
+      (error "Could not find plug in ~s named ~s - available plugs: ~s" next-topology in-or-out-plug-name (alexandria:hash-table-keys (topology:plugs next-topology))))
     (unless (= (length (topology:plug-bonds out-plug)) (length (topology:plug-bonds in-plug)))
       (error "There is a mismatch between the number of plug-bonds in ~s and ~s" out-plug in-plug))
     (loop for bond-index below (length (topology:plug-bonds out-plug))
@@ -274,7 +274,7 @@ This is for looking up parts but if the thing returned is not a part then return
       (unless (= (length next-monomer) 1)
         (format t "(length next-monomer) -> ~a~%" (length next-monomer))
         (if (< (length next-monomer) 1)
-            (error "There is no monomer with the in-plug-name ~a to connect to ~a" in-plug-name previous-parts)
+            (error "There is no monomer with the in-plug-name ~a to connect to ~a~% the candidates ~s don't have this plugname" in-plug-name previous-parts next-parts)
             (error "There is more than one monomer(~a) with the in-plug-name ~a" next-monomer in-plug-name)))
       (if (null ring-info)
           (couple oligomer

src/lisp/topology/jupyter.lisp

@@ -4,3 +4,159 @@
   "Generate an svg sketch of the topology - send args to sketch2d"
   (let ((mol (topology:build-one-molecule-for-topology topology)))
     (sketch2d:svg (apply 'sketch2d:sketch2d mol args))))
+
+(defclass node ()
+  ((label :initarg :label :reader label)
+   (uid :initarg :uid :reader uid)
+   (monomer :initarg :monomer :reader monomer)
+   ))
+
+(defclass edge ()
+  ((label :initarg :label :reader label)
+   (class :initarg :class :reader class)
+   (coupling :initarg :coupling :reader coupling)
+   (uid :initarg :uid :reader uid)
+   (weight :initarg :weight :reader weight)
+   (width :initarg :width :reader width)
+   (source :initarg :source :reader source)
+   (target :initarg :target :reader target)
+   ))
+
+(defgeneric make-node-label (monomer oligomer-or-space))
+
+
+(defmethod make-node-label (monomer (oligomer-space topology:oligomer-space))
+  (string-downcase
+   (cond
+     ((and (consp (topology:id monomer)) (symbolp (car (topology:id monomer))))
+      (format nil "~a" (first (topology:id monomer))))
+     ((consp (topology:id monomer))
+      (format nil "~{~a~%~}" (first (topology:id monomer))))
+     ((symbolp (topology:id monomer))
+      (format nil "~a" (topology:id monomer)))
+     (t (break "check monomer to generate name") (format nil "~a" monomer))))
+  )
+
+(defmethod make-node-label (monomer (oligomer topology:oligomer))
+  (string-downcase (topology:oligomer-monomer-name oligomer monomer)))
+
+
+(defun make-edge-label (coupling)
+  (typecase coupling
+    (topology:directional-coupling
+     (format nil "~a" (string-downcase (topology:name coupling))))
+    (topology:ring-coupling
+     (format nil "RING~%~a~%~a" (string-downcase (topology:plug1 coupling)) (string-downcase (topology:plug2 coupling))))
+    (t (break "Handle coupling ~s" coupling))))
+
+(defgeneric make-element (element))
+(defmethod make-element ((element node))
+  (cytoscape:make-element :group "nodes" :data (j:make-object "id" (string (uid element))
+                                                              "label" (label element)
+                                                              )))
+
+(defmethod make-element ((element edge))
+  (cytoscape:make-element :group "edges" :data (j:make-object "id" (string (uid element))
+                                                              "weight" (weight element)
+                                                              "width" (width element)
+                                                              "label" (label element)
+                                                              "source" (string (uid (source element)))
+                                                              "target" (string (uid (target element)))
+                                                              )))
+
+(defun make-weight (coupling)
+  (typecase coupling
+    (topology:directional-coupling
+     "100")
+    (topology:ring-coupling
+     "1")
+    (t (break "Handle coupling ~s" coupling))))
+
+(defun make-width (coupling)
+  (typecase coupling
+    (topology:directional-coupling
+     "6")
+    (topology:ring-coupling
+     "2")
+    (t (break "Handle coupling ~s" coupling))))
+
+(defun generate-elements (oligomer-or-space)
+  (let ((monomer-to-node (make-hash-table))
+        (rev-elements nil))
+    (loop for monomer across (topology:monomers oligomer-or-space)
+          for label = (make-node-label monomer oligomer-or-space)
+          for uid = (gensym)
+          for monomer-node = (make-instance 'node
+                                            :uid uid
+                                            :label label
+                                            :monomer monomer)
+          do (push monomer-node rev-elements)
+          do (setf (gethash monomer monomer-to-node) monomer-node))
+    (loop for coupling across (topology:couplings oligomer-or-space)
+          for source-node = (gethash (topology:source-monomer coupling) monomer-to-node)
+          for target-node = (gethash (topology:target-monomer coupling) monomer-to-node)
+          for edge = (make-instance 'edge
+                                    :label (make-edge-label coupling)
+                                    :uid (gensym)
+                                    :weight (make-weight coupling)
+                                    :width (make-width coupling)
+                                    :coupling coupling
+                                    :source source-node
+                                    :target target-node
+                                    )
+          for uid = (gensym)
+          do (push edge rev-elements)
+          )
+    (loop for element in (nreverse rev-elements)
+          collect (make-element element))))
+
+(defun build-cytoscape (elements)
+  (cytoscape:make-cytoscape-widget
+   :box-selection-enabled nil
+   :auto-unselectify t
+   :layout (make-instance 'jw:layout :height "640px")
+   :graph-layouts (list (cytoscape:make-fcose-layout :directed t :padding 10 :roots "#a"))
+   :elements elements
+   :graph-style "
+ node { content: data(label);
+        font-size: 12;
+        text-valign: center;
+        text-halign: center;
+        text-wrap: wrap;
+      }
+ edge { content: data(label);
+        curve-style: bezier;
+        target-arrow-shape: triangle;
+        width: data(width);
+        line-color: #0dd;
+        target-arrow-color: #d00;
+        font-size: 10;
+        text-wrap: wrap;
+      }
+ .highlighted {
+         backgrond-color: #61bffc;
+         line-color: #61bffc;
+         target-arrow-color: #61bffc;
+         transition-property: background-color, line-color, target-arrow-color;
+         transition-duration: 0.5s;
+ }"
+   ))
+
+
+(defmethod cando-widgets::show-on-pane (pane-instance (object topology:oligomer-space) &rest rest &key &allow-other-keys)
+  (let ((elements (generate-elements object)))
+    (build-cytoscape elements)))
+
+(defmethod cando-widgets::show-on-pane (pane-instance (object topology:oligomer) &rest rest &key &allow-other-keys)
+  (let ((elements (generate-elements object)))
+    (build-cytoscape elements)))
+
+
+
+(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)))
+

src/lisp/topology/oligomer-space-dag.lisp

@@ -118,6 +118,28 @@ Example of oligomer-space-dag
       (error "Could not find monomer for node ~a" node))
     monomer))
 
+(defun topology:verify-oligomer-space (oligomer-space &key print)
+  "Check that every monomer in the oligomer space has a monomer-context within the foldamer"
+  (let ((used-contexts-set (make-hash-table :test 'equal))
+        (foldamer (topology:foldamer oligomer-space)))
+    (loop for monomer across (topology:monomers oligomer-space)
+          for monomer-context = (topology:foldamer-monomer-context monomer oligomer-space foldamer)
+          do (when print (format t "monomer-context = ~s~%" monomer-context))
+          do (setf (gethash monomer-context used-contexts-set) t)
+          if monomer-context
+            do (when print
+                 (format t "monomer-context ~a~%   is matched by ~a~%" (recursive-dump-local-monomer-context monomer nil 1) monomer-context))
+          else
+            do (error "Foldamer does not describe oligomer space"))
+    (let (used-contexts unused-contexts)
+      (maphash (lambda (key value)
+                 (declare (ignore value))
+                 (if (gethash key used-contexts-set)
+                     (push key used-contexts)
+                     (push key unused-contexts)))
+               used-contexts-set)
+      (values t used-contexts unused-contexts))))
+
 (defun oligomer-space-from-dag (foldamer dag topology-groups)
   (let ((focus-node (root dag))
         (node-to-monomer (make-hash-table))

src/lisp/topology/packages.lisp

@@ -90,6 +90,7 @@
    #:internals
    #:fragments
    #:foldamer-monomer-context
+   #:foldamer-rotamers-database
    #:save-clusterable-context-rotamers
    #:load-clusterable-context-rotamers
    #:context-rotamers
@@ -425,7 +426,13 @@
    #:make-backbone-without-sidechain-rotamer-from-fragment-internals
    #:make-fragment-internals-with-shape-key-from-fragment-internals
    #:lookup-backbone-shape-key
-   #:rotamer-vector))
+   #:rotamer-vector
+   #:verify-oligomer-space
+   #:ring-coupling
+   #:plug1
+   #:plug2
+   #:monomer1
+   #:monomer2))
 
 (defpackage #:topology.dag
   (:use #:common-lisp)
@@ -470,5 +477,3 @@
    #:make-graph
    #:node-id
    #:dot-svg-foldamer-joint-trees))
-
-

src/lisp/topology/shape.lisp

@@ -523,6 +523,14 @@
     (copy-all-joint-positions-into-atoms ass coords)
     (aggregate ass)))
 
+(defmethod aggregate ((oligomer oligomer))
+  "Generate an aggregate for the oligomer-shape"
+  (let* ((oligomer-space (oligomer-space oligomer))
+         (foldamer (foldamer oligomer-space))
+         (rotamers (foldamer-rotamers-database foldamer))
+         (oligomer-shape (make-oligomer-shape oligomer rotamers)))
+    (random-oligomer-shape-aggregate oligomer-shape)))
+
 (defun analyze-oligomer-shape (oligomer-shape)
   "Print an analysis of the oligomer-shape. Print the number of backbone and sidechain monomer-shapes that have defined rotamer-index's "
   (let ((backbone-count 0)