Renversant?

I decided to name this code snippet after the french term for reversing because this algorithm does just that. It iterates through the perimeter of the array, extracts the anti-diagonal "(-1,1) direction" and reverses that list. Then it simply asigns it back to the same array.


Little idea extracted from an exercise of "Programming pearls"


The program reads:



;example of array transposition based on rotations
;The method consists of the following: we reverse each of the anti-diagonal arrays
;first we have to extract and re assign each of the elements

(setq arr (make-array '(11 11)))

;initialise the array
(dotimes (i (array-dimension arr 0))
(dotimes (j (array-dimension arr 1))
(setf (aref arr i j ) (+ (* i (array-dimension arr 0 )) j) )
)
)

;utility method for computing the sum of the elements in a list
(defun sum(in)
(setq temp 0)
(loop for item in in do
(setq temp (+ temp item))
)
(setq sum temp)
)

;utility for working out the first co-ordinate of the diagonal
(defun next-diag(pos dim)
(setq x (car pos))
(setq y (cadr pos))
(cond
((eq dim x)
(setq y (+ y 1 ))
)
((eq dim x)
(setq x (- x 1))
)
)
(cond
((eq y 0)(setq x (+ x 1)))
((eq y 0)(setq y (+ y 1)))
)
(setq pos (list x y))
(setq next-diag pos)
)

;method extracting the contents of an anti-diagonal of the array
;starting at the specified co-ordinates
(defun extract-diagonal(pos data)
(setq x (car pos))
(setq y (cadr pos))
(setq temp(list (aref data x y)))
(loop while(and (> x 0) (< y (- (array-dimension data 1) 1))) do
(setq x (- x 1))
(setq y (+ 1 y))
(setq temp (append temp (list (aref data x y )) ) )
)
(setq extract-diagonal temp)
)
(defun insert-diagonal(pos data diagonal)
(setq x (car pos))
(setq y (cadr pos))
(dolist (k diagonal)
(setf (aref data x y) k )
(setq x (- x 1))
(setq y (+ 1 y))
)
)

(defun transpose(data)
(setq xdim (- (array-dimension data 0) 1))
(cond
((evenp xdim)(setq modif 2))
((oddp xdim)(setq modif 3))
)
(setq numdiag (- (sum (array-dimensions data)) modif ))
(setq diagpos '(0 0))
(dotimes (i numdiag)
(setq diagpos (next-diag diagpos xdim))
;step one extract the diagonal to a list
(setq diagonal (extract-diagonal diagpos data))
;step two reverse
(setq diagonal(reverse diagonal))
(print diagonal)
;step three profit ;-)
(insert-diagonal diagpos data diagonal)
)
)

(print 'Before )
(print arr)
(print 'transpose)
(transpose arr)
(print 'After )
(print arr)


Program output is also very pretty:


prozak@Mistral:~/Exploration/lisp/pearls%clisp transpose.lisp

BEFORE
#2A((0 1 2 3 4 5 6 7 8 9 10)
(11 12 13 14 15 16 17 18 19 20 21)
(22 23 24 25 26 27 28 29 30 31 32)
(33 34 35 36 37 38 39 40 41 42 43)
(44 45 46 47 48 49 50 51 52 53 54)
(55 56 57 58 59 60 61 62 63 64 65)
(66 67 68 69 70 71 72 73 74 75 76)
(77 78 79 80 81 82 83 84 85 86 87)
(88 89 90 91 92 93 94 95 96 97 98)
(99 100 101 102 103 104 105 106 107 108 109)
(110 111 112 113 114 115 116 117 118 119 120))
TRANSPOSE
(1 11)
(2 12 22)
(3 13 23 33)
(4 14 24 34 44)
(5 15 25 35 45 55)
(6 16 26 36 46 56 66)
(7 17 27 37 47 57 67 77)
(8 18 28 38 48 58 68 78 88)
(9 19 29 39 49 59 69 79 89 99)
(10 20 30 40 50 60 70 80 90 100 110)
(21 31 41 51 61 71 81 91 101 111)
(32 42 52 62 72 82 92 102 112)
(43 53 63 73 83 93 103 113)
(54 64 74 84 94 104 114)
(65 75 85 95 105 115)
(76 86 96 106 116)
(87 97 107 117)
(98 108 118)
(109 119)
(120)
AFTER
#2A((0 11 22 33 44 55 66 77 88 99 110)
(1 12 23 34 45 56 67 78 89 100 111)
(2 13 24 35 46 57 68 79 90 101 112)
(3 14 25 36 47 58 69 80 91 102 113)
(4 15 26 37 48 59 70 81 92 103 114)
(5 16 27 38 49 60 71 82 93 104 115)
(6 17 28 39 50 61 72 83 94 105 116)
(7 18 29 40 51 62 73 84 95 106 117)
(8 19 30 41 52 63 74 85 96 107 118)
(9 20 31 42 53 64 75 86 97 108 119)
(10 21 32 43 54 65 76 87 98 109 120))

This is the sort of algorithm that may be handy if you have little memory and need to do everything in place, there is no need for a second array making things easy on the memory side of things.