lib/IDS/DeReKoVecs/Read.pm

use utf8;
package IDS::DeReKoVecs::Read;
use LWP::Simple;
use strict;
use warnings;
use Config;

my $src_file      = undef;

our $mergedEnd=0;
our $opt_p = 5676;
our $opt_C;

# Cached values are large (a classic collocator profile is tens to hundreds of
# kilobytes of JSON), so the caches are size limited. Without a limit a long
# running worker accumulates one entry per queried word until the box runs out
# of memory. Defaults can be overridden via configure_cache().
our $CC_CACHE_MAX_KEYS = 200;  # classic collocators
our $SP_CACHE_MAX_KEYS = 200;  # similar profiles

BEGIN {
  $src_file = __FILE__;
  $src_file =~ s/Read.pm/derekovecs-server.c/;
}

use Inline C => "$src_file" => CLEAN_AFTER_BUILD => 0, BUILD_NOISY => 1, ccflags =>  $Config{ccflags} . "-Wall -Wno-unused-result -O4 -mno-avx2 -I/usr/local/include", libs => "-L/usr/local/lib64 -L/usr/local/lib -lcollocatordb";
#use Inline C => Config => BUILD_NOISY => 1, CFLAGS => $Config{cflags}." -O4 -mtune k9";
#use Inline C => Config => CLEAN_AFTER_BUILD => 0, ccflags => $Config{ccflags}." -Ofast -march k8 -mtune k8 ";

use Mojo::JSON qw(decode_json encode_json to_json);
use Mojo::Cache;
use Exporter qw(import);

our @EXPORT = qw(init_net load_sprofiles getVocabSize getDowntimeCalendar getCollocationAssociation getClassicCollocatorsCached getSimilarProfiles getSimilarProfilesCached getBiggestMergedDifferences filter_garbage get_neighbours getWordNumber dump_vecs dump_for_numpy cos_similarity_as_json get_version getPosWiseW2VCollocators configure_cache cache_stats);

my $cccache = Mojo::Cache->new(max_keys => $CC_CACHE_MAX_KEYS); # classic collocator cache
my $spcache = Mojo::Cache->new(max_keys => $SP_CACHE_MAX_KEYS); # similar profile cache

# Adjust the caches at startup, e.g.
#   configure_cache(collocators_max_keys => 500, no_cache => 1)
# A max_keys value <= 0 disables the respective cache. Setting a limit starts
# from an empty cache, so that a lowered limit takes effect immediately.
sub configure_cache {
  my (%opt) = @_;
  $opt_C = $opt{no_cache} if defined $opt{no_cache};
  $cccache = Mojo::Cache->new(max_keys => $opt{collocators_max_keys})
    if defined $opt{collocators_max_keys};
  $spcache = Mojo::Cache->new(max_keys => $opt{profiles_max_keys})
    if defined $opt{profiles_max_keys};
  return;
}

sub cache_stats {
  return {
    collocators => {
      keys     => scalar keys %{$cccache->{cache} || {}},
      max_keys => $cccache->max_keys
    },
    profiles => {
      keys     => scalar keys %{$spcache->{cache} || {}},
      max_keys => $spcache->max_keys
    }
  };
}

sub getDowntimeCalendar {
  my ($url) = @_;
  if ($url =~ m/^\s*$/) {
    return "";
  }
  my $calendar = LWP::Simple::get($url);
  return $calendar;
}

sub getCollocationAssociation {
  my ($c, $word, $collocate) = @_;
  return getCollocationScores($word, $collocate)
}

sub getClassicCollocatorsCached {
  my ($c, $word, $compare_to) = @_;
  my $s2 = "";
  if($word > $mergedEnd) {
    $word-=$mergedEnd;
  }

  my $pipe;
  if($compare_to ne "") {
    $c->app->log->info("comparing syn neighbours to: $compare_to/getClassicCollocators?w=$word");
    open $pipe, "lwp-request $compare_to/getClassicCollocators?w=$word |";
  }

  my $collocators = $opt_C ? undef : $cccache->get($word);
  if(!defined $collocators) {
    $c->app->log->info("Getting classic collocates of $word.");
    $collocators = getClassicCollocators($word);
    $collocators =~ s/:(-?)(nan|inf)/:"${1}${2}"/g;
    $collocators =~ s/"""/"\\""/g;
    $cccache->set($word => $collocators) unless $opt_C;
  } else {
    $c->app->log->info("Getting classic collocates for $word from cache.");
  }

  if(defined($pipe)) {
    while(<$pipe>) {
      $s2 .= $_;
    }
    close($pipe);
  }

  if(length($s2) > 2000) {
    my $d1 = decode_json($collocators);
    my $d2 = decode_json($s2);
    my %d2ld;
    my $minLd = 14;
    foreach my $i (@{$d2->{collocates}}) {
      $d2ld{$i->{word}}=$i->{ld};
      $minLd=$i->{ld} if($i->{ld} < $minLd);
    }
    foreach my $i (@{$d1->{collocates}}) {
      my $w = $i->{word};
      $i->{delta} = $i->{ld} - (defined $d2ld{$w} ? $d2ld{$w} : $minLd-0.1);
    }
    return(encode_json($d1));
  } else {
    my $d1 = decode_json($collocators);
    foreach my $i (@{$d1->{collocates}}) {
      $i->{delta} = 0;
    }
    return(encode_json($d1));
  }
}

sub getSimilarProfilesCached {
  my ($c, $word) = @_;
  my $profiles = $opt_C ? undef : $spcache->get($word);
  if(!defined $profiles) {
    $profiles = getSimilarProfiles($word);
    $spcache->set($word => $profiles) unless $opt_C;
  } else {
    $c->app->log->info("Getting similar profiles for $word from cache:");
  }
  return $profiles;
}

return 1;