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

[Nathaniel Flath <flat0103@gmail.com>]

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

Hi

On Sat, Oct 11, 2014 at 12:16 PM, Michael Brand <michael.ch.brand@gmail.com>
wrote:

> Hi Nathaniel
>
> On Fri, Oct 10, 2014 at 9:43 PM, Nathaniel Flath <flat0103@gmail.com>
> wrote:
> > Mine is a pretty simple table (takes less than a second even in the
> original
> > case):
>
> Earlier I assumed that the issue is a very high number of messages
> from the loops. Now your example table clarifies to me that the issue
> is that already just one single message can take a significant time of
> a message-less table recalculation (your 17 ms).
>
> Only with this I understand now why you want to remove also the
> beginning/end processing messages. Good point as it should be
> noticeable at least for org-table-iterate-buffer-tables in a buffer
> with many tables where each one takes a short time to recalculate.
>
> I really wonder what the reason is that this
>
>     (progn
>       (message "%d" (random))  ;; Prevent collapsing of message lines.
>       (time (message nil)))
>
> in a terminal (emacs -nw) shows most of the times only 0.05 to 0.10 ms
> but in a window it shows most of the times 8 to 22 ms (here: GNU Emacs
> 24.3.1 on Mac OS X 10.9). Which Emacs version and OS are you using?
>

I'm running 24.3.1 on Mac OS X  10.8.4.

>
> For your patch I suggest to remove only the first message and to add
> the time check to all other messages. This should not make the patch
> noticeably slower but would keep showing the progress for table
> recalculations that last more than one second. To clean up the last
> loop message from the mode line I suggest to check the end messages
> against the very first log time in contrast to the next log time used
> for the loop messages (variables "log_first" and "log_next" instead of
> just "log").
>
> I suggest you split your patch: One for "(when eqlist" and one for the
> messages. The change with the messages will then become human readable
> also with a simple line diff.


OK, sounds reasonable.  Patches are attached.


>
> > Original recalculation:  (0 0 396224 0)
>
> > Version w/ time checks for per-field messages (still always printing at
> > beginning/end of processing):(0 0 56929 0)
>
> > Version w/ time checks and removing all beginning/end of processing
> > messages: (0 0 22077 0)
>
> > My patch:  (0 0 17405 0)
>
> I could not reproduce a reliable difference between the last two. As
> expected both did not log any message. Can you?
>

Rrunning more iterations they seemed to be mostly equal.

Patches are attached.

>
> Michael
>

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

[-- Attachment #2: org-table-speedup-1.patch --]
[-- Type: application/octet-stream, Size: 10370 bytes --]

diff --git a/lisp/org-table.el b/lisp/org-table.el
index bc32c45..0335280 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -42,7 +42,7 @@
 		  (string backend &optional body-only ext-plist))
 (declare-function aa2u "ext:ascii-art-to-unicode" ())
 (declare-function calc-eval "calc" (str &optional separator &rest args))
-		  
+
 (defvar orgtbl-mode) ; defined below
 (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
 (defvar constants-unit-system)
@@ -2768,7 +2768,7 @@ not overwrite the stored one."
 	    (user-error "Invalid field specifier \"%s\""
 			(match-string 0 form)))
 	  (setq form (replace-match repl t t form)))
-	
+
 	(if lispp
 	    (setq ev (condition-case nil
 			 (eval (eval (read form)))
@@ -3074,119 +3074,120 @@ 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"
-				   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))
-	(org-table-goto-column (nth 2 eq))
-	(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"))))))
+      (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))
+	  (org-table-goto-column (nth 2 eq))
+	  (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)

[-- Attachment #3: org-table-speedup-2.patch --]
[-- Type: application/octet-stream, Size: 4202 bytes --]

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 0335280..c30f80c 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -3047,6 +3047,15 @@ 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."
+  `(let ((curtime (current-time)))
+     (when (< 0 (nth 1 (time-subtract curtime ,t1)))
+       (setq ,t1 curtime)
+       ,@body
+       )))
+
 ;;;###autoload
 (defun org-table-recalculate (&optional all noalign)
   "Recalculate the current table line by applying all stored formulas.
@@ -3071,6 +3080,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
@@ -3119,7 +3130,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.
@@ -3144,7 +3154,7 @@ 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 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)
@@ -3157,8 +3167,8 @@ 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))
@@ -3170,7 +3180,9 @@ 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))
+	  (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))))
+
 	  (org-goto-line (nth 1 eq))
 	  (org-table-goto-column (nth 2 eq))
 	  (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst
@@ -3180,14 +3192,14 @@ 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-last-time (message "Re-applying formulas to %d lines...done" cnt))))
 
 	;; back to initial position
-	(message "Re-applying formulas...done")
+	(org-table-execute-once-per-second log-first-time (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")))))))
+	    (and all (org-table-execute-once-per-second log-first-time (message "Re-applying formulas...done"))))))))
 
 ;;;###autoload
 (defun org-table-iterate (&optional arg)