File Coverage

GO/Model/CrossProduct.pm

Criterion	Covered	Total	%
statement	18	75	24.0
branch	0	22	0.0
condition	0	2	0.0
subroutine	6	13	46.1
pod	0	6	0.0
total	24	118	20.3

# $Id: CrossProduct.pm,v 1.2 2004/11/24 02:28:01 cmungall Exp $
#
# This GO module is maintained by Chris Mungall
#
# see also - http://www.geneontology.org
#          - http://www.godatabase.org/dev
#
# You may distribute this module under the same terms as perl itself

package GO::Model::CrossProduct;

=head1 NAME

  GO::Model::CrossProduct;

=head1 SYNOPSIS

=head1 DESCRIPTION

for cross products - an intersection between another class/term and a
list of anonymous subclass over some restrictions

=cut


use Carp qw(cluck confess);
use Exporter;
use GO::Utils qw(rearrange);
use GO::Model::Root;
use strict;
use vars qw(@ISA);

@ISA = qw(GO::Model::Root Exporter);


sub _valid_params {
    return qw(xp_acc parent_acc restriction_list);
}

sub get_restriction_values_for_property {
    my $self = shift;
    my $prop = shift;
    my @vals =
      map {$_->value} grep {$_->property_name eq $prop} @{$self->restriction_list||[]};
    return \@vals;
}

sub add_restriction {
    my $self = shift;
    my $r = shift;
    if (!ref($r)) {
        $r = $self->apph->create_restriction_obj({property_name=>$r,
                                                  value=>shift});
    }
    my $rl = $self->restriction_list || [];
    $self->restriction_list([@$rl, $r]);

    $r;
}

sub all_parent_accs {
    my $self = shift;
    my $restrs = $self->restriction_list;
    return [
	    $self->parent_acc,
	    map { $_->value } @$restrs
	   ];
}

sub all_parent_relationships {
    my $self = shift;
    my $restrs = $self->restriction_list;
    my $xp_acc = $self->xp_acc;
    my @hashes =
      (
       {acc1=>$self->parent_acc,
	acc2=>$xp_acc,
	type=>'is_a'
       },
       map {
	   ({
	     acc1=>$_->value,
	     acc2=>$xp_acc,
	     type=>$_->property_name
	    })
       } @$restrs
      );

    return [
	    map {
		$self->apph->create_relationship_obj($_)
	    } @hashes
	   ];
}

sub to_obo {
    my $self = shift;
    my $restrs = $self->restriction_list;
    return
      sprintf("cross_product: %s %s\n",
              $self->parent_acc,
              join(' ',
                   map {sprintf("(%s %s)",
                                $_->property_name, $_->value)} @$restrs));


}

sub equals {
    my $self = shift;
    my $xp = shift;
#    printf "TESTING FOR EQUALITY (%s):\n", $xp->xp_acc;
#    print $self->to_obo;
#    print $xp->to_obo;
    return 0 unless $self->parent_acc eq $xp->parent_acc;
    my @r1 = @{$self->restriction_list || []};
    my @r2 = @{$xp->restriction_list || []};
    return 0 unless scalar(@r1) == scalar(@r2);

    my @propnames =
      map {$_->property_name}
        @{$self->restriction_list||[]},
          @{$xp->restriction_list||[]};
    my %uniqpropnames = map{$_=>1} @propnames;

    my $ok = 1;
    foreach my $pn (keys %uniqpropnames) {

        my @vals1 =
          sort
            @{$self->get_restriction_values_for_property($pn)};
        my @vals2 =
          sort
            @{$xp->get_restriction_values_for_property($pn)};
        while (@vals1) {
            if (shift @vals1 ne shift @vals2) {
                $ok = 0;
            }
        }
        if (@vals2) {
            $ok = 0;
        }
        last unless $ok;
    }
    return $ok;
}


1;