File Coverage

blib/lib/WordLists/Tag/Tagger.pm

Criterion	Covered	Total	%
statement	93	105	88.5
branch	12	16	75.0
condition	8	20	40.0
subroutine	13	17	76.4
pod	1	5	20.0
total	127	163	77.9

package WordLists::Tag::Tagger;
use strict;
use warnings;
use utf8;
use WordLists::Common qw(/generic/);
use Lingua::EN::Tagger;
use WordLists::WordList;
use WordLists::Sense;
use WordLists::Base;
our $VERSION = $WordLists::Base::VERSION;

our $AUTOLOAD;
our @ignore_pos_codes = qw(cd to prp prps sym pp pps ppr lrb rrb ppc ppl );
sub _norm_word($)
{
	my $s = shift;
	$s=~s/\.//g;
	$s=~s/\/.*//;
	$s=~s/['’]s$//;
	$s=~s/['‘’`"“”]$//;
	$s=~s/^['‘’`"“”]//;
	$s=~tr/…–\xA0\*//d;
	return lc $s;
}
sub human_pos($)
{
	my $sPos = shift;
	$sPos =~	s<^nn.*$>
				;
	$sPos =~	s<^in$>
				;
	$sPos =~	s<^to$>
				;
	$sPos =~	s<^jj.*$>
				;
	$sPos =~	s<^md.*$>
				;
	$sPos =~	s<^vb.*$>
				;
	$sPos =~	s<^rb.*$>
				;
	$sPos =~	s<^det$>
				;
	$sPos =~	s<^cc$>
				;
	$sPos =~	s<^wrb$>
				;
	$sPos =~	s<^wdt$>
				;
	$sPos =~	s<^wp$>
				;
	$sPos =~	s<^prp.*$>
				;
	$sPos =~	s<^cd.*$>
				;
	$sPos =~	s<^uh$>
				;
	return $sPos;
}


sub new
{
	my ($class,  $args) = @_;
	$args ||={};
	my $self = {
		tagger=>Lingua::EN::Tagger->new(%$args),
	};
	bless ($self, $class);
}

1;

sub add_tags
{
	my ($self, $sMS) = @_;
	my $taggedMS = $self->{tagger}->add_tags( $sMS );
	return $taggedMS;
}

sub add_human_tags
{
	my ($self, $sMS) = @_;
	my  $sMSOUT = '';
	foreach my $sSentence (@{$self->{tagger}->get_sentences($sMS)})
	{
		$sSentence =~ tr/<>&//d;
		my $taggedSentence = $self->{tagger}->add_tags( $sSentence );
		$taggedSentence =~ s`<([a-z]+)>([^<]+)`human_pos($1) ne $1 ? qq($2) : $2;`ge;
		$sMSOUT .= "$taggedSentence ";
	}
	return $sMSOUT;
}

sub get_wordlist
{
	my ($self, $sUntagged, $args) = @_;

	my $wl;
	if (defined $args->{'wl'} and ref $args->{'wl'} eq 'WordLists::WordList')
	{
		$wl=$args->{'wl'};
	}
	else
	{
		$wl = WordLists::WordList->new;
	}
	foreach my $sSentence (@{$self->{tagger}->get_sentences($sUntagged)})
	{
		my $taggedMS;
		$taggedMS = $self->{tagger}->add_tags( $sSentence );
		while ($taggedMS =~ m`<([a-z]+)>([^<]+)`g)
		{
			#print "\n$1\t$2";
			my $sHW = _norm_word($2);
			my $sPosCode = $1;
			my $bNext;
			foreach (@ignore_pos_codes) #
			{
				if ($sPosCode eq $_)
				{
					$bNext++;
					last;
				}
			}
			next if $bNext;
			my $sPos = human_pos($sPosCode);
			my $sense = WordLists::Sense->new();
			$sense->set_hw($sHW);
			$sense->set_pos($sPos);
			$sense->set_eg($sSentence);
			$sense->set_poscode($sPosCode);
			if (defined $args->{'callback_on_make_sense'} and ref $args->{'callback_on_make_sense'} eq ref sub{})
			{
				&{$args->{'callback_on_make_sense'}}($sense);
			}
			my @senses = $wl->get_senses_for($sense->get_hw, $sense->get_pos);
			if (@senses and !$args->{'keep_repeats'})
			{

			}
			else
			{
				if (defined $args->{'test_sense_before_add'} and ref $args->{'test_sense_before_add'} eq ref sub {} and !&{$args->{'test_sense_before_add'}}($sense))
				{
				}
				else
				{
					if (defined $args->{'callback_on_add_sense'} and ref $args->{'callback_on_add_sense'} eq ref sub{})
					{
						&{$args->{'callback_on_add_sense'}}($sense);
					}
					$wl->add_sense($sense);
				}
			}
		};
	}
	return $wl;
}
=pod

=head1 NAME

WordLists::Tag::Tagger

=head1 SYNOPSIS

	my $tagger = WordLists::Tag::Tagger->new();
	my $wl = $tagger->get_wordlist('The quick brown fox jumped over the lazy dog');

=head1 DESCRIPTION

Uses L to do various things with strings, chielfly to create a L out of a document, e.g. to use as a basis for a glossary.

=head1 METHODS

=head3 get_wordlist

Uses L to create a L out of a string (e.g. a manuscript).

L allows splitting into sentences, and these sentences become C fields in the Ls generated.

Only the first instance of each headword / part of speech combination is entered into the list, unless the third argument has a key C with a true value.

The fields populated are: C, C, C, and C, which is the original part of speech code outputted by the tagger.

The third argument is a hashref which allows you to configure several options.

C should be a coderef. It is passed the sense immediately before it is added to the wordlist, e.g. if you want to add a unit.

C should be a coderef. It is passed the sense before the wordlist is tested for inclusion. This is an opportunity to further normalise parts of speech.

C is a flag, which, if set, prevents the code from removing repetitions.

=head1 TODO

C is a wordlist or arrayref whose elements are L objects or plain hashrefs of the form C<< {hw=>'head', pos =>'n'} >>, or headwords as strings. If these words are found, they are not added to the list. (not yet implemented!)

=head1 BUGS

Please use the Github issues tracker.

=head1 LICENSE

Copyright 2011-2012 © Cambridge University Press. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut