* [Babel] Proposed addition to the Library of Babel: Merge two or more (possibly incomplete) tables by first column. And a question.
@ 2010-10-25 18:46 Marc-Oliver Ihm
0 siblings, 0 replies; only message in thread
From: Marc-Oliver Ihm @ 2010-10-25 18:46 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 6064 bytes --]
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)
)
)
[-- Attachment #2: merge-tables-by-first-column.el --]
[-- Type: text/x-emacs-lisp, Size: 4266 bytes --]
(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)
)
)
[-- 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 [flat|nested] only message in thread
only message in thread, other threads:[~2010-10-25 19:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-10-25 18:46 [Babel] Proposed addition to the Library of Babel: Merge two or more (possibly incomplete) tables by first column. And a question Marc-Oliver Ihm
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).