Bitmap/Histogram

From Rosetta Code
Task
Bitmap/Histogram
You are encouraged to solve this task according to the task description, using any language you may know.

Extend the basic bitmap storage defined on this page to support dealing with image histograms. The image histogram contains for each luminance the count of image pixels having this luminance. Choosing a histogram representation take care about the data type used for the counts. It must have range of at least 0..NxM, where N is the image width and M is the image height.

Test task

Histogram is useful for many image processing operations. As an example, use it to convert an image into black and white art. The method works as follows:

  • Convert image to grayscale;
  • Compute the histogram
  • Find the median: defined as the luminance such that the image has an approximately equal number of pixels with lesser and greater luminance.
  • Replace each pixel of luminance lesser than the median to black, and others to white.

Use read/write ppm file, and grayscale image solutions.

Ada[edit]

Histogram of an image:

type Pixel_Count is mod 2**64;
type Histogram is array (Luminance) of Pixel_Count;
 
function Get_Histogram (Picture : Grayscale_Image) return Histogram is
Result : Histogram := (others => 0);
begin
for I in Picture'Range (1) loop
for J in Picture'Range (2) loop
declare
Count : Pixel_Count renames Result (Picture (I, J));
begin
Count := Count + 1;
end;
end loop;
end loop;
return Result;
end Get_Histogram;

Median of a histogram:

function Median (H : Histogram) return Luminance is
From  : Luminance  := Luminance'First;
To  : Luminance  := Luminance'Last;
Left  : Pixel_Count := H (From);
Right : Pixel_Count := H (To);
begin
while From /= To loop
if Left < Right then
From := From + 1;
Left := Left + H (From);
else
To  := To - 1;
Right := Right + H (To);
end if;
end loop;
return From;
end Median;

Conversion of an image to black and white art:

   F1, F2 : File_Type;
begin
Open (F1, In_File, "city.ppm");
declare
X : Image := Get_PPM (F1);
Y : Grayscale_Image := Grayscale (X);
T : Luminance := Median (Get_Histogram (Y));
begin
Close (F1);
Create (F2, Out_File, "city_art.ppm");
for I in Y'Range (1) loop
for J in Y'Range (2) loop
if Y (I, J) < T then
X (I, J) := Black;
else
X (I, J) := White;
end if;
end loop;
end loop;
Put_PPM (F2, X);
end;
Close (F2);

BBC BASIC[edit]

Greyscale bbc.jpg
Histogram bbc.gif
      INSTALL @lib$+"SORTLIB"
Sort% = FN_sortinit(0,0)
 
Width% = 200
Height% = 200
 
VDU 23,22,Width%;Height%;8,16,16,128
*display c:\lenagrey
 
DIM hist%(255), idx%(255)
FOR i% = 0 TO 255 : idx%(i%) = i% : NEXT
 
REM Build histogram:
FOR y% = 0 TO Height%-1
FOR x% = 0 TO Width%-1
l% = FNgetpixel(x%,y%) AND &FF
hist%(l%) += 1
NEXT
NEXT y%
 
REM Sort histogram:
C% = 256
CALL Sort%, hist%(0), idx%(0)
 
REM Find median:
total% = SUM(hist%())
half% = 0
FOR i% = 0 TO 255
half% += hist%(i%)
IF half% >= total%/2 THEN
median% = idx%(i%)
EXIT FOR
ENDIF
NEXT
 
REM Display black & white version:
FOR y% = 0 TO Height%-1
FOR x% = 0 TO Width%-1
l% = FNgetpixel(x%,y%) AND &FF
IF l% > median% THEN
PROCsetpixel(x%,y%,255,255,255)
ELSE
PROCsetpixel(x%,y%,0,0,0)
ENDIF
NEXT
NEXT y%
END
 
DEF PROCsetpixel(x%,y%,r%,g%,b%)
COLOUR 1,r%,g%,b%
GCOL 1
LINE x%*2,y%*2,x%*2,y%*2
ENDPROC
 
DEF FNgetpixel(x%,y%)
LOCAL col%
col% = TINT(x%*2,y%*2)
SWAP ?^col%,?(^col%+2)
= col%

C[edit]

typedef unsigned int histogram_t;
typedef histogram_t *histogram;
 
#define GET_LUM(IMG, X, Y) ( (IMG)->buf[ (Y) * (IMG)->width + (X)][0] )
 
histogram get_histogram(grayimage im);
luminance histogram_median(histogram h);
histogram get_histogram(grayimage im)
{
histogram t;
unsigned int x, y;
 
if ( im == NULL ) return NULL;
t = malloc( sizeof(histogram_t)*256 );
memset(t, 0, sizeof(histogram_t)*256 );
if (t!=NULL)
{
for(x=0; x < im->width; x++ )
{
for(y=0; y < im->height; y++ )
{
t[ GET_LUM(im, x, y) ]++;
}
}
}
return t;
}

The given histogram must be freed with a simple free(histogram).

Translation of: Ada
luminance histogram_median(histogram h)
{
luminance From, To;
unsigned int Left, Right;
 
From = 0; To = (1 << (8*sizeof(luminance)))-1;
Left = h[From]; Right = h[To];
 
while( From != To )
{
if ( Left < Right )
{
From++; Left += h[From];
} else {
To--; Right += h[To];
}
}
return From;
}

