org-contrib/ob-table-operations.org

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