Rice Compress

Rice is data compression algorithm. This is most useful for compressing data like image and audio.

For Rice Decompress algorithm click here.



									Private Const RICE_HISTORY As Integer = 16
Private Const RICE_THRESHOLD As Integer = 8

Public Class BitStream
	Public BytePointer As Byte()
	Public BitPosition As UInteger
	Public NumBytes As UInteger
End Class

Private Shared Function numBits(x As UInteger) As Integer
	Dim n As Integer
	n = 32
	While Not Convert.ToBoolean(x And &H80000000UI) AndAlso (n > 0)
		x <<= 1
		n -= 1
	End While
	Return n
End Function

Private Shared Sub initBitStream(ByRef stream As BitStream, buffer As Byte(), bytes As UInteger)
	stream.BytePointer = buffer
	stream.BitPosition = 0
	stream.NumBytes = bytes
End Sub

Private Shared Sub writeBit(ByRef stream As BitStream, x As Integer)
	Dim index As UInteger = stream.BitPosition >> 3

	If index < stream.NumBytes Then
		Dim bit As UInteger = 7 - (stream.BitPosition And 7)
		Dim mask As UInteger = CUInt(&HFF Xor (1 << CInt(bit)))
		Dim [set] As UInteger = CUInt((x And 1) << CInt(bit))
		stream.BytePointer(index) = CByte((stream.BytePointer(index) And mask) Or [set])
		stream.BitPosition += 1
	End If
End Sub

Private Shared Sub encodeWord(x As UInteger, k As Integer, ByRef stream As BitStream)
	Dim j As Integer
	Dim q As UInteger = x >> k

	If q > RICE_THRESHOLD Then
		For j = 0 To RICE_THRESHOLD - 1
			writeBit(stream, 1)
		Next

		q -= RICE_THRESHOLD

		Dim o As Integer = numBits(q)

		For j = 0 To o - 1
			writeBit(stream, 1)
		Next

		writeBit(stream, 0)

		For j = o - 2 To 0 Step -1
			writeBit(stream, CInt((q >> j) And 1))
		Next
	Else
		For i As UInteger = 0 To q
			writeBit(stream, 1)
		Next

		writeBit(stream, 0)
	End If

	For j = k - 1 To 0 Step -1
		writeBit(stream, CInt((x >> j) And 1))
	Next
End Sub

Public Shared Function Compress(input As Byte(), output As Byte(), inputSize As UInteger) As Integer
	Dim stream As New BitStream()
	Dim i As UInteger, x As UInteger, k As UInteger, n As UInteger, wordSize As UInteger = 8
	Dim histogram As UInteger() = New UInteger(RICE_HISTORY - 1) {}
	Dim j As Integer

	Dim incount As UInteger = inputSize / (wordSize >> 3)

	If incount = 0 Then
		Return 0
	End If

	initBitStream(stream, output, inputSize + 1)
	k = 0

	i = 0
	While (i < RICE_HISTORY) AndAlso (i < incount)
		n = CUInt(numBits(input(i)))
		k += n
		i += 1
	End While

	k = (k + (i >> 1)) / i

	If k = 0 Then
		k = 1
	End If

	output(0) = CByte(k)
	stream.BitPosition = 8

	i = 0
	While (i < incount) AndAlso ((stream.BitPosition >> 3) <= inputSize)
		If i >= RICE_HISTORY Then
			k = 0

			For j = 0 To RICE_HISTORY - 1
				k += histogram(j)
			Next

			k = (k + (RICE_HISTORY >> 1)) / RICE_HISTORY
		End If

		x = input(i)
		encodeWord(x, CInt(k), stream)
		histogram(i Mod RICE_HISTORY) = CUInt(numBits(x))
		i += 1
	End While

	If i < incount Then
		output(0) = 0
		stream.BitPosition = 8

		For i = 0 To incount - 1
			x = input(i)

			For j = CInt(wordSize) - 1 To 0 Step -1
				writeBit(stream, CInt((x >> j) And 1))
			Next
		Next
	End If

	Return CInt((stream.BitPosition + 7) >> 3)
End Function
								


Example

									Dim str As String = "This is an example for Rice coding"
Dim originalData As Byte() = Encoding.[Default].GetBytes(str)
Dim originalDataSize As UInteger = CUInt(str.Length)
Dim compressedData As Byte() = New Byte(originalDataSize) {}

Dim compressedDataSize As Integer = Compress(originalData, compressedData, originalDataSize)