my $reg = "Bio::EnsEMBL::Registry";
  my $archiveStableIdAdaptor =
    $reg->get_adaptor( 'human', 'core', 'ArchiveStableId' );

  my $stable_id = 'ENSG00000068990';
  my $history =
    $archiveStableIdAdaptor->fetch_history_tree_by_stable_id('ENSG01');

  print "Unique stable IDs in this tree:\n";
  print join( ", ", @{ $history->get_unique_stable_ids } ), "\n";

  print "\nReleases in this tree:\n";
  print join( ", ", @{ $history->get_release_display_names } ), "\n";

  print "\nCoordinates of nodes in the tree:\n\n";
  foreach my $a ( @{ $history->get_all_ArchiveStableIds } ) {
    print "  Stable ID: " . $a->stable_id . "." . $a->version . "\n";
    print "  Release: "
      . $a->release . " ("
      . $a->assembly . ", "
      . $a->db_name . ")\n";
    print "  coords: "
      . join( ', ', @{ $history->coords_by_ArchiveStableId($a) } )
      . "\n\n";
  }

  ENSG001   1-------------- 2--
                                \
  ENSG003                         1-----1
                                /
  ENSG002   1-------2----------

           38      39      40    41    42

  ENSG001.1               (0, 0)
  ENSG001.2               (2, 0)
  ENSG003.1 (release 41)  (3, 1) 
  ENSG003.1 (release 42)  (4, 1) 
  ENSG002.1               (0, 2)
  ENSG002.2               (1, 2)

  my ($self, $n) = @_;
  my $s = 1;
  $s *= $n-- while $n > 0;
  return $s;
}


#
# sort links by vertical distance
#

  my ($self, $element, $arrayref) = @_;

  throw("Expecting arrayref argument.") unless (ref($arrayref) eq 'ARRAY');

  my @array = @$arrayref;

  while (my $e = pop(@array)) {
    return scalar(@array) if ($e eq $element);
  }

  return undef;

  my ($self, $event) = @_;

  my ($old_id, $old_db_name, $new_id, $new_db_name);
  if ($event->old_ArchiveStableId) {
    $old_id = $event->old_ArchiveStableId->stable_id;
    $old_db_name = $event->old_ArchiveStableId->db_name;
  }
  if ($event->new_ArchiveStableId) {
    $new_id = $event->new_ArchiveStableId->stable_id;
    $new_db_name = $event->new_ArchiveStableId->db_name;
  }

  return join(':', $old_id, $old_db_name, $new_id, $new_db_name);

  my ($self, $link, $pos, $direction) = @_;

  my $first_pos = $pos->{$link->[0]};
  my $second_pos = $pos->{$link->[1]};

  # swap positions if necessary
  if ($first_pos > $second_pos) {
    my $tmp = $second_pos;
    $second_pos = $first_pos;
    $first_pos = $tmp;
  }
  #warn "      $first_pos:$second_pos\n";

  foreach my $p (keys %$pos) {
    
    my $val = $pos->{$p};
    
    #warn "      $p $val\n";
    if ($direction eq 'up') {
      if ($val > $first_pos and $val < $second_pos) {
        $val++;
      } elsif ($val == $second_pos) {
        $val = $first_pos + 1;
      }
    } else {
      if ($val > $first_pos and $val < $second_pos) {
        $val--;
      } elsif ($val == $first_pos) {
        $val = $second_pos - 1;
      }
    }
    
    #warn "      $p $val\n";
    $pos->{$p} = $val;
    #warn "\n";
  }
}


#
# calculate the total link (vertical distance) length based on this sort order
#

  my ($self, $archive_id) = @_;
  return $archive_id->stable_id . ':' . $archive_id->db_name;

  my ($self, $links, $pos) = @_;

  my @lookup;

  foreach my $link (@$links) {
    my $dist = $pos->{$link->[0]} - $pos->{$link->[1]};
    $dist = -$dist if ($dist < 0);
    push @lookup, [$dist, $link];
    #warn " $dist ".join(' ', @$link)."\n";
  }

  @$links = map { $_->[1] } sort { $b->[0] <=> $a->[0] } @lookup;
}


