ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

FIX bugs for keeping track of floating nodes and removing nonexistent edges

This commit is contained in:
Nathan Dwarshuis 2022-01-15 20:17:54 -05:00
parent 37f5be9e37
commit 2da4115c42
1 changed files with 27 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
local/lib/dag/dag.el
View File

@ -130,17 +130,20 @@ The type of WHAT will determine how the hash table is build:
(when (--all-p (= 0 it) (ht-values parent-degrees)) (when (--all-p (= 0 it) (ht-values parent-degrees))
(nreverse ordered-nodes)))) (nreverse ordered-nodes))))
(defun dag--get-floating (adjlist) (defun dag--get-floating (adjlist init)
;; Find 'floating nodes', which are nodes that have no children or parents ;; Find 'floating nodes', which are nodes that have no children or parents
;; (this will happen if the original alist has node keys that aren't ;; (this will happen if the original alist has node keys that aren't
;; referenced by any parents). ;; referenced by any parents).
;; ;;
;; O(N) ;; O(N)
(let ((acc (dag--ht-create nil)) (let ((acc (or init (dag--ht-create nil)))
cur) cur)
(dag--each-key adjlist (dag--each-key adjlist
(setq cur (ht-get adjlist it)) (setq cur (ht-get adjlist it))
(unless (or (plist-get cur :children) (plist-get cur :parents)) ;; If adjlist key has parents and/or children, remove it from the floating
;; if present, otherwise add it to floating and remove it from adjlist
(if (or (plist-get cur :children) (plist-get cur :parents))
(ht-remove acc it)
(ht-remove adjlist it) (ht-remove adjlist it)
(ht-set acc it t))) (ht-set acc it t)))
(list adjlist acc))) (list adjlist acc)))
@ -215,8 +218,8 @@ The type of WHAT will determine how the hash table is build:
(setq order (cdr order))) (setq order (cdr order)))
extra-edges)) extra-edges))
(defun dag--create (adjlist broken-edges) (defun dag--create (adjlist broken-edges floating)
(-let (((a f) (dag--get-floating adjlist))) (-let (((a f) (dag--get-floating adjlist floating)))
(list :adjlist a (list :adjlist a
:broken-edges broken-edges :broken-edges broken-edges
:floating-nodes f :floating-nodes f
@ -228,16 +231,18 @@ The type of WHAT will determine how the hash table is build:
(ht-remove broken-edges it))) (ht-remove broken-edges it)))
broken-edges) broken-edges)
(defun dag--adjlist-remove-nodes (to-remove adjlist broken-edges) (defun dag--adjlist-remove-nodes (to-remove adjlist broken-edges floating)
(let (r r-rel child-rel) (let (r r-rel child-rel)
(while to-remove (while to-remove
;; If the node to be removed is in the adjacency list, get a list of its ;; If the node to be removed is in the adjacency list, get a list of its
;; parents, remove the node from the child list of each parent, then ;; parents, remove the node from the child list of each parent, then
;; delete the node itself. ;; delete the node itself. Otherwise try to delete if from floating nodes.
(when (setq r (car to-remove) (setq r (car to-remove))
r-rel (ht-get adjlist r)) (if (not (setq r-rel (ht-get adjlist r)))
(ht-remove floating r)
(--each (plist-get r-rel :parents) (--each (plist-get r-rel :parents)
(dag--adjlist-remove-child-edge it r adjlist)) (when (and (not (member it to-remove)) (ht-contains-p adjlist it))
(dag--adjlist-remove-child-edge it r adjlist)))
;; If a child edge refers to a node that is not about to be removed, ;; If a child edge refers to a node that is not about to be removed,
;; remove the parent edge from the the child and add it to broken edges. ;; remove the parent edge from the the child and add it to broken edges.
;; Otherwise do nothing because the child will be removed later anyways. ;; Otherwise do nothing because the child will be removed later anyways.
@ -251,7 +256,7 @@ The type of WHAT will determine how the hash table is build:
;; presence in the adjacency list ;; presence in the adjacency list
(ht-remove broken-edges r) (ht-remove broken-edges r)
(!cdr to-remove))) (!cdr to-remove)))
(list adjlist broken-edges)) (list adjlist broken-edges floating))
(defmacro dag--intersection-difference (xs ys &optional zs) (defmacro dag--intersection-difference (xs ys &optional zs)
"Calculate the intersection and difference of XS and YS. "Calculate the intersection and difference of XS and YS.
@ -355,24 +360,24 @@ The set of all car keys must be equivalent to the set of all cdr
keys. keys.
Return a DAG object." Return a DAG object."
(->> (dag--alist-to-ht parent-adjlist) (-let (((a b) (dag--alist-to-ht parent-adjlist)))
(apply #'dag--create))) (dag--create a b nil)))
(defun dag-remove-nodes (to-remove dag) (defun dag-remove-nodes (to-remove dag)
(-let (((&plist :adjlist a :broken-edges b) dag)) (-let (((&plist :adjlist a :broken-edges b :floating-nodes f) dag))
(->> (dag--adjlist-remove-nodes to-remove a b) (->> (dag--adjlist-remove-nodes to-remove a b f)
(apply #'dag--create)))) (apply #'dag--create))))
(defun dag-insert-nodes (to-insert dag) (defun dag-insert-nodes (to-insert dag)
(-let (((&plist :adjlist a :broken-edges b) dag)) (-let* (((&plist :adjlist a :broken-edges b :floating-nodes f) dag)
(->> (dag--adjlist-insert-nodes to-insert a b) ((a* b*) (dag--adjlist-insert-nodes to-insert a b)))
(apply #'dag--create)))) (dag--create a* b* f)))
(defun dag-edit-nodes (to-remove to-insert dag) (defun dag-edit-nodes (to-remove to-insert dag)
(-let (((&plist :adjlist a :broken-edges b) dag)) (-let* (((&plist :adjlist a :broken-edges b :floating-nodes f) dag)
(->> (dag--adjlist-remove-nodes to-remove a b) ((a* b* f*) (dag--adjlist-remove-nodes to-remove a b f))
(apply #'dag--adjlist-insert-nodes to-insert) ((a** b**) (dag--adjlist-insert-nodes to-insert a* b*)))
(apply #'dag--create)))) (dag--create a** b** f*)))
(defun dag-get-adjacency-list (dag) (defun dag-get-adjacency-list (dag)
(plist-get dag :adjlist)) (plist-get dag :adjlist))