org-contrib/ob-table-operations.org

   1 # This file is released by its authors and contributors under the GNU
   2 # Free Documentation license v1.3 or later, code examples are released
   3 # under the GNU General Public License v3 or later.
   4
   5 * Table operations --- filter or combine tables
   6
   7   This section within the library of babel provides table operations.
   8   See the documentation just below for details and working examples.
   9
  10   Author  : Marc-Oliver Ihm <ihm@ferntreffer.de>
  11   Version : 1.0
  12
  13 ** Documentation
  14
  15 *** Introduction
  16
  17     The table operations (currently four) are grouped in two categories:
  18
  19     - Filtering the rows of a single table: keeping or removing
  20     - Combining two tables into one: merging or intersecting
  21
  22     All four operations are demonstrated below.
  23
  24 *** Example tables
  25
  26     To demonstrate we need three tables: upper, lower and keys:
  27
  28 #+name: upper
  29 |  1 | A |
  30 |  3 | C |
  31 |  4 | D |
  32 | 10 | J |
  33 |  2 | B |
  34
  35 #+name: lower
  36 | Position | Letter |
  37 |----------+--------|
  38 |        2 | b      |
  39 |        4 | d      |
  40 |        5 | e      |
  41 |        6 | h      |
  42
  43 #+name: keys
  44 | Position |
  45 |----------|
  46 |        1 |
  47 |        2 |
  48 |        4 |
  49
  50     The tables upper and lower both have two columns and associate a position in
  51     the alphabet with the matching letter.  E.g. the row "| 1 | A |" from table
  52     upper, just states that the letter "A" comes at position 1 in the alphabet.
  53
  54     Nearly the same is true for table lower, only that it contains lower case
  55     letters.  Some of its letters (e.g. "b") have counterparts in table upper
  56     ("B"), some (e.g. "e") dont.
  57
  58     The table keys finally, contains keys (i.e. positions within the alphabet),
  59     that can be used to select rows from either table upper or lower.
  60
  61     Note, that tables may have column headings or not.
  62
  63 *** Filtering a table
  64
  65 **** Keeping rows
  66
  67      Let's say, we want to select the upper-case letters (i.e. rows from the
  68      table upper), that are given in table keys (i.e. the first, second and
  69      fourth letter).
  70
  71      This can be described as filtering table upper and keeping only those rows,
  72      that appear in table keys.
  73
  74      As a babel-call, this reads:
  75
  76 #+call: table-operations-filter-keep(upper,keys)
  77
  78 #+results: table-operations-filter-keep(upper,keys)
  79 | 1 | A |
  80 | 4 | D |
  81 | 2 | B |
  82
  83      ,which gives exactly those rows from table upper, that are specified in
  84      keys.
  85
  86 **** Removing rows
  87
  88      Now, if on the contrary you want to filter table upper to remove any rows,
  89      which are given in table keys:
  90
  91 #+call: table-operations-filter-remove(upper,keys) :colnames yes
  92
  93 #+results: table-operations-filter-remove(upper,keys)
  94 | Position | t2c2 |
  95 |----------+------|
  96 |        3 | C    |
  97 |       10 | J    |
  98
  99      ,which is the expected result.
 100
 101      Please note, that the call contains the header argument ":colnames yes",
 102      which causes the result table to contain the headings "Position" and
 103      "t2c2". These headings are taken from the input-tables upper and
 104      keys. However, as upper does not contain any headings, the heading "t2c2"
 105      is generated artificially; it stands for "table 2 column 2".
 106
 107      If you do not want to have column names in the result table, just leave out
 108      the header argument ":colnames yes" like in the first example. Note
 109      however, that ":colnames no" does not give the expected effect.
 110
 111 *** Combining tables
 112
 113     Now, lets have a look at the tables upper and lower alone and see how to
 114     combine them.
 115
 116     Note, that we only look at combining two tables for simplicity, however, all
 117     operations can be easily scaled up to seven tables.
 118
 119 **** Merging rows
 120
 121      We have two tables, one with upper case letters and one with lower
 122      case. What now, if you want to have only one table, which contains both,
 123      upper and lower case letters ?
 124
 125      You may want to merge them:
 126
 127 #+call: table-operations-combine-merge(upper,lower) :colnames yes
 128
 129 #+results: table-operations-combine-merge(upper,lower)
 130 | Position | t1c2 | Letter |
 131 |----------+------+--------|
 132 |        1 | A    |        |
 133 |        2 | B    | b      |
 134 |        3 | C    |        |
 135 |        4 | D    | d      |
 136 |        5 |      | e      |
 137 |        6 |      | h      |
 138 |       10 | J    |        |
 139
 140
 141      This result combines both upper and lower case letters and lists them by
 142      their position within the alphabet.
 143
 144 **** Intersecting rows
 145
 146      If you only want the rows, that are complete (i.e. have both upper and
 147      lower case letters) you may compute the intersection:
 148
 149 #+call: table-operations-combine-intersect(upper,lower)
 150
 151 #+results: table-operations-combine-intersect(upper,lower)
 152 | 2 | B | b |
 153 | 4 | D | d |
 154
 155
 156      ,which has only those keys and letters, that appear in both tables.
 157
 158      Note, that we have ommitted the headeragument ":colnames yes" so that the
 159      result table has no headings.
 160
 161 ** Internals
 162
 163    This section is not required if you just want to use table operations as
 164    described above. Only if you are curious about its implementation or
 165    development, you might want to have a look.
 166
 167 *** Implementation
 168
 169    Here is the actual lisp code, that implements the functionality of table
 170    operations.
 171
 172 **** table-operations-filter
 173 ***** Directly callable blocks
 174
 175 #+name: table-operations-filter-keep
 176 #+begin_src emacs-lisp :noweb yes :results silent :var table=() :var filter=()
 177   <<lob-table-operations-helper-get-headings-defun>>
 178   <<lob-table-operations-filter-defun>>
 179   (let ((filter-and-table (list filter table)))
 180     (lob-table-operations-filter 'keep filter-and-table))
 181 #+end_src
 182
 183 #+name: table-operations-filter-remove
 184 #+begin_src emacs-lisp :noweb yes :results silent :var table=() :var filter=() :colnames nil
 185   <<lob-table-operations-helper-get-headings-defun>>
 186   <<lob-table-operations-filter-defun>>
 187   (let ((filter-and-table (list filter table)))
 188     (lob-table-operations-filter 'remove filter-and-table))
 189 #+end_src
 190
 191 ***** Included defuns
 192
 193 #+name: lob-table-operations-filter-defun
 194 #+begin_src emacs-lisp
 195   (defun lob-table-operations-filter (what filter-and-table)
 196     "Internal function for table operations in orgmode library of babel"
 197
 198     (let (keys
 199           result-table
 200           headings-all-tables
 201           filter
 202           table)
 203
 204       ;; seperate headings from rest of tables
 205       (setq headings-all-tables
 206             (lob-table-operations-helper-get-headings filter-and-table))
 207
 208       ;; extract arguments
 209       (setq filter (car filter-and-table))
 210       (setq table (cadr filter-and-table))
 211
 212       ;; remove hlines
 213       (setq table (org-babel-del-hlines table))
 214       (setq filter (org-babel-del-hlines filter))
 215       (setq keys (mapcar 'car filter))
 216
 217       ;; start result with headings (reversed)
 218       (setq result-table (cons 'hline (cons headings-all-tables nil)))
 219
 220       (dolist (line table) ; loop over table lines
 221         (if (equal (not (not (member (car line) keys)))
 222                    (equal what 'keep)) ; 'keep or 'remove ?
 223             (setq result-table (cons line result-table))))
 224       (nreverse result-table)))
 225 #+end_src
 226
 227 **** table-operations-combine
 228 ***** Directly callable blocks
 229
 230 #+name: table-operations-combine-merge
 231 #+begin_src emacs-lisp :noweb yes :results silent :var t1=() :var t2=() :var t3=() :var t4=() :var t5=() :var t6=() :var t7=()
 232   <<lob-table-operations-helper-get-headings-defun>>
 233   <<lob-table-operations-combine-defun>>
 234   (let ((tables (list t1 t2 t3 t4 t5 t6 t7)))
 235     (lob-table-operations-combine 'merge tables))
 236 #+end_src
 237
 238 #+name: table-operations-combine-intersect
 239 #+begin_src emacs-lisp :noweb yes :results silent :var t1=() :var t2=() :var t3=() :var t4=() :var t5=() :var t6=() :var t7=()
 240   <<lob-table-operations-helper-get-headings-defun>>
 241   <<lob-table-operations-combine-defun>>
 242   (let ((tables (list t1 t2 t3 t4 t5 t6 t7)))
 243     (lob-table-operations-combine 'intersect tables))
 244 #+end_src
 245
 246 ***** Included defuns
 247
 248 #+name: lob-table-operations-combine-defun
 249 #+begin_src emacs-lisp
 250   (defun lob-table-operations-combine (what tables)
 251     "Internal function for table-operations in orgmode library of babel"
 252     (let (is-all-numbers
 253           format-specifier
 254           rest-of-tables
 255           rests-of-tables
 256           rest-of-rests-of-tables
 257           rest-of-table
 258           headings-all-tables
 259           widths-of-tables
 260           current-key
 261           current-key-in-intersection
 262           result-table
 263           result-line
 264           i)
 265
 266       ;; remove possible empty trailing tables
 267       (setq rest-of-tables tables)
 268       (while (cadr rest-of-tables) (setq rest-of-tables (cdr rest-of-tables)))
 269       (setcdr rest-of-tables nil)
 270
 271       ;; seperate headings from rest of tables
 272       (setq headings-all-tables (lob-table-operations-helper-get-headings
 273                                  tables))
 274       (setq result-table (cons 'hline (cons headings-all-tables nil)))
 275
 276       ;; remove all remaining hlines
 277       (setq tables (mapcar 'org-babel-del-hlines tables))
 278
 279       ;; Find out, if all keys in all tables are numbers or if
 280       ;; there are strings among them
 281       (setq is-all-numbers
 282             (catch 'not-a-number
 283               (dolist (table tables)
 284                 (dolist (line table)
 285                   (unless (numberp (car line))
 286                     (throw 'not-a-number 'nil))))
 287               't))
 288
 289       (setq format-specifier (if is-all-numbers "%g" "%s"))
 290       ;; Prepare functions to treat table contents in a unified way
 291       (flet ((convert (x)
 292                       (if is-all-numbers
 293                           x
 294                         (if (numberp x)
 295                             (number-to-string x)
 296                           x)))
 297              (less-than (x y)
 298                         (if is-all-numbers (< x y)
 299                           (string< (convert x)
 300                                    (convert y))))
 301              (compare (x y)
 302                       (if is-all-numbers (= x y)
 303                         (string= (convert x)
 304                                  (convert y)))))
 305
 306         ;; sort tables
 307         (setq tables (mapcar (lambda (table)
 308                                (sort table (lambda (x y)
 309                                              (less-than (car x)
 310                                                         (car y)))))
 311                              tables))
 312
 313         ;; compute and remember table widths
 314         (setq widths-of-tables (mapcar (lambda (x) (length (car x))) tables))
 315
 316         ;; copy initially and shorten below
 317         (setq rests-of-tables (copy-list tables))
 318
 319         ;; loop as long as the rest of table still contains lines
 320         (while (progn
 321                  ;; find lowest key among all tables, which is the key for the
 322                  ;; next line of the result
 323                  (setq current-key nil)
 324                  (setq current-key-in-intersection 't) ; remember for later
 325                  (dolist (rest-of-table rests-of-tables) ; loop over all tables
 326                    (when (and rest-of-table ; and compare against all keys
 327                               (or (null current-key)
 328                                   (less-than (caar rest-of-table)
 329                                              current-key)))
 330                      (setq current-key (caar rest-of-table))))
 331                  current-key)
 332
 333           (progn
 334
 335             (setq result-line (list current-key))
 336
 337             ;; go through all tables and collect one line for the result table
 338             (setq i 0)                      ; table-count
 339             ;; cannot use dolist like above, because we need to modify the
 340             ;; cons-cells
 341             (setq rest-of-rests-of-tables rests-of-tables)
 342             (while (progn
 343                      (setq rest-of-table (car rest-of-rests-of-tables))
 344                      (incf i)
 345                      ;; if table contains current key
 346                      (if (and rest-of-table
 347                               (compare current-key (caar rest-of-table)))
 348                          ;; then copy rest of line
 349                          (progn (nconc result-line (cdar rest-of-table))
 350                                 ;; and shorten rest
 351                                 (setcar rest-of-rests-of-tables
 352                                         (cdar rest-of-rests-of-tables))
 353                                 ;; and check, if current-key appears again
 354                                 (when (and (caadr rest-of-table)
 355                                            (compare current-key
 356                                                     (caadr rest-of-table)))
 357                                   (error (concat "Key '"
 358                                                  format-specifier
 359                                                  "' appears twice within "
 360                                                  "input table %i")
 361                                          (convert current-key) i)
 362                                   )
 363                                 )
 364                        ;; otherwise fill with nil and do not shorte
 365                        ;; rest of table
 366                        (progn
 367                          (setq current-key-in-intersection nil)
 368                          (nconc result-line (make-list (1-
 369                                                         (elt widths-of-tables
 370                                                              (1- i)))
 371                                                        ""))))
 372
 373                      (setq rest-of-rests-of-tables
 374                            (cdr rest-of-rests-of-tables))
 375                      rest-of-rests-of-tables)) ; condition for loop
 376             (if (or (eq what 'merge) current-key-in-intersection)
 377                 ;; store away line
 378                 (setq result-table (cons
 379                                     result-line
 380                                     result-table)))))
 381
 382         (nreverse result-table))))
 383 #+end_src
 384
 385 **** Common helper functions
 386
 387 #+name: lob-table-operations-helper-get-headings-defun
 388 #+begin_src emacs-lisp
 389   (defun lob-table-operations-helper-get-headings (tables)
 390     "Internal function for table-operations in orgmode library of babel"
 391     (let ((rest-of-tables tables)
 392           (i 1)
 393           headings-all-tables
 394           headings-one-table
 395           heading-of-key)
 396       (while rest-of-tables
 397         (progn
 398           (setq table (car rest-of-tables))
 399           (if (eq (cadr table) 'hline)
 400               ;; second line is a hline, so first is a heading
 401               (progn
 402                 ; take headings from first table row
 403                 (setq headings-one-table (cdar table))
 404                 (unless heading-of-key (setq heading-of-key (caar table)))
 405                 (unless (string= heading-of-key (caar table))
 406                   (error "Name of first column is not the same in all tables"))
 407                 (setcar rest-of-tables
 408                         (cdar rest-of-tables))) ; and shorten rest
 409             ;; table does not contain headings, so make them up
 410             (setq headings-one-table
 411                   (mapcar
 412                    (lambda (x) (format "t%dc%d" i x))
 413                    (number-sequence 2 (length (car table))))))
 414           (setq headings-all-tables (append headings-all-tables
 415                                             headings-one-table))
 416           (setq rest-of-tables (cdr rest-of-tables))
 417           (incf i)
 418           rest-of-tables)) ; condition for while loop
 419       (unless heading-of-key (setq heading-of-key "key"))
 420       (setq headings-all-tables (cons heading-of-key headings-all-tables))
 421       headings-all-tables))
 422
 423 #+end_src
 424
 425 **** Debugging and testing
 426 ***** Clean up
 427 #+begin_src emacs-lisp
 428   (save-excursion
 429     (beginning-of-buffer)
 430     (while (re-search-forward "^#\\+results:.*\n\\(^\|.+\n\\)*\n" nil t)
 431       (replace-match ""))
 432     )
 433 #+end_src
 434
 435 #+results:
 436
 437 ***** Byte Compilation
 438
 439    (byte-compile 'lob-table-operations-combine)
 440    (byte-compile 'lob-table-operations-filter)
 441
 442 *** Development
 443 **** Versions and history
 444
 445      [2012-03-18 So] Version 1.0:
 446      - Added handling of hlines and table headings
 447
 448      [2012-01-07 Sa] Version 0.01:
 449      - Restructured as a single org-file; no special .el-file needed any more
 450      - Combined and restructured documentation and implementation
 451
 452 **** Bugs and Todos
 453
 454      - [X] Brush up documentation
 455      - [X] Stay below 80 columns
 456      - [X] Tests with more than two columns per table
 457      - [X] Tests with more than two tables for merging
 458      - [X] Handle optional table captions
 459      - [X] Handle hlines
 460      - [X] flet within lob-table-operations-combine
 461      - [-] flet within directly callable blocks; try to avoid global functions
 462        Not feasible, because that hinders debugging to much
 463      - [X] Use :results silent
 464
 465 **** Testcases
 466
 467 #+name: upper-wide
 468 | Position | c1 | c2 | c3 | c4 |
 469 |----------+----+----+----+----|
 470 |        1 | A1 | A2 | A3 | A4 |
 471 |        3 | C1 | C2 | C3 | C4 |
 472 |        4 | D1 | D2 | D3 | D4 |
 473 |       10 | J1 | J2 | J3 | J4 |
 474 |        2 | B1 | B2 | B3 | B4 |
 475
 476 #+name: lower-wide
 477 | 2 | b1 | b2 | b3 | b4 |
 478 | 4 | d1 | d2 | d3 | d4 |
 479 | 5 | e1 | e2 | e3 | e4 |
 480 | 6 | h1 | h2 | h3 | h4 |
 481
 482 #+name: upper-lower-wide
 483 |  2 | Bb1 | Bb2 | Bb3 | Bb4 |
 484 |  6 | Hh1 | Hh2 | Hh3 | Hh4 |
 485 |  4 | Dd1 | Dd2 | Dd3 | Dd4 |
 486 | 10 | Jj1 | Jj2 | Jj3 | Jj4 |
 487
 488 #+call: table-operations-filter-keep(upper-wide,keys)
 489
 490 #+results: table-operations-filter-keep(upper-wide,keys)
 491 | 1 | A1 | A2 | A3 | A4 |
 492 | 4 | D1 | D2 | D3 | D4 |
 493 | 2 | B1 | B2 | B3 | B4 |
 494
 495 #+call: table-operations-filter-remove(lower-wide,keys) :colnames yes
 496
 497 #+results: table-operations-filter-remove(lower-wide,keys)
 498 | Position | t2c2 | t2c3 | t2c4 | t2c5 |
 499 |----------+------+------+------+------|
 500 |        5 | e1   | e2   | e3   | e4   |
 501 |        6 | h1   | h2   | h3   | h4   |
 502
 503 #+call: table-operations-combine-merge(upper-wide,lower-wide) :colnames yes
 504
 505 #+results: table-operations-combine-merge(upper-wide,lower-wide)
 506 | Position | c1 | c2 | c3 | c4 | t2c2 | t2c3 | t2c4 | t2c5 |
 507 |----------+----+----+----+----+------+------+------+------|
 508 |        1 | A1 | A2 | A3 | A4 |      |      |      |      |
 509 |        2 | B1 | B2 | B3 | B4 | b1   | b2   | b3   | b4   |
 510 |        3 | C1 | C2 | C3 | C4 |      |      |      |      |
 511 |        4 | D1 | D2 | D3 | D4 | d1   | d2   | d3   | d4   |
 512 |        5 |    |    |    |    | e1   | e2   | e3   | e4   |
 513 |        6 |    |    |    |    | h1   | h2   | h3   | h4   |
 514 |       10 | J1 | J2 | J3 | J4 |      |      |      |      |
 515
 516 #+call: table-operations-combine-intersect(upper-wide,lower-wide)
 517
 518 #+results: table-operations-combine-intersect(upper-wide,lower-wide)
 519 | 2 | B1 | B2 | B3 | B4 | b1 | b2 | b3 | b4 |
 520 | 4 | D1 | D2 | D3 | D4 | d1 | d2 | d3 | d4 |
 521
 522 #+call: table-operations-combine-merge(upper-wide,lower-wide,upper-lower-wide) :colnames yes
 523
 524 #+results: table-operations-combine-merge(upper-wide,lower-wide,upper-lower-wide)
 525 | Position | c1 | c2 | c3 | c4 | t2c2 | t2c3 | t2c4 | t2c5 | t3c2 | t3c3 | t3c4 | t3c5 |
 526 |----------+----+----+----+----+------+------+------+------+------+------+------+------|
 527 |        1 | A1 | A2 | A3 | A4 |      |      |      |      |      |      |      |      |
 528 |        2 | B1 | B2 | B3 | B4 | b1   | b2   | b3   | b4   | Bb1  | Bb2  | Bb3  | Bb4  |
 529 |        3 | C1 | C2 | C3 | C4 |      |      |      |      |      |      |      |      |
 530 |        4 | D1 | D2 | D3 | D4 | d1   | d2   | d3   | d4   | Dd1  | Dd2  | Dd3  | Dd4  |
 531 |        5 |    |    |    |    | e1   | e2   | e3   | e4   |      |      |      |      |
 532 |        6 |    |    |    |    | h1   | h2   | h3   | h4   | Hh1  | Hh2  | Hh3  | Hh4  |
 533 |       10 | J1 | J2 | J3 | J4 |      |      |      |      | Jj1  | Jj2  | Jj3  | Jj4  |
 534
 535 #+call: table-operations-combine-intersect(upper-wide,lower-wide,upper-lower-wide)
 536
 537 #+results: table-operations-combine-intersect(upper-wide,lower-wide,upper-lower-wide)
 538 | 2 | B1 | B2 | B3 | B4 | b1 | b2 | b3 | b4 | Bb1 | Bb2 | Bb3 | Bb4 |
 539 | 4 | D1 | D2 | D3 | D4 | d1 | d2 | d3 | d4 | Dd1 | Dd2 | Dd3 | Dd4 |
 540
 541 **** Keeping the margins
 542
 543      (setq-default fill-column 80)
 544      (column-marker-3 80)
 545
 546