An example of usage is the following code.

#include <stdio.h>
#include <stdlib.h>
#include "imglib.h"
 
/* usage example */
 
#define BLACK 0,0,0
#define WHITE 255,255,255
 
int main(int argc, char **argv)
{
image color_img;
grayimage g_img;
histogram h;
luminance T;
unsigned int x, y;
 
if ( argc < 2 )
{
fprintf(stderr, "histogram FILE\n");
exit(1);
}
color_img = read_image(argv[1]);
if ( color_img == NULL ) exit(1);
g_img = tograyscale(color_img);
h = get_histogram(g_img);
if ( h != NULL )
{
T = histogram_median(h);
 
for(x=0; x < g_img->width; x++)
{
for(y=0; y < g_img->height; y++)
{
if ( GET_LUM(g_img,x,y) < T )
{
put_pixel_unsafe(color_img, x, y, BLACK);
} else {
put_pixel_unsafe(color_img, x, y, WHITE);
}
}
}
output_ppm(stdout, color_img);
/* print_jpg(color_img, 90); */
free(h);
}
 
free_img((image)g_img);
free_img(color_img);
}

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)

Common Lisp[edit]

Library: opticl
(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)
(loop with num-pixels = (loop for count across histogram sum count)
with half = (/ num-pixels 2)
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-1-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) 1 0)))
bw-image))
 
(defun main ()
(let* ((image (read-jpeg-file "lenna.jpg"))
(bw-image (gray->black&white-image (color->gray-image image))))
(write-pbm-file "lenna-bw.pbm" bw-image)))

D[edit]

Translation of: Ada

It uses the grayscale_image from the Grayscale image Task. The loaded frog image is from the Color quantization Task.

import grayscale_image;
 
Color findSingleChannelMedian(Color)(in Image!Color img)
pure nothrow @nogc if (Color.tupleof.length == 1) // Hack.
in {
assert(img !is null);
} body {
size_t[Color.max + 1] hist;
foreach (immutable c; img.image)
hist[c]++;
 
// Slower indexes, but not significantly so.
auto from = Color(0);
auto to = Color(hist.length - 1);
 
auto left = hist[from];
auto right = hist[to];
 
while (from != to)
if (left < right) {
from++;
left += hist[from];
} else {
to--;
right += hist[to];
}
 
return from;
}
 
Image!Color binarizeInPlace(Color)(Image!Color img,
in Color thresh)
pure nothrow @nogc in {
assert(img !is null);
} body {
foreach (immutable i, ref c; img.image)
c = (c < thresh) ? Color.min : Color.max;
return img;
}
 
void main() {
Image!RGB im;
im.loadPPM6("quantum_frog.ppm");
auto img = im.rgb2grayImage();
img.binarizeInPlace(img.findSingleChannelMedian())
.savePGM("quantum_frog_bin.pgm");
}

FBSL[edit]

FBSL volatiles and function call concatenation used heavily for brevity.

24-bpp P.O.T.-size BMP solution:

FBSLHistogram.PNG
#DEFINE WM_CLOSE 16
 
DIM colored = ".\LenaClr.bmp", grayscale = ".\LenaGry.bmp", blackwhite = ".\LenaBnw.bmp"
DIM head, tail, r, g, b, l, m, ptr, blobsize = 54 ' sizeof BMP headers
 
FILEGET(FILEOPEN(colored, BINARY), FILELEN(colored)): FILECLOSE(FILEOPEN) ' fill buffer
head = @FILEGET + blobsize: tail = @FILEGET + FILELEN ' get buffer bounds
 
ToGrayScale() ' derive grayscale image and save it to disk
ToBlackAndWhite() ' ditto, black-and-white image
 
FBSLSETTEXT(ME, "Clr") ' display colored image
FBSLTILE(ME, FBSLLOADIMAGE(colored))
RESIZE(ME, 0, 0, 136, 162): CENTER(ME): SHOW(ME)
 
FBSLTILE(FBSLFORM("Gry"), FBSLLOADIMAGE(grayscale)) ' ditto, grayscale
RESIZE(FBSLFORM, 0, 0, 136, 162): CENTER(FBSLFORM): SHOW(FBSLFORM)
 
FBSLTILE(FBSLFORM("B/w"), FBSLLOADIMAGE(blackwhite)) ' ditto, black-and-white
RESIZE(FBSLFORM, 0, 0, 136, 162): CENTER(FBSLFORM): SHOW(FBSLFORM)
 
BEGIN EVENTS ' main message loop
IF CBMSG = WM_CLOSE THEN DESTROY(ME) ' click any [X] button to quit
END EVENTS
 
