[Orgmode] [Babel] Proposed addition to the Library of Babel: Merge two or more (possibly incomplete) tables by first column. And a question.

[Marc-Oliver Ihm]

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)
    )
  )

merge-tables-by-first-column.el
Description: Text Data