;;; org-babel-table-proc.el --- Common operations on tables for use with orgmode and lob

;; Copyright (C) 2010-2011
;;   Free Software Foundation, Inc.

;; Author: Marc-Oliver Ihm
;; Keywords: tables library of babel orgmode
;; Version: 0.01

;;; License:

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; Purpose:
;;  
;;  Common operations on tables for use with orgmode and lob:
;;   - simple set operations (intersection and merge)
;;   - filtering one table according to another
;; 
;;
;; Setup:
;;
;;  (require 'org-babel-table-proc)
;;
;; Further reading:
;;
;;  See the file org-babel-table-proc.org for complete examples.

;;

;;; Code:


(defun babel-table-proc-keep (t1 t2)
  "Keep only those keys from the second table, that appear within the first"
  (lob-tbl-filter 'keep t1 t2)
  )

(defun babel-table-proc-remove (t1 t2)
  "Remove those keys from the second table, that appear within the first"
  (lob-tbl-filter 'remove t1 t2)
  )

(defun lob-tbl-filter (what t1 t2)
  "Internal function to do the work of babel-table-proc-keep and -remove"
  (let (keys
        result)
    (setq keys (mapcar 'car t1))
    (dolist (line t2) 
      (if (equal (member (car line) keys)
                 (equal what 'keep))
          (setq result (cons line result))
        )
      )
    (nreverse result)
    )
)

(defun babel-table-proc-merge (&rest tables)
  "Merge two tables by first column; sort the result"
  (babel-table-proc-two-tables-to-one 'merge tables))

(defun babel-table-proc-intersect (&rest tables)
  "Intersect two tables by first column; sort the result"
  (babel-table-proc-two-tables-to-one 'intersect tables))

(defun babel-table-proc-two-tables-to-one (what tables)
  "Internal function to do the work of babel-table-proc-merge and -intersect"
  (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
        current-key-in-intersection
        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)
             (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)
    )
  )

(provide 'org-babel-table-proc)