dash.el
dash.el copied to clipboard
magnars
Partition-by-column function
I was writing a function to divide a list into columns, but -partition-all fills rows before columns, while I wanted columns filled first. So I came up with this:
(defun ap/partition-by-column2 (list columns)
"Partition LIST into COLUMNS columns.
Unlike some partition functions, columns are filled before rows.
If COLUMNS is more than can be evenly filled, the appropriate
smaller number will be used (for example, with a list of 8 items,
if 5 columns were specified, 4 columns will actually be used."
(let* ((length (length list))
(num-rows (+ (/ length columns)
(pcase (% length columns)
(0 0)
(_ 1))))
(calculated-columns (/ length num-rows))
(num-last-row-items (% length num-rows))
(difference (- columns num-last-row-items)))
(when (and (> columns calculated-columns)
(> difference 1))
(setq columns calculated-columns))
(->> list
(-partition-all num-rows)
(apply #'-interleave2)
(-partition-all columns)
(mapcar #'-non-nil))))
(defun -interleave2 (&rest lists)
"Return a new list of the first item in each list, then the second etc.
Note: unlike `-interleave', this does not discard lists that have
a `nil' element."
(declare (pure t) (side-effect-free t))
(when lists
(let (result)
(while (--some? (not (null it)) lists)
(--each lists (when (--some? (not (null it)) it)
(!cons (car it) result)))
(setq lists (-map 'cdr lists)))
(nreverse result))))
Used like:
(cl-loop with list = (list 1 2 3 4 5 6 7 8)
for columns from 1 to 8
collect (a-list 'columns columns
(ap/partition-by-column2 list columns)))
;; =>
;; (((columns . 1) (((1)
;; (2)
;; (3)
;; (4)
;; (5)
;; (6)
;; (7)
;; (8))))
;; ((columns . 2) (((1 5)
;; (2 6)
;; (3 7)
;; (4 8))))
;; ((columns . 3) (((1 4 7)
;; (2 5 8)
;; (3 6))))
;; ((columns . 4) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 5) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 6) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 7) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 8) (((1 2 3 4 5 6 7 8)))))
Note that I had to make a second version of -interleave, because -interleave discards lists that contain nil, which in this case means lists created by -partition-all that contain fewer than the desired number of elements--which means that if the last list returned by -partition-all has fewer elements than the other lists it returns, -interleave drops it. (Is this a bug in -interleave? Or should it at least be documented?)
Before I got this version working with -partition-all and -interleave2, I came up with a cl-loop version, which is somewhat faster:
(defun ap/partition-by-column (list columns)
"Partition LIST into COLUMNS columns.
Unlike some partition functions, columns are filled before rows.
If COLUMNS is more than can be evenly filled, the appropriate
smaller number will be used (for example, with a list of 8 items,
if 5 columns were specified, 4 columns will actually be used."
(cl-loop with length = (length list)
with num-rows = (+ (/ length columns)
(pcase (% length columns)
(0 0)
(_ 1)))
with result = (-repeat num-rows nil)
with row = 0
with col = 0
for elem = (pop list)
while elem
do (progn
(push elem (nth row result))
(incf row)
(when (= row num-rows)
(setq row 0)
(incf col)))
finally return (mapcar #'nreverse result)))
Used like:
(cl-loop with list = (list 1 2 3 4 5 6 7 8)
for columns from 1 to 8
collect (a-list 'columns columns
(ap/partition-by-column list columns)))
;; =>
;; (((columns . 1) (((1)
;; (2)
;; (3)
;; (4)
;; (5)
;; (6)
;; (7)
;; (8))))
;; ((columns . 2) (((1 5)
;; (2 6)
;; (3 7)
;; (4 8))))
;; ((columns . 3) (((1 4 7)
;; (2 5 8)
;; (3 6))))
;; ((columns . 4) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 5) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 6) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 7) (((1 3 5 7)
;; (2 4 6 8))))
;; ((columns . 8) (((1 2 3 4 5 6 7 8)))))
I benchmarked them by evaluating calls to this macro in an Org source block:
(cl-defmacro bench (&optional (times 100000) &rest body)
(declare (indent defun))
`(list '("Total runtime" "# of GCs" "Total GC runtime")
'hline
(benchmark-run-compiled ,times
(progn
,@body))))
(bench 1000000
(ap/partition-by-column '(1 2 3 4 5 6 7 8) 2))
#+RESULTS:
| Total runtime | # of GCs | Total GC runtime |
|---------------+----------+-------------------|
| 15.368093641 | 6 | 5.259181951999835 |
(bench 1000000
(ap/partition-by-column2 '(1 2 3 4 5 6 7 8) 2))
#+RESULTS:
| Total runtime | # of GCs | Total GC runtime |
|---------------+----------+-------------------|
| 21.046039133 | 15 | 13.04518886599999 |
As you can see, the -interleave-using version causes a lot more GC, but the code is a bit simpler.
If one of these would be useful in Dash, I'd be glad to send a PR.
Can we do this with partition and transpose? This gets me pretty far
(apply '-zip-fill nil (-partition-all 3 '(1 2 3 4 5 6 7 8)))
Well, on closer examination, it doesn't give the same results:
(cl-loop with list = (list 1 2 3 4 5 6 7 8)
for columns from 1 to 8
collect (a-list 'columns columns
'output (apply '-zip-fill nil (-partition-all columns list))))
;; =>
;; (((columns . 1) (output (1 2 3 4 5 6 7 8)))
;; ((columns . 2) (output (1 3 5 7)
;; (2 4 6 8)))
;; ((columns . 3) (output (1 4 7)
;; (2 5 8)
;; (3 6 nil)))
;; ((columns . 4) (output (1 . 5)
;; (2 . 6)
;; (3 . 7)
;; (4 . 8)))
;; ((columns . 5) (output (1 . 6)
;; (2 . 7)
;; (3 . 8)
;; (4)
;; (5)))
;; ((columns . 6) (output (1 . 7)
;; (2 . 8)
;; (3)
;; (4)
;; (5)
;; (6)))
;; ((columns . 7) (output (1 . 8)
;; (2)
;; (3)
;; (4)
;; (5)
;; (6)
;; (7)))
;; ((columns . 8) (output (1)
;; (2)
;; (3)
;; (4)
;; (5)
;; (6)
;; (7)
;; (8))))
Yea, I said pretty far not to the end :D I was hoping that the zip would not cons if there are just two items, but it is done so to be compatible with the -zip variant. I did not think of that :/
This is quite annoying and we wanted to change it for a long time now. I think we will have to bite the bullet some day and just go ahead with the change.
The nil is also annoying, but that can be fixed somehow probably.