view release on metacpan or  search on metacpan

perl/Record.pm  view on Meta::CPAN

package Algorithm::Cluster::Record;
use strict;

use Algorithm::Cluster;

sub new {
    my $class = shift;
    my $self = {};
    $self->{data} = undef;
    $self->{mask} = undef;
    $self->{geneid} = undef;
    $self->{genename} = undef;
    $self->{gweight} = undef;
    $self->{gorder} = undef;
    $self->{expid} = undef;
    $self->{eweight} = undef;
    $self->{eorder} = undef;
    $self->{uniqid} = undef;
    bless($self, $class);
    return $self;
}

sub read {
    my $self = shift;
    my $handle = shift;
    my $line = <$handle>;
    chomp($line);
    my @words = split(/\t/, $line);
    my $n = scalar @words;
    $self->{uniqid} = $words[0];
    $self->{expid} = [];
    my %cols = (0 => 'GENEID');
    my $i;
    for ($i = 1; $i < $n; $i++) {
        my $word = $words[$i];
        if ($word eq 'NAME') {
            $cols{$i} = $word;
            $self->{genename} = ();
        }
        elsif ($word eq 'GWEIGHT') {
            $cols{$i} = $word;
            $self->{gweight} = ();
        }
        elsif ($word eq 'GORDER') {
            $cols{$i} = $word;
            $self->{gorder} = ();
        }
        else {
            push(@{$self->{expid}}, $word);
        }
    }
    $self->{geneid} = [];
    $self->{data} = [];
    $self->{mask} = [];
    my $needmask = 0;
    while ($line = <$handle>) {
	my $count = ($line =~ tr/\t//);
        @words = split(/\t/, $line);
	chomp @words;
        scalar @words == $n or die "Line with " . scalar @words . " columns found (expected $n): $!";
        my $start = 0;
        for my $key (keys %cols) {
            if ($key > $start) {
                $start = $key;
            }
        }
        if ($words[0] eq 'EWEIGHT') {
            @{$self->{eweight}} = @words[$start+1..$n-1];
        }
        elsif ($words[0] eq 'EORDER') {
            @{$self->{eorder}} = @words[$start+1..$n-1];
        }
        else {
            my @rowdata = ();
            my @rowmask = ();
            for ($i = 0; $i < $n; $i++) {
                my $word = $words[$i];
                if (defined $cols{$i}) {
                    if ($cols{$i} eq 'GENEID') {