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
Histogram of an image: <lang ada>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;</lang> Median of a histogram: <lang ada>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;</lang> Conversion of an image to black and white art: <lang ada> 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);</lang>
BBC BASIC
<lang bbcbasic> 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%</lang>
C
<lang c>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);</lang>
<lang c>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;
}</lang>
The given histogram must be freed with a simple free(histogram).
<lang c>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;
}</lang>
An example of usage is the following code.
<lang c>#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);
}</lang>
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)
Forth
<lang forth>: histogram ( array gmp -- )
over 256 cells erase dup bdim * over bdata + swap bdata do 1 over i c@ cells + +! loop drop ;</lang>
Fortran
Note: luminance range is hard-encoded and is from 0 to 255. This could be enhanced.
<lang fortran>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</lang>
Example:
<lang fortran>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</lang>
Go
Histogram and Threshold functions are be added to the Grmap type for this task: <lang go>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
}
}
}</lang> Demonstration program computes the median: <lang go>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)
}
}</lang>
Haskell
First, an implementation of a black-and-white instance of Color. For simplicty, we use ASCII PBM for output instead of the raw format. <lang haskell>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</lang>
Every instance of Color has a luminance method, so we don't need to convert an image to Gray to calculate its histogram. <lang haskell>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, lL@(l : ls), rL@(r : rs)) =
if left < right
then (n + 1, left + l, right, ls, rL)
else (n, left, right + r, lL, rs)</lang>
J
Solution:
Using toGray from Grayscale image.
<lang j>getImgHist=: ([: /:~ ~. ,. #/.~)@,
medianHist=: {."1 {~ [: (+/\ I. -:@(+/)) {:"1
toBW=: 255 * medianHist@getImgHist < toGray</lang>
Example Usage:
Use Lenna100.jpg for testing (read using the media/platimg addon and convert to ppm file).
<lang j> require 'media/platimg'
'Lenna100.ppm' writeppm~ 256#.inv readimg 'Lenna100.jpg'
786447</lang>
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.
<lang j> 'Lenna100BW.ppm' writeppm~ toColor toBW readppm 'Lenna100.ppm'
786447</lang>
Lua
This solution uses functions defined at: Read ppm file#Lua, Write ppm file#Lua, Basic bitmap storage#Lua, Grayscale image#Lua. <lang 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 )</lang>
Mathematica
<lang Mathematica> ImageLevels[img]; </lang>
OCaml
<lang ocaml>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)
- </lang>
<lang ocaml>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
- </lang>
main: <lang ocaml>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;
- </lang>
Octave
Using package Image <lang octave>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);</lang>
PicoLisp
<lang PicoLisp>(de histogram (Pgm)
(let H (need 256 0)
(for L Pgm
(for G L
(inc (nth H (inc G))) ) )
H ) )</lang>
PureBasic
Also requires PureBasic solutions for Read a PPM file, Grayscale image, and Write a PPM file. <lang PureBasic>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</lang>
Ruby
<lang ruby>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')</lang>
Scala
See also
- Basic Bitmap Storage for RgbBitmap class
- Grayscale Bitmap Task for luminosity method
- Read a PPM File image loading
<lang scala>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
}
}</lang>
Usage: <lang scala>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)
}
}</lang>
Tcl
Uses readPPM, grayscale and output_ppm from other pages. <lang tcl>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
}
}
}
}</lang>
Vedit macro language
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. <lang vedit>: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</lang>