File Coverage

blib/lib/Lingua/ResourceAdequacy.pm

Criterion	Covered	Total	%
statement	136	204	66.6
branch	20	30	66.6
condition	2	6	33.3
subroutine	26	37	70.2
pod	32	32	100.0
total	216	309	69.9

package Lingua::ResourceAdequacy;

use strict;
use warnings;


our $VERSION='0.1';

sub new {
    my $class = shift;
    my %arg = @_;

    my @word_list;
    my @term_list;
    my $word;
    my @UP_list;
    my @DUP_list;

    if (exists $arg{"word_list"}) {
	@word_list = @{$arg{"word_list"}};
    }
    if (exists $arg{"term_list"}) {
	@term_list = @{$arg{"term_list"}};
    }

    if (exists $arg{"DUP_list"}) {
	@DUP_list = @{$arg{"DUP_list"}};
    }

    if (exists $arg{"UP_list"}) {
	@UP_list = @{$arg{"UP_list"}};
    }

    my $RA = {
	"word_list" => \@word_list,
	"term_list" => \@term_list,
	"word_list_stats" => {},
	"term_list_stats" => {},
	"DecompUsefulPart" => \@DUP_list,
	"UsefulPart" => \@UP_list,
	"UsefulPart_stats" => {},
	"DecompUsefulPart_stats" => {},
	"AdequacyMeasures" => {},
    };
    bless $RA, $class;
    return $RA;
}

sub set_word_list {
    my $self = shift;
    my $word_list_ref = shift;
    my @word_list;

    if (defined $word_list_ref) {
	@word_list = @$word_list_ref;
	$self->{"word_list"} = \@word_list;
	return(scalar(@word_list));
    } else {
	return -1;
    }

}

sub set_term_list {
    my $self = shift;
    my $term_list_ref = shift;
    my @term_list;

    if (defined $term_list_ref) {
	@term_list = @$term_list_ref;
	$self->{"term_list"} = \@term_list;
	return(scalar(@term_list));
    } else {
	return -1;
    }

}

sub set_DUP_list {
    my $self = shift;
    my $DUP_list_ref = shift;
    my @DUP_list;

    if (defined $DUP_list_ref) {
	@DUP_list = @$DUP_list_ref;
	$self->{"DecompUsefulPart"} = \@DUP_list;
	return(scalar(@DUP_list));
    } else {
	return 0;
    }

}

sub set_UP_list {
    my $self = shift;
    my $UP_list_ref = shift;
    my @UP_list;

    if (defined $UP_list_ref) {
	@UP_list = @$UP_list_ref;
	$self->{"UsefulPart"} = \@UP_list;
	return(scalar(@UP_list));
    } else {
	return 0;
    }

}

sub word_list_stats {
    my $self = shift;


    $self->_list_stats("word_list");

}

sub term_list_stats {
    my $self = shift;

    $self->_list_stats("term_list");

}

sub print_word_list_stats {
    my $self = shift;

    print STDERR "---\n";
    print STDERR "Word list statistics:\n";
    $self->_print_list_stats("word_list");
    print STDERR "---\n";
    print STDERR "\n";
}

sub print_term_list_stats {
    my $self = shift;

    print STDERR "---\n";
    print STDERR "Term list statistics:\n";
    $self->_print_list_stats("term_list");
    print STDERR "---\n";
    print STDERR "\n";

}

sub _average_Frequency {
    my $self = shift;
    my $field_name = $_[0];

    $self->{$field_name . "_stats"}->{'averageFreq'} = 0;
    map { $self->{$field_name . "_stats"}->{'averageFreq'} += $_} values %{$self->{$field_name . "_stats"}->{'vocableFreq'}};

    $self->{$field_name . "_stats"}->{'averageFreq'} /= $self->{$field_name . "_stats"}->{'vocabularySize'};

}