SUB ToGrayScale()
FOR ptr = head TO tail STEP 3
b = PEEK(ptr + 0, 1) ' Windows stores colors in BGR order
g = PEEK(ptr + 1, 1)
r = PEEK(ptr + 2, 1)
l = 0.2126 * r + 0.7152 * g + 0.0722 * b ' derive luminance
POKE(ptr + 0, CHR(l))(ptr + 1, CHR)(ptr + 2, CHR) ' set pixel to shade of gray
m = m + l
NEXT
FILEPUT(FILEOPEN(grayscale, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' save grayscale image
END SUB
 
SUB ToBlackAndWhite()
STATIC b = CHR(0), w = CHR(255) ' initialize once
 
m = m / (tail - head) * 3 ' derive median
FOR ptr = head TO tail STEP 3
IF PEEK(ptr + 0, 1) < m THEN ' set pixel black
POKE(ptr + 0, b)(ptr + 1, b)(ptr + 2, b)
ELSE ' set pixel white
POKE(ptr + 0, w)(ptr + 1, w)(ptr + 2, w)
END IF
NEXT
FILEPUT(FILEOPEN(blackwhite, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' save b/w image
END SUB

Forth[edit]

: histogram ( array gmp -- )
over 256 cells erase
dup bdim * over bdata + swap bdata
do 1 over i [email protected] cells + +! loop drop ;

Fortran[edit]

Works with: Fortran version 90 and later

Note: luminance range is hard-encoded and is from 0 to 255. This could be enhanced.

module RCImageProcess
use RCImageBasic
implicit none
contains
 
subroutine get_histogram(img, histogram)
type(scimage), intent(in) :: img
integer, dimension(0:255), intent(out) :: histogram
 
integer :: i
 
histogram = 0
do i = 0,255
histogram(i) = sum(img%channel, img%channel == i)
end do
end subroutine get_histogram
 
function histogram_median(histogram)
integer, dimension(0:255), intent(in) :: histogram
integer :: histogram_median
 
integer :: from, to, left, right
 
from = 0
to = 255
left = histogram(from)
right = histogram(to)
do while ( from /= to )
if ( left < right ) then
from = from + 1
left = left + histogram(from)
else
to = to - 1
right = right + histogram(to)
end if
end do
histogram_median = from
end function histogram_median
 
end module RCImageProcess

Example:

program BasicImageTests
use RCImageBasic
use RCImageIO
use RCImageProcess
 
implicit none
 
type(rgbimage) :: animage
type(scimage) :: gray
integer, dimension(0:255) :: histo
integer :: ml
 
open(unit=10, file='lenna.ppm', action='read', status='old')
call read_ppm(10, animage)
close(10)
 
call init_img(gray)
! or
! call alloc_img(gray, animage%width, animage%height)
 
gray = animage
 
call get_histogram(gray, histo)
ml = histogram_median(histo)
where ( gray%channel >= ml )
animage%red = 255
animage%green = 255
animage%blue = 255
elsewhere
animage%red = 0
animage%green = 0
animage%blue = 0
end where
 
open(unit=10, file='elaborated.ppm', action='write')
call output_ppm(10, animage)
close(10)
 
call free_img(animage)
call free_img(gray)
 
end program BasicImageTests

Go[edit]

Histogram and Threshold functions are be added to the Grmap type for this task:

package raster
 
import "math"
 
func (g *Grmap) Histogram(bins int) []int {
if bins <= 0 {
bins = g.cols
}
h := make([]int, bins)
for _, p := range g.px {
h[int(p)*(bins-1)/math.MaxUint16]++
}
return h
}
 
func (g *Grmap) Threshold(t uint16) {
for i, p := range g.px {
if p < t {
g.px[i] = 0
} else {
g.px[i] = math.MaxUint16
}
}
}

Demonstration program computes the median:

package main
 
// Files required to build supporting package raster are found in:
// * This task (immediately above)
// * Bitmap
// * Grayscale image
// * Read a PPM file
// * Write a PPM file
 
import (
"raster"
"fmt"
"math"
)
 
func main() {
// (A file with this name is output by the Go solution to the task
// "Bitmap/Read an image through a pipe," but of course any 8-bit
// P6 PPM file should work.)
b, err := raster.ReadPpmFile("pipein.ppm")
if err != nil {
fmt.Println(err)
return
}
g := b.Grmap()
h := g.Histogram(0)
// compute median
lb, ub := 0, len(h)-1
var lSum, uSum int
for lb <= ub {
if lSum+h[lb] < uSum+h[ub] {
lSum += h[lb]
lb++
} else {
uSum += h[ub]
ub--
}
}
// apply threshold and write output file
g.Threshold(uint16(ub * math.MaxUint16 / len(h)))
err = g.Bitmap().WritePpmFile("threshold.ppm")
if err != nil {
fmt.Println(err)
}
}

Haskell[edit]

First, an implementation of a black-and-white instance of Color. For simplicty, we use ASCII PBM for output instead of the raw format.

module Bitmap.BW(module Bitmap.BW) where
 
import Bitmap
import Control.Monad.ST
 
newtype BW = BW Bool deriving (Eq, Ord)
 
instance Color BW where
luminance (BW False) = 0
luminance _ = 255
black = BW False
white = BW True
toNetpbm [] = ""
toNetpbm l = init (concatMap f line) ++ "\n" ++ toNetpbm rest
where (line, rest) = splitAt 35 l
f (BW False) = "1 "
f _ = "0 "
fromNetpbm = map f
where f 1 = black
f _ = white
netpbmMagicNumber _ = "P1"
netpbmMaxval _ = ""
 
toBWImage :: Color c => Image s c -> ST s (Image s BW)
toBWImage = toBWImage' 128
 
toBWImage'
:: Color c => Int -> Image s c -> ST s (Image s BW)
{- The first argument gives the darkest luminance assigned
to white. -}

toBWImage' darkestWhite = mapImage $ f . luminance
where f x | x < darkestWhite = black
| otherwise = white

Every instance of Color has a luminance method, so we don't need to convert an image to Gray to calculate its histogram.

import Bitmap
import Bitmap.RGB
import Bitmap.BW
import Bitmap.Netpbm
import Control.Monad.ST
import Data.Array
 
main = do
i <- readNetpbm "original.ppm" :: IO (Image RealWorld RGB)
writeNetpbm "bw.pbm" =<< stToIO (do
h <- histogram i
toBWImage' (medianIndex h) i)
 
histogram :: Color c => Image s c -> ST s [Int]
histogram = liftM f . getPixels where
f = elems . accumArray (+) 0 (0, 255) . map (\i -> (luminance i, 1))
 
medianIndex :: [Int] -> Int
{- Given a list l, finds the index i that minimizes
abs $ sum (take i l) - sum (drop i l) -}
medianIndex l = result
where (result, _, _, _, _) =
iterate f (0, 0, 0, l, reverse l) !! (length l - 1)
f (n, left, right, [email protected](l : ls), [email protected](r : rs)) =
if left < right
then (n + 1, left + l, right, ls, rL)
else (n, left, right + r, lL, rs)

J[edit]

Solution:

Using toGray from Grayscale image.

getImgHist=: ([: /:~ ~. ,. #/.~)@,
medianHist=: {."1 {~ [: (+/\ I. -:@(+/)) {:"1
toBW=: 255 * [email protected] < toGray

Example Usage:

Use Lenna100.jpg for testing (read using the media/platimg addon and convert to ppm file).

   require 'media/platimg'
'Lenna100.ppm' writeppm~ 256#.inv readimg 'Lenna100.jpg'
786447

Read ppm file, convert to black and white and write to a new ppm file using writeppm, readppm and toColor from the read/write ppm file, and grayscale image solutions.

   'Lenna100BW.ppm' writeppm~ toColor toBW readppm 'Lenna100.ppm'
786447

Java[edit]

This solution is based on JAVA 8 stream API

 
package bitmap;
 
import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;
import java.util.Objects;
import java.util.Random;
import java.util.stream.Collectors;
import java.util.stream.Stream;
 
/**
* Image processing functions such as histogram, grayscale,..
* here we assume we have a YUV image. so we process only luma component Y
* the histogram can be called on luma pixel only (values from 0 to 255)
* greyscale is done with a constant middle value of FullRange / 2 = 127
*/

public class ImageProc {
 
static final private Integer MAX_VAL = 255;
static final private Integer MIN_VAL = 0;
static final private Integer MID_RANGE = (MAX_VAL - MIN_VAL) >> 1;
 
private static Integer[] lumaHist(Integer[] luma,Integer length) {
// from input length, select a number of classes (intervalles )
// usually take sqrt(length)
if ((length == 0 )|| (luma == null)){
return null;
}
double stepd = Math.sqrt(length);
// define the interval width
int step = (int)stepd ;
Integer width = (int)(length / stepd);
// define step Lists containing only values in one interval
// done with a loop generating a new list that discard lower part
// the luma buff is fist sorted to split the array correctly
// only values greater than width are kept in a new list
 
List<Integer> interv[] = new ArrayList[step];
Integer hist[] = new Integer[step];
interv[0] = Arrays.stream(luma)
.parallel()
.sorted()
.filter(value -> value >= width)
.collect(Collectors.toList());
hist[0] = length - interv[0].size();
 
// here due to a lambda expression limitation
// we can not modify the width value. (should be a final var)
// so we decrease each reaming values with width, and store in a new list
// the filter is than the same across iterations
// histogram is computed in the same loop: the number of data for the interval
// is equal to the previous list size minus the new list size
for (int i =1; i < step; i++){
 
interv[i] = interv[i-1].stream()
.map(value -> value -= width)
.filter(value -> value >= width)
.collect(Collectors.toList());
hist[i] = interv[i-1].size() - interv[i].size();
}
 
return hist;
}
 
private static Integer[] blackAndWhite(Integer[] luma,Integer length) {
 
List<Integer> bwPict ;
// compute the average value of the stream
// need to transform the List<Integer> in List<String> to transform in int !!!
 
double average;
average = Stream.of(luma).map(i -> i.toString())
.mapToInt(Integer::parseInt)
.average()
.getAsDouble();
System.out.println("Average value : " +average);
// compare each value with the average
// if less set to 0 (black) if more, set to 255 (black)
bwPict= Arrays.stream(luma)
.parallel()
.map(value -> (value > average) ?MAX_VAL: MIN_VAL)
.collect(Collectors.toList());
 
Integer retPict[] = new Integer[bwPict.size()];
return bwPict.toArray(retPict);
}
 
public static void main (String[] args)
{
Integer[] histo;
Integer img_y[] = new Integer[256];
// generate ramdom values just for testing algo
Random r = new Random();
for (int i=0;i< img_y.length; i++) {
img_y[i] = r.nextInt(MAX_VAL);
}
 
// ********* compute histogram ********************
histo = lumaHist(img_y,img_y.length);
 
System.out.println("histogram size =:" + histo.length );
 
int sum = 0;
for (int i=0; i< histo.length;i++) {
System.out.println("histo[" + i + "] =:" + histo[i]);
sum +=histo[i];
}
// check results are ok
// first check nb of elments in histo is 256
if (sum != img_y.length){
System.out.println("Error in histogram processing!\n"
+ "Numbers of value not coherent");
}
Integer hist[] = new Integer[16];
Arrays.fill(hist, 0);
for (int i=0;i< 256; i++) {
if (img_y[i] < 16) hist[0]++;
else if (img_y[i] < 32) hist[1]++;
else if (img_y[i] < 48) hist[2]++;
else if (img_y[i] < 64) hist[3]++;
else if (img_y[i] < 80) hist[4]++;
else if (img_y[i] < 96) hist[5]++;
else if (img_y[i] < 112) hist[6]++;
else if (img_y[i] < 128) hist[7]++;
else if (img_y[i] < 144) hist[8]++;
else if (img_y[i] < 160) hist[9]++;
else if (img_y[i] < 176) hist[10]++;
else if (img_y[i] < 192) hist[11]++;
else if (img_y[i] < 208) hist[12]++;
else if (img_y[i] < 224) hist[13]++;
else if (img_y[i] < 240) hist[14]++;
else hist[15]++;
 
}
if (hist.length != histo.length) {
System.out.println("Error in histogram processing!\n"
+ "histogram size is wrong ");
return;
}
else {
for (int i=0; i< histo.length;i++) {
if (!Objects.equals(hist[i], histo[i])) {
System.out.println("Error in histogram processing!\n"
+ "values are different (interv= " + i
+ " computed: " + histo[i]
+ " theorical :" + hist[i] + "\n");
return;
}
}
}
System.out.println("Test OK\n");
 
// ********* compute grayscale image ********************
Integer pictBW[];
pictBW = blackAndWhite(img_y,img_y.length);
 
for (int i=0;i< img_y.length; i++) {
System.out.println("Original[" + i +"]:" + img_y[i] +
" BandW[" + i +"]:" +pictBW[i] );
}
 
}
}
 

Julia[edit]

 
using Color, Images, FixedPointNumbers
 
ima = imread("bitmap_histogram_in.jpg")
imb = convert(Image{Gray{Ufixed8}}, ima)
 
# calculate histogram
a = map(x->x.val.i, imb.data)
(nothing, h) = hist(reshape(a, length(a)), -1:typemax(Uint8))
 
g = float(imb.data)
b = g .> median(g)
fill!(imb, Gray(0.0))
imb[b] = Gray(1.0)
 
imwrite(imb, "bitmap_histogram_out.png")
 

This solution calculates the histogram, h, to comply with the letter of the task description. However, because it is easiest to calculate the median luminosity directly, h is not used to calculate the black to white threshold used to create the output image.

Output:

The input and output files.

Lua[edit]

This solution uses functions defined at: Read ppm file#Lua, Write ppm file#Lua, Basic bitmap storage#Lua, Grayscale image#Lua.

function Histogram( image )
local size_x, size_y = #image, #image[1]
 
local histo = {}
for i = 0, 255 do
histo[i] = 0
end
 
for i = 1, size_x do
for j = 1, size_y do
histo[ image[i][j] ] = histo[ image[i][j] ] + 1
end
end
 
return histo
end
 
function FindMedian( histogram )
local sum_l, sum_r = 0, 0
local left, right = 0, 255
 
repeat
if sum_l < sum_r then
sum_l = sum_l + histogram[left]
left = left + 1
else
sum_r = sum_r + histogram[right]
right = right - 1
end
until left == right
 
return left
end
 
 
bitmap = Read_PPM( "inputimage.ppm" )
gray_im = ConvertToGrayscaleImage( bitmap )
histogram = Histogram( gray_im )
median = FindMedian( histogram )
 
for i = 1, #gray_im do
for j = 1, #gray_im[1] do
if gray_im[i][j] < median then
gray_im[i][j] = 0
else
gray_im[i][j] = 255
end
end
end
 
bitmap = ConvertToColorImage( gray_im )
Write_PPM( "outputimage.ppm", bitmap )

Mathematica[edit]

 
ImageLevels[img];
 

OCaml[edit]

Translation of: C
type histogram = int array
 
let get_histogram ~img:gray_channel =
let width = Bigarray.Array2.dim1 gray_channel
and height = Bigarray.Array2.dim2 gray_channel in
let t = Array.make 256 0 in
for x = 0 to pred width do
for y = 0 to pred height do
let v = gray_get_pixel_unsafe gray_channel x y in
t.(v) <- t.(v) + 1;
done;
done;
(t: histogram)
;;
let histogram_median (h : histogram) =
 
let from = 0 and to_ = 255 in
let left = h.(from) and right = h.(to_) in
 
let rec aux from to_ left right =
if from = to_
then (from)
else
if left < right
then aux (succ from) to_ (left + h.(from)) right
else aux from (pred to_) left (right + h.(to_))
in
aux from to_ left right
;;

main:

let () =
let img = read_ppm ~filename:"/tmp/foo.ppm" in
 
let width, height = get_dims img in
let res = new_img ~width ~height in
 
let g_img = to_grayscale ~img in
let h = get_histogram g_img in
let m = histogram_median h in
 
let light = (255, 255, 0)
and dark = (127, 0, 127) in
 
for x = 0 to pred width do
for y = 0 to pred height do
let v = gray_get_pixel_unsafe g_img x y in
if v > m
then put_pixel_unsafe res light x y
else put_pixel_unsafe res dark x y
done;
done;
 
output_ppm ~oc:stdout ~img:res;
;;

Octave[edit]

Using package Image

function h = imagehistogram(imago)
if ( isgray(imago) )
for j = 0:255
h(j+1) = numel(imago( imago == j ));
endfor
else
error("histogram on gray img only");
endif
endfunction
 
% test
im = jpgread("Lenna100.jpg");
img = rgb2gray(im);
h = imagehistogram(img);
% let's try to show the histogram
bar(h);
pause;
 
% in order to obtain the requested filtering, we
% can use median directly on the img, and then
% use that value, this way:
m = median(reshape(img, 1, numel(img)));
disp(m);
ibw = img;
ibw( img > m ) = 255;
ibw( img <= m ) = 0;
jpgwrite("lennamed_.jpg", ibw, 100);
% which disagree (128) with the m computed with histog_med (130).
% If we compute it this way:
% m = sort(reshape(img, 1, numel(img)))(ceil(numel(img)/2));
% we obtain 130... but builtin median works as expected, since
% N (number of pixel of Lenna) is even, not odd.
 
% but let's use our histogram h instead
function m = histog_med(histog)
from = 0; to = 255;
left = histog(from + 1); right = histog(to+1);
while ( from != to )
if ( left < right )
from++; left += histog(from+1);
else
to--; right += histog(to+1);
endif
endwhile
m = from;
endfunction
 
m = histog_med(h);
disp(m);
ibw( img > m ) = 255;
ibw( img <= m ) = 0;
jpgwrite("lennamed.jpg", ibw, 100);

Phix[edit]

Requires read_ppm() from Read_a_PPM_file, write_ppm() from Write_a_PPM_file. Uses lena.ppm, which you will have to find/download to demo/rosetta yourself. Included as demo\rosetta\Bitmap_Histogram.exw, results may be verified with demo\rosetta\viewppm.exw

function to_bw(sequence image)
sequence color
integer lum
sequence hist = repeat(0,256)
integer l = 1, r = 256
integer ltot, rtot
for i=1 to length(image) do
for j=1 to length(image[i]) do
color = sq_div(sq_and_bits(image[i][j], {#FF0000,#FF00,#FF}),
{#010000,#0100,#01})
lum = floor(0.2126*color[1] + 0.7152*color[2] + 0.0722*color[3])
image[i][j] = lum
hist[lum+1] += 1
end for
end for
ltot = hist[l]
rtot = hist[r]
while l!=r do
if ltot<rtot then
l += 1
ltot += hist[l]
else
r -= 1
rtot += hist[r]
end if
end while
lum = l
for i=1 to length(image) do
for j=1 to length(image[i]) do
image[i][j] = iff(image[i][j]<lum?black:white)
end for
end for
return image
end function
 
sequence img = read_ppm("Lena.ppm")
img = to_bw(img)
write_ppm("LenaBW.ppm",img)

PHP[edit]

 
define('src_name', 'input.jpg'); // source image
define('dest_name', 'output.jpg'); // destination image
 
$img = imagecreatefromjpeg(src_name); // read image
 
if(empty($img)){
echo 'Image could not be loaded!';
exit;
}
 
$black = imagecolorallocate($img, 0, 0, 0);
$white = imagecolorallocate($img, 255, 255, 255);
$width = imagesx($img);
$height = imagesy($img);
 
$array_lum = array(); // for storage of luminosity of each pixel
$sum_lum = 0; // total sum of luminosity
$average_lum = 0; // average luminosity of whole image
 
for($x = 0; $x < $width; $x++){
for($y = 0; $y < $height; $y++){
// read pixel value
$color = imagecolorat($img, $x, $y);
$r = ($color >> 16) & 0xFF;
$g = ($color >> 8) & 0xFF;
$b = $color & 0xFF;
// save pixel luminosity in temporary array
$array_lum[$x][$y] = ($r + $g + $b);
// add pixel luminosity to sum
$sum_lum += $array_lum[$x][$y];
}
}
 
// calculate average luminosity
$average_lum = $sum_lum / ($width * $height);
 
for($x = 0; $x < $width; $x++){
for($y = 0; $y < $height; $y++){
// pixel is brighter than average -> set white
// else -> set black
if($array_lum[$x][$y] > $average_lum){
imagesetpixel($img, $x, $y, $white);
}
else{
imagesetpixel($img, $x, $y, $black);
}
}
}
// save black and white image to dest_name
imagejpeg($img, dest_name);
 
if(!file_exists(dest_name)){
echo 'Image not saved! Check permission!';
}
 

Example:

Input.jpg
Output.jpg


The Image on the left is read in and the average luminosity calculated.
Every pixel darker than average is painted black; brighter painted white.
The black and white image on the right is then saved to the file system.

PicoLisp[edit]

Translation of: Forth
(de histogram (Pgm)
(let H (need 256 0)
(for L Pgm
(for G L
(inc (nth H (inc G))) ) )
H ) )

PureBasic[edit]

Also requires PureBasic solutions for Read a PPM file, Grayscale image, and Write a PPM file.

Procedure getHistogram(image, Array histogram(1))
Protected w = ImageWidth(image) - 1
Protected h = ImageHeight(image) - 1
Dim histogram(255) ;output
 
StartDrawing(ImageOutput(image))
For x = 0 To w
For y = 0 To h
lum = Red(Point(x, y)) ;the Green or Blue color components could be used also
histogram(lum) + 1
Next
Next
StopDrawing()
EndProcedure
 
Procedure median(Array histogram(1))
Protected low, high = 255, left, right
 
While low <> high
If left < right
low + 1
left + histogram(low)
Else
high - 1
right + histogram(high)
EndIf
Wend
ProcedureReturn low
EndProcedure
 
Procedure blackAndWhite(image, median)
Protected w = ImageWidth(image) - 1
Protected h = ImageHeight(image) - 1
CallDebugger
StartDrawing(ImageOutput(image))
For x = 0 To w
For y = 0 To h
If Red(Point(x, y)) < median ;the Green or Blue color components could be used also
Plot(x, y, $000000) ;black
Else
Plot(x, y, $FFFFFF) ;white
EndIf
Next
Next
StopDrawing()
EndProcedure
 
Define sourceFile.s, outputFile.s, image = 3, m
Dim histogram(255)
 
sourceFile = OpenFileRequester("Select source image file", "*.ppm", "PPM image (*.ppm)|PPM", 0)
 
If sourceFile And LCase(GetExtensionPart(sourceFile)) = "ppm"
LoadImagePPM(image, sourceFile)
ImageGrayout(image)
 
getHistogram(image,histogram())
m = median(histogram())
blackAndWhite(image, m)
 
outputFile = Left(sourceFile, Len(sourceFile) - Len(GetExtensionPart(sourceFile))) + "_bw." + GetExtensionPart(sourceFile)
SaveImageAsPPM(image, outputFile, 1)
EndIf

Racket[edit]

 #lang racket
(require racket/draw math/statistics racket/require
(filtered-in
(lambda (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))
 
;; CIE formula as discussed in "Greyscale image" task
(define (L r g b)
 ;; In fact there is no need, statistically for L to be divided by 10000
(fx+ (fx* r 2126) (fx+ (fx* g 7152) (fx* b 722))))
 
(define (prepare-bytes bm depth load-content?)
(define w (send bm get-width))
(define h (send bm get-height))
(define rv (make-bytes (* w h depth)))
(define just-alpha? #f)
(define pre-multiply? #t); let racket cope with alpha-ness
(when load-content? (send bm get-argb-pixels 0 0 w h rv just-alpha? pre-multiply?))
rv)
 
(define (bitmap-histogram bm)
(unless (send bm is-color?) (error 'bitmap->histogram "bitmap must be colour"))
(define pxls (prepare-bytes bm 4 #t))
(define l# (make-hash))
(for ((r (in-bytes pxls 1 #f 4)) (g (in-bytes pxls 2 #f 4)) (b (in-bytes pxls 3 #f 4)))
(hash-update! l# (L r g b) add1 0))
(define xs (hash-keys l#))  ; the colour values
(define ws (hash-values l#)) ; the "weights" i.e. counts for median
(values xs ws))
 
(define (bitmap-quantile q bm (hist-xs #f) (hist-ws #f))
(define-values (xs ws) (if (and hist-xs hist-ws)
(values hist-xs hist-ws)
(bitmap-histogram bm)))
(quantile q < xs ws))
 
;; we don't return a 1-depth bitmap, so we can do more interesting things with colour
(define (bitmap->monochrome q bm (hist-xs #f) (hist-ws #f))
(define Q (bitmap-quantile q bm hist-xs hist-ws))
(define pxls (prepare-bytes bm 4 #t))
(for ((r (in-bytes pxls 1 #f 4))
(g (in-bytes pxls 2 #f 4))
(b (in-bytes pxls 3 #f 4))
(i (sequence-map (curry fx* 4) (in-naturals))))
(define l (L r g b))
(define rgb+ (cond [(fx< l Q) 0] [else 255]))
(bytes-set! pxls (fx+ i 1) rgb+)
(bytes-set! pxls (fx+ i 2) rgb+)
(bytes-set! pxls (fx+ i 3) rgb+))
(define w (send bm get-width))
(define h (send bm get-height))
(define rv (make-bitmap w h #f))
(send rv set-argb-pixels 0 0 w h pxls)
rv)
 
(module+ main
(define bm (read-bitmap "271px-John_Constable_002.jpg"))
(define-values (xs ws) (bitmap-histogram bm))
(void
(send (bitmap->monochrome 1/4 bm) save-file "histogram-racket-0.25.png" 'png)
(send (bitmap->monochrome 1/2 bm) save-file "histogram-racket-0.50.png" 'png) ; median
(send (bitmap->monochrome 3/4 bm xs ws) save-file "histogram-racket-0.75.png" 'png)))
Output:

Original Image, 25% image, 50% image, 75% image

Sorry guys... I just give up on linking/displaying these images any other way!

Ruby[edit]

class Pixmap
def histogram
histogram = Hash.new(0)
@height.times do |y|
@width.times do |x|
histogram[self[x,y].luminosity] += 1
end
end
histogram
end
 
def to_blackandwhite
hist = histogram
 
# find the median luminosity
median = nil
sum = 0
hist.keys.sort.each do |lum|
sum += hist[lum]
if sum > @height * @width / 2
median = lum
break
end
end
 
# create the black and white image
bw = self.class.new(@width, @height)
@height.times do |y|
@width.times do |x|
bw[x,y] = self[x,y].luminosity < median ? RGBColour::BLACK : RGBColour::WHITE
end
end
bw
end
 
def save_as_blackandwhite(filename)
to_blackandwhite.save(filename)
end
end
 
Pixmap.open('file.ppm').save_as_blackandwhite('file_bw.ppm')

Scala[edit]

See also

object BitmapOps {
def histogram(bm:RgbBitmap)={
val hist=new Array[Int](255)
for(x <- 0 until bm.width; y <- 0 until bm.height; l=luminosity(bm.getPixel(x,y)))
hist(l)+=1
hist
}
 
def histogram_median(hist:Array[Int])={
var from=0
var to=hist.size-1
var left=hist(from)
var right=hist(to)
 
while(from!=to){
if (left<right)
{from+=1; left+=hist(from)}
else
{to-=1; right+=hist(to)}
}
from
}
 
def monochrom(bm:RgbBitmap, threshold:Int)={
val image=new RgbBitmap(bm.width, bm.height)
val c1=Color.BLACK
val c2=Color.WHITE
for(x <- 0 until bm.width; y <- 0 until bm.height; l=luminosity(bm.getPixel(x,y)))
image.setPixel(x, y, if(l>threshold) c2 else c1)
image
}
}

Usage:

val img=Pixmap.load("image.ppm").get
val hist=BitmapOps.histogram(img)
val mid=BitmapOps.histogram_median(hist);
 
val mainframe=new MainFrame(){
title="Test"
visible=true
contents=new Label(){
icon=new ImageIcon(BitmapOps.monochrom(img, mid).image)
}
}

Tcl[edit]

Library: Tk

Uses readPPM, grayscale and output_ppm from other pages.

package require Tcl 8.5
package require Tk
 
proc convert_to_blackandwhite {filename} {
set img [image create photo]
readPPM $img $filename
grayscale $img
set hist [histogram $img]
set median [median $img $hist]
blackandwhite $img $median
output_ppm $img bw_$filename
}
 
proc histogram {image} {
set hist [dict create]
for {set x 0} {$x < [image width $image]} {incr x} {
for {set y 0} {$y < [image height $image]} {incr y} {
dict incr hist [luminance {*}[$image get $x $y]]
}
}
return $hist
}
 
proc luminance {r g b} {
expr {
int(0.2126*$r + 0.7152*$g + 0.0722*$b)
}
}
 
proc median {img hist} {
set sum [expr {[image width $img] * [image height $img]}]
set total 0
foreach luminance [lsort -integer [dict keys $hist]] {
incr total [dict get $hist $luminance]
if {$total > $sum / 2} break
}
return $luminance
}
 
proc blackandwhite {image median} {
for {set x 0} {$x < [image width $image]} {incr x} {
for {set y 0} {$y < [image height $image]} {incr y} {
if {[luminance {*}[$image get $x $y]] < $median} {
$image put black -to $x $y
} else {
$image put white -to $x $y
}
}
}
}

Vedit macro language[edit]

The input image is in edit buffer pointed by numeric register #15. On return, #30 points to buffer containing histogram data. The histogram data is given as ASCII decimal values, one value per line.

:HISTOGRAM:
#30 = Buf_Free // #30 = buffer to store histogram data
for (#9=0; #9<256; #9++) {
Out_Reg(21) TC(#9) Out_Reg(Clear) // @21 = intensity value to be counted
Buf_Switch(#15) // switch to image buffer
#8 = Search(@21, CASE+BEGIN+ALL+NOERR) // count intensity values
Buf_Switch(#30) // switch to histogram buffer
Num_Ins(#8, FILL) // store count
}
Return

zkl[edit]

Translation of: C

Uses the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl

fcn histogram(image){
hist:=List.createLong(256,0); // array[256] of zero
image.data.howza(0).pump(Void,'wrap(c){ hist[c]+=1 }); // byte by byte loop
hist;
}
fcn histogramMedian(hist){
from,to:=0,(2).pow(8) - 1; // 16 bits of luminance
left,right:=hist[from],hist[to];
while(from!=to){
if(left<right){ from+=1; left +=hist[from]; }
else { to -=1; right+=hist[to]; }
}
from
}
img:=PPM.readPPMFile("lenaGrey.ppm"); // a grey scale image
median:=histogramMedian(histogram(img));
median.println();
 
bw:=PPM(img.w,img.h);
// stream bytes from orginal, convert to black/white, write to new image
// each pixel is 24 bit RGB
img.data.pump(bw.data.clear(),'wrap(c){ if(c>median) 0xff else 0 });
 
bw.write(File("foo.ppm","wb"));
Output:
101

See the BBC Basic entry or: http://www.zenkinetic.com/Images/RosettaCode/lenaBW.jpg