use strict;
our $VERSION = '1.0.1';
use Moose;
has cache_namespace => (
is => 'ro',
isa => 'Str',
default => 'SUGGEST-PREPOP',
);
my $key_sep = '<>';
has _lex_key => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $self = shift;
return join($key_sep, $self->cache_namespace, 'ITEMS_BY_LEX');
},
);
has _cnt_key => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $self = shift;
return join($key_sep, $self->cache_namespace, 'ITEMS_BY_COUNT');
},
);
has min_activity => (
is => 'ro',
isa => 'Int',
default => 5,
);
has entries_limit => (
is => 'ro',
isa => 'Int',
default => 32768,
);
has top_count => (
is => 'ro',
isa => 'Int',
default => 5,
);
# Convenience
sub _redis { Cache::RedisDB->redis }
sub add {
my ($self, $item, $count) = @_;
$count //= 1; # Most of the time we'll just get a single entry
# For now, we just assume supplied items are well-formed
my $redis = $self->_redis;
# Lexically sorted items are all zero-scored
$redis->zadd($self->_lex_key, 0, $item);
# Score sorted items get incremented.
return $redis->zincrby($self->_cnt_key, $count, $item);
}
sub ask {
my ($self, $prefix, $count) = @_;
$count //= $self->top_count; # If they don't say we try to find the 5 best.
my $redis = $self->_redis;
my @full =
map { $_->[0] }
sort { $b->[1] <=> $a->[1] }
grep { $_->[1] >= $self->min_activity }
map { [$_, $redis->zscore($self->_cnt_key, $_)] } @{
$redis->zrangebylex(
$self->_lex_key,
'[' . $prefix,
'[' . $prefix . "\xff"
) // []};
return [scalar(@full <= $count) ? @full : @full[0 .. $count - 1]];
}
sub prune {
my ($self, $keep) = @_;
$keep //= $self->entries_limit;
my $redis = $self->_redis;
# Count key is the one from which results are collated, so even
# if things are out of sync, this is the one about which we care.
return 0 if ($redis->zcard($self->_cnt_key) <= $keep);
my $final_index = -1 * $keep - 1; # Range below is inclusive.
my @to_prune = @{$redis->zrange($self->_cnt_key, 0, $final_index)};
my $count = scalar @to_prune;
# We're going to do this the slow way to keep them in sync.
foreach my $item (@to_prune) {
$redis->zrem($self->_cnt_key, $item);
$redis->zrem($self->_lex_key, $item);
}
return $count;
}
1;
__END__
=encoding utf-8
=head1 NAME
Suggest::PrePop - suggestions based on prefix and popularity
=head1 SYNOPSIS
use Suggest::PrePop;
my $suggestor = Suggest::Prepop->new;
$suggestor->add("item - complete", 10);
$suggestor->ask("item"); ["item - complete"];
=head1 DESCRIPTION
Suggest::PrePop is a suggestion engine which uses a string prefix and
the popularity of items to make suggestions. This is pattern is most often
used for suggestions of partially typed items (e.g. web search forms.)
=head1 METHODS
=over 4
=item new
Constructor. The following attributes (with defaults) may be set:
- C<cache_namespace> ('SUGGEST-PREPOP') - C<Cache::RedisDB> namespace to use for our accounting
- C<min_activity> (5) - The minimum number of times an item must have been seen to be suggested
- C<entries_limit> (32768) - The count of most popular entries to maintain in a purge event
- C<top_count> (5) - The default number of entries to return from 'ask'
=item add($item, [$count])
Add C<$item> to the index, or increment its current popularity. Any C<$count> is taken as the number of times it was seen; defaults to 1.
=item ask($prefix, [$count])
Suggest the C<$count> most popular items matching the supplied C<$prefix>. Defaults to 5.
=item prune([$count])
Prune all but the C<$count> most popular items. Defaults to the instance C<entries_limit>.
=back
=head1 AUTHOR
Inspire
=head1 COPYRIGHT
Copyright 2016- Inspire.com
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
=cut