Re: [PATH] Speedups to org-table-recalculate

[Nathaniel Flath <flat0103@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1763 bytes --]

Hi Michael,

Thanks for the review! Updated patches attached.  I believe I've fixed
everything you mentioned - let me know if I missed something.

On Sun, Oct 19, 2014 at 3:57 PM, Michael Brand <michael.ch.brand@gmail.com>
wrote:

> Hi Nathaniel
>
> On Sat, Oct 18, 2014 at 7:11 AM, Nathaniel Flath <flat0103@gmail.com>
> wrote:
> > Patches are attached.
>
> I am not an expert for all the following comments, please correct me
> or contradict where necessary.
>
> The patches do not apply on current master, so I did not try them out
> yet.
>
> You might want to add a def-edebug-spec like there is one for many
> other defmacro in Org.
>

Limit lines to max. 80 chars.
>
> It will make it easier for the maintainer Bastien to apply the patches
> when you format them with git including a changelog etc. as described
> here
> http://orgmode.org/worg/org-contribute.html
>

> > +          (if (not all) (message "Re-applying formula to field: %s"
> (car eq))
> > +            (org-table-execute-once-per-second log-last-time (message
> "Re-applying formula to field: %s" (car eq))))
>
> Good idea to still log always when only one table row is recalculated.
>
> The doubling of the message makes it more complicated to maintain its
> string. I suggest to change the macro to allow
>
>     (org-table-execute-once-per-second
>      (when all log-last-time)  ; Log just always when `all' is nil.
>      (message "Re-applying formula to field: %s" (car eq)))



> Why not test `all' also for the other message with "to field"?
>
>

> > +       ,@body
> > +       )))
>
>
> > +            (and all (org-table-execute-once-per-second log-last-time
> (message "Re-applying formulas to %d lines...done" cnt))))
>
> Shouldn't this use `log-first-time'?
>
>


> Michael
>

