Guest User

Align matrix

a guest
Aug 25th, 2015
130
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (defun my/string-to-number (line re)
  2.   (let ((matched (string-match re line)))
  3.     (if matched
  4.         (list (match-string 0 line)
  5.               (substring line (length (match-string 0 line))))
  6.       (list nil line))))
  7.  
  8. (defun my/string-to-double (line)
  9.   (my/string-to-number
  10.    line
  11.    "\\s-*[+-]?[0-9]+\\(?:\\.[0-9]+\\(?:[eE][+-]?[0-9]+\\)?\\)?"))
  12.  
  13. (defun my/string-to-int (line)
  14.   (my/string-to-number line "\\s-*[+-]?[0-9]+"))
  15.  
  16. (defun my/vector-transpose (vec)
  17.   (cl-coerce
  18.    (cl-loop for i below (length (aref vec 0))
  19.             collect (cl-coerce
  20.                      (cl-loop for j below (length vec)
  21.                               collect (aref (aref vec j) i))
  22.                      'vector))
  23.    'vector))
  24.  
  25. (defun my/align-metric (col num-parser)
  26.   (cl-loop with max-left = 0
  27.            with max-right = 0
  28.            with decimal = 0
  29.            for cell across col
  30.            for nump = (car (funcall num-parser cell))
  31.            for has-decimals = (cl-position ?\. cell) do
  32.            (if nump
  33.                (if has-decimals
  34.                    (progn
  35.                      (setf decimal 1)
  36.                      (when (> has-decimals max-left)
  37.                        (setf max-left has-decimals))
  38.                      (when (> (1- (- (length cell) has-decimals))
  39.                               max-right)
  40.                        (setf max-right (1- (- (length cell) has-decimals)))))
  41.                  (when (> (length cell) max-left)
  42.                    (setf max-left (length cell))))
  43.              (when (> (length cell) max-left)
  44.                (setf max-left (length cell))))
  45.            finally (cl-return (list max-left decimal max-right))))
  46.  
  47. (defun my/print-matrix (rows metrics num-parser prefix spacer)
  48.   (cl-loop with first-line = t
  49.            for i upfrom 0
  50.            for row across rows do
  51.            (unless first-line (insert prefix))
  52.            (setf first-line nil)
  53.            (cl-loop with first-row = t
  54.                     for cell across row
  55.                     for metric in metrics
  56.                     for has-decimals =
  57.                     (and (cl-position ?\. cell)
  58.                          (car (funcall num-parser cell)))
  59.                     do
  60.                     (unless first-row (insert spacer))
  61.                     (setf first-row nil)
  62.                     (cl-destructuring-bind (left decimal right) metric
  63.                       (if has-decimals
  64.                           (cl-destructuring-bind (whole fraction)
  65.                               (split-string cell "\\.")
  66.                             (insert (make-string (- left (length whole)) ?\ )
  67.                                     whole
  68.                                     "."
  69.                                     fraction
  70.                                     (make-string (- right (length fraction)) ?\ )))
  71.                         (insert (make-string (- left (length cell)) ?\ )
  72.                                 cell
  73.                                 (make-string (1+ right) ?\ )))))
  74.            (unless (= i (1- (length rows)))
  75.              (insert "\n"))))
  76.  
  77. (defun my/read-rows (beg end)
  78.   (cl-coerce
  79.    (cl-loop for line in (split-string
  80.                          (buffer-substring-no-properties beg end) "\n")
  81.             collect
  82.             (cl-coerce
  83.              (nreverse
  84.               (cl-loop with result = nil
  85.                        with remaining = line do
  86.                        (cl-destructuring-bind (num remainder)
  87.                            (funcall num-parser remaining)
  88.                          (if num
  89.                              (progn
  90.                                (push (org-trim num) result)
  91.                                (setf remaining remainder))
  92.                            (push (org-trim remaining) result)
  93.                            (cl-return result)))))
  94.              'vector))
  95.    'vector))
  96.  
  97. (defun my/align-matrix (parser)
  98.   (interactive "SParse numbers using: ")
  99.   (let ((num-parser
  100.          (cl-case parser
  101.            (:double 'my/string-to-double)
  102.            (:int 'my/string-to-int)
  103.            (otherwise
  104.             (if (functionp parser)
  105.                 parser
  106.               'my/string-to-number))))
  107.         beg end)
  108.     (if (region-active-p)
  109.         (setf beg (region-beginning)
  110.               end (region-end))
  111.       (setf end (1- (search-forward-regexp "\\s)" nil t))
  112.             beg (1+ (progn (backward-sexp) (point)))))
  113.     (goto-char beg)
  114.     (let* ((prefix (make-string (current-column) ?\ ))
  115.            (spacer " ")
  116.            (rows (my/read-rows beg end))
  117.            (cols (my/vector-transpose rows))
  118.            (metrics
  119.             (cl-loop for col across cols
  120.                      collect (my/align-metric col num-parser))))
  121.       (delete-region beg end)
  122.       (my/print-matrix rows metrics num-parser prefix spacer))))
RAW Paste Data