#
# make two nodes adjacent by moving the second node next to the first node
# all other node coordinates are adjusted accordingly
#

  my $self = shift;

  unless ($self->{'sorted_tree'}->{'releases'}) {

    my %unique = ();

    foreach my $archive_id (@{ $self->get_all_ArchiveStableIds }) {
      $unique{join(':', $archive_id->db_name, $archive_id->release)} = 1;
    }

    # sort releases by release number, then db_name; this should get them into
    # chronological order
    my @releases = sort { $a->[1] <=> $b->[1] || $a->[0] cmp $b->[0] }
      map { [ split(/:/, $_) ] } keys(%unique);

    $self->{'sorted_tree'}->{'releases'} =\@ releases;
  
  }

  return $self->{'sorted_tree'}->{'releases'};

  my $self = shift;
  my %unique = map { $_->stable_id => 1 } @{ $self->get_all_ArchiveStableIds };
  return [sort keys %unique];

  my ($self, $links, $pos) = @_;

  my $total_length;

  foreach my $link (@$links) {
    my $length = $pos->{$link->[0]} - $pos->{$link->[1]};
    $length = -$length if ($length < 0);
    $total_length += $length;
  }

  return $total_length;

  my ($self, @archive_ids) = @_;

  throw("You must provide one or more Bio::EnsEMBL::ArchiveStableIds to add.")
    unless (@archive_ids);

  foreach my $archive_id (@archive_ids) {
    throw("Bio::EnsEMBL::ArchiveStableId object expected.")
      unless (ref($archive_id) &&
              $archive_id->isa('Bio::EnsEMBL::ArchiveStableId'));

    $self->{'nodes'}->{$self->_node_id($archive_id)} = $archive_id;
  }

  my $self = shift;

  foreach my $event (@{ $self->get_all_StableIdEvents }) {
    if ($event->old_ArchiveStableId) {
      $self->add_ArchiveStableIds($event->old_ArchiveStableId);
    }
    if ($event->new_ArchiveStableId) {
      $self->add_ArchiveStableIds($event->new_ArchiveStableId);
    }
  }

  my ($self, @events) = @_;

  throw("You must provide one or more Bio::EnsEMBL::StableIdsEvents to add.")
    unless (@events);

  foreach my $event (@events) {
    throw("Bio::EnsEMBL::StableIdEvent object expected.")
      unless ($event->isa('Bio::EnsEMBL::StableIdEvent'));

    $self->{'links'}->{$self->_link_id($event)} = $event;
  }

  my $self = shift;

  # reset any previous tree cordinate calculations
  $self->reset_tree;

  # the "master" information for the sorted tree is stored as the sorted lists
  # of releases (x) and stable IDs (y). Sort them now.
  my $db_names = $self->get_release_db_names;

  # untangle tree by sorting stable IDs appropriately
  $self->optimise_tree;
  my $stable_ids = $self->get_unique_stable_ids;
  
  # for performance reasons, additionally store coordinates in a lookup hash
  foreach my $archive_id (@{ $self->get_all_ArchiveStableIds }) {
  
    # coordinates are positions in the sorted lists
    my $x = $self->_index_of($archive_id->db_name, $db_names);
    my $y = $self->_index_of($archive_id->stable_id, $stable_ids);
  
    $self->{'sorted_tree'}->{'coords'}->{$self->_node_id($archive_id)} =
      [ $x, $y ];
  }
}

