Set.pm

Code Index:

NAME

Set - simple integer set handling class

SYNOPSIS

  my @array = ( 1..10 );
  Set->new(@array);

VERSION

This is Set version 0.3, alpha quality and still in construction. Most basic set operators are missing. May break your computer or burn your coffee. Use at your own risk!

DESCRIPTION

A simple object oriented class for integer sets providing basic set operators and iteration functionality as methods. Set is a linked list.

METHODS

new(@array)


  Creates a new set object. Takes as a parameter an array or a list of
  scalars. Does not do any type checking but forces parameters to integers.

=head2 to_string( )

  Returns set as a string.

=head2 elements( )

  Returns an array containing the elements of the set.

=head2 rewind( )


  Rewinds the set pointer to the first element.


=head2 current( )


  Returns the current element in the set.


=head2 next( )


  Returns the current element or undef if at the end of the set. Sets the
  pointer to the next element if not at the end of the set, 0 otherwise.


=head2 prev( )


  Returns the current element or undef if at the beginning of the set. Sets
  the pointer to the previous element if not at the beginning of the
  set, 0 otherwise.


=head2 size( )


  Returns the size of the set.


=head2 min( )


  Returns the smallest integer in the set or undef if set is emtpy.


=head2 max( )


  Returns the largest integer in the set or undef if set is empty.


=head2 remove($int)


  Removes the given integer from the set and returns the removed integer or
  undef if nothing was removed.


=head2 add($int)


  Adds the given integer to the set if set doesn't yet contain it and returns
  the given integer or undef if nothing was added.


=head2 contains($int)


  Returns 1 if set contains the given integer, otherwise 0.


=head2 union($set)


  Performs an union of self and given set object.


=head1 AUTHOR

Set by Marko Vihoma <marko (dot) vihoma (at) pp1 (dot) inet (dot) fi>

LICENSE AND COPYRIGHT

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

CREDITS

Many thanks go to the llama book, which I have read recently. Thanks also to my brother who has given me insights to Perl. Method naming conventions from Set::IntSpan by Steven McDougall, and discrete math course in Kuopio university. 

package Set;

# We need perl 5.*
use 5;

# Pragmas
use integer;
use strict;
use warnings;

# Version string
our $VERSION = "0.3";

## no critic # Should I buy Perl Best Practices?
sub new {
  my $class = shift; # How do I unpack @_ first? See page 178 of PBP.
  my $set = [];
  if (@_) {
    $set = [ @_ ]; # Or is it this?
  }
  my $self = { pos => 0, set => $set };
  
  bless($self, ref $class || $class);
  
  return $self;
}
## use critic

sub to_string {
  my $self = shift;
  my @set = $self->elements();
  my $ret = "";
  for my $i (0..$#set) {
    if ($i == $#set) {
      $ret .= $set[$i];
    }
    else {
      $ret .= "$set[$i], ";
    }
  }
  return $ret;
}

sub elements {
  my $self = shift;
  my @set = @{ $self->{'set'} };
  return @set;
}

sub rewind {
  my $self = shift;
  $self->{'pos'} = 0;
  return 1;
}

sub is_empty {
  my $self = shift;
  my @set = @{ $self->{'set'} };
  
  if (@set) {
    return 0;
  }
  else {
    return 1;
  }
}

sub position {
  my $self = shift;

  my $prevpos = $self->{'pos'};
 
  if (@_) {
    my $position = shift;

    if ($position <= $self->size()) {
      $self->{'pos'} = $position;
      return $position;
    }
    else {
      return undef;
    }
  }
    
  return $prevpos;
}

sub current {
  my $self = shift;
  return $self->{'set'}->[$self->position()];
}

sub next {
  my $self = shift;
  my $position = $self->position();
  
  if ($position == $self->size()) {
    $self->position(0);
    return undef;
  }
  else {
    my $current = $self->current();
    $self->position(++$position);
    return $current;
  }
}

sub prev {
  my $self = shift;
  my $position = $self->position();
  
  if ($position < 0) {
    $self->position($self->size() - 1);
    return undef;
  }
  else {
    my $current = $self->current();
    $self->position(--$position);
    return $current;
  }
}

sub size {
  my $self = shift;
  return $#{ $self->{'set'} } + 1;
}

sub min {
  my $self = shift;
  # min is undef if set is empty
  my $min = undef;
  
  # We'll find min only if set is not empty
  if(not $self->is_empty) {
    # Save current position
    my $position = $self->position();
    # Rewind position to 0
    $self->rewind();
    
    $min = $self->next();
    # Let's iterate through self
    while (my $element = $self->next()) {
      $min = $element if ($element < $min);
    }
    
    # Restore old position
    $self->position($position);
  }
  
  return $min;
}

sub max {
  my $self = shift;
  my $max = undef;
  
  # We'll find max only if set is not empty
  if (not $self->is_empty()) {
    # Save current position
    my $position = $self->position();
    # Rewind position to 0
    $self->rewind();
    
    $max = $self->next();
    # Let's iterate through self
    while (my $element = $self->next()) {
      $max = $element if ($element > $max);
    }
    
    # Restore old position
    $self->position($position);
  }
  
  # Return undef if set is emtpy
  return $max;
}

sub clear {
  my $self = shift;
  $self->{'set'} = \();
  return;
}

sub remove {
  my ($self, $element) = @_;
  my $s = new Set ();
  
  if ($self->contains($element)) {
    # Save the sets position
    my $position = $self->position();
    # We'll start from the beginning of the set
    $self->rewind();
    # Let's iterate through current set
    while (my $cell = $self->next()) {
      # Add all elements except the one to be removed to the new set
      $s->add($cell) unless ($cell == $element);
    }
    
    # Go back to old position
    $self->position($position);
    
    # self's set gets only $s's elements
    $self->{'set'} = [ $s->elements() ];
    
    # Return the removed element
    return $element;
  }
  else {
    # If nothing was removed, return undef
    return undef;
  }
}

sub add {
  my ($self, $new) = @_;
  
  # Add element only if we don't have it already
  unless ($self->contains($new)) {
    $self->{'set'}->[$self->size()] = $new;
    return $new;
  }
  else {
    return undef;
  }
}

sub contains {
  my ($self, $other) = @_;
  # Return value is false by default
  my $ret = 0;
  
  # Save sets position
  my $position = $self->position();
  # rewind position to 0
  $self->rewind();
  
  # Let's iterate through self
  while (my $element = $self->next()) {
    # Exit loop if set contains the given element
    if (int($other) == $element) {
      $ret = 1;
      last;
    }
  }
  
  # Restore old position
  $self->position($position);
  
  return $ret;
}

sub union {
  my ($self, $s) = @_;
  
  # Complain if parameter is not a reference
  if (not ref $s) {
    print STDERR "Parameter must be an object reference!\n";
    return 0;
  }
  
  bless($s);
  # Save $s's position
  my $position = $s->position();
  # Rewind position to 0
  $s->rewind();
  
  # Let's iterate through $s
  while (my $cell = $s->next()) {
    $self->add($cell);
  }
  
  # Restore old position
  $s->position($position);
  
  return 1;
}

1;

__END__