Module rbtree_fd4_mdsd_mod
Uses:
module fd4_mdsd_mod, only: fd4_mdsd
module kinds_mod, only: i_k
Types:
public type rb_node_fd4_mdsd_links
public type rb_node_fd4_mdsd
public type rbtree_fd4_mdsd
public type rbtree_fd4_mdsd_iter
Subroutines and functions:
private function is_red (node)
private function single_rotate (node, dir)
private function double_rotate (node, dir)
private recursive function validate (node) result (height)
private recursive subroutine print_tree (node, level)
private function create_node (key, value)
private function node_equal (node1, node2)
public subroutine rbtree_fd4_mdsd_validate (rbtree, ierr)
public subroutine rbtree_fd4_mdsd_print (rbtree)
public function rbtree_fd4_mdsd_get (rbtree, key)
public subroutine rbtree_fd4_mdsd_insert (rbtree, key, value, ierr)
public function rbtree_fd4_mdsd_delete (rbtree, key, iter)
public subroutine rbtree_fd4_mdsd_clear (rbtree, dealloc_sub)
public subroutine rbtree_fd4_mdsd_detach (rbtree)
public subroutine rbtree_fd4_mdsd_swap (rbtree1, rbtree2)
public function rbtree_fd4_mdsd_iter_first (iter, rbtree)
public function rbtree_fd4_mdsd_iter_last (iter, rbtree)
public function rbtree_fd4_mdsd_iter_next (iter)
public function rbtree_fd4_mdsd_iter_prev (iter)
public function rbtree_fd4_mdsd_iter_set (iter, key)
public function rbtree_fd4_mdsd_iter_key (iter)
public function rbtree_fd4_mdsd_iter_value (iter)
Red-Black binary search tree combined with a doubly-linked list for fast iteration.
The compexity of the insert, delete, and get (i.e. find) routines is logarithmic.
Iterator functions next and previous have constant complexity.
The tree stores pointers to a derived type fd4_mdsd.
It is assumed that the type definition resides in a module called
fd4_mdsd_mod.
The Red-Black tree is coded following the descripton from Julienne Walker at
http://www.eternallyconfuzzled.com.
Author: Matthias Lieber
Description of Types
rb_node_fd4_mdsd_links
public type rb_node_fd4_mdsd_links
type (rb_node_fd4_mdsd), pointer :: n => NULL ()
end type rb_node_fd4_mdsd_links
Helper to build an array of pointers to tree nodes. Only used internally.
rb_node_fd4_mdsd
public type rb_node_fd4_mdsd
type (rb_node_fd4_mdsd_links), dimension (0:1) :: link
type (rb_node_fd4_mdsd_links), dimension (0:1) :: list
integer (kind=i_k) :: red = 0
integer (kind=i_k) :: key = 0
type (fd4_mdsd), pointer :: value => NULL ()
end type rb_node_fd4_mdsd
Components:
link | pointers to left and right children |
list | pointers to previous and next node in sorted list |
red | color of the node, 1 if red, 0 if black |
key | the key of the data |
value | pointer to a type containing the actual data |
A tree node. Only used internally.
rbtree_fd4_mdsd
public type rbtree_fd4_mdsd
type (rb_node_fd4_mdsd), pointer :: root => NULL ()
type (rb_node_fd4_mdsd_links), dimension (0:1) :: list
integer (kind=i_k) :: length = 0
end type rbtree_fd4_mdsd
Components:
root | pointer to root node |
list | pointers to first and last node in sorted list |
length | number of elements in the tree |
The tree.
rbtree_fd4_mdsd_iter
public type rbtree_fd4_mdsd_iter
type (rbtree_fd4_mdsd), pointer :: rbtree
type (rb_node_fd4_mdsd), pointer :: cur => NULL ()
end type rbtree_fd4_mdsd_iter
Components:
rbtree | pointer to the tree to iterate |
cur | pointer to the current node |
A tree iterator type.
Description of Subroutines and Functions
is_red
private function is_red (node)
type (rb_node_fd4_mdsd), pointer :: node
logical :: is_red
end function is_red
Check if node is red. Internal.
single_rotate
private function single_rotate (node, dir)
type (rb_node_fd4_mdsd), pointer :: node
integer (kind=i_k), intent(in) :: dir
type (rb_node_fd4_mdsd), pointer :: single_rotate
end function single_rotate
Parameters:
node | pivot node |
dir | direction of rotation, 0 means left, 1 means right |
single_rotate | return value, new root node of the subtree |
Single rotation. Internal.
double_rotate
private function double_rotate (node, dir)
type (rb_node_fd4_mdsd), pointer :: node
integer (kind=i_k), intent(in) :: dir
type (rb_node_fd4_mdsd), pointer :: double_rotate
end function double_rotate
Parameters:
node | pivot node |
dir | direction of rotation, 0 means left, 1 means right |
double_rotate | return value, new root node of the subtree |
validate
private recursive function validate (node) result (height)
type (rb_node_fd4_mdsd), pointer :: node
integer (kind=i_k) :: height
end function validate
Check if tree is a valid red black tree. Internal.
print_tree
private recursive subroutine print_tree (node, level)
type (rb_node_fd4_mdsd), pointer :: node
integer (kind=i_k), intent(in) :: level
end subroutine print_tree
Print tree. Internal.
create_node
private function create_node (key, value)
integer (kind=i_k), intent(in) :: key
type (fd4_mdsd), pointer :: value
type (rb_node_fd4_mdsd), pointer :: create_node
end function create_node
Parameters:
key | the key |
value | pointer to the data the node should hold |
create_node | return value, the new node just created |
Create new node. Internal.
node_equal
private function node_equal (node1, node2)
type (rb_node_fd4_mdsd), pointer :: node1
type (rb_node_fd4_mdsd), pointer :: node2
integer (kind=i_k) :: node_equal
end function node_equal
Parameters:
node1 | first node to compare |
node2 | second node to compare |
node_equal | return value, 1 if equal, 0 otherwise |
Check if two node pointers are the same node. Internal.
rbtree_fd4_mdsd_validate
public subroutine rbtree_fd4_mdsd_validate (rbtree, ierr)
type (rbtree_fd4_mdsd), intent(in) :: rbtree
integer (kind=i_k), optional, intent(out) :: ierr
end subroutine rbtree_fd4_mdsd_validate
Parameters:
rbtree | the red black tree |
ierr | error status |
Check if tree is valid red black tree.
Prints errors to stdout.
rbtree_fd4_mdsd_print
public subroutine rbtree_fd4_mdsd_print (rbtree)
type (rbtree_fd4_mdsd), intent(in) :: rbtree
end subroutine rbtree_fd4_mdsd_print
Parameters:
rbtree | the red black tree |
Print the tree to stdout. Useful for debugging.
rbtree_fd4_mdsd_get
public function rbtree_fd4_mdsd_get (rbtree, key)
type (rbtree_fd4_mdsd), intent(in) :: rbtree
integer (kind=i_k), intent(in) :: key
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_get
end function rbtree_fd4_mdsd_get
Parameters:
rbtree | the red black tree |
key | key of the entry to retrieve |
rbtree_fd4_mdsd_get | return value, pointer to requested data or null if not found |
Get a value from the tree. Top-down search without recursion.
rbtree_fd4_mdsd_insert
public subroutine rbtree_fd4_mdsd_insert (rbtree, key, value, ierr)
type (rbtree_fd4_mdsd), intent(inout) :: rbtree
integer (kind=i_k), intent(in) :: key
type (fd4_mdsd), pointer :: value
integer (kind=i_k), optional, intent(out) :: ierr
end subroutine rbtree_fd4_mdsd_insert
Parameters:
rbtree | the red black tree |
key | key of the entry to insert |
value | pointer to value of the entry to insert |
ierr | optional error status, 0 means ok, 1 means duplicate key |
Insert new entry to the tree. Top-down insertion without recursion.
rbtree_fd4_mdsd_delete
public function rbtree_fd4_mdsd_delete (rbtree, key, iter)
type (rbtree_fd4_mdsd), intent(inout) :: rbtree
integer (kind=i_k), intent(in) :: key
type (rbtree_fd4_mdsd_iter), optional, intent(inout) :: iter
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_delete
end function rbtree_fd4_mdsd_delete
Parameters:
rbtree | the red black tree |
key | key of the entry to delete |
iter | an optional iterator which will be repaired if damaged due to deletion |
rbtree_fd4_mdsd_delete | return value, pointer to the value deleted from list or null if key not found |
Delete entry from the tree. Top-down deletion without recursion.
If an optional iterator is given, it will be repaired when damaged due
deletion. This damage may happen to any iterator of the tree,
so you must do this when deleting entries within a tree iteration!
This damage is due to the delete algorithm, which sometimes swap tree node contents.
In this case, the iterator would point to the wrong node.
CAUTION: Do not delete the current entry of the iterator!
If you still do so, you must re-initialize the iterator.
The following code snipped shows how to safely delete entries within an iteration:
value => rbtree_fd4_mdsd_iter_first(rbiter, rbtree)
do while ( associated(value) )
! get key of current
key = rbtree_fd4_mdsd_iter_key(rbiter)
! this function returns true if we do not longer need this item
useless = is_item_useless(value)
! iterate one item forward
value => rbtree_fd4_mdsd_iter_next(rbiter)
if(useless) then
! delete previous item and fix iterator if necessary
deleted => rbtree_fd4_mdsd_delete(rbtree, key, rbiter)
end if
end do
rbtree_fd4_mdsd_clear
public subroutine rbtree_fd4_mdsd_clear (rbtree, dealloc_sub)
type (rbtree_fd4_mdsd), intent(inout) :: rbtree
interface dealloc_sub
subroutine dealloc_sub (p)
type (fd4_mdsd), pointer :: p
end subroutine dealloc_sub
end interface dealloc_sub
-
subroutine which deallocates a pointer of type fd4_mdsd
end subroutine rbtree_fd4_mdsd_clear
Parameters:
rbtree | the red black tree |
dealloc_sub | subroutine which deallocates a pointer of type fd4_mdsd |
Clear the whole tree.
rbtree_fd4_mdsd_detach
public subroutine rbtree_fd4_mdsd_detach (rbtree)
type (rbtree_fd4_mdsd), intent(inout) :: rbtree
end subroutine rbtree_fd4_mdsd_detach
Parameters:
rbtree | the red black tree |
Clear the whole tree
without deallocating contained items.
rbtree_fd4_mdsd_swap
public subroutine rbtree_fd4_mdsd_swap (rbtree1, rbtree2)
type (rbtree_fd4_mdsd), intent(inout) :: rbtree1
type (rbtree_fd4_mdsd), intent(inout) :: rbtree2
end subroutine rbtree_fd4_mdsd_swap
Parameters:
rbtree1 | the 1st red black tree |
rbtree2 | the 2nd red black tree |
Swap two rbtrees (just swaps the internal pointers of the tree structure)
rbtree_fd4_mdsd_iter_first
public function rbtree_fd4_mdsd_iter_first (iter, rbtree)
type (rbtree_fd4_mdsd_iter), intent(inout) :: iter
type (rbtree_fd4_mdsd), target, intent(in) :: rbtree
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_iter_first
end function rbtree_fd4_mdsd_iter_first
Parameters:
iter | the iterator |
rbtree | the red black tree |
rbtree_fd4_mdsd_iter_first | return value, pointer to first value in the tree |
Initialize iterator for tree
rbtree,
position on the first element.
rbtree_fd4_mdsd_iter_last
public function rbtree_fd4_mdsd_iter_last (iter, rbtree)
type (rbtree_fd4_mdsd_iter), intent(inout) :: iter
type (rbtree_fd4_mdsd), target, intent(in) :: rbtree
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_iter_last
end function rbtree_fd4_mdsd_iter_last
Parameters:
iter | the iterator |
rbtree | the red black tree |
rbtree_fd4_mdsd_iter_last | return value, pointer to last value in the tree |
Initialize iterator for tree
rbtree,
position on the last element.
rbtree_fd4_mdsd_iter_next
public function rbtree_fd4_mdsd_iter_next (iter)
type (rbtree_fd4_mdsd_iter), intent(inout) :: iter
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_iter_next
end function rbtree_fd4_mdsd_iter_next
Parameters:
iter | the iterator |
rbtree_fd4_mdsd_iter_next | return value, pointer to next value |
Iterate to next item in tree.
CAUTION: This routine will intentionally cause a segmentation violation
if the iterator is not valid!
rbtree_fd4_mdsd_iter_prev
public function rbtree_fd4_mdsd_iter_prev (iter)
type (rbtree_fd4_mdsd_iter), intent(inout) :: iter
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_iter_prev
end function rbtree_fd4_mdsd_iter_prev
Parameters:
iter | the iterator |
rbtree_fd4_mdsd_iter_prev | return value, pointer to previous value |
Iterate to previous item in tree.
CAUTION: This routine will intentionally cause a segmentation violation
if the iterator is not valid!
rbtree_fd4_mdsd_iter_set
public function rbtree_fd4_mdsd_iter_set (iter, key)
type (rbtree_fd4_mdsd_iter), intent(inout) :: iter
integer (kind=i_k), intent(in) :: key
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_iter_set
end function rbtree_fd4_mdsd_iter_set
Parameters:
iter | the iterator |
key | key of the entry to search |
rbtree_fd4_mdsd_iter_set | return value, value at the requested position or null if not found |
Set position of an iterator. Top-down search without recursion.
rbtree_fd4_mdsd_iter_key
public function rbtree_fd4_mdsd_iter_key (iter)
type (rbtree_fd4_mdsd_iter), intent(in) :: iter
integer (kind=i_k) :: rbtree_fd4_mdsd_iter_key
end function rbtree_fd4_mdsd_iter_key
Parameters:
iter | the iterator |
rbtree_fd4_mdsd_iter_key | return value, the key of current node |
Get the key of current node.
CAUTION: This routine will intionally cause a segmentation violation
if the iterator is not valid!
rbtree_fd4_mdsd_iter_value
public function rbtree_fd4_mdsd_iter_value (iter)
type (rbtree_fd4_mdsd_iter), intent(in) :: iter
type (fd4_mdsd), pointer :: rbtree_fd4_mdsd_iter_value
end function rbtree_fd4_mdsd_iter_value
Parameters:
iter | the iterator |
rbtree_fd4_mdsd_iter_value | return value, the value of current node or null if current node is null |
Get value of current node.