#
# Description : Returns the index of an element in an array
# Example     : my @array = (a, b, c);
#               my $i = _index_of('b', \@array); # will return 1
# Return type : Int (or undef if element is not found in array)
#

  my $self = shift;

  #
  # get all self-events and creations/deletions and sort them (by stable ID and
  # chronologically)
  #
  my @event_lookup;
  
  foreach my $event (@{ $self->get_all_StableIdEvents }) {

    my $old_id = $event->old_ArchiveStableId;
    my $new_id = $event->new_ArchiveStableId;

    if (!$old_id or !$new_id or ($old_id->stable_id eq $new_id->stable_id)) {
      if ($old_id) {
        push @event_lookup, [$old_id->stable_id, $old_id->release, 
          $old_id->db_name, $event];
      } else {
        push @event_lookup, [$new_id->stable_id, $new_id->release - 1,
          $new_id->db_name, $event];
      }
    }
  }

  my @self_events = map { $_->[3] }
    sort { $a->[0] cmp $b->[0] || $a->[1] <=> $b->[1] || $a->[2] cmp $b->[2] }
      @event_lookup;

  #
  # consolidate tree
  #
  my $last = shift(@self_events);

  while (my $event = shift(@self_events)) {

    my $lo = $last->old_ArchiveStableId;
    my $ln = $last->new_ArchiveStableId;
    my $eo = $event->old_ArchiveStableId;
    my $en = $event->new_ArchiveStableId;

    if ($lo and $eo and $en and $lo->stable_id eq $eo->stable_id
        and $lo->version eq $eo->version) {

      # this removes redundant nodes and connects the remaining nodes:
      #
      # o--o--o  ->  o-----o
      # 1  1  1      1     1

      #warn 'A: '.$last->ident_string.' | '.$event->ident_string."\n";

      $self->remove_StableIdEvent($last);
      $self->remove_StableIdEvent($event);

      $event->old_ArchiveStableId($lo);

      $self->add_StableIdEvents($event);

    } elsif ($ln and $eo and $ln->db_name ne $eo->db_name
        and $ln->stable_id eq $eo->stable_id and $ln->version eq $eo->version) {
        
      # try to brigde gaps

      if ($en) {
        
        # o--o  o--o  ->  o--o-----o
        # 1  2  2  2      1  2     2
        #
        #    o  o--o  ->  o-----o
        #    1  1  1      1     1
        
        #warn 'X: '.$last->ident_string.' | '.$event->ident_string."\n";

        $self->remove_StableIdEvent($event);
        $event->old_ArchiveStableId($ln);
        $self->add_StableIdEvents($event);

      } elsif ($lo) {
        
        # there's a deletion event, deal with it differently

        if ($lo->version eq $ln->version) {
        
          # o--o  o  ->  o-----o
          # 1  1  1      1     1
          
          #warn 'Y: '.$last->ident_string.' | '.$event->ident_string."\n";

          $self->remove_StableIdEvent($last);
          $last->new_ArchiveStableId($eo);
          $self->add_StableIdEvents($last);

        } else {

          # o--o  o  ->  o--o--o
          # 1  2  2      1  2  2
          
          #warn 'Z: '.$last->ident_string.' | '.$event->ident_string."\n";

          $self->remove_StableIdEvent($event);
          $event->old_ArchiveStableId($ln);
          $event->new_ArchiveStableId($eo);
          $self->add_StableIdEvents($event);

        }

      } else {

        # creation followed by deletion in next mapping
        #
        # o  o  ->  o--o
        # 1  1      1  1

        #warn 'Q: '.$last->ident_string.' | '.$event->ident_string."\n";

        $self->remove_StableIdEvent($last);
        $self->remove_StableIdEvent($event);
        $event->old_ArchiveStableId($ln);
        $event->new_ArchiveStableId($eo);
        $self->add_StableIdEvents($event);

      }

    } else {
      #warn 'C: '.$last->ident_string.' | '.$event->ident_string."\n";
    }
  
    $last = $event;
  }
  
  # now add ArchiveStableIds of the remaining events to the tree
  $self->add_ArchiveStableIds_for_events;

  my ($self, $archive_id) = @_;

  throw("Bio::EnsEMBL::ArchiveStableId object expected.")
    unless ($archive_id and ref($archive_id) and
      $archive_id->isa('Bio::EnsEMBL::ArchiveStableId'));
  
  return $self->{'sorted_tree'}->{'coords'}->{$self->_node_id($archive_id)}
    || [];

  my $self = shift;
  $self->{'current_assembly'} = shift if (@_);
  return $self->{'current_assembly'};

  my $self = shift;
  $self->{'current_dbname'} = shift if (@_);
  return $self->{'current_dbname'};

  my $self = shift;
  $self->{'current_release'} = shift if (@_);
  return $self->{'current_release'};

  my $self = shift;
  $self->{'nodes'} = undef;
}


