Bitmap/Histogram: Difference between revisions

m
→‎{{header|Wren}}: ImageData.loadFromFile now deprecated, changed to ImageData.load
m (→‎{{header|Wren}}: ImageData.loadFromFile now deprecated, changed to ImageData.load)
 
(11 intermediate revisions by 7 users not shown)
Line 11:
* 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.
=={{header|Action!}}==
In the following solution the input file [https://gitlab.com/amarok8bit/action-rosetta-code/-/blob/master/source/lena30g.PPM lena30g.PPM] is loaded from H6 drive. Altirra emulator automatically converts CR/LF character from ASCII into 155 character in ATASCII charset used by Atari 8-bit computer when one from H6-H10 hard drive under DOS 2.5 is used.
{{libheader|Action! Bitmap tools}}
<syntaxhighlight lang="action!">INCLUDE "H6:LOADPPM5.ACT"
 
DEFINE HISTSIZE="256"
 
PROC PutBigPixel(INT x,y BYTE col)
IF x>=0 AND x<=79 AND y>=0 AND y<=47 THEN
y==LSH 2
col==RSH 4
IF col<0 THEN col=0
ELSEIF col>15 THEN col=15 FI
Color=col
Plot(x,y)
DrawTo(x,y+3)
FI
RETURN
 
PROC DrawImage(GrayImage POINTER image INT x,y)
INT i,j
BYTE c
 
FOR j=0 TO image.gh-1
DO
FOR i=0 TO image.gw-1
DO
c=GetGrayPixel(image,i,j)
PutBigPixel(x+i,y+j,c)
OD
OD
RETURN
 
PROC CalcHistogram(GrayImage POINTER image INT ARRAY hist)
INT i,j
BYTE c
 
Zero(hist,HISTSIZE*2)
FOR j=0 TO image.gh-1
DO
FOR i=0 TO image.gw-1
DO
c=GetGrayPixel(image,i,j)
hist(c)==+1
OD
OD
RETURN
 
BYTE FUNC CalcThresholdValue(INT width,height INT ARRAY hist)
INT i,sum,total,curr
 
total=width*height
sum=0
FOR i=0 TO HISTSIZE-1
DO
curr=hist(i)
IF sum>=(total-curr)/2 THEN
RETURN (i)
FI
sum==+curr
OD
RETURN (HISTSIZE-1)
 
PROC Binarize(GrayImage POINTER src,dst BYTE threshold)
INT i,j
BYTE c
 
FOR j=0 TO src.gh-1
DO
FOR i=0 TO src.gw-1
DO
c=GetGrayPixel(src,i,j)
IF c<threshold THEN
c=0
ELSE
c=255
FI
SetGrayPixel(dst,i,j,c)
OD
OD
RETURN
 
PROC Main()
BYTE CH=$02FC ;Internal hardware value for last key pressed
BYTE ARRAY dataIn(900),dataOut(900)
GrayImage in,out
INT ARRAY hist(HISTSIZE)
BYTE threshold
INT size=[30],x,y
 
Put(125) PutE() ;clear the screen
 
InitGrayImage(in,size,size,dataIn)
InitGrayImage(out,size,size,dataOut)
PrintE("Loading source image...")
LoadPPM5(in,"H6:LENA30G.PPM")
PrintE("Calc histogram...")
CalcHistogram(in,hist)
PrintE("Calc threshold value...")
threshold=CalcThresholdValue(in.gw,in.gh,hist)
PrintE("Binarization...")
Binarize(in,out,threshold)
 
Graphics(9)
x=(40-size)/2
y=(48-size)/2
DrawImage(in,x,y)
DrawImage(out,x+40,y)
 
DO UNTIL CH#$FF OD
CH=$FF
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Bitmap_Histogram.png Screenshot from Atari 8-bit computer]
=={{header|Ada}}==
Histogram of an image:
<langsyntaxhighlight lang="ada">type Pixel_Count is mod 2**64;
type Histogram is array (Luminance) of Pixel_Count;
Line 30 ⟶ 143:
end loop;
return Result;
end Get_Histogram;</langsyntaxhighlight>
Median of a histogram:
<langsyntaxhighlight lang="ada">function Median (H : Histogram) return Luminance is
From : Luminance := Luminance'First;
To : Luminance := Luminance'Last;
Line 48 ⟶ 161:
end loop;
return From;
end Median;</langsyntaxhighlight>
Conversion of an image to black and white art:
<langsyntaxhighlight lang="ada"> F1, F2 : File_Type;
begin
Open (F1, In_File, "city.ppm");
Line 71 ⟶ 184:
Put_PPM (F2, X);
end;
Close (F2);</langsyntaxhighlight>
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
[[Image:greyscale_bbc.jpg|right]]
[[Image:histogram_bbc.gif|right]]
<langsyntaxhighlight lang="bbcbasic"> INSTALL @lib$+"SORTLIB"
Sort% = FN_sortinit(0,0)
Line 135 ⟶ 247:
col% = TINT(x%*2,y%*2)
SWAP ?^col%,?(^col%+2)
= col%</langsyntaxhighlight>
 
