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.

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

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;

  1. 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).

Translation of: Ada

<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>

  1. include <stdlib.h>
  2. include "imglib.h"

/* usage example */

  1. define BLACK 0,0,0
  2. 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)

D

Translation of: Ada

It uses the grayscale_image from the Grayscale image Task. The loaded frog image is from the Color quantization Task. <lang d>import grayscale_image;

Color findSingleChannelMedian(Color)(in Image!Color img) nothrow 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)

nothrow 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");

}</lang>

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

Works with: Fortran version 90 and later

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

Translation of: C

<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>

PHP

<lang PHP> 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!'; } </lang> Example:

 
 


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

Translation of: Forth

<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

<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

Library: Tk

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:

  1. 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>