Table rows and ranges as LHS of formulas

* Table rows and ranges as LHS of formulas
@ 2011-03-01 14:28 Carsten Dominik
  2011-03-01 15:10 ` Carsten Dominik
                   ` (2 more replies)
  0 siblings, 3 replies; 23+ messages in thread
From: Carsten Dominik @ 2011-03-01 14:28 UTC (permalink / raw)
  To: emacs-orgmode List

[-- Attachment #1: Type: text/plain, Size: 870 bytes --]

Hi everyone,

A frequently requested feature for tables has been to
be able to define row formulas in a way similar to column
formulas.  The patch below allows things like 

   @3=
   @2$2..@5$7=
   @I$2..@II$4=

as the left hand side for table formulas in order to
write a formula that is valid for an entire column or
for a rectangular section in a table.

Note that in contrast to column formulas, @3= will not
automatically skip a "header column" or field formulas in the
same row.  In fact, making both a range formula and a field
point to the same field is forbidden and throws an error.
So to have a formula apply to all but the first column, use
something like this:

    @3$2..@3$8=....

Testing is welcome, but I am confident that this works
pretty well.

Bastien, please let me know if you want to have this integrated
before the release, then I will do so.


[-- Attachment #2: 0001-Implement-table-formulas-that-apply-to-field-ranges.patch --]
[-- Type: application/octet-stream, Size: 19428 bytes --]

From a8bfe81b33c4eeb5a46482c5435ace68d5c6ccf3 Mon Sep 17 00:00:00 2001
From: Carsten Dominik <carsten.dominik@gmail.com>
Date: Tue, 1 Mar 2011 09:05:56 +0100
Subject: [PATCH] Implement table formulas that apply to field ranges

* lisp/org-table.el (org-table-fedit-finish): Read more general LHS of formulas.
(org-table-current-ncol): New variable.
(org-table-line-to-dline): New function.
(org-table-get-stored-formulas): Accept range formulas as matches.
(org-table-get-specials): Compute and store the number of columns.
(org-table-get-range): New optional argument CORNERS-ONLY, to retrieve
only the region marked by the range, not the content.
(org-table-recalculate): Call `org-table-expand-lhs-ranges' to expand
range targets.  Also check for duplicate access to fields.
(org-table-expand-lhs-ranges): New funktion.
(org-table-get-remote-range): Bind `org-table-current-ncol' to protect
the caller's value.
(org-table-edit-formulas): Support highlighting of range targets.

* doc/org.texi (Field and range formulas): Renamed from "Field formulas".
Document the use of range operators as targets.
---
 doc/org.texi      |   33 +++++++++----
 lisp/org-table.el |  140 ++++++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 136 insertions(+), 37 deletions(-)

diff --git a/doc/org.texi b/doc/org.texi
index 5288604..f5fa976 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -378,7 +378,7 @@ The spreadsheet
 * References::                  How to refer to another field or range
 * Formula syntax for Calc::     Using Calc to compute stuff
 * Formula syntax for Lisp::     Writing formulas in Emacs Lisp
-* Field formulas::              Formulas valid for a single field
+* Field and range formulas::    Formula for specific (ranges of) fields
 * Column formulas::             Formulas valid for an entire column
 * Editing and debugging formulas::  Fixing formulas
 * Updating the table::          Recomputing all dependent fields
@@ -670,6 +670,8 @@ Specific header arguments
                                 directory for code block execution
 * exports::                     Export code and/or results
 * tangle::                      Toggle tangling and specify file name
+* mkdirp::                      Toggle creation of parent directories of target
+                                files during tangling
 * comments::                    Toggle insertion of comments in tangled
                                 code files
 * no-expand::                   Turn off variable assignment and noweb
@@ -677,7 +679,7 @@ Specific header arguments
 * session::                     Preserve the state of code evaluation
 * noweb::                       Toggle expansion of noweb references
 * cache::                       Avoid re-evaluating unchanged code blocks
-* sep::                         Specify delimiter for writing external tables
+* sep::                         Delimiter for writing tabular results outside Org
 * hlines::                      Handle horizontal lines in tables
 * colnames::                    Handle column names in tables
 * rownames::                    Handle row names in tables
@@ -2243,7 +2245,7 @@ formula, moving these references by arrow keys
 * References::                  How to refer to another field or range
 * Formula syntax for Calc::     Using Calc to compute stuff
 * Formula syntax for Lisp::     Writing formulas in Emacs Lisp
-* Field formulas::              Formulas valid for a single field
+* Field and range formulas::    Formula for specific (ranges of) fields
 * Column formulas::             Formulas valid for an entire column
 * Editing and debugging formulas::  Fixing formulas
 * Updating the table::          Recomputing all dependent fields
@@ -2501,7 +2503,7 @@ Calc also contains a complete set of logical operations.  For example
 if($1<20,teen,string(""))  @r{``teen'' if age $1 less than 20, else empty}
 @end example
 
-@node Formula syntax for Lisp, Field formulas, Formula syntax for Calc, The spreadsheet
+@node Formula syntax for Lisp, Field and range formulas, Formula syntax for Calc, The spreadsheet
 @subsection Emacs Lisp forms as formulas
 @cindex Lisp forms, as table formulas
 
@@ -2532,10 +2534,12 @@ like @code{"$3"}.  Ranges are inserted as space-separated fields, so you can
   '(apply '+ '($1..$4));N
 @end example
 
-@node Field formulas, Column formulas, Formula syntax for Lisp, The spreadsheet
-@subsection Field formulas
+@node Field and range formulas, Column formulas, Formula syntax for Lisp, The spreadsheet
+@subsection Field and range formulas
 @cindex field formula
+@cindex range formula
 @cindex formula, for individual table field
+@cindex formula, for range of fields
 
 To assign a formula to a particular field, type it directly into the
 field, preceded by @samp{:=}, for example @samp{:=$1+$2}.  When you
@@ -2565,7 +2569,14 @@ formula with default taken from the @samp{#+TBLFM:} line, applies
 it to the current field, and stores it.
 @end table
 
-@node Column formulas, Editing and debugging formulas, Field formulas, The spreadsheet
+The left hand side of the formula may also be a column or range reference in
+order to assign the same formula to a range of fields.  These formulas can
+only be entered directly in the @code{#+TBLFM:} line, or by using the formula
+editor (@pxref{Editing and debugging formulas}).  For example @code{@@5=...}
+will define a formula for all fields in row 5, and @code{@@1$1..@@2$2=...} will
+define a formula for the four fields in the rectangle.
+
+@node Column formulas, Editing and debugging formulas, Field and range formulas, The spreadsheet
 @subsection Column formulas
 @cindex column formula
 @cindex formula, for table column
@@ -2575,7 +2586,9 @@ particular column.  Instead of having to copy the formula to all fields
 in that column, Org allows you to assign a single formula to an entire
 column.  If the table contains horizontal separator hlines, everything
 before the first such line is considered part of the table @emph{header}
-and will not be modified by column formulas.
+and will not be modified by column formulas.  Also, fields that have
+individual field or range formulas assigning to them will be skipped by
+column formulas.
 
 To assign a formula to a column, type it directly into any field in the
 column, preceded by an equal sign, like @samp{=$1+$2}.  When you press
@@ -2617,7 +2630,7 @@ if possible.  If you prefer to only work with the internal format (like
 @table @kbd
 @orgcmdkkc{C-c =,C-u C-c =,org-table-eval-formula}
 Edit the formula associated with the current column/field in the
-minibuffer.  See @ref{Column formulas}, and @ref{Field formulas}.
+minibuffer.  See @ref{Column formulas}, and @ref{Field and range formulas}.
 @orgcmd{C-u C-u C-c =,org-table-eval-formula}
 Re-insert the active formula (either a
 field formula, or a column formula) into the current field, so that you
@@ -2720,7 +2733,7 @@ following commands:
 @table @kbd
 @orgcmd{C-c *,org-table-recalculate}
 Recalculate the current row by first applying the stored column formulas
-from left to right, and all field formulas in the current row.
+from left to right, and all field/range formulas in the current row.
 @c
 @kindex C-u C-c *
 @item C-u C-c *
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 56d927e..d4ae2b1 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -316,6 +316,8 @@ available parameters."
   "Table begin line, non-nil only for the duration of a command.")
 (defvar org-table-current-begin-pos nil
   "Table begin position, non-nil only for the duration of a command.")
+(defvar org-table-current-ncol nil
+  "Number of columns in table, non-nil only for the duration of a command.")
 (defvar org-table-dlines nil
   "Vector of data line line numbers in the current table.")
 (defvar org-table-hlines nil
@@ -1246,6 +1248,28 @@ However, when FORCE is non-nil, create new columns if necessary."
 	(error
 	 "Please position cursor in a data line for column operations")))))
 
+(defun org-table-line-to-dline (line &optional above)
+  "Turn a buffer line number into a data line number.
+If there is no data line in this line, return nil.
+If there is no matchin dline (most likely te refrence was a hline), the
+first dline below it is used.  When ABOVE is non-nil, the one above is used."
+  (catch 'exit
+    (let ((ll (length org-table-dlines))
+	  i)
+      (if above
+	  (progn
+	    (setq i (1- ll))
+	    (while (> i 0)
+	      (if (<= (aref org-table-dlines i) line)
+		  (throw 'exit i))
+	      (setq i (1- i))))
+	(setq i 1)
+	(while (< i ll)
+	  (if (>= (aref org-table-dlines i) line)
+	      (throw 'exit i))
+	(setq i (1+ i)))))
+      nil))
+
 (defun org-table-delete-column ()
   "Delete a column from the table."
   (interactive)
@@ -1966,7 +1990,7 @@ When NAMED is non-nil, look for a named equation."
       (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
 	(setq strings (org-split-string (match-string 2) " *:: *"))
 	(while (setq string (pop strings))
-	  (when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
+	  (when (string-match "\\`\\(@[^= \t\n]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
 	    (setq scol (if (match-end 2)
 			   (match-string 2 string)
 			 (match-string 1 string))
@@ -2022,7 +2046,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
 	    org-table-named-field-locations nil
 	    org-table-current-begin-line nil
 	    org-table-current-begin-pos nil
-	    org-table-current-line-types nil)
+	    org-table-current-line-types nil
+	    org-table-current-ncol 0)
       (goto-char beg)
       (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
 	(setq names (org-split-string (match-string 1) " *| *")
@@ -2078,6 +2103,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
 		      "[ \t]*|[ \t]*"))
 	     (nfields (length fields))
 	     al al2)
+	(setq org-table-current-ncol nfields)
 	(loop for i from 1 to nfields do
 	      (push (list (format "LR%d" i) l i) al)
 	      (push (cons (format "LR%d" i) (nth (1- i) fields)) al2))
@@ -2415,11 +2441,16 @@ $1->    %s\n" orig formula form0 form))
 		       (progn (skip-chars-forward "^|") (point))
 		       prop value)))
 
-(defun org-table-get-range (desc &optional tbeg col highlight)
+(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
   "Get a calc vector from a column, according to descriptor DESC.
 Optional arguments TBEG and COL can give the beginning of the table and
 the current column, to avoid unnecessary parsing.
-HIGHLIGHT means just highlight the range."
+
+HIGHLIGHT means just highlight the range.
+
+When CORNERS-ONLY is set, only return the corners of the range as
+a list (line1 column1 line2 column2) where line1 and line2 are line numbers
+in the buffer and column1 and column2 are table column numbers."
   (if (not (equal (string-to-char desc) ?@))
       (setq desc (concat "@" desc)))
   (save-excursion
@@ -2448,7 +2479,8 @@ HIGHLIGHT means just highlight the range."
       (if (not r2) (setq r2 thisline))
       (if (not c1) (setq c1 col))
       (if (not c2) (setq c2 col))
-      (if (or (not rangep) (and (= r1 r2) (= c1 c2)))
+      (if (and (not corners-only)
+	       (or (not rangep) (and (= r1 r2) (= c1 c2))))
 	  ;; just one field
 	  (progn
 	    (org-goto-line r1)
@@ -2460,22 +2492,26 @@ HIGHLIGHT means just highlight the range."
 	;; First sort the numbers to get a regular ractangle
 	(if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
 	(if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
-	(org-goto-line r1)
-	(while (not (looking-at org-table-dataline-regexp))
-	  (beginning-of-line 2))
-	(org-table-goto-column c1)
-	(setq beg (point))
-	(org-goto-line r2)
-	(while (not (looking-at org-table-dataline-regexp))
-	  (beginning-of-line 0))
-	(org-table-goto-column c2)
-	(setq end (point))
-	(if highlight
-	    (org-table-highlight-rectangle
-	     beg (progn (skip-chars-forward "^|\n") (point))))
-	;; return string representation of calc vector
-	(mapcar 'org-trim
-		(apply 'append (org-table-copy-region beg end)))))))
+	(if corners-only
+	    ;; Only return the corners of the range
+	    (list r1 c1 r2 c2)
+	  ;; Copy the range values into a list
+	  (org-goto-line r1)
+	  (while (not (looking-at org-table-dataline-regexp))
+	    (beginning-of-line 2))
+	  (org-table-goto-column c1)
+	  (setq beg (point))
+	  (org-goto-line r2)
+	  (while (not (looking-at org-table-dataline-regexp))
+	    (beginning-of-line 0))
+	  (org-table-goto-column c2)
+	  (setq end (point))
+	  (if highlight
+	      (org-table-highlight-rectangle
+	       beg (progn (skip-chars-forward "^|\n") (point))))
+	  ;; return string representation of calc vector
+	  (mapcar 'org-trim
+		  (apply 'append (org-table-copy-region beg end))))))))
 
 (defun org-table-get-descriptor-line (desc &optional cline bline table)
   "Analyze descriptor DESC and retrieve the corresponding line number.
@@ -2595,7 +2631,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))
-	   beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name)
+	   seen-fields
+	   beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
       ;; Insert constants in all formulas
       (setq eqlist
 	    (mapcar (lambda (x)
@@ -2608,6 +2645,10 @@ known that the table will be realigned a little later anyway."
 	    (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))))
@@ -2626,11 +2667,19 @@ known that the table will be realigned a little later anyway."
       (goto-char beg)
       (and all (message "Re-applying formulas to full table..."))
 
-      ;; First find the named fields, and mark them untouchable
+      ;; 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)
+	      (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
@@ -2646,7 +2695,7 @@ known that the table will be realigned a little later anyway."
 	  (org-table-goto-column (nth 2 a))
 	  (push (append a (list (cdr eq))) eqlname1)
 	  (org-table-put-field-property :org-untouchable t)))
-
+      
       ;; Now evaluate the column formulas, but skip fields covered by
       ;; field formulas
       (goto-char beg)
@@ -2735,6 +2784,35 @@ known that the table will be realigned a little later anyway."
 	     (setq checksum c1)))
 	 (error "No convergence after %d iterations" imax))))))
 
+(defun org-table-expand-lhs-ranges (equations)
+  "Expand list of formulas.
+If some of the RHS in the formulas are ranges or a row reference, expand
+them to individual field equations for each field."
+  (let (e res lhs rhs range r1 r2 c1 c2)
+    (while (setq e (pop equations))
+      (setq lhs (car e) rhs (cdr e))
+      (cond
+       ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs)
+	;; This just refers to one fixed field
+	(push e res))
+       ((string-match "^[a-zA-Z][a-zA-Z0-9]*$" lhs)
+	;; This just refers to one fixed named field
+	(push e res))
+       ((string-match "^@[0-9]+$" lhs)
+	(loop for ic from 1 to org-table-current-ncol do
+	      (push (cons (format "%s$%d" lhs ic) rhs) res)))
+       (t
+	(setq range (org-table-get-range lhs org-table-current-begin-pos
+					 1 nil 'corners))
+	(setq r1 (nth 0 range) c1 (nth 1 range)
+	      r2 (nth 2 range) c2 (nth 3 range))
+	(setq r1 (org-table-line-to-dline r1))
+	(setq r2 (org-table-line-to-dline r2 'above))
+	(loop for ir from r1 to r2 do
+	      (loop for ic from c1 to c2 do
+		    (push (cons (format "@%d$%d" ir ic) rhs) res))))))
+    (nreverse res)))
+
 (defun org-table-formula-substitute-names (f)
   "Replace $const with values in string F."
   (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
@@ -2837,7 +2915,7 @@ Parameters get priority."
 	(wc (current-window-configuration))
 	(sel-win (selected-window))
 	(titles '((column . "# Column Formulas\n")
-		  (field . "# Field Formulas\n")
+		  (field . "# Field and Range Formulas\n")
 		  (named . "# Named Field Formulas\n")))
 	entry s type title)
     (org-switch-to-buffer-other-window "*Edit Formulas*")
@@ -2861,7 +2939,7 @@ Parameters get priority."
       (when (setq title (assq type titles))
 	(or (bobp) (insert "\n"))
 	(insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
-	(setq titles (delq title titles)))
+	(setq titles (remove title titles)))
       (if (equal key (car entry)) (setq startline (org-current-line)))
       (setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$")
 		      (car entry) " = " (cdr entry) "\n"))
@@ -3078,7 +3156,7 @@ With prefix ARG, apply the new formulas to the table."
   (let ((pos org-pos) (sel-win org-selected-window) eql var form)
     (goto-char (point-min))
     (while (re-search-forward
-	    "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
+	    "^\\(@[^=\n \t]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
 	    nil t)
       (setq var (if (match-end 2) (match-string 2) (match-string 1))
 	    form (match-string 3))
@@ -3167,6 +3245,12 @@ With prefix ARG, apply the new formulas to the table."
 	  var name e what match dest)
       (if local (org-table-get-specials))
       (setq what (cond
+		  ((org-at-regexp-p "^@[0-9]+[ \t=]")
+		   (setq match (concat (substring (match-string 0) 0 -1)
+				       "$1.."
+				       (substring (match-string 0) 0 -1)
+				       "$100"))
+		   'range)
 		  ((or (org-at-regexp-p org-table-range-regexp2)
 		       (org-at-regexp-p org-table-translate-regexp)
 		       (org-at-regexp-p org-table-range-regexp))
@@ -4359,6 +4443,7 @@ list of the fields in the rectangle ."
 	  org-table-local-parameters org-table-named-field-locations
 	  org-table-current-line-types org-table-current-begin-line
 	  org-table-current-begin-pos org-table-dlines
+	  org-table-current-ncol
 	  org-table-hlines org-table-last-alignment
 	  org-table-last-column-widths org-table-last-alignment
 	  org-table-last-column-widths tbeg
@@ -4402,3 +4487,4 @@ list of the fields in the rectangle ."
 ;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef
 
 ;;; org-table.el ends here
+
-- 
1.7.1.575.gf526


[-- Attachment #3: Type: text/plain, Size: 201 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode

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