=={{header|C}}==
 
<langsyntaxhighlight lang="c">typedef unsigned int histogram_t;
typedef histogram_t *histogram;
 
Line 145 ⟶ 256:
 
histogram get_histogram(grayimage im);
luminance histogram_median(histogram h);</langsyntaxhighlight>
 
<langsyntaxhighlight lang="c">histogram get_histogram(grayimage im)
{
histogram t;
Line 166 ⟶ 277:
}
return t;
}</langsyntaxhighlight>
 
The given <tt>histogram</tt> must be freed with a simple <tt>free(histogram)</tt>.
Line 172 ⟶ 283:
{{trans|Ada}}
 
<langsyntaxhighlight lang="c">luminance histogram_median(histogram h)
{
luminance From, To;
Line 190 ⟶ 301:
}
return From;
}</langsyntaxhighlight>
 
An example of usage is the following code.
 
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include "imglib.h"
Line 243 ⟶ 354:
free_img((image)g_img);
free_img(color_img);
}</langsyntaxhighlight>
 
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]])
 
=={{header|Common Lisp}}==
{{libheader|opticl}}
<langsyntaxhighlight lang="lisp">(defpackage #:histogram
(:use #:cl
#:opticl))
Line 294 ⟶ 404:
(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)))</langsyntaxhighlight>
 
=={{header|D}}==
{{trans|Ada}}
It uses the grayscale_image from the Grayscale image Task. The loaded frog image is from the Color quantization Task.
<langsyntaxhighlight lang="d">import grayscale_image;
 
Color findSingleChannelMedian(Color)(in Image!Color img)
Line 345 ⟶ 454:
img.binarizeInPlace(img.findSingleChannelMedian())
.savePGM("quantum_frog_bin.pgm");
}</langsyntaxhighlight>
 
=={{header|FBSL}}==
FBSL volatiles and function call concatenation used heavily for brevity.
Line 352 ⟶ 460:
'''24-bpp P.O.T.-size BMP solution:'''
[[File:FBSLHistogram.PNG|right]]
<langsyntaxhighlight lang="qbasic">#DEFINE WM_CLOSE 16
 
DIM colored = ".\LenaClr.bmp", grayscale = ".\LenaGry.bmp", blackwhite = ".\LenaBnw.bmp"
Line 401 ⟶ 509:
NEXT
FILEPUT(FILEOPEN(blackwhite, BINARY_NEW), FILEGET): FILECLOSE(FILEOPEN) ' save b/w image
END SUB</langsyntaxhighlight>
 
=={{header|Forth}}==
<langsyntaxhighlight lang="forth">: histogram ( array gmp -- )
over 256 cells erase
dup bdim * over bdata + swap bdata
do 1 over i c@ cells + +! loop drop ;</langsyntaxhighlight>
\ will not work as far as bdim bdata are not ans forth words
\ do not forget to assign them yourself in your code
 
