File Coverage

blib/lib/Lingua/TermWeight.pm

Criterion	Covered	Total	%
statement	74	78	94.8
branch	16	28	57.1
condition	5	6	83.3
subroutine	9	11	81.8
pod	3	5	60.0
total	107	128	83.5

# SPDX-FileCopyrightText: 2014 Koichi SATOH
# SPDX-FileCopyrightText: 2026 Wesley Schwengle
#
# SPDX-License-Identifier: MIT

package Lingua::TermWeight;
use utf8;

# ABSTRACT: Language-independent TermWeight calculator.

use v5.26;
use warnings;
use Object::Pad 0.800 ':experimental(init_expr)';
use Carp       qw(croak);
use List::Util qw(sum);

our $VERSION = '0.01';

class Lingua::TermWeight {
  field $word_counter :reader = do {
    require Lingua::TermWeight::WordCounter::Simple;
    Lingua::TermWeight::WordCounter::Simple->new;
  };

  field $word_segmenter : reader : param;

  ADJUST {
    croak "word_segmenter must provide a segment method"
      unless $word_segmenter->can('segment');

    croak "word_counter must provide clear, add_count, and frequencies methods"
      unless $word_counter->can('clear')
      && $word_counter->can('add_count')
      && $word_counter->can('frequencies');
  }

  method tf (%args) {
    croak "tf requires a document argument"
      unless exists $args{document};

    my $document  = $args{document};
    my $normalize = $args{normalize} // 0;

    $word_counter->clear;

    my $iter = $word_segmenter->segment($document);
    croak "word_segmenter->segment must return a coderef iterator"
      unless ref($iter) eq 'CODE';

    while (defined(my $word = $iter->())) {
      $word_counter->add_count($word);
    }

    my $tf = $word_counter->frequencies;
    return $tf unless $normalize;

    return {} unless %$tf;

    my $total_words = sum(values %$tf) // 0;
    return {} unless $total_words;

    return +{ map { ($_ => $tf->{$_} / $total_words) } keys %$tf };
  }

  method idf (%args) {
    croak "idf requires a documents argument"
      unless exists $args{documents};

    my $documents = $args{documents};
    croak "documents must be an arrayref"
      unless ref($documents) eq 'ARRAY';

    return {} if @$documents == 0;

    my @tfs
      = ref($documents->[0])
      ? @$documents
      : map { $self->tf(document => \$_) } @$documents;

    my %seen_word;
    for my $tf (@tfs) {
      croak "each term-frequency entry must be a hashref"
        unless ref($tf) eq 'HASH';
      $seen_word{$_} = 1 for keys %$tf;
    }

    my %idf;
    for my $word (keys %seen_word) {
      my $num_documents_including_word = grep { exists $_->{$word} } @tfs;
      next unless $num_documents_including_word;
      $idf{$word} = log(@tfs / $num_documents_including_word);
    }

    return \%idf;
  }

  method tf_idf (%args) {
    croak "tf_idf requires a documents argument"
      unless exists $args{documents};

    my $documents = $args{documents};
    my $normalize = $args{normalize} // 0;

    croak "documents must be an arrayref"
      unless ref($documents) eq 'ARRAY';

    return [] if @$documents == 0;

    my @tfs = map { $self->tf(document => \$_, normalize => $normalize) }
      @$documents;

    my $idf = $self->idf(documents => \@tfs);

    my @tf_idf;
    for my $tf (@tfs) {
      push @tf_idf, +{ map { ($_ => $tf->{$_} * $idf->{$_}) } keys %$tf };
    }

    return \@tf_idf;
  }
}

1;

__END__