 # 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.
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 " ")