emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Marc-Oliver Ihm <marc-oliver.ihm@online.de>
To: Eric Schulte <eric.schulte@gmx.com>
Cc: emacs-orgmode@gnu.org
Subject: Re: [babel] Code for simple set-operations on two tables. Asking for some input.
Date: Sat, 14 Jan 2012 10:27:42 +0100	[thread overview]
Message-ID: <4F114A8E.8070200@online.de> (raw)
In-Reply-To: <87sjk5ka7s.fsf@gmx.com>

[-- Attachment #1: Type: text/plain, Size: 688 bytes --]

Hello,

please find attached an early draft of lob-table-operations.org.

It already has a reasonable documentation and working examples, so it should be easy to play with.

Some features are still missing (e.g. handling of column names and hlines)
and the coding needs some improvement (using the cl-package ?).
So it is probably not yet fit for official inclusion into the library of babel.

with kind regards,
Marc-Oliver Ihm

As a side note: I am very pleased and fascinated, how easily babel and org have made the task of keeping together
all aspects of development; from user documentation to implementation and (of course !) organisation.

This has made my coding even more fun !


[-- Attachment #2: lob-table-operations.org --]
[-- Type: text/plain, Size: 11584 bytes --]


* Table Operations
  :PROPERTIES:
  :ID:       1f8371eb-65e8-416d-ac22-b77431a7df3f
  :END:

** Documentation
   :PROPERTIES:
   :ID:       90a0c9e2-6092-492e-bd4b-c1c737087ac5
   :END:

*** Introduction

    This section within the library of babel implements some simple operations, that act on
    one or more tables to produce other tables.
    
    The known operations are grouped in two categories:
    
    - Filtering the rows of a single table
    - Merging two tables into one
     
*** Example tables

    To demonstrate we need three tables: upper, lower and keys.

    Please note, that column-names are currently not supported !

#+name: upper
|  1 | A |
|  3 | C |
|  4 | D |
| 10 | J |
|  2 | B |

#+name: lower
| 2 | b |
| 4 | d |
| 5 | e |
| 6 | h |

#+name: keys
| 1 |
| 2 |
| 4 |

    The tables upper and lower both have two columns and associate a numerical position
    within the alphabet with the matching letter. E.g. the row "| 1 | A |" within table
    upper, just states that the letter "A" comes at position 1 within the alphabet.

    Nearly the same is true for table lower, only that it contains lower case letters only
    and deliberatly not quite the same ones as table upper.

    The table keys finally, contains keys (i.e. positions within the alphabet), that can be
    used to select rows from either table upper or lower.

*** Filtering a table

**** Keeping rows

     Let's say, we want to select the upper-case letters (i.e. rows from the table upper),
     that are given in table keys (i.e. the first, second and fourth letter).

     This can be described as filtering table upper and keeping only those rows, that are
     specified in table keys.

     As a babel-call, this reads:

#+call: table-operations-filter-keep(upper,keys)

#+results: table-operations-filter-keep(upper,keys)
| 1 | A |
| 4 | D |
| 2 | B |

     Which gives exactly those rows from table upper, that are specified in keys.

**** Removing rows

     Now if on the contrary you want to filter table upper to remove any rows, which are given
     in table keys:

#+call: table-operations-filter-remove(upper,keys)

#+results: table-operations-filter-remove(upper,keys)
|  3 | C |
| 10 | J |

*** Combining tables

    Now, if we have a look at tables upper and lower (and drop table keys for the moment),
    it comes to combining tables.

    (Here we only look at combining two tables for simplicity, however, all examples can
    be easily scaled up to seven tables.)

**** Merging rows

     We have two table, one with upper-case letter and one with lower-case. What now if you
     want to have only one table, which contains both, upper- and lower-case ?
     
     Probably you want to merge them:

#+call: table-operations-combine-merge(upper,lower)

#+results: table-operations-combine-merge(upper,lower)
|  1 | A |   |
|  2 | B | b |
|  3 | C |   |
|  4 | D | d |
|  5 |   | e |
|  6 |   | h |
| 10 | J |   |

     This results-table combines both upper- and lower-case letters and lists them by
     their position within the alphabet.

     Speaking more abstract, the result is a single table. Its rows are gained by
     combining rows from tables upper and lower with the same key.

**** Intersecting rows

     If you only want the rows, that are complete (i.e. have both lower- and upper-case
     letters, you should compute the intersection:

#+call: table-operations-combine-intersect(upper,lower)

#+results: table-operations-combine-intersect(upper,lower)
| 2 | B | b |
| 4 | D | d |

     which has only those keys, that apear in both tables.

** Internals

   This section is not required reading for normal users of these table operations. Only
   if you are curious about its implementation or development, you might want to have a
   look.

*** Implementation
   
   Here is the actual lisp code, that implements the functionality of [[id:1f8371eb-65e8-416d-ac22-b77431a7df3f][Table Operations]].

**** table-operations-filter
***** Directly callable blocks

#+name: table-operations-filter-keep
#+begin_src emacs-lisp :noweb yes :var table=() :var filter=() 
<<lob-table-operations-filter-defun>>
(lob-table-operations-filter 'keep table filter)
#+end_src

#+name: table-operations-filter-remove
#+begin_src emacs-lisp :noweb yes :var table=() :var filter=() 
  <<lob-table-operations-filter-defun>>
  (lob-table-operations-filter 'remove table filter)
#+end_src

***** Included defuns

#+name: lob-table-operations-filter-defun
#+begin_src emacs-lisp
  (defun lob-table-operations-filter (what table filter)
    "Internal function for table-operations in orgmodes library of babel"
    (let (keys
          result)
      (setq keys (mapcar 'car filter))
      (dolist (line table) 
        (if (equal (not (not (member (car line) keys)))
                   (equal what 'keep))
            (setq result (cons line result))
          )
        )
      (nreverse result)
      )
    )
#+end_src

**** table-operations-combine
***** Directly callable blocks

#+name: table-operations-combine-merge 
#+begin_src emacs-lisp :noweb yes :var t1=() :var t2=() :var t3=() :var t4=() :var t5=() :var t6=() :var t7=()
  <<lob-table-operations-combine-defun>>
  (let ((tables (list t1 t2 t3 t4 t5 t6 t7)))
  (lob-table-operations-combine 'merge tables)
  )
#+end_src

#+name: table-operations-combine-intersect
#+begin_src emacs-lisp :noweb yes :var t1=() :var t2=() :var t3=() :var t4=() :var t5=() :var t6=() :var t7=()
  <<lob-table-operations-combine-defun>>
  (let ((tables (list t1 t2 t3 t4 t5 t6 t7)))
    (lob-table-operations-combine 'intersect tables)
    )
#+end_src

***** Included defuns

#+name: lob-table-operations-combine-defun
#+begin_src emacs-lisp
  (defun lob-table-operations-combine (what tables)
    "Internal function for table-operations in orgmode library of babel"
    (let (is-all-numbers          
          less-than-function 
          equal-function
          conversion-function
          format-specifier
          rest-of-tables
          rests-of-tables
          rest-of-rests-of-tables
          rest-of-table
          widths-of-tables
          current-key
          current-key-in-intersection
          result-table
          result-line
          i
          )
  
      ;; remove possible empty trailing tables
      (setq rest-of-tables tables)
      (while (cadr rest-of-tables) (setq rest-of-tables (cdr rest-of-tables)))
      (setcdr rest-of-tables nil)
  
      ;; 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)
               (setq current-key-in-intersection 't)
               (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 
                       (setq current-key-in-intersection nil)
                       (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 
                   )
            )
          (if (or (eq what 'merge) current-key-in-intersection)
              (setq result-table (cons result-line result-table)) ; store away line
            )
          )
        )
      (nreverse result-table)
      )
    )
#+end_src

: lob-table-operations-combine

**** Debugging and testing
***** Clean up
#+begin_src emacs-lisp
  (save-excursion
    (beginning-of-buffer)
    (while (re-search-forward "^#\\+results:.*\n\\(^\|.+\n\\)*\n" nil t)
      (replace-match ""))
    )
#+end_src

#+results:

***** Byte Compilation

   (byte-compile 'lob-table-operations-combine)
   (byte-compile 'lob-table-operations-filter)

*** Development
**** Versions and history

     - [2012-01-07 Sa] Version 0.01 which comes as a single org-file (no special .el-file
       needed any more). Combines and restructures documentation and implementation.

**** Bugs and Todos

     - [ ] Brush up documentation
     - [ ] Tests with more than two columns per table
     - [ ] Tests with more than two tables for merging
     - [ ] Handle optional table captions
     - [ ] Handle hlines
     - [ ] Error messages as result of block
     - [ ] Restructure code to make use of cl 

  parent reply	other threads:[~2012-01-14  9:27 UTC|newest]

Thread overview: 5+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2011-12-26 11:00 [babel] Code for simple set-operations on two tables. Asking for some input Marc-Oliver Ihm
2011-12-27 20:53 ` Eric Schulte
2011-12-28  8:56   ` Marc-Oliver Ihm
2012-01-14  9:27   ` Marc-Oliver Ihm [this message]
2012-01-15 16:10     ` Eric Schulte

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=4F114A8E.8070200@online.de \
    --to=marc-oliver.ihm@online.de \
    --cc=emacs-orgmode@gnu.org \
    --cc=eric.schulte@gmx.com \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).