ENH only add a scheduled action if an action and qtp point to the same goal node
This commit is contained in:
parent
c8be4f52f9
commit
f77967681d
|
@ -1482,14 +1482,20 @@ used for optimization."
|
||||||
|
|
||||||
(defun org-x-dag-ns-action (adjlist links ns)
|
(defun org-x-dag-ns-action (adjlist links ns)
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((get-planned
|
((ns-overlaps
|
||||||
(htbl ids)
|
(ids key ns)
|
||||||
(--mapcat (org-x-dag-ht-get-maybe htbl it :planned) ids)))
|
(-intersection (plist-get (either-from-right ns nil) key) ids)))
|
||||||
(-let* (((&alist :endpoint ht-e
|
(-let* (((&alist :endpoint ht-e
|
||||||
:lifetime ht-l
|
:lifetime ht-l
|
||||||
:survival ht-s
|
:survival ht-s
|
||||||
:quarterly ht-q)
|
:quarterly ht-q)
|
||||||
ns)
|
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
|
(is-committed-leaf-p
|
||||||
(lambda (id)
|
(lambda (id)
|
||||||
(if (org-x-dag-ht-get-maybe ht-e id :committed)
|
(if (org-x-dag-ht-get-maybe ht-e id :committed)
|
||||||
|
@ -1513,10 +1519,14 @@ used for optimization."
|
||||||
(t
|
(t
|
||||||
(either :right `(:committed (,@e ,@l) :survivalp nil))))
|
(either :right `(:committed (,@e ,@l) :survivalp nil))))
|
||||||
(ht-set this-h id))
|
(ht-set this-h id))
|
||||||
(when (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id)
|
;; TODO add additional restriction that these must be scheduled
|
||||||
(org-ml-get-property :scheduled))
|
;; within the current week
|
||||||
(->> (-union (get-planned ht-e e) (get-planned ht-l l))
|
(when (org-x-dag-adjlist-id-planning adjlist :scheduled id)
|
||||||
(org-x-dag-ht-add-links id ht-q :scheduled-actions)))
|
(-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-l :fulfilled l)
|
||||||
(org-x-dag-ht-add-links id ht-s :fulfilled s)
|
(org-x-dag-ht-add-links id ht-s :fulfilled s)
|
||||||
(org-x-dag-ht-add-links id ht-e :fulfilled e)
|
(org-x-dag-ht-add-links id ht-e :fulfilled e)
|
||||||
|
|
Loading…
Reference in New Issue