[This is only lightly tested and therefore probably not quite ready for merging yet; however I'm submitting now to get feedback.] org-entries-lessp was not as efficient a multi-criteria comparator as it could have been, since it evaluated all criteria and then combined them via (eval (cons 'or ...)), thereby missing a chance for lazy evaluation via short-circuiting: if one of the earlier criteria in org-agenda-sorting-strategy-selected evaluates to non-nil, giving a definitive comparison result, there is no need to evaluate any of the later criteria. So instead iterate over the criteria one by one, and return as soon as we have a definitive result. Also remove code duplication by adopting a unified approach to ascending/descending sorting. Note that the way org-entries-lessp is invoked by org-agenda-finalize-entries is still inefficient, because the same values (e.g. timestamps, priorities, etc.) are extracted from every pair of entries in each comparison within the sort. In the future, introducing a Schwartzian transform can probably address this. However the refactoring in this commit is a step in the right direction, and it also allows other code to determine which comparison is decisive in ordering any two elements. Signed-off-by: Adam Spiers <orgmode@adamspiers.org> --- lisp/org-agenda.el | 103 ++++++++++++++++++++------------------------- 1 file changed, 46 insertions(+), 57 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 88bb3f90d..eadc7fedd 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7187,65 +7187,54 @@ (defsubst org-cmp-habit-p (a b) (cond ((and ha (not hb)) -1) ((and (not ha) hb) +1)))) +(defun org-entries-cmp (a b) + "Iterate through the sorting criteria in +`org-agenda-sorting-strategy-selected' until a sorter returns a +definitive comparison, then return a cons cell (RESULT . SORTER)." + (let (sorted-by + sort-result + (ss org-agenda-sorting-strategy-selected)) + (while (and ss (not sorted-by)) + (let* ((sorter (car ss)) + (sorter-name (symbol-name sorter)) + ;; If sorter symbol ends in "-down" then pass the -up version + ;; to org-entries-cmp-1 and then negate the result. + (sorter-down-p (string-match "-down\\'" sorter-name)) + (up-sorter + (if sorter-down-p + (replace-regexp-in-string "-down\\'" "-up" sorter-name) + sorter-name))) + (setq sort-result (org-entries-cmp-1 a b (intern up-sorter))) + (setq ss (cdr ss)) + (when sort-result + (setq sort-result (if sorter-down-p (- sort-result) sort-result)) + (setq sorted-by sorter)))) + (cons sort-result sorted-by))) + +(defun org-entries-cmp-1 (a b sorter) + "Compare two entries via the given sorter." + (pcase sorter + ('timestamp-up (org-cmp-ts a b "")) + ('scheduled-up (org-cmp-ts a b "scheduled")) + ('deadline-up (org-cmp-ts a b "deadline")) + ('tsia-up (org-cmp-ts a b "timestamp_ia")) + ('ts-up (org-cmp-ts a b "timestamp")) + ('time-up (org-cmp-time a b)) + ('stats-up (org-cmp-values a b 'org-stats)) + ('priority-up (org-cmp-values a b 'priority)) + ('effort-up (org-cmp-effort a b)) + ('category-up (org-cmp-category a b)) + ('category-keep (if (org-cmp-category a b) +1 nil)) ;; FIXME: check this + ('tag-up (org-cmp-tag a b)) + ('todo-state-up (org-cmp-todo-state a b)) + ('habit-up (org-cmp-habit-p a b)) + ('alpha-up (org-cmp-alpha a b)) + ('user-defined-up (funcall org-agenda-cmp-user-defined a b)))) + (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." - ;; The following variables will be used when the form is evaluated. - ;; So even though the compiler complains, keep them. - (let* ((ss org-agenda-sorting-strategy-selected) - (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) - (org-cmp-ts a b ""))) - (timestamp-down (if timestamp-up (- timestamp-up) nil)) - (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) - (org-cmp-ts a b "scheduled"))) - (scheduled-down (if scheduled-up (- scheduled-up) nil)) - (deadline-up (and (org-em 'deadline-up 'deadline-down ss) - (org-cmp-ts a b "deadline"))) - (deadline-down (if deadline-up (- deadline-up) nil)) - (tsia-up (and (org-em 'tsia-up 'tsia-down ss) - (org-cmp-ts a b "timestamp_ia"))) - (tsia-down (if tsia-up (- tsia-up) nil)) - (ts-up (and (org-em 'ts-up 'ts-down ss) - (org-cmp-ts a b "timestamp"))) - (ts-down (if ts-up (- ts-up) nil)) - (time-up (and (org-em 'time-up 'time-down ss) - (org-cmp-time a b))) - (time-down (if time-up (- time-up) nil)) - (stats-up (and (org-em 'stats-up 'stats-down ss) - (org-cmp-values a b 'org-stats))) - (stats-down (if stats-up (- stats-up) nil)) - (priority-up (and (org-em 'priority-up 'priority-down ss) - (org-cmp-values a b 'priority))) - (priority-down (if priority-up (- priority-up) nil)) - (effort-up (and (org-em 'effort-up 'effort-down ss) - (org-cmp-effort a b))) - (effort-down (if effort-up (- effort-up) nil)) - (category-up (and (or (org-em 'category-up 'category-down ss) - (memq 'category-keep ss)) - (org-cmp-category a b))) - (category-down (if category-up (- category-up) nil)) - (category-keep (if category-up +1 nil)) - (tag-up (and (org-em 'tag-up 'tag-down ss) - (org-cmp-tag a b))) - (tag-down (if tag-up (- tag-up) nil)) - (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) - (org-cmp-todo-state a b))) - (todo-state-down (if todo-state-up (- todo-state-up) nil)) - (habit-up (and (org-em 'habit-up 'habit-down ss) - (org-cmp-habit-p a b))) - (habit-down (if habit-up (- habit-up) nil)) - (alpha-up (and (org-em 'alpha-up 'alpha-down ss) - (org-cmp-alpha a b))) - (alpha-down (if alpha-up (- alpha-up) nil)) - (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) - user-defined-up user-defined-down) - (when (and need-user-cmp org-agenda-cmp-user-defined - (functionp org-agenda-cmp-user-defined)) - (setq user-defined-up - (funcall org-agenda-cmp-user-defined a b) - user-defined-down (if user-defined-up (- user-defined-up) nil))) - (cdr (assoc - (eval (cons 'or org-agenda-sorting-strategy-selected)) - '((-1 . t) (1 . nil) (nil . nil)))))) + (let ((sort-result (car (org-entries-cmp a b)))) + (cdr (assoc sort-result '((-1 . t) (1 . nil) (nil . nil)))))) ;;; Agenda restriction lock -- 2.28.0
Hi Adam, this looks good to me, thanks a lot. Does "WIP" means that you want to wait for other patches to complete this one or shall I apply this one already? Best, -- Bastien
On Sat, Oct 24, 2020 at 01:36:05PM +0200, Bastien wrote: >Hi Adam, > >this looks good to me, thanks a lot. Thanks for the review :-) >Does "WIP" means that you want to wait for other patches to complete >this one or shall I apply this one already? The intention is for it to be a standalone patch, so I don't think there's any need to wait for other patches. The "WIP" was coming more from the fact that I haven't done extensive testing to make sure I didn't break a single one of the many sorting criteria - especially this one: + ('category-keep (if (org-cmp-category a b) +1 nil)) ;; FIXME: check this Ideally there would already be unit and/or functional tests covering agenda sorting, but I can't see any and I imagine they would be non-trivial to add (although perhaps not too difficult either). Also, the previous behaviour was to silently ignore user-defined-{up,down} if org-agenda-cmp-user-defined was not defined, but that intuitively felt wrong to me (IMHO it kind of violates the Principle of Least Surprise) so I didn't bother to preserve that behaviour. However I admit that is a pretty subjective choice, so if you think the existing behaviour should be preserved, I can tweak the code to do that. In fact, even if you agree with me that it would be better to generate an error when user-defined-{up,down} is used with org-agenda-cmp-user-defined being nil, I just noticed that it currently generates the very unhelpful error: org-entries-cmp-1: Symbol’s function definition is void: nil so we would want to explicitly catch that case and generate a more helpful error message, e.g. "org-agenda-sorting-strategy contains user-defined sorting but org-agenda-cmp-user-defined is nil". BTW, as you can partially see from the below link, I did some performance profiling relating to this change and it did indeed seem to shave a few milliseconds off org-entries-lessp, although in the grand scheme of things, that didn't make as much of a dent in org-agenda's running time as I'd hoped for ;-) https://gist.github.com/trishume/40bf7045a23412d4c016f5e8533437db#gistcomment-3494087
Hi Adam,
Adam Spiers <orgmode@adamspiers.org> writes:
> [This is only lightly tested and therefore probably not quite ready
> for merging yet; however I'm submitting now to get feedback.]
Did you make any progress on stabilizing this patch?
Thanks
Hi Adam,
Adam Spiers <orgmode@adamspiers.org> writes:
> [This is only lightly tested and therefore probably not quite ready
> for merging yet; however I'm submitting now to get feedback.]
We didn't get feedback from others and the patch does not look
critical in terms of performance. Also, there are uncertainties
about it, so I'll close this right now. Feel free to re-open if
you think this is a needed change (even just a nice refactoring,
with no uncertainties on the result.)
Thanks,
--
Bastien