sub _list_stats {
    my $self = shift;
    my $field_name = $_[0];

    my $vocable;

    $self->{$field_name . "_stats"}->{'listSize'} = scalar(@{$self->{$field_name}});

    foreach $vocable (@{$self->{$field_name}}) {
	$self->{$field_name . "_stats"}->{'vocableFreq'}->{$vocable}++;
    }



    $self->{$field_name . "_stats"}->{'vocabularySize'} = scalar(keys %{$self->{$field_name . "_stats"}->{'vocableFreq'}});

    $self->_average_Frequency($field_name);

#     map { $self->{$field_name . "_stats"}->{'averageFreq'} += $_} values %{$self->{$field_name . "_stats"}->{'vocableFreq'}};

#     $self->{$field_name . "_stats"}->{'averageFreq'} /= $self->{$field_name . "_stats"}->{'vocabularySize'};

#     print $self->{$field_name . "_stats"}->{'vocabularySize'};
#     foreach $vocable (keys %{$self->{$field_name . "_stats"}->{'vocableFreq'}}) {

# 	print "$vocable : " . $self->{$field_name . "_stats"}->{'vocableFreq'}->{$vocable} . "\n";
#     }

}

sub get_Vocabulary_size {
    my $self = shift;
    my $field_name = shift;

    if (defined $field_name) {
	return ($self->{$field_name . "_stats"}->{'vocabularySize'});
    } else {
	return(-1);
    }
}

sub get_List_size {
    my $self = shift;
    my $field_name = shift;

    if (defined $field_name) {
	return ($self->{$field_name . "_stats"}->{'listSize'});
    } else {
	return(-1);
    }
}

sub get_Average_frequency {
    my $self = shift;
    my $field_name = shift;

    if (defined $field_name) {
	return ($self->{$field_name . "_stats"}->{'averageFreq'});
    } else {
	return(-1);
    }
}

sub get_FrequencyLength {
    my $self = shift;
    my $field_name = shift;

    if ((defined $field_name) && (exists $self->{$field_name . "_stats"}->{'FreqLength'})) {
	return ($self->{$field_name . "_stats"}->{'FreqLength'});
    } else {
	return(-1);
    }
}




sub _print_list_stats {
    my $self = shift;
    my $field_name = $_[0];
    my $vocable;

    print STDERR "List size: " .  $self->get_List_size($field_name) . "\n";
    print STDERR "Vocabulary size: " . $self->get_Vocabulary_size($field_name) . "\n";
    print STDERR "Average frequency: " . $self->get_Average_frequency($field_name) . "\n";
#     if (exists $self->{$field_name . "_stats"}->{'FreqLength'}) {
	print STDERR "Frequency * Length: " . $self->get_FrequencyLength($field_name) . "\n";
#     }

    print STDERR "Vocable : freqency\n";
    foreach $vocable (keys %{$self->{$field_name . "_stats"}->{'vocableFreq'}}) {
	print STDERR "\t$vocable : " . $self->{$field_name . "_stats"}->{'vocableFreq'}->{$vocable} . "\n";
    }

}


sub UP_list_stats {
    my $self = shift;
    my $vocable;
    my $term;

    $self->_list_stats("UsefulPart");

    foreach $vocable (keys %{$self->{"UsefulPart_stats"}->{'vocableFreq'}}) {
	foreach $term (keys %{$self->{"UsefulPart_stats"}->{'vocableFreq'}}) {
	    if (length($vocable) < length($term)) {
		if ((length($vocable) > 0) && ($vocable ne $term)) {
		    if ($term =~ /\b$vocable\b/o) {
			$self->{"UsefulPart_stats"}->{'vocableFreq'}->{$vocable} -= $self->{"UsefulPart_stats"}->{'vocableFreq'}->{$term};
		    }
		}
	    }
	}
    }
    $self->_average_Frequency("UsefulPart");

    my $term_components;
    my @components;
    my $freq_length = 0;

    foreach $term (keys %{$self->{"UsefulPart_stats"}->{'vocableFreq'}}) {
# 	print STDERR "$term\n";
# 	print STDERR $self->{"UsefulPart_stats"}->{'vocableFreq'}->{$term} . "\n";
#	$term_components = $term;
	@components = split /\s/, $term;
# 	print STDERR join(":", @components) . "\n";
# 	print STDERR scalar(@components) . "\n";
	$freq_length += $self->{"UsefulPart_stats"}->{'vocableFreq'}->{$term} * scalar(@components);
# 	print STDERR "=> $freq_length\n";
    }
    $self->{"UsefulPart_stats"}->{'FreqLength'} = $freq_length;
}

