Column View: Implement new operators

Mikael Fornius writes:

> This is my suggestion of an implementation of min/mean/max computation
> in columnview summaries. If you like it feel free to use it.
>
> New operators: {min}, {max} and {mean} possibly prefixed with : for use
> with timevalues.
>
> Example from my running exercise diary:
>
> #+COLUMNS: %DISTANCE{+;%.1f} %HEARTRATE{mean;%.1f} %SPEED{:min} %CALORIES{+}
>
> Gives a colview with summaries:
>
> total distance, mean heartrate, fastest speed (min/km) and total
> calories.
>
> I have tested it on emacs-23 and it works well for me now, also with the
> interactive colview functions.
>
> But you never know really. ;-) Anyway, there should not be any emacs-23
> specific elisp code added afik.
>
> (Because I do not use xemacs I have not tested it with xemacs but the
> small changes I made should be compitable to both xemacs and emacs. I
> would appreciate if someone on this list who uses xemacs will give it a
> try for me. Thanks!)
>
> (This fix also opens up for using user defined lisp functions to
> calculate colview summaries, but I am not sure if that is something
> useful. Like this:
>
> (defun std (&rest values)
>  "Compute standard deviation."
>  ...)
>
> #+COLUMNS: %DATA{eval:std}
>
> If someone finds this attractive it would now be easy to implement as well.)
>

doc/ChangeLog

@@ -1,3 +1,7 @@
+2009-05-21  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org.texi (Column attributes): Document new colciew operators.
+
 2009-05-20  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org.texi (Publishing options): Document :xml-declaration.

doc/org.texi

@@ -2831,7 +2831,7 @@ Store a link to the current location.  This is a @emph{global} command (you
 must create the key binding yourself) which can be used in any buffer to
 create a link.  The link will be stored for later insertion into an Org
 buffer (see below).  What kind of link will be created depends on the current
-buffer: 
+buffer:
 
 @b{Org-mode buffers}@*
 For Org files, if there is a @samp{<<target>>} at the cursor, the link points
@@ -3580,7 +3580,7 @@ giving you an overview of what has been done.
 
 @vindex org-log-states-order-reversed
 @vindex org-log-into-drawer
-@cindex property: LOG_INTO_DRAWER 
+@cindex property: LOG_INTO_DRAWER
 When TODO keywords are used as workflow states (@pxref{Workflow states}), you
 might want to keep track of when a state change occurred and maybe take a
 note about this change.  You can either record just a timestamp, or a
@@ -4474,6 +4474,12 @@ property        @r{The property that should be edited in this column.}
                 @{X@}       @r{Checkbox status, [X] if all children are [X].}
                 @{X/@}      @r{Checkbox status, [n/m].}
                 @{X%@}      @r{Checkbox status, [n%].}
+                @{min@}     @r{Smallest number in column.}
+                @{max@}     @r{Largest number.}
+                @{mean@}    @r{Arithmetic mean of numbers.}
+                @{:min@}    @r{Smallest time value in column.}
+                @{:max@}    @r{Largest time value.}
+                @{:mean@}   @r{Arithmetic mean of time values.}
 @end example
 
 @noindent
@@ -8240,9 +8246,9 @@ additional information.  These lines may be put anywhere in the file.
 The whole set of lines can be inserted into the buffer with @kbd{C-c
 C-e t}.  For individual lines, a good way to make sure the keyword is
 correct is to type @samp{#+} and then use @kbd{M-@key{TAB}} completion
-(@pxref{Completion}).   For a summary of other in-buffer settings not 
-specifically related to export, see @ref{In-buffer settings}. 
-In particular, note that you can place commonly-used (export) options in 
+(@pxref{Completion}).   For a summary of other in-buffer settings not
+specifically related to export, see @ref{In-buffer settings}.
+In particular, note that you can place commonly-used (export) options in
 a separate file which can be included using @code{#+SETUPFILE}.
 
 @table @kbd
@@ -9480,7 +9486,7 @@ pages of your "org web" project and the links will work as expected when
 you publish them to HTML.  If you also publish the Org source file and want
 to link to that, use an @code{http:} link instead of an @code{file:} link,
 because @code{file:} links are converted to link to the corresponding
-@file{html} file. 
+@file{html} file.
 
 You may also link to related files, such as images. Provided you are careful
 with relative pathnames, and provided you have also configured Org to upload
@@ -9941,7 +9947,7 @@ keys.  The corresponding variable is @code{org-tag-alist}.
 This line contains the formulas for the table directly above the line.
 @item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+TEXT:, #+OPTIONS, #+DATE:,
 @itemx #+DESCRIPTION:, #+KEYWORDS:
-@itemx #+LATEX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:, 
+@itemx #+LATEX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:,
 @itemx #+EXPORT_SELECT_TAGS:, #+EXPORT_EXCLUDE_TAGS:
 These lines provide settings for exporting files.  For more details see
 @ref{Export options}.

lisp/ChangeLog

@@ -1,3 +1,10 @@
+2009-05-21  Carsten Dominik  <carsten.dominik@gmail.com>
+
+	* org-colview.el (org-columns-compile-map): New variable.
+	(org-columns-new, org-columns-compute)
+	(org-columns-number-to-string, org-columns-uncompile-format)
+	(org-columns-compile-format): Implement new operators.
+
 2009-05-20  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org-exp.el (org-export-plist-vars): Add :xml-declaration.

lisp/org-colview-xemacs.el

@@ -874,13 +874,31 @@ around it."
 				  (current-buffer))
 	  (org-set-local 'org-colview-initial-truncate-line-value
 			 truncate-lines))
