Back in June I wrote about a balanced binary tree problem I was having. We have since come up with a C++ solution and it’s working really well, though we have to link to some extra C++ stuff.
Today, out of the blue, I got an email from David Car who not only read the original blog post, but sent me a version which actually runs! This is what he had to say:
I came across your Fortran implementation of the Red Black Tree while reading a post by Mike Page on LinkedIn. I’ve attached an implementation that works built on what you did. At the moment I’m scratching my head as to why I had to do what I did in the attached code. Basically, I tracked down that in rotate_left (and rotate_right), the pointer x was reassigned to x%parent after the line
y%parent => x%parent
i.e. between your print statements. I don’t know why that happens. I discovered this by stepping through that section with gdb and also ran valgrind on it. You probably noticed that too. What I did was to simply treat the dummy argument to rotate_left(…) as simply a treenode with the target attribute rather than a pointer. I then use a local pointer x to point to it and it works fine. I often do this because it allows me to pass in a pointer or a an actual type as a dummy argument, but in this case it fixed the problem. I’m trying to track down why this is and will let you know what I find. I did some rearranging of the code and created a RedBlackTree type and a few other things.
BTW, I say your recent blog post on git. I think git is the best version control out there. I hope you find the same.
He later sent me this link which explains what happened.
Who is this person, you ask? This is what he’s up to:
BTW, I have written a templating preprocessor for Fortran 95/2003. I’m not sure how familiar you are with generic programming, but since you’re using C++, you are most likely knowledgeable in the Standard Template Library. I know of two other projects that try to provide this kind of capability in Fortran: Forpedo and Parametric Fortran. My project tried to achieve a more native look and feel to the language. The pre-processor is written in Python and I’m working on the Wiki. I have an ACM Fortran Forum article coming up in April on it. The main site is:
You’ll want to look at the Wiki for more documentation (link is in the upper left). The project comes with PyF95++ which is the templating preprocessor front end. It also included a pretty good start to a standard template library in Fortran. It has different types of linked lists, hashtable, pairs, etc. that are all generic containers, i.e. templated. It also has a unit testing framework for Fortran. You may have colleagues that could use such functionality in Fortran. It’s all under the MIT license. All the best.
Edit: A few days, a few iterations later, the code now looks like:
MODULE mod_tree ! !================================================== Kate Hedstrom ====== ! Fixes and improvements by David Car (david.car7@gmail.com) ! !======================================================================= ! Copyright (c) 2002-2010 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! Set up tree structure and functions. ! !======================================================================= ! implicit none !................................................................................ type treenode type(treenode), pointer :: left => null() type(treenode), pointer :: right => null() type(treenode), pointer :: parent => null() logical :: red = .FALSE. integer :: eggs = 0 real(kind=8) :: dist = 0.d0 end type treenode type RedBlackTree type(treenode), pointer :: root => null() integer :: nitems = 0 end type RedBlackTree !................................................................................ !................................................................................ ! Global nil node for leaves and parent of root. !................................................................................ type(treenode), target, save :: nil PUBLIC :: insert, RedBlackTree PRIVATE :: nil CONTAINS SUBROUTINE init(this) type (RedBlackTree) :: this this%root => nil END SUBROUTINE init !................................................................................ SUBROUTINE insert(this, eggs, dist) !.............................................................................. ! Insert a node into the tree !.............................................................................. type (RedBlackTree), target :: this integer, intent(in) :: eggs real(kind=8), intent(in) :: dist type(treenode), pointer :: cur, p, x, y ! Empty tree, deposit eggs at the top if (.not. associated(this % root)) return ALLOCATE(cur) cur % eggs = eggs cur % dist = dist cur % left => nil cur % right => nil this % nitems = this % nitems + 1 IF (ASSOCIATED(this % root, nil)) THEN this % root => cur this % root % parent => nil RETURN ENDIF ! Otherwise find somewhere to put these eggs ! New nodes end up at the bottom until a rebalance p => this%root DO IF (dist <= p % dist) THEN IF (.not. isLeaf(p % left)) THEN p => p % left CYCLE ELSE p % left => cur cur % parent => p EXIT END IF ELSE IF (.not. isLeaf(p % right)) THEN p => p % right CYCLE ELSE p % right => cur cur % parent => p EXIT END IF END IF END DO ! Balance the thing... red-black for now, until I get smarter about ! balancing eggs. cur % red = .true. x => cur p => null() DO WHILE (x % parent % red) IF (ASSOCIATED(x % parent % parent % left, x % parent)) THEN y => x % parent % parent % right ! uncle IF (y % red) THEN x % parent % red = .false. y % red = .false. x % parent % parent % red = .true. x => x % parent % parent ELSE IF (ASSOCIATED(x, x % parent % right)) THEN x => x % parent CALL rotate_left(this, x) END IF x % parent % red = .false. x % parent % parent % red = .true. CALL rotate_right(this, x % parent % parent) END IF ELSE ! Must be right grandchild to get here y => x % parent % parent % left ! aunt IF (y % red) THEN x % parent % red = .false. y % red = .false. x % parent % parent % red = .true. x => x % parent % parent ELSE IF (ASSOCIATED(x, x % parent % left)) THEN x => x % parent CALL rotate_right(this, x) END IF x % parent % red = .false. x % parent % parent % red = .true. CALL rotate_left(this, x % parent % parent) END IF END IF END DO this % root % red = .false. END SUBROUTINE insert ! ! For the rotating, I’m working from C code I found online for red-black trees, ! with reference to Introduction to Algorithms by Cormen, Leiserson, ! Rivest (Chapter 14). It makes right child of x into the parent of x. !................................................................................ SUBROUTINE rotate_left(this, x_) !.............................................................................. ! Rotate node x_ to the left in tree `this` !.............................................................................. type(RedBlackTree), intent(inout) :: this type(treenode), target, intent(inout) :: x_ type(treenode), pointer :: x => null() type(treenode), pointer :: y => null() integer :: mine, theirs x => x_ y => x % right x % right => y % left IF (.not. isLeaf(y % left)) THEN y % left % parent => x END IF y % parent => x % parent IF (ASSOCIATED(x % parent, nil)) THEN this % root => y ELSE IF (ASSOCIATED(x, x % parent % left)) THEN x % parent % left => y ELSE x % parent % right => y ENDIF END IF y % left => x x % parent => y END SUBROUTINE rotate_left !................................................................................ SUBROUTINE rotate_right(this, x_) !.............................................................................. ! Rotate node x_ to the right in tree `this` !.............................................................................. type(RedBlackTree), intent(inout) :: this type(treenode), target, intent(inout) :: x_ type(treenode), pointer :: x => null() type(treenode), pointer :: y => null() x => x_ y => x % left x % left => y % right IF (.not. isLeaf(y % right)) THEN y % right % parent => x END IF y % parent => x % parent IF (ASSOCIATED(x % parent, nil)) THEN this % root => y ELSE IF (ASSOCIATED(x, x % parent % right)) THEN x % parent % right => y ELSE x % parent % left => y ENDIF END IF y % right => x x % parent => y END SUBROUTINE rotate_right !................................................................................ ! None of these are used at the moment !................................................................................ !................................................................................ FUNCTION isLeft(x, y) result(b) !.............................................................................. ! Check if node y is left child of x !.............................................................................. type (treenode), pointer :: x, y logical :: b b = ASSOCIATED(x % left, y) END FUNCTION isLeft !................................................................................ FUNCTION isRight(x, y) result(b) !.............................................................................. ! Check if node y is right child of x !.............................................................................. type (treenode), pointer :: x, y logical :: b b = ASSOCIATED(x % right, y) END FUNCTION isRight !................................................................................ FUNCTION isLeaf(x) result(b) !.............................................................................. ! Check if node x is a leaf !.............................................................................. type (treenode), pointer :: x logical :: b b = ASSOCIATED(x, nil) END FUNCTION isLeaf END MODULE mod_tree !................ ! Test code !................ program main use mod_tree implicit none integer, parameter :: num = 8 type(RedBlackTree) :: tree integer :: caviar(num) real(kind=8) :: dist(num) integer :: i dist = (/ 21, 2, 3, 56, 78, 5, 7, 4 /) caviar = 100*dist call init(tree) do i=1,num call insert(tree, caviar(i), dist(i)) end do print *, 'Done' end program main