From mboxrd@z Thu Jan 1 00:00:00 1970 From: Marc-Oliver Ihm Subject: [Babel] Proposed addition to the Library of Babel: Merge two or more (possibly incomplete) tables by first column. And a question. Date: Mon, 25 Oct 2010 20:46:53 +0200 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------060401000900070301090307" Return-path: Received: from [140.186.70.92] (port=57511 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1PAT4X-0007sb-5m for emacs-orgmode@gnu.org; Mon, 25 Oct 2010 15:51:13 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PAStq-0007mx-Aj for emacs-orgmode@gnu.org; Mon, 25 Oct 2010 15:40:07 -0400 Received: from lo.gmane.org ([80.91.229.12]:58329) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PAStp-0007mh-Rj for emacs-orgmode@gnu.org; Mon, 25 Oct 2010 15:40:06 -0400 Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1PASto-0000mN-9s for emacs-orgmode@gnu.org; Mon, 25 Oct 2010 21:40:04 +0200 Received: from p54a885c5.dip0.t-ipconnect.de ([84.168.133.197]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 25 Oct 2010 21:40:04 +0200 Received: from marc-oliver.ihm by p54a885c5.dip0.t-ipconnect.de with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 25 Oct 2010 21:40:04 +0200 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org This is a multi-part message in MIME format. --------------060401000900070301090307 Content-Type: text/plain; charset=ISO-8859-15 Content-Transfer-Encoding: 7bit Hello ! Well, here is an example: > #+tblname: lower > | 2 | b | > | 4 | d | > | 5 | e | > | 6 | h | > > #+tblname: upper > | 1 | A | > | 3 | C | > | 4 | D | > | 10 | J | > | 2 | B | > > #+begin_src emacs-lisp :var t1=lower :var t2=upper > (merge-tables-by-first-column t1 t2) > #+end_src > > #+results: > | 1 | | A | > | 2 | b | B | > | 3 | | C | > | 4 | d | D | > | 5 | e | | > | 6 | h | | > | 10 | | J | > This example uses two tables as input; both of which associate numbers (first column, simply the position within the alphabet) with letters (second column). There is one table for lower- and one table for upper-case letters. Both tables are processed with babel and the function merge-tables-by-first-column. The third table is the result, which merges the two input tables: It contains all lines and all columns from both tables. Note, that not every number needs to appear in both input-tables; e.g. "1" does not appear in the table "lower" and therefore the corresponding cell (first line, second column) within the result table is empty; this is probably different from existing ways of merging tables. This function might be useful for consolidating results from different data sources. Please find the elisp-code for merge-tables-by-first-column below. Having explained so far, I have a question: Currently I have defined the function merge-tables-by-first-column within my emacs startup file. However, I think, that this defun should be placed within the library of babel (if acceptable); and for efficency reasons maybe even in a way, that it will only be compiled at emacs startup (and not at every invocation). Is that possible ? In the meantime, however this code works well, if placed within your .emacs-file. I hope this code might proof useful and would like to thank for any answers to my question ! With kind regards, Marc-Oliver Ihm (defun merge-tables-by-first-column (&rest tables) "Merge any number of tables by treating their first column as a key; sort the result" (interactive) (let (is-all-numbers less-than-function equal-function conversion-function format-specifier rests-of-tables rest-of-rests-of-tables rest-of-table widths-of-tables current-key result-table result-line i) ;; Find out, if all keys in all tables are numbers or if there are strings among them (setq is-all-numbers (catch 'not-a-number (dolist (table tables) (dolist (line table) (unless (numberp (car line)) (throw 'not-a-number 'nil)))) 't)) ;; prepare functions to treat table contents in a unified way (setq format-specifier (if is-all-numbers "%g" "%s")) (setq conversion-function (if is-all-numbers (lambda (x) x) (lambda (x) (if (numberp x) (number-to-string x) x)) )) (setq less-than-function (lambda (x y) (if is-all-numbers (< x y) (string< (funcall conversion-function x) (funcall conversion-function y))))) (setq equal-function (lambda (x y) (if is-all-numbers (= x y) (string= (funcall conversion-function x) (funcall conversion-function y))))) ;; sort tables (setq tables (mapcar (lambda (table) (sort table (lambda (x y) (funcall less-than-function (car x) (car y))))) tables)) ;; compute and remember table widths (setq widths-of-tables (mapcar (lambda (x) (length (car x))) tables)) (setq rests-of-tables (copy-list tables)) ;; loop as long as the rest of table still contains lines (while (progn ;; find lowest key among all tables, which is the key for the next line of the result (setq current-key nil) (dolist (rest-of-table rests-of-tables) (when (and rest-of-table (or (null current-key) (funcall less-than-function (caar rest-of-table) current-key))) (setq current-key (caar rest-of-table)))) current-key) (progn (setq result-line (list current-key)) ;; go through all tables and collect one line for the result table ... (setq i 0) ; table-count ;; cannot use dolist like above, because we need to modify the cons-cells (setq rest-of-rests-of-tables rests-of-tables) (while (progn (setq rest-of-table (car rest-of-rests-of-tables)) (setq i (1+ i)) ;; if table contains current key (if (and rest-of-table (funcall equal-function current-key (caar rest-of-table))) ;; then copy rest of line (progn (nconc result-line (cdar rest-of-table)) ;; and shorten rest (setcar rest-of-rests-of-tables (cdar rest-of-rests-of-tables)) ;; and check, if current-key appears again (when (and (caadr rest-of-table) (funcall equal-function current-key (caadr rest-of-table)) ) (error (concat "Key '" format-specifier "'appears twice within input table %i") (funcall conversion-function current-key) i) ) ) ;; otherwise fill with nil and do not shorten rest of table (progn (nconc result-line (make-list (1- (elt widths-of-tables (1- i))) "")) ) ) (setq rest-of-rests-of-tables (cdr rest-of-rests-of-tables)) ;; condition for while-loop rest-of-rests-of-tables ) ) (setq result-table (cons result-line result-table)) ; store away line ) ) (nreverse result-table) ) ) --------------060401000900070301090307 Content-Type: text/x-emacs-lisp; name="merge-tables-by-first-column.el" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="merge-tables-by-first-column.el" (defun merge-tables-by-first-column (&rest tables) "Merge any number of tables by treating their first column as a key; sort the result" (interactive) (let (is-all-numbers less-than-function equal-function conversion-function format-specifier rests-of-tables rest-of-rests-of-tables rest-of-table widths-of-tables current-key result-table result-line i) ;; Find out, if all keys in all tables are numbers or if there are strings among them (setq is-all-numbers (catch 'not-a-number (dolist (table tables) (dolist (line table) (unless (numberp (car line)) (throw 'not-a-number 'nil)))) 't)) ;; prepare functions to treat table contents in a unified way (setq format-specifier (if is-all-numbers "%g" "%s")) (setq conversion-function (if is-all-numbers (lambda (x) x) (lambda (x) (if (numberp x) (number-to-string x) x)) )) (setq less-than-function (lambda (x y) (if is-all-numbers (< x y) (string< (funcall conversion-function x) (funcall conversion-function y))))) (setq equal-function (lambda (x y) (if is-all-numbers (= x y) (string= (funcall conversion-function x) (funcall conversion-function y))))) ;; sort tables (setq tables (mapcar (lambda (table) (sort table (lambda (x y) (funcall less-than-function (car x) (car y))))) tables)) ;; compute and remember table widths (setq widths-of-tables (mapcar (lambda (x) (length (car x))) tables)) (setq rests-of-tables (copy-list tables)) ;; loop as long as the rest of table still contains lines (while (progn ;; find lowest key among all tables, which is the key for the next line of the result (setq current-key nil) (dolist (rest-of-table rests-of-tables) (when (and rest-of-table (or (null current-key) (funcall less-than-function (caar rest-of-table) current-key))) (setq current-key (caar rest-of-table)))) current-key) (progn (setq result-line (list current-key)) ;; go through all tables and collect one line for the result table ... (setq i 0) ; table-count ;; cannot use dolist like above, because we need to modify the cons-cells (setq rest-of-rests-of-tables rests-of-tables) (while (progn (setq rest-of-table (car rest-of-rests-of-tables)) (setq i (1+ i)) ;; if table contains current key (if (and rest-of-table (funcall equal-function current-key (caar rest-of-table))) ;; then copy rest of line (progn (nconc result-line (cdar rest-of-table)) ;; and shorten rest (setcar rest-of-rests-of-tables (cdar rest-of-rests-of-tables)) ;; and check, if current-key appears again (when (and (caadr rest-of-table) (funcall equal-function current-key (caadr rest-of-table)) ) (error (concat "Key '" format-specifier "'appears twice within input table %i") (funcall conversion-function current-key) i) ) ) ;; otherwise fill with nil and do not shorten rest of table (progn (nconc result-line (make-list (1- (elt widths-of-tables (1- i))) "")) ) ) (setq rest-of-rests-of-tables (cdr rest-of-rests-of-tables)) ;; condition for while-loop rest-of-rests-of-tables ) ) (setq result-table (cons result-line result-table)) ; store away line ) ) (nreverse result-table) ) ) --------------060401000900070301090307 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ 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 --------------060401000900070301090307--