[PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient

[PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient

[Adam Spiers]

[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

Re: [PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient

[Bastien]

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

Re: [PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient

[Adam Spiers]

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

Re: [PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient

[Bastien]

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

Re: [PATCH] [WIP] org-agenda.el: Make org-entries-lessp more efficient

[Bastien]

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