A min-heap in Red/System

min-heap.reds

Red/System [
	Title:	"A min-heap implementation"
	Author: "Xie Qingtian"
	File: 	%min-heap.reds
	Tabs:	4
	Rights: "Copyright (C) 2018 Xie Qingtian. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/red/red/blob/master/BSL-License.txt
	}
]

heap-cmpfunc!: alias function! [
	a		[int-ptr!]
	b		[int-ptr!]
	return: [integer!]		;-- 0 => a = b, negative => a < b, positive => a > b
]

min-heap!: alias struct! [
	data	[int-ptr!]		;-- array of pointers, @@ change the spec once we support it
	size	[integer!]
	maxn	[integer!]
	grow	[integer!]
	compare	[heap-cmpfunc!]
]

min-heap: context [
	create: func [
		grow		[integer!]
		cmpfunc		[int-ptr!]
		return:		[min-heap!]
		/local
			hp		[min-heap!]
	][
		hp: as min-heap! allocate size? min-heap!
		hp/data: as int-ptr! allocate grow * size? int-ptr!
		hp/size: 0
		hp/maxn: grow
		hp/grow: grow
		hp/compare: as heap-cmpfunc! cmpfunc
		hp
	]

	put: func [
		hp	[min-heap!]
		val	[int-ptr!]
		/local
			n	[integer!]
			idx	[integer!]
			pv	[int-ptr!]
			arr	[int-ptr!]
	][
		if hp/size = hp/maxn [			;-- increase the memory
			n: hp/maxn + hp/grow + 3 >> 2 << 2		;-- align by 4-bytes
			assert n < 40000000h

			hp/maxn: n
			hp/data: as int-ptr! realloc as byte-ptr! hp/data n * size? int-ptr!
			assert (as-integer hp/data) and 3 = 0
		]

		arr: hp/data
		idx: hp/size
		hp/size: idx + 1

		while [
			n: idx - 1 >> 2 + 1			;-- parent index
			pv: as int-ptr! arr/n
			all [idx > 0 0 > hp/compare val pv]
		][
			idx: idx + 1
			arr/idx: as-integer pv		;-- move the parent down
			idx: n - 1
		]

		idx: idx + 1
		arr/idx: as-integer val
	]

	pop: func [
		hp		[min-heap!]
		return:	[int-ptr!]			;-- return the top value and remove it from the heap
		/local
			val		[int-ptr!]
			arr		[int-ptr!]
			idx		[integer!]
			idx1	[integer!]
			idx2	[integer!]
			cur		[integer!]
			lchild	[int-ptr!]
			rchild	[int-ptr!]
			last	[int-ptr!]
			sz		[integer!]
	][
		sz: hp/size
		if zero? sz [return null]

		arr: hp/data
		val: as int-ptr! arr/1
		idx: 0
		hp/size: sz - 1
		last: as int-ptr! arr/sz	;-- last value
		cur: 1

		while [
			idx: idx << 1 + 1		;-- index of the left child
			idx < sz
		][
			idx1: idx + 1
			lchild: as int-ptr! arr/idx1
			if idx1 < sz [			;-- have a right child
				idx2: idx1 + 1
				rchild: as int-ptr! arr/idx2
				if 0 < hp/compare lchild rchild [	;-- if lchild > rchild
					idx: idx1
					lchild: rchild
				]
			]
			if 0 <= hp/compare lchild last [break]

			arr/cur: as-integer lchild
			cur: idx + 1
		]
		arr/cur: as-integer last
		val
	]

	top: func [
		hp		[min-heap!]
		return: [int-ptr!]			;-- return the top value
	][
		as int-ptr! hp/data/1
	]

	;foreach: func [
	;	hp		[min-heap!]
	;	process [function! [data [int-ptr!]]]
	;][
	;	0
	;]

	;find: func [					;-- O(n) 
	;	hp		[min-heap!]
	;	value	[int-ptr!]
	;	return: [integer!]			; return index of the value, -1 if not find
	;][
	;	-1
	;]

	;remove: func [					;-- O(n)
	;	hp		[min-heap!]
	;	value	[int-ptr!]
	;	return: [logic!]			;-- true if find the value, otherwise false
	;][
	;	false
	;]

	clear: func [
		hp		[min-heap!]
	][
		hp/size: 0
	]

	destroy: func [
		hp		[min-heap!]
	][
		free as byte-ptr! hp/data
		free as byte-ptr! hp
	]
]