Bitmap/Histogram

From Rosetta Code
Revision as of 04:57, 20 October 2009 by 203.114.189.210 (talk) (→‎{{header|J}}: fix toBW)
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

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>

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)

Forth

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

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>

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

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 i = do

   h <- newArray (0, 255) 0 :: ST s (STArray s Int Int)
   let increment i = readArray h i >>= writeArray h i . (+1)
   getPixels i >>= mapM_ (increment . luminance)
   getElems h

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: <lang j> getImgHist=: ([: /:~ ~. ,. #/.~)@, medianHist=: {."1 {~ [: (+/\ I. -:@(+/)) {:"1 toBW=: (255 * medianHist@getImgHist < ])@toGray </lang>

Example Usage: <lang j> NB. read jpg and write ppm

  'lenna100.ppm' writeppm~ 256#.inv readimg 'lenna100.jpg'

786447 NB. Write black and white version to file

  'lenna100BW.ppm' writeppm~ toColor toBW readppm 'lenna100.ppm'

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

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>

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.

: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