File Coverage

blib/lib/FrameNet/WordNet/Detour/Data.pm

Criterion	Covered	Total	%
statement	9	105	8.5
branch	0	22	0.0
condition	0	7	0.0
subroutine	3	19	15.7
pod	15	15	100.0
total	27	168	16.0

package FrameNet::WordNet::Detour::Data;

require Exporter;
our @ISA = qw(Exporter);
our $VERSION = "0.99";

use strict;
use warnings;
use FrameNet::WordNet::Detour::Frame;

sub new {
  my $class = shift;
  my $this = {};

  bless($this, $class);

  $this->{'s2f-result'} = shift;
  $this->{'raw'} = $this->{'s2f-result'}{'raw'};
  $this->{'sorted'} = $this->{'s2f-result'}{'sorted'};
  my @warr = reverse (sort { $a <=> $b } keys %{$this->{'sorted'}});
  $this->{'weights'} = \@warr;
  $this->query(shift);
  $this->message(shift) || $this->message('OK');

  return $this;
}

sub query {
    my ($self,$query) = @_;
    if (defined $query) {
	$self->{'query'} = $query;
    };
    return $self->{'query'};
}

#sub get_query {
#    my ($self,$query) = @_;
#    if (defined $query) {
#	return $self->query($query);
#    };
#    return $self->query;
#}

sub message {
    my ($self,$msg) = @_;
    if (defined $msg) {
	$self->{'message'} = $msg;
    };
    return $self->{'message'};
}



# Checks, wether the query returned some useful results or not.
# If not, one should check the error message via &get_message.
# Could be better, by checking deeper in the data structure,
# if there is a 'Frame'-Object.
sub isOK {
  my $self = shift;
  return 1 if ($self->{'message'} eq 'OK');
  return 0;
};



sub get_fees {
  my $self = shift;
  my $_frame = shift;
  my $f = $self->get_frame($_frame);
  return $f if ($f == -1);
  return $f->fees;
};

sub get_weight {
  my $self = shift;
  my $frame = shift;
  my $f = $self->get_frame($frame);

  return $f if ($f == -1);
  return $f->weight;
};

sub get_weights {
  my $self = shift;
  return $self->{'weights'};
};

# not working
sub _get_delta {
  my $self = shift;
  my $frame = shift;


  my $w0 = $self->{'raw'}->{$frame}->{'weight'};
  my $w1 = 0;
  my @weights = ( sort { $a <=> $b } (keys %{$self->{'sorted'}}));



  for(my $i = 0; $i < scalar @weights; $i++) {
    $w1 = $weights[$i+1] if ($w0 == $weights[$i] &&
			     exists($weights[$i+1]));
  };
  return int((($w0 - $w1)*1000)+0.5)/1000;
};

sub get_number_of_frames {
  my $self = shift;
  return scalar (keys %{$self->{'raw'}});
};

# Returns a reference to an array containing the arg1
# best frames (as Frame-Objects). Frames are sorted according
# to their weight.
# If arg1 is not given, the best frame will be returned.
# Works always on the first (e.g. 0th) synset.
sub get_best_frames {
  my $self = shift;
  my $n = 0;
  my $m = shift || 1;

  my $ResultsByWeight = $self->{'sorted'};

  my $ResultList = [];

  my $result_counter = 1;

  foreach my $weight (reverse(sort(keys %$ResultsByWeight))) {
    if ($result_counter <= $m) {
      foreach my $frame (keys %{$ResultsByWeight->{$weight}}) {
	push (@$ResultList, $ResultsByWeight->{$weight}->{$frame});
      };
    };
    $result_counter++;
  };
  return $ResultList;
};

# WORKS
sub get_best_framenames {
  my $self = shift;
  my $m = shift || 1;
  my $frames = $self->get_best_frames($m);
  my @arr =  map($_->name, @$frames);
  return \@arr;
};

# Returns a list of all found frames.
sub get_all_framenames ($) {
  my $self = shift;
  my $tmp = {};
  foreach my $frame (keys %{$self->{'raw'}}) {
      $tmp->{$frame} = 1;
  }
  my @ret = keys %$tmp;
  return \@ret;
};

sub get_all_frames {
  my $self = shift;
  my $ResultsByWeight = $self->{'sorted'};
  my $ResultList = [];

  foreach my $weight (reverse(sort(keys %$ResultsByWeight))) {
    foreach my $frame (keys %{$ResultsByWeight->{$weight}}) {
      push (@$ResultList, $ResultsByWeight->{$weight}->{$frame});
    };
  };
  return $ResultList;
};

sub get_frame {
  my $self = shift;
  my $frame = shift;
  #print STDERR $frame."!!!";
  return $self->{'raw'}->{$frame} if (exists($self->{'raw'}->{$frame}));
  return $self->{'raw'}->{lc($frame)} if (exists($self->{'raw'}->{lc($frame)}));
  return $self->{'raw'}->{ucfirst($frame)} if (exists($self->{'raw'}->{ucfirst($frame)}));
  return -1;
};

sub get_best_weight {
  my $self = shift;
  my $w = $self->get_weights;
  return $w->[0];
};

sub get_frames_with_weight {
  my $self = shift;
  my $weight = shift;
  my @l = keys %{$self->{'sorted'}->{$weight}};
  return \@l;
};

__END__