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

FIX adding edges without nodes bug

This commit is contained in:
Nathan Dwarshuis 2022-01-22 18:04:25 -05:00
parent 1c4668db62
commit 7c11a0c4da
1 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -219,6 +219,8 @@ The type of WHAT will determine how the hash table is build:
extra-edges)) extra-edges))
(defun dag--create (adjlist broken-edges floating) (defun dag--create (adjlist broken-edges floating)
;; TODO this floating this is probably not necessary; it automatically makes
;; any algorithm using this function at least O(N)
(-let (((a f) (dag--get-floating adjlist floating))) (-let (((a f) (dag--get-floating adjlist floating)))
(list :adjlist a (list :adjlist a
:broken-edges broken-edges :broken-edges broken-edges
@ -308,7 +310,7 @@ ZS."
(defun dag--adjlist-insert-nodes (to-insert adjlist broken-ht) (defun dag--adjlist-insert-nodes (to-insert adjlist broken-ht)
(let (i i-key i-rel edges-to-add parent-edges broken-edges edges-to-remove (let (i i-key i-rel edges-to-add parent-edges broken-edges edges-to-remove
parent-rel) parent-rel to-insert*)
(while to-insert (while to-insert
(setq i (car to-insert) (setq i (car to-insert)
i-key (car i) i-key (car i)
@ -338,16 +340,23 @@ ZS."
;; remain, and set the broken edges hash table to the latter. ;; remain, and set the broken edges hash table to the latter.
(setq broken-edges (ht-get broken-ht i-key)) (setq broken-edges (ht-get broken-ht i-key))
(dag--intersection-difference broken-edges edges-to-add) (dag--intersection-difference broken-edges edges-to-add)
(ht-set broken-ht i-key broken-edges)) (ht-set broken-ht i-key broken-edges)
(!cons (cons i-key edges-to-add) to-insert*)
(!cdr to-insert)))
;; Add edges in a separate loop since we need all the inserted nodes to be
;; present before testing if an edge is broken
(while to-insert*
(setq i (car to-insert*)
i-key (car i))
;; Add new node to the child list of newly linked parents. This needs to ;; Add new node to the child list of newly linked parents. This needs to
;; be done separately from above since we don't know if the new edges are ;; be done separately from above since we don't know if the new edges are
;; broken or not ;; broken or not
(--each edges-to-add (--each (cdr i)
(if (not (setq parent-rel (ht-get adjlist it))) (if (not (setq parent-rel (ht-get adjlist it)))
(dag--ht-cons broken-ht i-key it) (dag--ht-cons broken-ht i-key it)
(ht-set adjlist it (dag--plist-cons parent-rel :children i-key)) (ht-set adjlist it (dag--plist-cons parent-rel :children i-key))
(dag--adjlist-add-parent-edge i-key it adjlist))) (dag--adjlist-add-parent-edge i-key it adjlist)))
(!cdr to-insert)) (!cdr to-insert*))
(list adjlist (dag--prune-broken-edges broken-ht)))) (list adjlist (dag--prune-broken-edges broken-ht))))
(defun dag-alist-to-dag (parent-adjlist) (defun dag-alist-to-dag (parent-adjlist)
@ -374,10 +383,12 @@ Return a DAG object."
(dag--create a* b* f))) (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 :floating-nodes f) dag) (if (not (or to-remove to-insert)) dag
(-let* ((to-remove* (-difference to-remove (-map #'car to-insert)))
((&plist :adjlist a :broken-edges b :floating-nodes f) dag)
((a* b* f*) (dag--adjlist-remove-nodes to-remove a b f)) ((a* b* f*) (dag--adjlist-remove-nodes to-remove a b f))
((a** b**) (dag--adjlist-insert-nodes to-insert a* b*))) ((a** b**) (dag--adjlist-insert-nodes to-insert a* b*)))
(dag--create a** b** f*))) (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))