Bitmap/Histogram: Difference between revisions
Add Common Lisp implementation
m (Omit from AWK) |
(Add Common Lisp implementation) |
||
Line 246:
Which reads from the file specified from the command line and outputs to the standard out the PPM B/W version of the input image. The input image can be of any format handled by ImageMagick (see [[Read image file through a pipe]])
=={{header|Common Lisp}}==
{{libheader|opticl}}
<lang lisp>(defpackage #:histogram
(:use #:cl
#:opticl))
(in-package #:histogram)
(defun color->gray-image (image)
(check-type image 8-bit-rgb-image)
(let ((gray-image (with-image-bounds (height width) image
(make-8-bit-gray-image height width :initial-element 0))))
(do-pixels (i j) image
(multiple-value-bind (r g b) (pixel image i j)
(let ((gray (+ (* 0.2126 r) (* 0.7152 g) (* 0.0722 b))))
(setf (pixel gray-image i j) (round gray)))))
gray-image))
(defun make-histogram (image)
(check-type image 8-bit-gray-image)
(let ((histogram (make-array 256 :element-type 'fixnum :initial-element 0)))
(do-pixels (i j) image
(incf (aref histogram (pixel image i j))))
histogram))
(defun find-median (histogram)
(let* ((num-pixels (loop for count across histogram sum count))
(half (/ num-pixels 2)))
(loop for count across histogram
for i from 0
sum count into acc
when (>= acc half)
return i)))
(defun gray->black&white-image (image)
(check-type image 8-bit-gray-image)
(let* ((histogram (make-histogram image))
(median (find-median histogram))
(bw-image (with-image-bounds (height width) image
(make-8-bit-gray-image height width :initial-element 0))))
(do-pixels (i j) image
(setf (pixel bw-image i j) (if (< (pixel image i j) median) 0 255)))
bw-image))
(defun main ()
(let* ((image (read-jpeg-file "lena.jpg"))
(bw-image (gray->black&white-image (color->gray-image image))))
(write-pgm-file "lena-bw.pgm" bw-image)))</lang>
=={{header|D}}==
| |||