=={{header|GnuForth 0.7}}==
<syntaxhighlight lang="forth">
: bar ( v y x -- )
2dup at-xy .\" [" 100 spaces .\" ]" swap 1 + swap at-xy 0
DO .\" #"
LOOP
cr ;
: demo \ just demo to show it working in percentage 1% to 4%
5 1
DO i 10 i bar
LOOP
cr ;
\ will display :
[# ]
[## ]
[### ]
[#### ]
</syntaxhighlight>
Call it from an array
0 toto swap cells + @ 10 5 bar \ draws bar from first item of toto array
 
=={{header|Fortran}}==
Line 414 ⟶ 544:
'''Note''': ''luminance'' range is hard-encoded and is from 0 to 255. This could be enhanced.
 
<langsyntaxhighlight lang="fortran">module RCImageProcess
use RCImageBasic
implicit none
Line 453 ⟶ 583:
end function histogram_median
end module RCImageProcess</langsyntaxhighlight>
 
Example:
 
<langsyntaxhighlight lang="fortran">program BasicImageTests
use RCImageBasic
use RCImageIO
Line 498 ⟶ 628:
call free_img(gray)
 
end program BasicImageTests</langsyntaxhighlight>
 
=={{header|Go}}==
Histogram and Threshold functions are be added to the Grmap type for this task:
<langsyntaxhighlight lang="go">package raster
 
import "math"
Line 525 ⟶ 654:
}
}
}</langsyntaxhighlight>
Demonstration program computes the median:
<langsyntaxhighlight lang="go">package main
 
// Files required to build supporting package raster are found in:
Line 571 ⟶ 700:
fmt.Println(err)
}
}</langsyntaxhighlight>
 
=={{header|Haskell}}==
First, an implementation of a black-and-white instance of <tt>Color</tt>. For simplicty, we use ASCII PBM for output instead of the raw format.
<langsyntaxhighlight lang="haskell">module Bitmap.BW(module Bitmap.BW) where
 
import Bitmap
Line 606 ⟶ 734:
toBWImage' darkestWhite = mapImage $ f . luminance
where f x | x < darkestWhite = black
| otherwise = white</langsyntaxhighlight>
 
Every instance of <tt>Color</tt> has a <tt>luminance</tt> method, so we don't need to convert an image to <tt>Gray</tt> to calculate its histogram.
<langsyntaxhighlight lang="haskell">import Bitmap
import Bitmap.RGB
import Bitmap.BW
Line 635 ⟶ 763:
if left < right
then (n + 1, left + l, right, ls, rL)
else (n, left, right + r, lL, rs)</langsyntaxhighlight>
 
=={{header|J}}==
'''Solution:'''
 
