emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] org-clock-sum: Rewrite function to improve performance
@ 2023-07-19 21:35 Morgan Smith
  2023-07-20  7:46 ` Ihor Radchenko
  0 siblings, 1 reply; 2+ messages in thread
From: Morgan Smith @ 2023-07-19 21:35 UTC (permalink / raw)
  To: emacs-orgmode

* lisp/org-clock.el(org-clock-sum): Rewrite function using
'org-element-map' to traverse the file instead of searching.
---

Hello!

I have a very big file with lots of clock entries and refreshing my clocktable
has become slow.  Using '(benchmark-elapse (org-ctrl-c-ctrl-c))' I saw that it
took 5.660532903 seconds to refresh it!  After this rewrite it only takes
3.384914703 seconds.  Not great, but better.

Thanks,

Morgan

 lisp/org-clock.el | 148 +++++++++++++++++-----------------------------
 1 file changed, 54 insertions(+), 94 deletions(-)

diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 264774032..148af864b 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -33,15 +33,10 @@
 
 (require 'cl-lib)
 (require 'org)
+(require 'org-element)
 
 (declare-function calendar-iso-to-absolute "cal-iso" (date))
 (declare-function notifications-notify "notifications" (&rest params))
-(declare-function org-element-property "org-element-ast" (property node))
-(declare-function org-element-contents-end "org-element" (node))
-(declare-function org-element-end "org-element" (node))
-(declare-function org-element-type "org-element-ast" (node &optional anonymous))
-(declare-function org-element-type-p "org-element-ast" (node types))
-(defvar org-element-use-cache)
 (declare-function org-inlinetask-at-task-p "org-inlinetask" ())
 (declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
 (declare-function org-inlinetask-goto-end "org-inlinetask" ())
@@ -1948,100 +1943,65 @@ each headline in the time range with point at the headline.  Headlines for
 which HEADLINE-FILTER returns nil are excluded from the clock summation.
 PROPNAME lets you set a custom text property instead of :org-clock-minutes."
   (with-silent-modifications
-    (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
-		       org-clock-string
-		       "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
-	   (lmax 30)
-	   (ltimes (make-vector lmax 0))
-	   (level 0)
-	   (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
+    (let* ((tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
 			 ((consp tstart) (float-time tstart))
 			 (t tstart)))
 	   (tend (cond ((stringp tend) (org-time-string-to-seconds tend))
 		       ((consp tend) (float-time tend))
 		       (t tend)))
-	   (t1 0)
-	   time)
+           (file-total 0))
       (remove-text-properties (point-min) (point-max)
-			      `(,(or propname :org-clock-minutes) t
-				:org-clock-force-headline-inclusion t))
-      (save-excursion
-	(goto-char (point-max))
-	(while (re-search-backward re nil t)
-          (let* ((element (save-match-data (org-element-at-point)))
-                 (element-type (org-element-type element)))
-	    (cond
-	     ((and (eq element-type 'clock) (match-end 2))
-	      ;; Two time stamps.
-	      (let* ((timestamp (org-element-property :value element))
-		     (ts (float-time
-                          (org-encode-time
-                           (list 0
-                                 (org-element-property :minute-start timestamp)
-                                 (org-element-property :hour-start timestamp)
-                                 (org-element-property :day-start timestamp)
-                                 (org-element-property :month-start timestamp)
-                                 (org-element-property :year-start timestamp)
-                                 nil -1 nil))))
-		     (te (float-time
-                          (org-encode-time
-                           (list 0
-                                 (org-element-property :minute-end timestamp)
-                                 (org-element-property :hour-end timestamp)
-                                 (org-element-property :day-end timestamp)
-                                 (org-element-property :month-end timestamp)
-                                 (org-element-property :year-end timestamp)
-                                 nil -1 nil))))
-		     (dt (- (if tend (min te tend) te)
-			    (if tstart (max ts tstart) ts))))
-	        (when (> dt 0) (cl-incf t1 (floor dt 60)))))
-	     ((match-end 4)
-	      ;; A naked time.
-	      (setq t1 (+ t1 (string-to-number (match-string 5))
-			  (* 60 (string-to-number (match-string 4))))))
-	     ((memq element-type '(headline inlinetask)) ;A headline
-	      ;; Add the currently clocking item time to the total.
-	      (when (and org-clock-report-include-clocking-task
-		         (eq (org-clocking-buffer) (current-buffer))
-		         (eq (marker-position org-clock-hd-marker) (point))
-		         tstart
-		         tend
-		         (>= (float-time org-clock-start-time) tstart)
-		         (<= (float-time org-clock-start-time) tend))
-	        (let ((time (floor (org-time-convert-to-integer
-				    (time-since org-clock-start-time))
-				   60)))
-		  (setq t1 (+ t1 time))))
-	      (let* ((headline-forced
-		      (get-text-property (point)
-				         :org-clock-force-headline-inclusion))
-		     (headline-included
-		      (or (null headline-filter)
-			  (save-excursion
-			    (save-match-data (funcall headline-filter))))))
-	        (setq level (- (match-end 1) (match-beginning 1)))
-	        (when (>= level lmax)
-		  (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
-	        (when (or (> t1 0) (> (aref ltimes level) 0))
-		  (when (or headline-included headline-forced)
-		    (if headline-included
-		        (cl-loop for l from 0 to level do
-			         (aset ltimes l (+ (aref ltimes l) t1))))
-		    (setq time (aref ltimes level))
-		    (goto-char (match-beginning 0))
-                    (put-text-property (point) (line-end-position)
-				       (or propname :org-clock-minutes) time)
-		    (when headline-filter
-		      (save-excursion
-		        (save-match-data
-			  (while (org-up-heading-safe)
-			    (put-text-property
-			     (point) (line-end-position)
-			     :org-clock-force-headline-inclusion t))))))
-		  (setq t1 0)
-		  (cl-loop for l from level to (1- lmax) do
-			   (aset ltimes l 0))))))))
-	(setq org-clock-file-total-minutes (aref ltimes 0))))))
+                              `(,(or propname :org-clock-minutes) t))
+      (org-element-map (org-element-parse-buffer 'element nil t) '(headline inlinetask)
+        (lambda (headline)
+          (when headline-filter
+            (unless
+                (save-excursion
+                  (org-element-map headline '(headline inlinetask)
+                    (lambda (child)
+                      (goto-char (org-element-begin child))
+                      (funcall headline-filter))))
+              (throw :org-element-skip nil)))
+          (let ((headline-total 0))
+            (org-element-map (org-element-contents headline) 'clock
+              (lambda (el)
+                (let (duration)
+                  (if
+                      (eq 'running (org-element-property :status el))
+                      (progn
+                        (when (and org-clock-report-include-clocking-task
+                                   (eq (org-clocking-buffer) (current-buffer))
+                                   (eq (marker-position org-clock-hd-marker)
+                                       (org-element-begin headline))
+                                   tstart
+                                   tend
+                                   (>= (float-time org-clock-start-time) tstart)
+                                   (<= (float-time org-clock-start-time) tend))
+                          (let ((time (floor (org-time-convert-to-integer
+                                              (time-since org-clock-start-time))
+                                             60)))
+                            (setq duration time))))
+                    (let* ((timestamp (org-element-property :value el))
+                           (ts (float-time (org-timestamp-to-time timestamp)))
+                           (te (float-time (org-timestamp-to-time timestamp t)))
+                           (dt (- (if tend (min te tend) te)
+                                  (if tstart (max ts tstart) ts))))
+                      (setq duration (floor dt 60))))
+                  (when (> duration 0)
+                    (setq headline-total (+ headline-total duration)))))
+              nil nil 'headline)
+            (put-text-property (org-element-begin headline) (1- (org-element-contents-begin headline))
+                               (or propname :org-clock-minutes) headline-total)
+            (org-element-lineage-map headline
+                (lambda (parent)
+                  (put-text-property (org-element-begin parent) (1- (org-element-contents-begin parent))
+                                     (or propname :org-clock-minutes)
+                                     (+ headline-total
+                                        (get-text-property (org-element-begin parent)
+                                                           (or propname :org-clock-minutes)))))
+              'headline)
+            (setq file-total (+ file-total headline-total)))))
+      (setq org-clock-file-total-minutes file-total))))
 
 (defun org-clock-sum-current-item (&optional tstart)
   "Return time, clocked on current item in total."
-- 
2.41.0



^ permalink raw reply related	[flat|nested] 2+ messages in thread

* Re: [PATCH] org-clock-sum: Rewrite function to improve performance
  2023-07-19 21:35 [PATCH] org-clock-sum: Rewrite function to improve performance Morgan Smith
@ 2023-07-20  7:46 ` Ihor Radchenko
  0 siblings, 0 replies; 2+ messages in thread
From: Ihor Radchenko @ 2023-07-20  7:46 UTC (permalink / raw)
  To: Morgan Smith; +Cc: emacs-orgmode

Morgan Smith <Morgan.J.Smith@outlook.com> writes:

> I have a very big file with lots of clock entries and refreshing my clocktable
> has become slow.  Using '(benchmark-elapse (org-ctrl-c-ctrl-c))' I saw that it
> took 5.660532903 seconds to refresh it!  After this rewrite it only takes
> 3.384914703 seconds.  Not great, but better.

Thanks, but the approach you used is questionable.
You are forcing Org to parse the whole buffer as opposed to the existing
approach with parsing only the necessary parts.

While I do see how your implementation might be faster for certain Org
files (many clock entries, little other elements), but I do not see how
it can be faster in general case.

May you instead share the benchmark data for the original Org's code on
your file?

1. M-x profiler-start <RET> cpu <RET>
2. Generate the clock table
3. M-x profiler-report <RET>
4. M-x profiler-report-write-profile
5. Share the saved profile file

P.S.

I did a benchmark on another large buffer and with the existing
implementation I am getting (first column is time in ms):

       15989  58%                                              - org-clock-sum
       15837  58%                                               - org-element-at-point
       15517  56%                                                + org-element--parse-to

With your code

       27347  87%                                   - org-clock-sum
       27347  87%                                    - let*
       27347  87%                                     - unwind-protect
       27347  87%                                      - progn
       27347  87%                                       - let*
       27310  87%                                        - org-element-map
       27230  87%                                         + org-element-parse-buffer

and the code is not yet even done, stopping processing due to error.

Further, you dropped the

	     ((match-end 4)
	      ;; A naked time.

branch of the code, which accounts for CLOCK: => HH:MM lines that are not clock elements.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>


^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2023-07-20  7:47 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-07-19 21:35 [PATCH] org-clock-sum: Rewrite function to improve performance Morgan Smith
2023-07-20  7:46 ` Ihor Radchenko

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).