-	(setq truncate-lines t)	
+	(setq truncate-lines t)
 	(mapc (lambda (x)
 		(goto-line (car x))
 		(org-columns-display-here (cdr x)))
 	      cache)))))
 
-(defun org-columns-new (&optional prop title width op fmt &rest rest)
+(defvar org-columns-compile-map
+  '(("none"  none              +)
+    (":"     add_times         +)
+    ("+"     add_numbers       +)
+    ("$"     currency          +)
+    ("X"     checkbox          +)
+    ("X/"    checkbox-n-of-m   +)
+    ("X%"    checkbox-percent  +)
+    ("max"   max_numbers       max)
+    ("min"   min_numbers       min)
+    ("mean"  mean_numbers      (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
+    (":max"  max_times         max)
+    (":min"  min_times         min)
+    (":mean" mean_times        (lambda (&rest x) (/ (apply '+ x) (float (length x))))))
+  "Operator <-> format,fuction map.
+Used to compile/uncompile columns format and completing read in
+interactive function org-columns-new.")
+
+(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
   "Insert a new column, to the left of the current column."
   (interactive)
   (let ((n (org-columns-current-column))
@@ -895,18 +913,17 @@ around it."
 	(setq width (string-to-number width))
       (setq width nil))
     (setq fmt (org-ido-completing-read "Summary [none]: "
-			       '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox") ("checkbox-n-of-m") ("checkbox-percent"))
-			       nil t))
-    (if (string-match "\\S-" fmt)
-	(setq fmt (intern fmt))
-      (setq fmt nil))
+				       (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map)
+				       nil t))
+    (setq fmt (intern fmt)
+	  fun (cadr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
     (if (eq fmt 'none) (setq fmt nil))
     (if editp
 	(progn
 	  (setcar editp prop)
-	  (setcdr editp (list title width nil fmt)))
+	  (setcdr editp (list title width nil fmt nil fun)))
       (setq cell (nthcdr (1- n) org-columns-current-fmt-compiled))
-      (setcdr cell (cons (list prop title width nil fmt)
+      (setcdr cell (cons (list prop title width nil fmt nil fun)
 			 (cdr cell))))
     (org-columns-store-format)
     (org-columns-redo)))
@@ -1056,12 +1073,13 @@ Don't set this, this is meant for dynamic scoping.")
   (interactive)
   (let* ((re (concat "^" outline-regexp))
 	 (lmax 30) ; Does anyone use deeper levels???
-	 (lsum (make-vector lmax 0))
+	 (lvals (make-vector lmax nil))
 	 (lflag (make-vector lmax nil))
 	 (level 0)
 	 (ass (assoc property org-columns-current-fmt-compiled))
 	 (format (nth 4 ass))
 	 (printf (nth 5 ass))
+	 (fun (nth 6 ass))
 	 (beg org-columns-top-level-marker)
 	 last-level val valflag flag end sumpos sum-alist sum str str1 useval)
     (save-excursion
@@ -1079,7 +1097,7 @@ Don't set this, this is meant for dynamic scoping.")
 	(cond
 	 ((< level last-level)
 	  ;; put the sum of lower levels here as a property
-	  (setq sum (aref lsum last-level)   ; current sum
+	  (setq sum (apply fun (aref lvals last-level))
 		flag (aref lflag last-level) ; any valid entries from children?
 		str (org-columns-number-to-string sum format printf)
 		str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
@@ -1095,18 +1113,18 @@ Don't set this, this is meant for dynamic scoping.")
 	    (org-entry-put nil property (if flag str val)))
 	  ;; add current to current  level accumulator
 	  (when (or flag valflag)
-	    (aset lsum level (+ (aref lsum level)
-				(if flag sum (org-column-string-to-number
-					      (if flag str val) format))))
+	    (push (if flag sum
+		    (org-column-string-to-number (if flag str val) format))
+		  (aref lvals level))
 	    (aset lflag level t))
 	  ;; clear accumulators for deeper levels
 	  (loop for l from (1+ level) to (1- lmax) do
-		(aset lsum l 0)
+		(aset lvals l nil)
 		(aset lflag l nil)))
 	 ((>= level last-level)
 	  ;; add what we have here to the accumulator for this level
-	  (aset lsum level (+ (aref lsum level)
-			      (org-column-string-to-number (or val "0") format)))
+	  (push (org-column-string-to-number (or val "0") format)
+		(aref lvals level))
 	  (and valflag (aset lflag level t)))
 	 (t (error "This should not happen")))))))
 
@@ -1145,7 +1163,7 @@ Don't set this, this is meant for dynamic scoping.")
 (defun org-columns-number-to-string (n fmt &optional printf)
   "Convert a computed column number to a string value, according to FMT."
   (cond
-   ((eq fmt 'add_times)
+   ((memq fmt '(add_times max_times min_times mean_times))
     (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
       (format org-time-clocksum-format h m)))
    ((eq fmt 'checkbox)
@@ -1179,21 +1197,17 @@ Don't set this, this is meant for dynamic scoping.")
 
 (defun org-columns-uncompile-format (cfmt)
   "Turn the compiled columns format back into a string representation."
-  (let ((rtn "") e s prop title op width fmt printf)
+  (let ((rtn "") e s prop title op op-match width fmt printf)
     (while (setq e (pop cfmt))
       (setq prop (car e)
 	    title (nth 1 e)
 	    width (nth 2 e)
 	    op (nth 3 e)
 	    fmt (nth 4 e)
-	    printf (nth 5 e))
-      (cond
-       ((eq fmt 'add_times) (setq op ":"))
-       ((eq fmt 'checkbox) (setq op "X"))
-       ((eq fmt 'checkbox-n-of-m) (setq op "X/"))
-       ((eq fmt 'checkbox-percent) (setq op "X%"))
-       ((eq fmt 'add_numbers) (setq op "+"))
-       ((eq fmt 'currency) (setq op "$")))
+	    printf (nth 5 e)
+	    fun (nth 6 e))
+      (when (setq op-match (rassoc (list fmt fun) org-columns-compile-map))
+	(setq op (car op-match)))
       (if (and op printf) (setq op (concat op ";" printf)))
       (if (equal title prop) (setq title nil))
       (setq s (concat "%" (if width (number-to-string width))
@@ -1212,8 +1226,9 @@ title        the title field for the columns
 width        the column width in characters, can be nil for automatic
 operator     the operator if any
 format       the output format for computed results, derived from operator
-printf       a printf format for computed values"
-  (let ((start 0) width prop title op f printf)
+printf       a printf format for computed values
+fun          the lisp function to compute values, derived from operator"
+  (let ((start 0) width prop title op op-match f printf fun)
     (setq org-columns-current-fmt-compiled nil)
     (while (string-match
 	    (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
@@ -1224,20 +1239,16 @@ printf       a printf format for computed values"
 	    title (or (match-string 3 fmt) prop)
 	    op (match-string 4 fmt)
 	    f nil
-	    printf nil)
+	    printf nil
+	    fun '+)
       (if width (setq width (string-to-number width)))
       (when (and op (string-match ";" op))
 	(setq printf (substring op (match-end 0))
 	      op (substring op 0 (match-beginning 0))))
-      (cond
-       ((equal op "+")  (setq f 'add_numbers))
-       ((equal op "$")  (setq f 'currency))
-       ((equal op ":")  (setq f 'add_times))
-       ((equal op "X")  (setq f 'checkbox))
-       ((equal op "X/") (setq f 'checkbox-n-of-m))
-       ((equal op "X%") (setq f 'checkbox-percent))
-       )
-      (push (list prop title width op f printf) org-columns-current-fmt-compiled))
+      (when (setq op-match (assoc op org-columns-compile-map))
+	(setq f (cadr op-match)
+	      fun (caddr op-match)))
+      (push (list prop title width op f printf fun) org-columns-current-fmt-compiled))
     (setq org-columns-current-fmt-compiled
 	  (nreverse org-columns-current-fmt-compiled))))
 

lisp/org-colview.el

@@ -692,13 +692,31 @@ around it."
 	(unless (local-variable-p 'org-colview-initial-truncate-line-value)
 	  (org-set-local 'org-colview-initial-truncate-line-value
 			 truncate-lines))
-	(setq truncate-lines t)	
+	(setq truncate-lines t)
 	(mapc (lambda (x)
 		(goto-line (car x))
 		(org-columns-display-here (cdr x)))
 	      cache)))))
 
-(defun org-columns-new (&optional prop title width op fmt &rest rest)
+(defvar org-columns-compile-map
+  '(("none"  none              +)
+    (":"     add_times         +)
+    ("+"     add_numbers       +)
+    ("$"     currency          +)
+    ("X"     checkbox          +)
+    ("X/"    checkbox-n-of-m   +)
+    ("X%"    checkbox-percent  +)
+    ("max"   max_numbers       max)
+    ("min"   min_numbers       min)
+    ("mean"  mean_numbers      (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
+    (":max"  max_times         max)
+    (":min"  min_times         min)
+    (":mean" mean_times        (lambda (&rest x) (/ (apply '+ x) (float (length x))))))
+  "Operator <-> format,fuction map.
+Used to compile/uncompile columns format and completing read in
+interactive function org-columns-new.")
+
+(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
   "Insert a new column, to the left of the current column."
   (interactive)
   (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
@@ -712,19 +730,18 @@ around it."
 	(setq width (string-to-number width))
       (setq width nil))
     (setq fmt (org-ido-completing-read "Summary [none]: "
-			       '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox") ("checkbox-n-of-m") ("checkbox-percent"))
-			       nil t))
-    (if (string-match "\\S-" fmt)
-	(setq fmt (intern fmt))
-      (setq fmt nil))
+				       (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map)
+				       nil t))
+    (setq fmt (intern fmt)
+	  fun (cadr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
     (if (eq fmt 'none) (setq fmt nil))
     (if editp
 	(progn
 	  (setcar editp prop)
-	  (setcdr editp (list title width nil fmt)))
+	  (setcdr editp (list title width nil fmt nil fun)))
       (setq cell (nthcdr (1- (current-column))
 			 org-columns-current-fmt-compiled))
-      (setcdr cell (cons (list prop title width nil fmt)
+      (setcdr cell (cons (list prop title width nil fmt nil fun)
 			 (cdr cell))))
     (org-columns-store-format)
     (org-columns-redo)))
@@ -869,12 +886,13 @@ Don't set this, this is meant for dynamic scoping.")
   (interactive)
   (let* ((re (concat "^" outline-regexp))
 	 (lmax 30) ; Does anyone use deeper levels???
-	 (lsum (make-vector lmax 0))
+	 (lvals (make-vector lmax nil))
 	 (lflag (make-vector lmax nil))
 	 (level 0)
 	 (ass (assoc property org-columns-current-fmt-compiled))
 	 (format (nth 4 ass))
 	 (printf (nth 5 ass))
+	 (fun (nth 6 ass))
 	 (beg org-columns-top-level-marker)
 	 last-level val valflag flag end sumpos sum-alist sum str str1 useval)
     (save-excursion
@@ -892,7 +910,7 @@ Don't set this, this is meant for dynamic scoping.")
 	(cond
 	 ((< level last-level)
 	  ;; put the sum of lower levels here as a property
-	  (setq sum (aref lsum last-level)   ; current sum
+	  (setq sum (apply fun (aref lvals last-level))
 		flag (aref lflag last-level) ; any valid entries from children?
 		str (org-columns-number-to-string sum format printf)
 		str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
@@ -908,18 +926,18 @@ Don't set this, this is meant for dynamic scoping.")
 	    (org-entry-put nil property (if flag str val)))
 	  ;; add current to current  level accumulator
 	  (when (or flag valflag)
-	    (aset lsum level (+ (aref lsum level)
-				(if flag sum (org-column-string-to-number
-					      (if flag str val) format))))
+	    (push (if flag sum
+		    (org-column-string-to-number (if flag str val) format))
+		  (aref lvals level))
 	    (aset lflag level t))
 	  ;; clear accumulators for deeper levels
 	  (loop for l from (1+ level) to (1- lmax) do
-		(aset lsum l 0)
+		(aset lvals l nil)
 		(aset lflag l nil)))
 	 ((>= level last-level)
 	  ;; add what we have here to the accumulator for this level
-	  (aset lsum level (+ (aref lsum level)
-			      (org-column-string-to-number (or val "0") format)))
+	  (push (org-column-string-to-number (or val "0") format)
+		(aref lvals level))
 	  (and valflag (aset lflag level t)))
 	 (t (error "This should not happen")))))))
 
@@ -958,7 +976,7 @@ Don't set this, this is meant for dynamic scoping.")
 (defun org-columns-number-to-string (n fmt &optional printf)
   "Convert a computed column number to a string value, according to FMT."
   (cond
-   ((eq fmt 'add_times)
+   ((memq fmt '(add_times max_times min_times mean_times))
     (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
       (format org-time-clocksum-format h m)))
    ((eq fmt 'checkbox)
@@ -992,21 +1010,17 @@ Don't set this, this is meant for dynamic scoping.")
 
 (defun org-columns-uncompile-format (cfmt)
   "Turn the compiled columns format back into a string representation."
-  (let ((rtn "") e s prop title op width fmt printf)
+  (let ((rtn "") e s prop title op op-match width fmt printf)
     (while (setq e (pop cfmt))
       (setq prop (car e)
 	    title (nth 1 e)
 	    width (nth 2 e)
 	    op (nth 3 e)
 	    fmt (nth 4 e)
-	    printf (nth 5 e))
-      (cond
-       ((eq fmt 'add_times) (setq op ":"))
-       ((eq fmt 'checkbox) (setq op "X"))
-       ((eq fmt 'checkbox-n-of-m) (setq op "X/"))
-       ((eq fmt 'checkbox-percent) (setq op "X%"))
-       ((eq fmt 'add_numbers) (setq op "+"))
-       ((eq fmt 'currency) (setq op "$")))
+	    printf (nth 5 e)
+	    fun (nth 6 e))
+      (when (setq op-match (rassoc (list fmt fun) org-columns-compile-map))
+	(setq op (car op-match)))
       (if (and op printf) (setq op (concat op ";" printf)))
       (if (equal title prop) (setq title nil))
       (setq s (concat "%" (if width (number-to-string width))
@@ -1025,8 +1039,9 @@ title        the title field for the columns
 width        the column width in characters, can be nil for automatic
 operator     the operator if any
 format       the output format for computed results, derived from operator
-printf       a printf format for computed values"
-  (let ((start 0) width prop title op f printf)
+printf       a printf format for computed values
+fun          the lisp function to compute values, derived from operator"
+  (let ((start 0) width prop title op op-match f printf fun)
     (setq org-columns-current-fmt-compiled nil)
     (while (string-match
 	    (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
@@ -1037,20 +1052,16 @@ printf       a printf format for computed values"
 	    title (or (match-string 3 fmt) prop)
 	    op (match-string 4 fmt)
 	    f nil
-	    printf nil)
+	    printf nil
+	    fun '+)
       (if width (setq width (string-to-number width)))
       (when (and op (string-match ";" op))
 	(setq printf (substring op (match-end 0))
 	      op (substring op 0 (match-beginning 0))))
-      (cond
-       ((equal op "+")  (setq f 'add_numbers))
-       ((equal op "$")  (setq f 'currency))
-       ((equal op ":")  (setq f 'add_times))
-       ((equal op "X")  (setq f 'checkbox))
-       ((equal op "X/") (setq f 'checkbox-n-of-m))
-       ((equal op "X%") (setq f 'checkbox-percent))
-       )
-      (push (list prop title width op f printf) org-columns-current-fmt-compiled))
+      (when (setq op-match (assoc op org-columns-compile-map))
+	(setq f (cadr op-match)
+	      fun (caddr op-match)))
+      (push (list prop title width op f printf fun) org-columns-current-fmt-compiled))
     (setq org-columns-current-fmt-compiled
 	  (nreverse org-columns-current-fmt-compiled))))