Smart use of Inheritance and recursiveness when working with tree-structured data in object orientated perl5 programming

When developing an program for managing a series of mah-jong games, I recently tried different techniques to work with tree structures in object oriented perl5 programming. Basically, when working with data-trees, the kind of inheritance you get with object orientation has to be combined with recursiveness for children-objects to be able to find data that is located in parent-objects at an unkown higher level in the tree. Modules like Class::MethodMaker will not be helpful here, because they simply let the children inherit the method, but if the data is stored in the parent (or parents parent, the child is not expected to know), the child will not get the data, only a "empty" method.

Perhaps it is an indication of the power of PERL, but a good AUTOLOAD function conviniently adds everything I want here.

Representation of data

Build a tree of four levels:

• set of players, contains:
  • A list of names of 4 players who play together (eg: ("Alice", "Bob", "Caesar", "Danuta")
• match, contains:
  • a reference to player_set object (the "parent" of the match)
  • a numerical identifier corresponding to the order in which the matches was played (e.g. a 3, if this was the fourth game played)
• round, contains:
  • a reference to a match object (the "parent" of the round)
  • a numerical identifier corresponding to the order in which the round was played (must be number between 0-3)
  • a list of numbers refering to the players in the order in which they played "east" in this round (eg: (3,1,2,0) if the order was Danuta, Bob, Caesar, Alice).
  • a numerical identifier of the wind that the first was the wind of the round in this round
• game, contains:
  • a reference of a round object (the "parent" of the game)
  • a numerical identifier corresponding to the order in which the game was played within the round
  • base points for each player (input from user)
  • a number refering to the winner (eg: 2 if Caesar won) (input from user)
  • a number refering to the player who was east (eg: 2 if Caesar won) (calculated using information about the previous game)
  • for each player, a number representing how this game altered the total points of this player in the round (calculated using the other information in this game)

When a match object is created, a reference to a player_set must be given. When a round object is created, a reference to a match object must be given. When a game object is created, a reference to a round must be given.

from winds.pm, each round object inherits a (reference to a?) list, @winds, starting with east and going counter-clock-wise: east, north, west, south.

When this tree is filled with data, we should be able to output results in different formats (csv, latex, even xml?) and write functions to answer questions like: give a list of player and number of wins for the 10 longest consequtive wins. Here is the outline of such a function:

• group the games into rounds and matches, either by
  • go through all games, and make list of unique matches
  • go through all games, and make list of unique rounds for each match in that list
• or keep a list of all round and match objects
• Now, for each round in each match:
  • make a list of winners using the order of the games.
  • for each of these lists, create lists of winning sequences.
  • sort the lists of winning sequences according to length, return the 10 first items in that list.

What is wrong with class data? Representation of data, take two

Use class data, common for all instances of a class. All matches with the same parent has the same players, they share this info. They can inherit it from their parent. However, the parent then must be a particular object.

For a particular match, $one_match_obj->players() should return ["alice", "bob" ...]

For another match, with another parent, $another_match_obj->players() should return ["Fred", "Barney" ...]

While this can be accomplished by run-time modifying of playerset->players, that's a dirty hack. We want an accessible and correct representation of data.

Therefore, we just use methods!! remove libclass-data-accessor-perl and implement a recursive method instead!

inherting data from objects, not classes, by recursive methods

Consider the tree structure outlined above, and where each level is represented by a class, and objects at each level has a parent who is member of the class above. Objects know nothing about their decendents. Data in the higher level objects can reached by the decendents using a little recursive trick which automatically traverses "the parent object" until the current object is of the right class for that type of data (and all this using a simple function that can be inherited from the top class).

This gives us the following features:

• data is only stored at one place in the tree
• lower-level object can get data at higher levels, without knowing exactly where it is. (well, they inherit the function that tells them at what level the data is to be found).
• a one-liner test prohibits that lower level object write data at higher levels, they may only read such data.

playerset is a top level class, parent of all parents. For its descendents to get its data "players" that is in playerset objects, let them inherit a recursive function that has 'playerset' hadcoded as the class where 'players' data exists. The Descendent will first test if it is of class playerset, and since it it not, $self will "become" its parent, until $self is of the right class, then it will get the data for you (it already has it, it just have to return it).

package playerset;
use oocore;
use vars qw( @ISA );
@ISA = qw (oocore);

# if you are not a playerset object, then recursively look upwards in
# the tree. Yes, here it is determined that players is a property of
# playerset. If you don't like that, then supply your own players()
# instead of inheriting this one :-)

sub players {
  my $self = shift;
  my $value = shift;
  my $maybe_new_self = $self->get_right('playerset');
  unless ($value and (ref($self) ne ref($maybe_new_self))) {
    $maybe_new_self->set_or_return_data('players', $value);
  } else {
    croak("Write access to players denied \n");
  }
}

1;

------------------

package oocore;
use strict;
use Carp;

sub new {
  my $class = shift;
  my $self = {};
  bless($self, $class);
  # if new() is called with an argument, assume it is a reference to parent object, and pass it on
  my $parent_ref = shift;
  if (ref($parent_ref)) {
    $self->_initialize($parent_ref);
  } else {
    $self->_initialize();
  }
}

sub _initialize {
  my $self = shift;
  $self->{debug} = 0;
  $self->{error_log} = "/tmp/" . ref($self) . "-error.log";
  $self->{log_file} = "/tmp/" . ref($self) . ".log";
  $self->{store_state_dir} = '/tmp/';
  my $parent_ref = shift;
  if (ref($parent_ref)) {
    $self->{parent_ref} = $parent_ref;
  }
  return $self;
}

sub get_right {
  my $self = shift;
  my $class_to_be = shift;
  while (ref($self) ne $class_to_be and $self) {
    die "not a ref" unless $self->{parent_ref};
    $self = $self->{parent_ref};
  }
  return $self;
}

sub set_or_return_data {
  my $self = shift;
  my $name = shift;
  my $value = shift;
  if ($value) {
    return $self->{$name} = $value;
  } else {
    return $self->{$name};
  }
}

1;

comments powered by Disqus

Back to the index

Blog roll

R-bloggers, Debian Weekly

---

Last modified: oktober 17, 2019