Using <code>toGray</code> from [[Grayscale image#J|Grayscale image]].
<langsyntaxhighlight lang="j">getImgHist=: ([: /:~ ~. ,. #/.~)@,
medianHist=: {."1 {~ [: (+/\ I. -:@(+/)) {:"1
toBW=: 255 * medianHist@getImgHist < toGray</langsyntaxhighlight>
 
'''Example Usage:'''
Line 649 ⟶ 776:
Use [http://rosettacode.org/mw/images/b/b6/Lenna100.jpg Lenna100.jpg] for testing (read using the [[j:Addons/media/platimg|media/platimg]] addon and convert to ppm file).
 
<langsyntaxhighlight lang="j"> require 'media/platimg'
'Lenna100.ppm' writeppm~ 256#.inv readimg 'Lenna100.jpg'
786447</langsyntaxhighlight>
 
Read ppm file, convert to black and white and write to a new ppm file using <code>writeppm</code>, <code>readppm</code> and <code>toColor</code> from the [[read ppm file#J | read]]/[[write ppm file#J|write ppm file]], and [[grayscale image#J|grayscale image]] solutions.
<langsyntaxhighlight lang="j"> 'Lenna100BW.ppm' writeppm~ toColor toBW readppm 'Lenna100.ppm'
786447</langsyntaxhighlight>
 
=={{header|Java}}==
<langsyntaxhighlight Javalang="java">import java.awt.image.BufferedImage;
import java.io.File;
import java.io.IOException;
Line 720 ⟶ 846:
return median;
}
}</langsyntaxhighlight>
 
=={{header|Julia}}==
{{works with|Julia|0.6}}
 
<langsyntaxhighlight lang="julia">using Images, FileIO
 
ima = load("data/lenna50.jpg")
Line 733 ⟶ 858:
imb[imb .≤ medcol] = Gray(0.0)
imb[imb .> medcol] = Gray(1.0)
save("data/lennaGray.jpg", imb)</langsyntaxhighlight>
 
=={{header|Kotlin}}==
Uses the image from the [[Percentage difference between images]] task as an example.
<langsyntaxhighlight lang="scala">// version 1.2.10
 
import java.io.File
Line 797 ⟶ 921:
val bwFile = File("Lenna_bw.jpg")
ImageIO.write(image, "jpg", bwFile)
}</langsyntaxhighlight>
 
=={{header|Lua}}==
This solution uses functions defined at:
Line 805 ⟶ 928:
[[Basic bitmap storage#Lua]],
[[Grayscale image#Lua]].
<langsyntaxhighlight lang="lua">function Histogram( image )
local size_x, size_y = #image, #image[1]
Line 856 ⟶ 979:
 
bitmap = ConvertToColorImage( gray_im )
Write_PPM( "outputimage.ppm", bitmap )</langsyntaxhighlight>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
 
<syntaxhighlight lang="mathematica">ImageLevels[img]</syntaxhighlight>
=={{header|Mathematica}}==
<lang Mathematica>
ImageLevels[img];
</lang>
 
=={{header|Nim}}==
<langsyntaxhighlight Nimlang="nim">import bitmap
import grayscale_image
 
Line 915 ⟶ 1,034:
 
# Save image as a PPM file.
image.writePPM("house_bw.ppm")</langsyntaxhighlight>
 
=={{header|OCaml}}==
{{Trans|C}}
 
<langsyntaxhighlight lang="ocaml">type histogram = int array
 
let get_histogram ~img:gray_channel =
Line 933 ⟶ 1,051:
done;
(t: histogram)
;;</langsyntaxhighlight>
 
<langsyntaxhighlight lang="ocaml">let histogram_median (h : histogram) =
 
let from = 0 and to_ = 255 in
Line 949 ⟶ 1,067:
in
aux from to_ left right
;;</langsyntaxhighlight>
 
main:
<langsyntaxhighlight lang="ocaml">let () =
let img = read_ppm ~filename:"/tmp/foo.ppm" in
 
Line 975 ⟶ 1,093:
 
output_ppm ~oc:stdout ~img:res;
;;</langsyntaxhighlight>
 
=={{header|Octave}}==
'''Using package''' [http://octave.sourceforge.net/image/index.html Image]
<langsyntaxhighlight lang="octave">function h = imagehistogram(imago)
if ( isgray(imago) )
for j = 0:255
Line 1,030 ⟶ 1,147:
ibw( img > m ) = 255;
ibw( img <= m ) = 0;
jpgwrite("lennamed.jpg", ibw, 100);</langsyntaxhighlight>
=={{header|Phix}}==
Requires read_ppm() from [[Bitmap/Read_a_PPM_file#Phix|Read_a_PPM_file]], write_ppm() from [[Bitmap/Write_a_PPM_file#Phix|Write_a_PPM_file]]. <br>
Uses demo\rosetta\lena.ppm, included in the distribution, results may be verified with demo\rosetta\viewppm.exw
<syntaxhighlight lang="phix">-- demo\rosetta\Bitmap_Histogram.exw (runnable version)
include ppm.e -- black, white, read_ppm(), write_ppm() (covers above requirements)
 
function to_bw(sequence image)
=={{header|Phix}}==
sequence hist = repeat(0,256)
Requires read_ppm() from [[Bitmap/Read_a_PPM_file#Phix|Read_a_PPM_file]], write_ppm() from [[Bitmap/Write_a_PPM_file#Phix|Write_a_PPM_file]].
for x=1 to length(image) do
Uses lena.ppm, which you will have to find/download to demo/rosetta yourself.
for y=1 to length(image[x]) do
Included as demo\rosetta\Bitmap_Histogram.exw, results may be verified with demo\rosetta\viewppm.exw
integer pixel = image[x][y] -- red,green,blue
<lang Phix>function to_bw(sequence image)
sequence r_g_b = sq_and_bits(pixel,{#FF0000,#FF00,#FF})
sequence color
integer {r,g,b} = sq_floor_div(r_g_b,{#010000,#0100,#01}),
integer lum
lum = floor(0.2126*r + 0.7152*g + 0.0722*b)
sequence hist = repeat(0,256)
image[x][y] = lum
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
ltotinteger lo = 1, hi = hist[l]256,
rtot ltot = hist[rlo],
while l! rtot =r dohist[hi]
while lo!=hi do
if ltot<rtot then
llo += 1
ltot += hist[llo]
else
rhi -= 1
rtot += hist[rhi]
end if
end while
integer lum = llo
for i=1 to length(image) do
for j=1 to length(image[i]) do
Line 1,072 ⟶ 1,188:
 
sequence img = read_ppm("Lena.ppm")
img = to_bw(img)
write_ppm("LenaBW.ppm",img)</langsyntaxhighlight>
 
=={{header|PHP}}==
 
<syntaxhighlight lang="php">
<lang PHP>
define('src_name', 'input.jpg'); // source image
define('dest_name', 'output.jpg'); // destination image
Line 1,132 ⟶ 1,247:
echo 'Image not saved! Check permission!';
}
</syntaxhighlight>
</lang>
Example: <br>
<div>
Line 1,146 ⟶ 1,261:
</i>
</div>
 
=={{header|PicoLisp}}==
{{trans|Forth}}
<langsyntaxhighlight PicoLisplang="picolisp">(de histogram (Pgm)
(let H (need 256 0)
(for L Pgm
(for G L
(inc (nth H (inc G))) ) )
H ) )</langsyntaxhighlight>
 
=={{header|PureBasic}}==
Also requires PureBasic solutions for [[Bitmap/Read_a_PPM_file#PureBasic|Read a PPM file]], [[Grayscale_image#PureBasic|Grayscale image]], and [[Bitmap/Write_a_PPM_file#PureBasic|Write a PPM file]].
<langsyntaxhighlight PureBasiclang="purebasic">Procedure getHistogram(image, Array histogram(1))
Protected w = ImageWidth(image) - 1
Protected h = ImageHeight(image) - 1
Line 1,220 ⟶ 1,333:
outputFile = Left(sourceFile, Len(sourceFile) - Len(GetExtensionPart(sourceFile))) + "_bw." + GetExtensionPart(sourceFile)
SaveImageAsPPM(image, outputFile, 1)
EndIf</langsyntaxhighlight>
 
=={{header|Python}}==
Makes use of the Pillow library (PIL) you can install it using pip. The code is probably not the fastest or the image I used (1960x1960) is just too big.
<langsyntaxhighlight lang="python">from PIL import Image
 
# Open the image
Line 1,265 ⟶ 1,377:
 
bw_image.show()
bm_image.show()</langsyntaxhighlight>
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket"> #lang racket
(require racket/draw math/statistics racket/require
(filtered-in
Line 1,329 ⟶ 1,440:
(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)))</langsyntaxhighlight>
 
{{out}}
Line 1,338 ⟶ 1,449:
 
Sorry guys... I just give up on linking/displaying these images any other way!
 
=={{header|Raku}}==
(formerly Perl 6)
Line 1,344 ⟶ 1,454:
Uses pieces from [[Bitmap#Raku| Bitmap]], [[Bitmap/Write_a_PPM_file#Raku| Write a PPM file]] and [[Grayscale_image#Raku| Grayscale image]] tasks. Included here to make a complete, runnable program.
 
<syntaxhighlight lang="raku" perl6line>class Pixel { has UInt ($.R, $.G, $.B) }
class Bitmap {
has UInt ($.width, $.height);
Line 1,395 ⟶ 1,505:
histogram($b);
 
'./Lenna-bw.pbm'.IO.open(:bin, :w).write: $b.P4;</langsyntaxhighlight>
 
See [https://github.com/thundergnat/rc/blob/master/img/Lenna.png Lenna], and [https://github.com/thundergnat/rc/blob/master/img/Lenna-bw.png Lenna-bw] images. (converted to .png as .ppm format is not widely supported).
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">class Pixmap
def histogram
histogram = Hash.new(0)
Line 1,440 ⟶ 1,549:
end
 
Pixmap.open('file.ppm').save_as_blackandwhite('file_bw.ppm')</langsyntaxhighlight>
=={{header|Rust}}==
<syntaxhighlight lang="rust">extern crate image;
use image::{DynamicImage, GenericImageView, ImageBuffer, Rgba};
 
/// index of the alpha channel in RGBA
const ALPHA: usize = 3;
 
/// Computes the luminance of a single pixel
/// Result lies within `u16::MIN..u16::MAX`
const fn luminance(rgba: Rgba<u8>) -> u16 {
let Rgba([r, g, b, _a]) = rgba;
55 * r as u16 + 183 * g as u16 + 19 * b as u16
}
 
/// computes the median of a given histogram
/// Result lies within `u16::MIN..u16::MAX`
fn get_median(total: usize, histogram: &[usize]) -> u16 {
let mut sum = 0;
for (index, &count) in histogram.iter().enumerate() {
sum += count;
if sum >= total / 2 {
return index as u16;
}
}
 
u16::MAX
}
 
/// computes the histogram of a given image
fn compute_histogram(img: &DynamicImage) -> Vec<usize> {
let mut histogram = vec![0; 1 << u16::BITS];
 
img.pixels()
.map(|(_x, _y, pixel)| luminance(pixel))
.for_each(|luminance| histogram[luminance as usize] += 1);
 
histogram
}
 
/// returns a black or white pixel with an alpha value
const fn black_white(is_white: bool, alpha: u8) -> [u8; 4] {
if is_white {
[255, 255, 255, alpha]
} else {
[0, 0, 0, alpha]
}
}
 
/// create a monochome compy of the given image
/// preserves alpha data
fn convert_to_monochrome(img: &DynamicImage) -> ImageBuffer<Rgba<u8>, Vec<u8>> {
let histogram = compute_histogram(img);
 
let (width, height) = img.dimensions();
let pixel_count = (width * height) as usize;
let median = get_median(pixel_count, &histogram);
 
let pixel_buffer = img.pixels()
.flat_map(|(_x, _y, pixel)| black_white(luminance(pixel) > median, pixel[ALPHA]))
.collect();
 
ImageBuffer::from_vec(width, height, pixel_buffer).unwrap_or_else(|| unreachable!())
}
 
fn main() {
let img = image::open("lena.jpg").expect("could not load image file");
let img = convert_to_monochrome(&img);
img.save("lena-mono.png").expect("could not save result image");
}
</syntaxhighlight>
=={{header|Scala}}==
See also
Line 1,448 ⟶ 1,626:
* [[Read_ppm_file#Scala|Read a PPM File]] image loading
 
<langsyntaxhighlight lang="scala">object BitmapOps {
def histogram(bm:RgbBitmap)={
val hist=new Array[Int](255)
Line 1,479 ⟶ 1,657:
image
}
}</langsyntaxhighlight>
 
Usage:
<langsyntaxhighlight lang="scala">val img=Pixmap.load("image.ppm").get
val hist=BitmapOps.histogram(img)
val mid=BitmapOps.histogram_median(hist);
Line 1,492 ⟶ 1,670:
icon=new ImageIcon(BitmapOps.monochrom(img, mid).image)
}
}</langsyntaxhighlight>
 
=={{header|Tcl}}==
{{libheader|Tk}}
Uses [[read ppm file#Tcl|readPPM]], [[grayscale image#Tcl|grayscale]] and [[write ppm file#Tcl|output_ppm]] from other pages.
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
package require Tk
 
Line 1,546 ⟶ 1,723:
}
}
}</langsyntaxhighlight>
 
=={{header|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.
<langsyntaxhighlight lang="vedit">:HISTOGRAM:
#30 = Buf_Free // #30 = buffer to store histogram data
for (#9=0; #9<256; #9++) {
Line 1,561 ⟶ 1,737:
Num_Ins(#8, FILL) // store count
}
Return</langsyntaxhighlight>
=={{header|Wren}}==
{{libheader|DOME}}
<syntaxhighlight lang="wren">import "dome" for Window
import "graphics" for Canvas, Color, ImageData
 
class ImageHistogram {
construct new(filename, filename2) {
_image = ImageData.load(filename)
Window.resize(_image.width, _image.height)
Canvas.resize(_image.width, _image.height)
Window.title = filename2
_image2 = ImageData.create("Grayscale", _image.width, _image.height)
_image3 = ImageData.create("B & W", _image.width, _image.height)
}
 
init() {
toGrayScale()
var h = histogram
var m = median(h)
toBlackAndWhite(m)
_image3.draw(0, 0)
_image3.saveToFile(Window.title)
}
 
luminance(c) { (0.2126 * c.r + 0.7152 * c.g + 0.0722 * c.b).floor }
 
toGrayScale() {
for (x in 0..._image.width) {
for (y in 0..._image.height) {
var c1 = _image.pget(x, y)
var lumin = luminance(c1)
var c2 = Color.rgb(lumin, lumin, lumin, c1.a)
_image2.pset(x, y, c2)
}
}
}
 
toBlackAndWhite(median) {
for (x in 0..._image2.width) {
for (y in 0..._image2.height) {
var c = _image2.pget(x, y)
var lum = luminance(c)
if (lum < median) {
_image3.pset(x, y, Color.black)
} else {
_image3.pset(x, y, Color.white)
}
}
}
}
 
histogram {
var h = List.filled(256, 0)
for (x in 0..._image2.width) {
for (y in 0..._image2.height) {
var c = _image2.pget(x, y)
var lum = luminance(c)
h[lum] = h[lum] + 1
}
}
return h
}
 
median(h) {
var lSum = 0
var rSum = 0
var left = 0
var right = 255
while (true) {
if (lSum < rSum) {
lSum = lSum + h[left]
left = left + 1
} else {
rSum = rSum + h[right]
right = right - 1
}
if (left == right) break
}
return left
}
 
update() {}
 
draw(alpha) {}
}
 
var Game = ImageHistogram.new("Lenna100.jpg", "Lenna100_B&W.png")</syntaxhighlight>
 
=={{header|zkl}}==
{{trans|C}}
Uses the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl
<langsyntaxhighlight lang="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
Line 1,579 ⟶ 1,842:
}
from
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">img:=PPM.readPPMFile("lenaGrey.ppm"); // a grey scale image
median:=histogramMedian(histogram(img));
median.println();
Line 1,589 ⟶ 1,852:
img.data.pump(bw.data.clear(),'wrap(c){ if(c>median) 0xff else 0 });
 
bw.write(File("foo.ppm","wb"));</langsyntaxhighlight>
{{out}}<pre>101</pre>
See the BBC Basic entry or:
http://www.zenkinetic.com/Images/RosettaCode/lenaBW.jpg
 
{{omit from|AWK}}
{{omit from|PARI/GP}}
9,476

edits