/usr/share/perl5/GO/Model/CrossProduct.pm is in libgo-perl 0.15-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | # $Id: CrossProduct.pm,v 1.2 2004/11/24 02:28:01 cmungall Exp $
#
# This GO module is maintained by Chris Mungall <cjm@fruitfly.org>
#
# 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 - intersection between class/term and list of anonymous subclass
=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;
|