?The big difference in transpose-pg is that it cons very little, only one row of the matrix.
?The algorithm is about changing pointers in the original matrix to get the tranpose.
?A benchmark using sbcl outside of maxima. The file has been? compiled.
CL-USER> (progn (setq l2 (copy-tree (setq l1 (a-matrix 1000 1000)))) nil)
NIL
CL-USER> (time (progn (transpose-wb l1) 'done))
Evaluation took:
? 0.184 seconds of real time
? 0.190000 seconds of total run time (0.130000 user, 0.060000 system)
? [ Run times consist of 0.140 seconds GC time, and 0.050 seconds non-GC time. ]
? 103.26% CPU
? 431,324,341 processor cycles
? 32,046,400 bytes consed
?
DONE
CL-USER> (time (progn (transpose-pg l2) 'done))
Evaluation took:
? 0.028 seconds of real time
? 0.030000 seconds of total run time (0.020000 user, 0.010000 system)
? 107.14% CPU
? 67,007,521 processor cycles
? 16,384 bytes consed
?
--------------------------
(defvar l1 nil)
(defvar l2 nil)
(defun transpose-pg(m)
? (let (m1)
??? (setq m1 (loop for x on (car m) collect x))
??? (transposeaux m)
??? m1))
?? ??? ?
(defun transposeaux(ll)
? (let (next)
??? (loop for l1 in ll
?????? for l2 in (cdr ll) do
?? ??? (loop for ai = l1 then next
?? ?????? for bi on l2 do
?? ??? ?(setf next (cdr ai))
?? ??? ?(rplacd ai bi))
?? ? finally
?? ??? (loop for bi = l2 then next
?? ??? ?while (cdr bi) do
?? ??? ?(setf next (cdr bi)
?? ??? ?????? (cdr bi) nil)))?? ???? ?
??? ll))
(defun a-matrix(i j)
? "construct a rectangular matrix"
? (loop repeat i collect
?????? (loop repeat j collect (random 20))))
(defun transpose-wb (ll)
? (let ((acc nil))
??? (loop while (car ll) do
????? (push (mapcar #'car ll) acc)
????? (setq ll (mapcar #'cdr ll)))
??? (nreverse acc)))