#
# generate a unique node identifier
# 

  my $self = shift;
  $self->{'links'} = undef; 
}


#
# generate a unique link identifier
# 

  my $self = shift;
  return [ values %{ $self->{'nodes'} } ];

  my $self = shift;
  return [ values %{ $self->{'links'} } ];

  my $self = shift;

  my @current = ();

  foreach my $arch_id (@{ $self->get_all_ArchiveStableIds }) {
    push @current, $arch_id if ($arch_id->is_current);
  }

  return\@ current;

  my $self = shift;
  my $arch_id = shift;
  
  unless ($arch_id and $arch_id->isa('Bio::EnsEMBL::ArchiveStableId')) {
    throw("Need a Bio::EnsEMBL::ArchiveStableId.");
  }

  my @all_events = @{ $self->get_all_StableIdEvents };
  my @self_events = ();

  while (my $event = shift(@all_events)) {
    if ($event->new_ArchiveStableId and
        $event->new_ArchiveStableId->stable_id eq $arch_id->stable_id) {
      push @self_events, $event;
    }
  }

  my @sorted = sort { $b->new_ArchiveStableId->release <=>
                      $a->new_ArchiveStableId->release } @self_events;
  
  # give priority to self events
  my $latest;
  while ($latest = shift @sorted) {
    last if (($latest->old_ArchiveStableId and
              $latest->old_ArchiveStableId->stable_id eq $arch_id->stable_id)
             or !$latest->old_ArchiveStableId);
  }

  return $latest;

  my $self = shift;
  
  my @db_names = map { $_->[0] } @{ $self->_sort_releases };

  return\@ db_names;
}


#
# Create a chronologically sorted list of releases.
#
# Return type : Arrayref of arrayrefs (db_name, release)
#

  my $self = shift;
  
  my @display_names = map { $_->[1] } @{ $self->_sort_releases };

  return\@ display_names;

  my $self = shift;
  
  unless ($self->{'sorted_tree'}->{'stable_ids'}) {
    $self->{'sorted_tree'}->{'stable_ids'} = $self->_sort_stable_ids;
  }
  
  return $self->{'sorted_tree'}->{'stable_ids'};
}


#
# Returns a list of stable IDs in this history tree, sorted alphabetically.
# This is the simplest sort function used and doesn't try to untangle the tree.
#
# Return type : Arrayref
#

  my $self = shift;
  $self->{'incomplete'} = shift if (@_);
  return $self->{'incomplete'};
}


