ADD functions to rank goals
This commit is contained in:
parent
15e82d8471
commit
2b477b2bb0
|
@ -137,6 +137,12 @@ that file as it currently sits on disk.")
|
||||||
(parent-tags (and inherit? (ascend id nil))))
|
(parent-tags (and inherit? (ascend id nil))))
|
||||||
(append local-tags parent-tags init))))
|
(append local-tags parent-tags init))))
|
||||||
|
|
||||||
|
(defun org-x-dag-id->bucket (inherit? id)
|
||||||
|
(-some->> (org-x-dag-id->tags inherit? nil id)
|
||||||
|
(--find (= (elt it 0) org-x-tag-category-prefix))
|
||||||
|
(s-chop-prefix "_")
|
||||||
|
(intern)))
|
||||||
|
|
||||||
(defun org-x-dag-id->link (id)
|
(defun org-x-dag-id->link (id)
|
||||||
(org-x-dag-with-id-in-file id
|
(org-x-dag-with-id-in-file id
|
||||||
(let ((desc (org-get-heading t t t t)))
|
(let ((desc (org-get-heading t t t t)))
|
||||||
|
@ -160,10 +166,48 @@ that file as it currently sits on disk.")
|
||||||
(->> (org-x-dag-id->children id)
|
(->> (org-x-dag-id->children id)
|
||||||
(--filter (equal (org-x-dag-id->metaprop it :buffer-parent) id))))
|
(--filter (equal (org-x-dag-id->metaprop it :buffer-parent) id))))
|
||||||
|
|
||||||
|
(defun org-x-dag-id->all-headline-children (id)
|
||||||
|
(->> (org-x-dag-id->headline-children id)
|
||||||
|
(-mapcat #'org-x-dag-id->all-headline-children)
|
||||||
|
(cons id)))
|
||||||
|
|
||||||
(defun org-x-dag-files->ids (files)
|
(defun org-x-dag-files->ids (files)
|
||||||
(let ((filemap (plist-get org-x-dag :file->ids)))
|
(let ((filemap (plist-get org-x-dag :file->ids)))
|
||||||
(--mapcat (ht-get filemap it) files)))
|
(--mapcat (ht-get filemap it) files)))
|
||||||
|
|
||||||
|
(defun org-x-dag->epg-ids ()
|
||||||
|
(org-x-dag-files->ids `(,(org-x-get-endpoint-goal-file))))
|
||||||
|
|
||||||
|
(defun org-x-dag->ltg-ids ()
|
||||||
|
(org-x-dag-files->ids `(,(org-x-get-lifetime-goal-file))))
|
||||||
|
|
||||||
|
(defun org-x-dag->leaf-epg-ids ()
|
||||||
|
(-remove #'org-x-dag-id->headline-children (org-x-dag->epg-ids)))
|
||||||
|
|
||||||
|
(defun org-x-dag->leaf-ltg-ids ()
|
||||||
|
(let ((epg-file (org-x-get-endpoint-goal-file)))
|
||||||
|
(->> (org-x-dag->ltg-ids)
|
||||||
|
(-remove #'org-x-dag-id->headline-children)
|
||||||
|
(--remove (equal (org-x-dag-id->file it) epg-file)))))
|
||||||
|
|
||||||
|
(defun org-x-dag-goal-count-tasks (id)
|
||||||
|
(->> (org-x-dag-id->children id)
|
||||||
|
(-mapcat #'org-x-dag-id->all-headline-children)
|
||||||
|
;; TODO this isn't very efficient, looking up children twice
|
||||||
|
(-remove #'org-x-dag-id->headline-children)
|
||||||
|
(length)))
|
||||||
|
|
||||||
|
(defun org-x-dag-rank-leaf-goals (quarter ids)
|
||||||
|
(cl-flet
|
||||||
|
((score
|
||||||
|
(buckets id)
|
||||||
|
;; TODO what happens when I don't have a bucket?
|
||||||
|
(let ((idx (-elem-index (org-x-dag-id->bucket t id) (reverse buckets)))
|
||||||
|
(ntasks (org-x-dag-goal-count-tasks id)))
|
||||||
|
(list idx ntasks))))
|
||||||
|
(let ((bs (org-x-qtp-get-buckets quarter)))
|
||||||
|
(org-x-dag-ids-rank (score bs it) ids))))
|
||||||
|
|
||||||
;; planning state
|
;; planning state
|
||||||
|
|
||||||
;; TODO might be less tedious to just set the date and have functions handy
|
;; TODO might be less tedious to just set the date and have functions handy
|
||||||
|
@ -291,12 +335,20 @@ A date like (YEAR MONTH DAY).")
|
||||||
(org-x-dag-qtp-map quarter
|
(org-x-dag-qtp-map quarter
|
||||||
(plist-put it key xs)))
|
(plist-put it key xs)))
|
||||||
|
|
||||||
(defun org-x-qtp-get-categories (quarter)
|
(defun org-x-qtp-get-buckets (quarter)
|
||||||
(org-x-dag-qtp-get-key :categories quarter))
|
(org-x-dag-qtp-get-key :categories quarter))
|
||||||
|
|
||||||
(defun org-x-qtp-get-goals (quarter)
|
(defun org-x-qtp-get-goals (quarter)
|
||||||
(org-x-dag-qtp-get-key :goals quarter))
|
(org-x-dag-qtp-get-key :goals quarter))
|
||||||
|
|
||||||
|
(defun org-x-qtp-get-goal-ids (quarter)
|
||||||
|
(->> (org-x-qtp-get-goals quarter)
|
||||||
|
(--map (org-ml-headline-get-node-property "ID" it))))
|
||||||
|
|
||||||
|
(defun org-x-qtp-get-goal-parent-ids (quarter)
|
||||||
|
(->> (org-x-qtp-get-goals quarter)
|
||||||
|
(-mapcat #'org-x-dag-headline-get-parent-links)))
|
||||||
|
|
||||||
(defun org-x-qtp-set-categories (quarter categories)
|
(defun org-x-qtp-set-categories (quarter categories)
|
||||||
(org-x-dag-qtp-set-key quarter :categories categories))
|
(org-x-dag-qtp-set-key quarter :categories categories))
|
||||||
|
|
||||||
|
@ -304,7 +356,7 @@ A date like (YEAR MONTH DAY).")
|
||||||
(org-x-dag-qtp-set-key quarter :goals goals))
|
(org-x-dag-qtp-set-key quarter :goals goals))
|
||||||
|
|
||||||
(defmacro org-x-qtp-map-categories (quarter form)
|
(defmacro org-x-qtp-map-categories (quarter form)
|
||||||
`(let ((it (org-x-qtp-get-categories ,quarter)))
|
`(let ((it (org-x-qtp-get-buckets ,quarter)))
|
||||||
(org-x-qtp-set-categories ,quarter ,form)))
|
(org-x-qtp-set-categories ,quarter ,form)))
|
||||||
|
|
||||||
(defmacro org-x-qtp-map-goals (quarter form)
|
(defmacro org-x-qtp-map-goals (quarter form)
|
||||||
|
@ -409,6 +461,8 @@ valid keyword or none of its parents have valid keywords."
|
||||||
;; If parent is not a todo and we want tag inheritance, store all tags
|
;; If parent is not a todo and we want tag inheritance, store all tags
|
||||||
;; above this headline (sans file-tags which we can get later easily)
|
;; above this headline (sans file-tags which we can get later easily)
|
||||||
;; (org-entry-get nil org-x-prop-parent-type)
|
;; (org-entry-get nil org-x-prop-parent-type)
|
||||||
|
;; TODO add the file tags here so I don't need to worry about them
|
||||||
|
;; later
|
||||||
(setq all-tags (if (and (not this-parent-key)
|
(setq all-tags (if (and (not this-parent-key)
|
||||||
org-use-tag-inheritance)
|
org-use-tag-inheritance)
|
||||||
(->> cur-path
|
(->> cur-path
|
||||||
|
@ -444,6 +498,7 @@ valid keyword or none of its parents have valid keywords."
|
||||||
"Return a list of all files to be used in the DAG."
|
"Return a list of all files to be used in the DAG."
|
||||||
`(,(org-x-get-lifetime-goal-file)
|
`(,(org-x-get-lifetime-goal-file)
|
||||||
,(org-x-get-endpoint-goal-file)
|
,(org-x-get-endpoint-goal-file)
|
||||||
|
,(org-x-qtp-get-file)
|
||||||
,@(org-x-get-action-and-incubator-files)))
|
,@(org-x-get-action-and-incubator-files)))
|
||||||
|
|
||||||
(defun org-x-dag-get-md5 (path)
|
(defun org-x-dag-get-md5 (path)
|
||||||
|
@ -885,8 +940,15 @@ FUTURE-LIMIT in a list."
|
||||||
|
|
||||||
(defmacro org-x-dag-ids-rank (form ids)
|
(defmacro org-x-dag-ids-rank (form ids)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
`(->> (--map (cons it ,form) ,ids)
|
`(cl-labels
|
||||||
(--sort (> (cdr it) (cdr other)))))
|
((compare
|
||||||
|
(a b)
|
||||||
|
(cond
|
||||||
|
((not (or a b)) t)
|
||||||
|
((= (car a) (car b)) (compare (cdr a) (cdr b)))
|
||||||
|
(t (> (car a) (car b))))))
|
||||||
|
(->> (--map (cons it ,form) ,ids)
|
||||||
|
(--sort (compare (cdr it) (cdr other))))))
|
||||||
|
|
||||||
(defmacro org-x-dag-ids-rank-by-children (form ids)
|
(defmacro org-x-dag-ids-rank-by-children (form ids)
|
||||||
`(org-x-dag-ids-rank
|
`(org-x-dag-ids-rank
|
||||||
|
@ -1411,6 +1473,17 @@ FUTURE-LIMIT in a list."
|
||||||
(= (org-today)))))
|
(= (org-today)))))
|
||||||
(format-id todayp it-category it)))))
|
(format-id todayp it-category it)))))
|
||||||
|
|
||||||
|
(defun org-x-dag-scan-quarterly-plan ()
|
||||||
|
(cl-flet
|
||||||
|
((format-id
|
||||||
|
(category id)
|
||||||
|
(-> (org-x-dag-format-tag-node category nil id)
|
||||||
|
(org-add-props nil))))
|
||||||
|
(org-x-dag-with-files (list (org-x-qtp-get-file))
|
||||||
|
nil
|
||||||
|
(org-x-dag-with-id it
|
||||||
|
(list (format-id it-category it))))))
|
||||||
|
|
||||||
;;; AGENDA VIEWS
|
;;; AGENDA VIEWS
|
||||||
|
|
||||||
;; (defun org-x-dag-show-tasks (_match)
|
;; (defun org-x-dag-show-tasks (_match)
|
||||||
|
|
Loading…
Reference in New Issue