sub print_UP_list_stats {
    my $self = shift;

    print STDERR "---\n";
    print STDERR "Useful Part list statistics:\n";
    $self->_print_list_stats("UsefulPart");
    print STDERR "---\n";
    print STDERR "\n";

}

sub DUP_list_stats {
    my $self = shift;
    my $vocable;
    my $term;

    $self->_list_stats("DecompUsefulPart");


}

sub print_DUP_list_stats {
    my $self = shift;

    print STDERR "---\n";
    print STDERR "Decomposed Useful Part list statistics:\n";
    $self->_print_list_stats("DecompUsefulPart");
    print STDERR "---\n";
    print STDERR "\n";

}

sub get_UP_VocabularySize {
    my $self = shift;

    return($self->get_Vocabulary_size("UsefulPart"));

}

sub get_UP_ListSize {
    my $self = shift;

    return($self->get_List_size("UsefulPart"));

}

sub get_UP_AverageFrequency {
    my $self = shift;

    return($self->get_Average_frequency("UsefulPart"));

}

sub get_UP_FrequencyLength {
    my $self = shift;

    return($self->get_FrequencyLength("UsefulPart"));

}

sub get_DUP_VocabularySize {
    my $self = shift;

    return($self->get_Vocabulary_size("DecompUsefulPart"));

}

sub get_DUP_ListSize {
    my $self = shift;

    return($self->get_List_size("DecompUsefulPart"));

}

sub get_DUP_AverageFrequency {
    my $self = shift;

    return($self->get_Average_frequency("DecompUsefulPart"));

}

sub get_term_list_VocabularySize {
    my $self = shift;

    return($self->get_Vocabulary_size("term_list"));

}

sub get_term_list_ListSize {
    my $self = shift;

    return($self->get_List_size("term_list"));

}

sub get_term_list_AverageFrequency {
    my $self = shift;

    return($self->get_Average_frequency("term_list"));

}

sub get_word_list_VocabularySize {
    my $self = shift;

    return($self->get_Vocabulary_size("word_list"));

}

sub get_word_list_ListSize {
    my $self = shift;

    return($self->get_List_size("word_list"));

}

sub get_word_list_AverageFrequency {
    my $self = shift;

    return($self->get_Average_frequency("word_list"));

}


sub AdequacyMeasures {
    my $self = shift;

    $self->{"AdequacyMeasures"}->{"Contribution"} = $self->get_UP_VocabularySize / $self->get_term_list_VocabularySize;
    $self->{"AdequacyMeasures"}->{"Excess"} = 1 - $self->{"AdequacyMeasures"}->{"Contribution"};

    $self->{"AdequacyMeasures"}->{"Recognition"} = $self->get_DUP_VocabularySize / $self->get_word_list_VocabularySize;
    $self->{"AdequacyMeasures"}->{"Ignorance"} = 1 - $self->{"AdequacyMeasures"}->{"Recognition"};

    $self->{"AdequacyMeasures"}->{"Coverage"} = $self->get_UP_FrequencyLength / $self->get_word_list_ListSize;

    $self->{"AdequacyMeasures"}->{"Density"} = $self->get_DUP_AverageFrequency / $self->get_word_list_AverageFrequency;
    return(0);
}


sub print_AdequacyMeasures {
    my $self = shift;

    print STDERR "-----\n";
    print STDERR "Adequacy Measures: \n";
    print STDERR "\tContribution: " . $self->{"AdequacyMeasures"}->{"Contribution"} . "\n";
    print STDERR "\tExcess: " . $self->{"AdequacyMeasures"}->{"Excess"} . "\n";
    print STDERR "\t-----\n";
    print STDERR "\tRecognition: " . $self->{"AdequacyMeasures"}->{"Recognition"} . "\n";
    print STDERR "\tIgnorance: " . $self->{"AdequacyMeasures"}->{"Ignorance"} . "\n";
    print STDERR "\t-----\n";
    print STDERR "\tCoverage: " . $self->{"AdequacyMeasures"}->{"Coverage"} . "\n";
    print STDERR "\tDensity: " . $self->{"AdequacyMeasures"}->{"Density"} . "\n";

    print STDERR "-----\n";
}

1;

__END__