B

Task/Bitmap-Histogram/0DESCRIPTION

@@ -0,0 +1,10 @@
+Extend the basic bitmap storage defined [[Basic_bitmap_storage|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 ppm file | read]]/[[write ppm file]], and [[grayscale image]] solutions.

Task/Bitmap-Histogram/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Image processing

Task/Bitmap-Histogram/Ada/bitmap-histogram-1.ada

@@ -0,0 +1,17 @@
+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;

Task/Bitmap-Histogram/Ada/bitmap-histogram-2.ada

@@ -0,0 +1,17 @@
+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;

Task/Bitmap-Histogram/Ada/bitmap-histogram-3.ada

@@ -0,0 +1,22 @@
+   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);

Task/Bitmap-Histogram/BBC-BASIC/bitmap-histogram.bbc

@@ -0,0 +1,59 @@
+      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%

Task/Bitmap-Histogram/C/bitmap-histogram-1.c

@@ -0,0 +1,7 @@
+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);

Task/Bitmap-Histogram/C/bitmap-histogram-2.c

@@ -0,0 +1,20 @@
+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;
+}

Task/Bitmap-Histogram/C/bitmap-histogram-3.c

@@ -0,0 +1,19 @@
+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;
+}

Task/Bitmap-Histogram/C/bitmap-histogram-4.c

@@ -0,0 +1,50 @@
+#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);
+}

Task/Bitmap-Histogram/Forth/bitmap-histogram.fth

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

Task/Bitmap-Histogram/Fortran/bitmap-histogram-1.f

@@ -0,0 +1,40 @@
+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

Task/Bitmap-Histogram/Fortran/bitmap-histogram-2.f

@@ -0,0 +1,42 @@
+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

Task/Bitmap-Histogram/Go/bitmap-histogram-1.go

@@ -0,0 +1,24 @@
+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
+        }
+    }
+}

Task/Bitmap-Histogram/Go/bitmap-histogram-2.go

@@ -0,0 +1,45 @@
+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)
+    }
+}

Task/Bitmap-Histogram/Haskell/bitmap-histogram-1.hs

@@ -0,0 +1,32 @@
+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

Task/Bitmap-Histogram/Haskell/bitmap-histogram-2.hs

@@ -0,0 +1,27 @@
+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)

Task/Bitmap-Histogram/Lua/bitmap-histogram.lua

@@ -0,0 +1,52 @@
+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 )

Task/Bitmap-Histogram/PHP/bitmap-histogram.php

@@ -0,0 +1,54 @@
+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!';
+}

Task/Bitmap-Histogram/PicoLisp/bitmap-histogram.l

@@ -0,0 +1,6 @@
+(de histogram (Pgm)
+   (let H (need 256 0)
+      (for L Pgm
+         (for G L
+            (inc (nth H (inc G))) ) )
+      H ) )

Task/Bitmap-Histogram/Ruby/bitmap-histogram.rb

@@ -0,0 +1,41 @@
+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')

Task/Bitmap-Histogram/Scala/bitmap-histogram-1.scala

@@ -0,0 +1,32 @@
+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		
+   }
+}

Task/Bitmap-Histogram/Scala/bitmap-histogram-2.scala

@@ -0,0 +1,11 @@
+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)
+   }
+}

Task/Bitmap-Histogram/Tcl/bitmap-histogram.tcl

@@ -0,0 +1,50 @@
+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
+            }
+        }
+    }
+}