1;

  my $caller = shift;
  my $class = ref($caller) || $caller;
  
  my $self = {};
  bless $self, $class;

  my ($current_dbname, $current_release, $current_assembly) =
    rearrange([qw( CURRENT_DBNAME CURRENT_RELEASE CURRENT_ASSEMBLY )], @_ );

  # initialise
  $self->{'current_dbname'} = $current_dbname;
  $self->{'current_release'} = $current_release;
  $self->{'current_assembly'} = $current_assembly;
  
  return $self;

  my $self = shift;

  # get all non-self events
  my @links;
  foreach my $event (@{ $self->get_all_StableIdEvents }) {
    next unless ($event->old_ArchiveStableId and $event->new_ArchiveStableId);
    my $old_id = $event->old_ArchiveStableId->stable_id;
    my $new_id = $event->new_ArchiveStableId->stable_id;
    push @links, [$old_id, $new_id] if ($old_id ne $new_id);
  }

  # get initial list of sorted unique stable IDs and put them into a position
  # lookup hash
  my $i = 0;
  my %pos = map { $_ => $i++ } @{ $self->_sort_stable_ids };

  my $opt_length;
  my $successive_fails = 0;
  my $k = 0;
  my %seen;

  # for debug purposes:
  # find the number of permutations for the given number of stable IDs
  my $fact = $self->_factorial(scalar(keys %pos));

  OPT:
  while ($successive_fails < 100) {

    # sort links by vertical distance
    #warn "sorting\n";
    $self->_sort_links(\@links,\% pos);

    # loop over sorted links
    SORTED:
    foreach my $link (@links) {
      
      #warn "  trying ".join('-', @$link)."\n";

      $k++;
      
      # remember last sort order
      my %last = %pos;
      
      #my $this_order = join(':', sort { $pos{$a} <=> $pos{$b} } keys %pos);
      #warn "    before $this_order\n";

      # try both to move bottom node next to top node's current position and
      # top node next to bottom node's position - one of the methods might give
      # you better results
      DIRECT:
      foreach my $direction (qw(up down)) {

        # move the nodes next to each other
        $self->_move_nodes($link,\% pos, $direction);

        # next if we've seen this sort order before
        my $new_order = join(':', sort { $pos{$a} <=> $pos{$b} } keys %pos);
        #warn "    after ($direction) $new_order\n";
        if ($seen{$new_order}) {
          #warn "      seen\n";
          %pos = %last;
          next DIRECT;
        }
        $seen{$new_order} = 1;

        # calculate total link length for this sort order
        my $total_length = $self->_total_link_length(\@links,\% pos);

        if (!$opt_length or $total_length < $opt_length) {
          #warn "      better ($total_length/$opt_length)\n";
          $opt_length = $total_length;
          $successive_fails = 0;
          next OPT;
        } else {
          #warn "      worse ($total_length/$opt_length)\n";
          %pos = %last;
          $successive_fails++;
        }
      }
      
    }

    last OPT;
    
  }

  #warn "Needed $k tries (of $fact) to find optimal tree.\n";

  my @best = sort { $pos{$a} <=> $pos{$b} } keys %pos;
  $self->{'sorted_tree'}->{'stable_ids'} =\@ best;
}


#
# find the number of permutations for a give array size.
# used for debugging code (compare implemented algorithm to looping over all
# possible permutations).
#

  my ($self, $archive_id) = @_;
    
  throw("Bio::EnsEMBL::ArchiveStableId object expected.")
    unless ($archive_id && ref($archive_id) &&
            $archive_id->isa('Bio::EnsEMBL::ArchiveStableId'));

  my %nodes = %{ $self->{'nodes'} };
  delete $nodes{$self->_node_id($archive_id)};
  $self->{'nodes'} =\% nodes;

  my ($self, $event) = @_;
    
  throw("Bio::EnsEMBL::StableIdEvent object expected.") unless
    ($event && ref($event) && $event->isa('Bio::EnsEMBL::StableIdEvent'));

  my %links = %{ $self->{'links'} };
  delete $links{$self->_link_id($event)};
  $self->{'links'} =\% links;

  my $self = shift;
  $self->{'sorted_tree'} = undef;

  Copyright (c) 1999-2009 The European Bioinformatics Institute and
  Genome Research Limited.  All rights reserved.

  This software is distributed under a modified Apache license.
  For license details, please see

    /info/about/code_licence.html

  Please email comments or questions to the public Ensembl
  developers list at <ensembl-dev@ebi.ac.uk>.

  Questions may also be sent to the Ensembl help desk at
  <helpdesk@ensembl.org>.

  Bio::EnsEMBL::ArchiveStableId
  Bio::EnsEMBL::DBSQL::ArchiveStableIdAdaptor
  Bio::EnsEMBL::StableIdEvent