removed org-refer-by-number.el
[worg.git] / 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