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.