From f77967681d968caa335850a8d4e48552e69dd258 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 8 May 2022 20:03:37 -0400 Subject: [PATCH] ENH only add a scheduled action if an action and qtp point to the same goal node --- local/lib/org-x/org-x-dag.el | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el index c2e59c8..178eae7 100644 --- a/local/lib/org-x/org-x-dag.el +++ b/local/lib/org-x/org-x-dag.el @@ -1482,14 +1482,20 @@ used for optimization." (defun org-x-dag-ns-action (adjlist links ns) (cl-flet - ((get-planned - (htbl ids) - (--mapcat (org-x-dag-ht-get-maybe htbl it :planned) ids))) + ((ns-overlaps + (ids key ns) + (-intersection (plist-get (either-from-right ns nil) key) ids))) (-let* (((&alist :endpoint ht-e :lifetime ht-l :survival ht-s :quarterly ht-q) ns) + (q-committed + (->> (ht->alist ht-q) + (--map (cons (car it) + (-> (either-from-right (cdr it) nil) + (plist-get :committed)))) + (-filter #'cdr))) (is-committed-leaf-p (lambda (id) (if (org-x-dag-ht-get-maybe ht-e id :committed) @@ -1513,10 +1519,14 @@ used for optimization." (t (either :right `(:committed (,@e ,@l) :survivalp nil)))) (ht-set this-h id)) - (when (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id) - (org-ml-get-property :scheduled)) - (->> (-union (get-planned ht-e e) (get-planned ht-l l)) - (org-x-dag-ht-add-links id ht-q :scheduled-actions))) + ;; TODO add additional restriction that these must be scheduled + ;; within the current week + (when (org-x-dag-adjlist-id-planning adjlist :scheduled id) + (-when-let (committed-ids (-union e l)) + (->> q-committed + (--filter (-intersection committed-ids (cdr it))) + (-map #'car) + (org-x-dag-ht-add-links id ht-q :scheduled-actions)))) (org-x-dag-ht-add-links id ht-l :fulfilled l) (org-x-dag-ht-add-links id ht-s :fulfilled s) (org-x-dag-ht-add-links id ht-e :fulfilled e)