Otsu Threshold

This algorithm is used to automatically perform clustering-based image thresholding or, the reduction of a graylevel image to a binary image.

   



									Public Shared Sub ApplyOtsuThreshold(ByRef bmp As Bitmap)
	Grayscale(bmp)
	Dim otsuThreshold As Integer = GetOtsuThreshold(bmp) * 3
	Threshold(bmp, CShort(otsuThreshold))
End Sub

Private Shared Sub Grayscale(ByRef bmp As Bitmap)
	Dim bmData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
	Dim p As IntPtr = bmData.Scan0
	Dim stopAddress As Integer = CInt(p) + bmData.Stride * bmData.Height

	While CInt(p) <> stopAddress
		Dim gs = Math.Truncate(0.299 * Marshal.ReadByte(p + 2) + 0.587 * Marshal.ReadByte(p + 1) + 0.114 * Marshal.ReadByte(p))
		Marshal.WriteByte(p, gs)
		Marshal.WriteByte(p + 1, gs)
		Marshal.WriteByte(p + 2, gs)
		p += 3
	End While

	bmp.UnlockBits(bmData)
End Sub

Private Shared Sub Threshold(ByRef bmp As Bitmap, thresholdValue As Short)
	Dim MaxVal As Integer = 768

	If thresholdValue < 0 Then
		Return
	ElseIf thresholdValue > MaxVal Then
		Return
	End If

	Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
	Dim TotalRGB As Integer
	Dim ptr As IntPtr = bmpData.Scan0
	Dim stopAddress As Integer = CInt(ptr) + bmpData.Stride * bmpData.Height

	While CInt(ptr) <> stopAddress
		TotalRGB = CInt(Marshal.ReadByte(ptr)) + CInt(Marshal.ReadByte(ptr + 1)) + CInt(Marshal.ReadByte(ptr + 2))

		If TotalRGB <= thresholdValue Then
			Marshal.WriteByte(ptr + 2, 0)
			Marshal.WriteByte(ptr + 1, 0)
			Marshal.WriteByte(ptr, 0)
		Else
			Marshal.WriteByte(ptr + 2, 255)
			Marshal.WriteByte(ptr + 1, 255)
			Marshal.WriteByte(ptr, 255)
		End If

		ptr += 3
	End While

	bmp.UnlockBits(bmpData)
End Sub

Private Shared Function Px(init As Integer, [end] As Integer, hist As Integer()) As Single
	Dim sum As Integer = 0
	Dim i As Integer

	For i = init To [end]
		sum += hist(i)
	Next

	Return CSng(sum)
End Function

Private Shared Function Mx(init As Integer, [end] As Integer, hist As Integer()) As Single
	Dim sum As Integer = 0
	Dim i As Integer

	For i = init To [end]
		sum += i * hist(i)
	Next

	Return CSng(sum)
End Function

Private Shared Function FindMax(vec As Single(), n As Integer) As Integer
	Dim maxVec As Single = 0
	Dim idx As Integer = 0
	Dim i As Integer

	For i = 1 To n - 2
		If vec(i) > maxVec Then
			maxVec = vec(i)
			idx = i
		End If
	Next

	Return idx
End Function

Private Shared Sub GetHistogram(p As IntPtr, w As Integer, h As Integer, ws As Integer, hist As Integer())
	hist.Initialize()

	For i As Integer = 0 To h - 1
		For j As Integer = 0 To w * 3 - 1 Step 3
			Dim index As Integer = i * ws + j
			hist(Marshal.ReadByte(p + index)) += 1
		Next
	Next
End Sub

Private Shared Function GetOtsuThreshold(bmp As Bitmap) As Integer
	Dim t As Byte = 0
	Dim vet As Single() = New Single(255) {}
	Dim hist As Integer() = New Integer(255) {}
	vet.Initialize()

	Dim p1 As Single, p2 As Single, p12 As Single
	Dim k As Integer

	Dim bmData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)
	Dim p As IntPtr = bmData.Scan0

	GetHistogram(p, bmp.Width, bmp.Height, bmData.Stride, hist)

	k = 1
	While k <> 255
		p1 = Px(0, k, hist)
		p2 = Px(k + 1, 255, hist)
		p12 = p1 * p2
		If p12 = 0 Then
			p12 = 1
		End If
		Dim diff As Single = (Mx(0, k, hist) * p2) - (Mx(k + 1, 255, hist) * p1)
		vet(k) = CSng(diff) * diff / p12
		k += 1
	End While

	bmp.UnlockBits(bmData)
	t = CByte(FindMax(vet, 256))

	Return t
End Function
								


Example

									DIm b As Bitmap = CType(Image.FromFile("rose.jpg"), Bitmap)
ApplyOtsuThreshold(b)