ROMS/TOMS Developers

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:

blockit

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

Back in a prior post, I wrote an introduction to git, a new open source version control package. I’ve since been learning more about it, especially reading much of the O’Reilly book “Version Control with Git” by Jon Loeliger over the holiday break. There are a few things which I’ve found just a little confusing or surprising coming from a cvs/svn background, in addition to the concept of a distributed repository system. I’d like to talk about one just a little, but first, I’d like to apologize for this incorrect statement from last time:

It can then be pointed to a different SVN server – from the same sandbox! Magic!

It turns out that’s not true – a git sandbox can point to any number of remote git repositories, but only to at most one remote svn server. All is not lost, however, since you can have two git sandboxes, each pointing to one svn server, but as git remotes of each other. Thanks to Brian Powell for sending me
this link.

I actually think you can point to two branches in the same svn site from one git directory, but you have to tell it how the branches are layed out in the “git svn clone” operation. I haven’t tried it yet, though.

The Index
The concept of the index is new to me, and something I didn’t come to appreciate until working with git for a bit. It is a staging area for building up your next commit, between the working directory and the repository. You can have changes going on which should logically be checked in separately – you add the first set to the index with “git add file1”, then commit with “git commit”, leaving changes to file2 to be checked in later, assuming the changes aren’t all in the same file.

Also, “git diff” is a diff between the working directory and the index, not a diff between the working directory and the latest commit (HEAD), as is the case with cvs and svn. To get the diff from the last commit, use instead “git diff HEAD”. Likewise, “git diff –cached” is the diff between the HEAD and the index, showing what would be checked in with a “git commit”.

Also, when doing a “git pull” or a “git merge”, only the conflicts show up with “git diff”. I’ve been caught by this one, thinking I knew what all had arrived in a “git pull” from a colleague! I think the advice of sticking to “git fetch” rather than “git pull” is one I’ll try. By the way, “git pull” is a “git fetch” followed by a “git merge”.

I’m still committed to getting more comfortable with git and using it more intelligently. We got a proposal funded which will involve me having to work with svn at two remote sites in two different states, one of which is now woefully out of date. Call it a New Year’s resolution to get that fixed with git!