[-- Attachment #1.2: Type: text/html, Size: 3168 bytes --]

[-- Attachment #2: 0001-org-table.el-Add-early-return-check-to-org-table-rec.patch --]
[-- Type: application/octet-stream, Size: 11560 bytes --]

From 2b24ffcdfa02b165114412a90874b8f3a9b7f337 Mon Sep 17 00:00:00 2001
From: Nathaniel Flath <flat0103@gmail.com>
Date: Sun, 19 Oct 2014 21:04:31 -0400
Subject: [PATCH 1/2] org-table.el: Add early return check to
 org-table-recalculate

* lisp/org-table.el (org-table-recalculate): Add early return.
---
 lisp/org-table.el | 263 ++++++++++++++++++++++++++++--------------------------
 1 file changed, 134 insertions(+), 129 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 3db6087..816709e 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -3040,136 +3040,141 @@ known that the table will be realigned a little later anyway."
 	   seen-fields lhs1
 	   beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
       ;; Insert constants in all formulas
-      (setq eqlist
-	    (mapcar (lambda (x)
-		      (if (string-match "^@-?I+" (car x))
-			  (user-error "Can't assign to hline relative reference"))
-		      (when (string-match "\\`$[<>]" (car x))
-			(setq lhs1 (car x))
-			(setq x (cons (substring
-				       (org-table-formula-handle-first/last-rc
-					(car x)) 1)
-				      (cdr x)))
-			(if (assoc (car x) eqlist1)
-			    (user-error "\"%s=\" formula tries to overwrite existing formula for column %s"
+      (when eqlist
+	(setq eqlist
+	      (mapcar
+	       (lambda (x)
+		 (if (string-match "^@-?I+" (car x))
+		     (user-error "Can't assign to hline relative reference"))
+		 (when (string-match "\\`$[<>]" (car x))
+		   (setq lhs1 (car x))
+		   (setq x (cons (substring
+				  (org-table-formula-handle-first/last-rc
+				   (car x)) 1)
+				 (cdr x)))
+		   (if (assoc (car x) eqlist1)
+		       (user-error "\"%s=\" formula tries to overwrite existing formula for column %s"
 				   lhs1 (car x))))
-		      (cons
-		       (org-table-formula-handle-first/last-rc (car x))
-		       (org-table-formula-substitute-names
-			(org-table-formula-handle-first/last-rc (cdr x)))))
-		    eqlist))
-      ;; Split the equation list
-      (while (setq eq (pop eqlist))
-	(if (<= (string-to-char (car eq)) ?9)
-	    (push eq eqlnum)
-	  (push eq eqlname)))
-      (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
-      ;; Expand ranges in lhs of formulas
-      (setq eqlname (org-table-expand-lhs-ranges eqlname))
-
-      ;; Get the correct line range to process
-      (if all
-	  (progn
-	    (setq end (move-marker (make-marker) (1+ (org-table-end))))
-	    (goto-char (setq beg (org-table-begin)))
-	    (if (re-search-forward org-table-calculate-mark-regexp end t)
-		;; This is a table with marked lines, compute selected lines
-		(setq line-re org-table-recalculate-regexp)
-	      ;; Move forward to the first non-header line
-	      (if (and (re-search-forward org-table-dataline-regexp end t)
-		       (re-search-forward org-table-hline-regexp end t)
-		       (re-search-forward org-table-dataline-regexp end t))
-		  (setq beg (match-beginning 0))
-		nil))) ;; just leave beg where it is
-	(setq beg (point-at-bol)
-	      end (move-marker (make-marker) (1+ (point-at-eol)))))
-      (goto-char beg)
-      (and all (message "Re-applying formulas to full table..."))
-
-      ;; First find the named fields, and mark them untouchable.
-      ;; Also check if several field/range formulas try to set the same field.
-      (remove-text-properties beg end '(org-untouchable t))
-      (while (setq eq (pop eqlname))
-	(setq name (car eq)
-	      a (assoc name org-table-named-field-locations))
-	(setq name1 name)
-	(if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
-				  (nth 2 a))))
-	(when (member name1 seen-fields)
-	  (user-error "Several field/range formulas try to set %s" name1))
-	(push name1 seen-fields)
-
-	(and (not a)
-	     (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
-	     (setq a (list name
-			   (condition-case nil
-			       (aref org-table-dlines
-				     (string-to-number (match-string 1 name)))
-			     (error (user-error "Invalid row number in %s"
-					   name)))
-			   (string-to-number (match-string 2 name)))))
-	(when (and a (or all (equal (nth 1 a) thisline)))
-	  (message "Re-applying formula to field: %s" name)
-	  (org-goto-line (nth 1 a))
-	  (org-table-goto-column (nth 2 a))
-	  (push (append a (list (cdr eq))) eqlname1)
-	  (org-table-put-field-property :org-untouchable t)))
-      (setq eqlname1 (nreverse eqlname1))
-
-      ;; Now evaluate the column formulas, but skip fields covered by
-      ;; field formulas
-      (goto-char beg)
-      (while (re-search-forward line-re end t)
-	(unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
-	  ;; Unprotected line, recalculate
-	  (and all (message "Re-applying formulas to full table...(line %d)"
-			    (setq cnt (1+ cnt))))
-	  (setq org-last-recalc-line (org-current-line))
-	  (setq eql eqlnum)
-	  (while (setq entry (pop eql))
-	    (org-goto-line org-last-recalc-line)
-	    (org-table-goto-column (string-to-number (car entry)) nil 'force)
-	    (unless (get-text-property (point) :org-untouchable)
-	      (org-table-eval-formula nil (cdr entry)
-				      'noalign 'nocst 'nostore 'noanalysis)))))
-
-      ;; Now evaluate the field formulas
-      (while (setq eq (pop eqlname1))
-	(message "Re-applying formula to field: %s" (car eq))
-	(org-goto-line (nth 1 eq))
-	(let ((column-target (nth 2 eq)))
-	  (when (> column-target 1000)
-	    (user-error "Formula column target too large"))
-	  (let* ((column-count (progn (end-of-line)
-				      (1- (org-table-current-column))))
-		 (create-new-column
-		  (and (> column-target column-count)
-		       (or (eq org-table-formula-create-columns t)
-			   (and
-			    (eq org-table-formula-create-columns 'warn)
-			    (progn
-			      (org-display-warning "Out-of-bounds formula added columns")
-			      t))
-			   (and
-			    (eq org-table-formula-create-columns 'prompt)
-			    (yes-or-no-p "Out-of-bounds formula. Add columns?"))))))
-	    (org-table-goto-column column-target nil create-new-column))
-
-	  (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst
-				  'nostore 'noanalysis)))
-
-      (org-goto-line thisline)
-      (org-table-goto-column thiscol)
-      (remove-text-properties (point-min) (point-max) '(org-untouchable t))
-      (or noalign (and org-table-may-need-update (org-table-align))
-	  (and all (message "Re-applying formulas to %d lines...done" cnt)))
-
-      ;; back to initial position
-      (message "Re-applying formulas...done")
-      (org-goto-line thisline)
-      (org-table-goto-column thiscol)
-      (or noalign (and org-table-may-need-update (org-table-align))
-	  (and all (message "Re-applying formulas...done"))))))
+		 (cons
+		  (org-table-formula-handle-first/last-rc (car x))
+		  (org-table-formula-substitute-names
+		   (org-table-formula-handle-first/last-rc (cdr x)))))
+	       eqlist))
+	;; Split the equation list
+	(while (setq eq (pop eqlist))
+	  (if (<= (string-to-char (car eq)) ?9)
+	      (push eq eqlnum)
+	    (push eq eqlname)))
+	(setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
+	;; Expand ranges in lhs of formulas
+	(setq eqlname (org-table-expand-lhs-ranges eqlname))
+
+	;; Get the correct line range to process
+	(if all
+	    (progn
+	      (setq end (move-marker (make-marker) (1+ (org-table-end))))
+	      (goto-char (setq beg (org-table-begin)))
+	      (if (re-search-forward org-table-calculate-mark-regexp end t)
+		  ;; This is a table with marked lines, compute selected lines
+		  (setq line-re org-table-recalculate-regexp)
+		;; Move forward to the first non-header line
+		(if (and (re-search-forward org-table-dataline-regexp end t)
+			 (re-search-forward org-table-hline-regexp end t)
+			 (re-search-forward org-table-dataline-regexp end t))
+		    (setq beg (match-beginning 0))
+		  nil))) ;; just leave beg where it is
+	  (setq beg (point-at-bol)
+		end (move-marker (make-marker) (1+ (point-at-eol)))))
+	(goto-char beg)
+	(and all (message "Re-applying formulas to full table..."))
+
+	;; First find the named fields, and mark them untouchable.
+	;; Also check if several field/range formulas try to set the same field.
+	(remove-text-properties beg end '(org-untouchable t))
+	(while (setq eq (pop eqlname))
+	  (setq name (car eq)
+		a (assoc name org-table-named-field-locations))
+	  (setq name1 name)
+	  (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
+				    (nth 2 a))))
+	  (when (member name1 seen-fields)
+	    (user-error "Several field/range formulas try to set %s" name1))
+	  (push name1 seen-fields)
+
+	  (and (not a)
+	       (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
+	       (setq a (list name
+			     (condition-case nil
+				 (aref org-table-dlines
+				       (string-to-number (match-string 1 name)))
+			       (error (user-error "Invalid row number in %s"
+						  name)))
+			     (string-to-number (match-string 2 name)))))
+	  (when (and a (or all (equal (nth 1 a) thisline)))
+	    (message "Re-applying formula to field: %s" name)
+	    (org-goto-line (nth 1 a))
+	    (org-table-goto-column (nth 2 a))
+	    (push (append a (list (cdr eq))) eqlname1)
+	    (org-table-put-field-property :org-untouchable t)))
+	(setq eqlname1 (nreverse eqlname1))
+
+	;; Now evaluate the column formulas, but skip fields covered
+	;; by field formulas
+	(goto-char beg)
+	(while (re-search-forward line-re end t)
+	  (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
+	    ;; Unprotected line, recalculate
+	    (and all (message "Re-applying formulas to full table...(line %d)"
+			      (setq cnt (1+ cnt))))
+	    (setq org-last-recalc-line (org-current-line))
+	    (setq eql eqlnum)
+	    (while (setq entry (pop eql))
+	      (org-goto-line org-last-recalc-line)
+	      (org-table-goto-column (string-to-number (car entry)) nil 'force)
+	      (unless (get-text-property (point) :org-untouchable)
+		(org-table-eval-formula
+		 nil (cdr entry)
+		 'noalign 'nocst 'nostore 'noanalysis)))))
+
+	;; Now evaluate the field formulas
+	(while (setq eq (pop eqlname1))
+	  (message "Re-applying formula to field: %s" (car eq))
+	  (org-goto-line (nth 1 eq))
+	  (let ((column-target (nth 2 eq)))
+	    (when (> column-target 1000)
+	      (user-error "Formula column target too large"))
+	    (let* ((column-count (progn (end-of-line)
+					(1- (org-table-current-column))))
+		   (create-new-column
+		    (and (> column-target column-count)
+			 (or (eq org-table-formula-create-columns t)
+			     (and
+			      (eq org-table-formula-create-columns 'warn)
+			      (progn
+				(org-display-warning
+				 "Out-of-bounds formula added columns")
+				t))
+			     (and
+			      (eq org-table-formula-create-columns 'prompt)
+			      (yes-or-no-p
+			       "Out-of-bounds formula. Add columns?"))))))
+	      (org-table-goto-column column-target nil create-new-column))
+
+	    (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst
+				    'nostore 'noanalysis)))
+
+	(org-goto-line thisline)
+	(org-table-goto-column thiscol)
+	(remove-text-properties (point-min) (point-max) '(org-untouchable t))
+	(or noalign (and org-table-may-need-update (org-table-align))
+	    (and all (message "Re-applying formulas to %d lines...done" cnt)))
+
+	;; back to initial position
+	(message "Re-applying formulas...done")
+	(org-goto-line thisline)
+	(org-table-goto-column thiscol)
+	(or noalign (and org-table-may-need-update (org-table-align))
+	    (and all (message "Re-applying formulas...done")))))))
 
 ;;;###autoload
 (defun org-table-iterate (&optional arg)
-- 
1.8.5.2 (Apple Git-48)


[-- Attachment #3: 0002-org-table.el-Print-far-fewer-messages-when-recalcula.patch --]
[-- Type: application/octet-stream, Size: 4821 bytes --]

From 0d0b2a3744257a274f6e102d9c2dc65dfbf09a1c Mon Sep 17 00:00:00 2001
From: Nathaniel Flath <flat0103@gmail.com>
Date: Sun, 19 Oct 2014 21:55:05 -0400
Subject: [PATCH 2/2] org-table.el: Print far fewer messages when recalculating
 tables.

* lisp/org-table.el (org-table-recalculate): Removed message for start of
processing.  When ALL is t, messages are printed at most once per second.
---
 lisp/org-table.el | 44 +++++++++++++++++++++++++++++++++++---------
 1 file changed, 35 insertions(+), 9 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 816709e..e5a8ce7 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -3013,6 +3013,19 @@ list, 'literal is for the format specifier L."
 		(push (cons (match-string 1 e) (match-string 2 e)) cst)))
 	    (setq org-table-formula-constants-local cst)))))))
 
+(defmacro org-table-execute-once-per-second (t1 &rest body)
+  "If there has been more than one second since T1, execute BODY.
+Updates T1 to 'current-time' if this condition is met. If T1 is
+nil, always execute body."
+  `(if ,t1
+       (let ((curtime (current-time)))
+	 (when (< 0 (nth 1 (time-subtract curtime ,t1)))
+	   (setq ,t1 curtime)
+	   ,@body))
+     ,@body))
+
+(def-edebug-spec org-table-execute-once-per-second (form body))
+
 ;;;###autoload
 (defun org-table-recalculate (&optional all noalign)
   "Recalculate the current table line by applying all stored formulas.
@@ -3037,6 +3050,8 @@ known that the table will be realigned a little later anyway."
 	   (line-re org-table-dataline-regexp)
 	   (thisline (org-current-line))
 	   (thiscol (org-table-current-column))
+	   (log-first-time (current-time))
+	   (log-last-time log-first-time)
 	   seen-fields lhs1
 	   beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
       ;; Insert constants in all formulas
@@ -3086,7 +3101,6 @@ known that the table will be realigned a little later anyway."
 	  (setq beg (point-at-bol)
 		end (move-marker (make-marker) (1+ (point-at-eol)))))
 	(goto-char beg)
-	(and all (message "Re-applying formulas to full table..."))
 
 	;; First find the named fields, and mark them untouchable.
 	;; Also check if several field/range formulas try to set the same field.
@@ -3111,7 +3125,9 @@ known that the table will be realigned a little later anyway."
 						  name)))
 			     (string-to-number (match-string 2 name)))))
 	  (when (and a (or all (equal (nth 1 a) thisline)))
-	    (message "Re-applying formula to field: %s" name)
+	    (org-table-execute-once-per-second
+	     (when all log-last-time)
+	     (message "Re-applying formula to field: %s" name))
 	    (org-goto-line (nth 1 a))
 	    (org-table-goto-column (nth 2 a))
 	    (push (append a (list (cdr eq))) eqlname1)
@@ -3124,8 +3140,11 @@ known that the table will be realigned a little later anyway."
 	(while (re-search-forward line-re end t)
 	  (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
 	    ;; Unprotected line, recalculate
-	    (and all (message "Re-applying formulas to full table...(line %d)"
-			      (setq cnt (1+ cnt))))
+	    (and all (org-table-execute-once-per-second
+		      log-last-time
+		      (message
+		       "Re-applying formulas to full table...(line %d)"
+		       (setq cnt (1+ cnt)))))
 	    (setq org-last-recalc-line (org-current-line))
 	    (setq eql eqlnum)
 	    (while (setq entry (pop eql))
@@ -3138,7 +3157,10 @@ known that the table will be realigned a little later anyway."
 
 	;; Now evaluate the field formulas
 	(while (setq eq (pop eqlname1))
-	  (message "Re-applying formula to field: %s" (car eq))
+	  (org-table-execute-once-per-second
+	   (when all log-last-time)
+	   (message "Re-applying formula to field: %s" (car eq)))
+
 	  (org-goto-line (nth 1 eq))
 	  (let ((column-target (nth 2 eq)))
 	    (when (> column-target 1000)
@@ -3167,14 +3189,18 @@ known that the table will be realigned a little later anyway."
 	(org-table-goto-column thiscol)
 	(remove-text-properties (point-min) (point-max) '(org-untouchable t))
 	(or noalign (and org-table-may-need-update (org-table-align))
-	    (and all (message "Re-applying formulas to %d lines...done" cnt)))
+	    (and all (org-table-execute-once-per-second
+		      log-first-time
+		      (message "Re-applying formulas to %d lines...done" cnt))))
+
+	(org-table-execute-once-per-second
+	 log-first-time
+	 (message "Re-applying formulas...done" cnt))
 
 	;; back to initial position
-	(message "Re-applying formulas...done")
 	(org-goto-line thisline)
 	(org-table-goto-column thiscol)
-	(or noalign (and org-table-may-need-update (org-table-align))
-	    (and all (message "Re-applying formulas...done")))))))
+	(or noalign (and org-table-may-need-update (org-table-align)))))))
 
 ;;;###autoload
 (defun org-table-iterate (&optional arg)
-- 
1.8.5.2 (Apple Git-48)