lisp で DCT

http://www.thoughtstuff.com/rme/lisp.html
とか
http://www.ice.gunma-ct.ac.jp/~tsurumi/courses/ImagePro/DCT/2D_DCT.htm
とかを参考につくる。
まぁ自分のプログラム、これじゃ性能は出ないね。

(defun make-block8 (&optional (elm 0))
  (make-array '(8 8) :initial-element elm))

(defun dct-value (x y u v)
  (*
    (cos (/ (* (+ (* 2 x) 1) u pi) 16))
    (cos (/ (* (+ (* 2 y) 1) v pi) 16))))

(defun ndct-one (block8 x y value)
  (do ((u 0 (+ u 1)))
    ((= u 8))

    (do ((v 0 (+ v 1)))
      ((= v 8))

      (incf
        (aref block8 u v)
        (* value (dct-value x y u v)))))
  block8)

(defun cx (n)
  (if (= 0 n) (/ 1 (sqrt 2)) 1))

(defun post-all-dct (block8)
  (do ((u 0 (+ u 1)))
    ((= u 8))

    (do ((v 0 (+ v 1)))
      ((= v 8))

      (let ((cu (cx u))
            (cv (cx v)))

        (setf (aref block8 u v)
              (ceiling
                (* cu cv (/ 1 4)
                   (aref block8 u v))))))))

(defun dct (block8)
  (let ((rv (make-block8)))
    (do ((x 0 (+ x 1)))
      ((= x 8))

      (do ((y 0 (+ y 1)))
        ((= y 8))

        (ndct-one rv x y (aref block8 x y))
        ;(format t "~a~%" (aref rv 0 0))
        ))
    (post-all-dct rv)
    rv))

(defun nqunt (block8a block8b)
  (do ((x 0 (+ x 1)))
    ((= x 8))

    (do ((y 0 (+ y 1)))
      ((= y 8))

     (setf (aref block8a x y)
           (floor
           (/ (aref block8a x y)
              (aref block8b x y))))))
  block8a)

(setf m (make-array '(8 8) :initial-element 0))
(ndct-one m 0 0 16)
(ndct-one m 1 0 11)
;(format t "~a~%" m)

(setf m (make-array '(8 8) :initial-contents
         '((192 192 128 128 192 192 128 128 )
                 (192 192 128 128 192 192 128 128 )
                 (128 128 192 192 128 128 192 192 )
                 (128 128 192 192 128 128 192 192 )
                 (192 192 128 128 192 192 128 128 )
                 (192 192 128 128 192 192 128 128 )
                 (128 128 192 192 128 128 192 192 )
                 (128 128 192 192 128 128 192 192 ))))

(setf q (make-array '(8 8) :initial-contents
                    '((16 11 10 16 24 40 51 61)
                      (12 12 14 19 26 58 60 55)
                      (14 13 16 24 40 57 69 56)
                      (14 17 22 29 51 87 80 62)
                      (18 22 37 56 68 109 103 77)
                      (24 35 55 64 81 104 113 92)
                      (49 64 78 87 103 121 120 101)
                      (72 92 95 98 112 100 103 99))))

(format t "~s~%" (dct m))

dotimes を使うともう少しプログラムが小さくなるか、、、