view release on metacpan or  search on metacpan

lib/Acme/Partitioner.pm  view on Meta::CPAN

package Acme::Partitioner;
use 5.012000;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

our $VERSION = '0.01';

sub using {
  my ($class, @list) = @_;
  bless {
    by_string => { map { $_ => 0 } @list },
    sublists => [\@list],
  }, $class;
}

sub once_by {
  my ($self, $sub) = @_;
  Acme::Partitioner::Actor::_new(undef, "once", $sub, $self);
}

sub partition_of {
  my ($self, $item) = @_;
  $self->{by_string}{$item};
}

sub items_in {
  my ($self, $partition) = @_;
  @{ $self->{sublists}[$partition] }
}

sub size {
  my ($self) = @_;
  scalar @{ $self->{sublists} }
}

sub all_partitions {
  my ($self) = @_;
  map { [@$_] } @{ $self->{sublists} }
}

package Acme::Partitioner::Actor;
use 5.012000;
use strict;
use warnings;

sub _new {
  my ($old, $type, $sub, $partitioner) = @_;
  $partitioner //= $old->{partitioner};
  bless {
    partitioner => $partitioner,
    subs => [
      ($old ? @{ $old->{subs} } : ()),
      [$type, $sub],
    ],
  }, __PACKAGE__
}

sub once_by {
  my ($self, $sub) = @_;
  _new($self, "once", $sub);
}

sub then_by {
  my ($self, $sub) = @_;
  _new($self, "then", $sub);
}

sub refine {
  my ($self) = @_;

  unless (@{ $self->{subs} }) {
    warn "Attempt to refine partitions without active refiners";
    return;
  }
  
  my $old_size = $self->{partitioner}->size();
  my $next_id = $old_size;
  
  for (my $ix = 0; $ix < @{ $self->{subs} }; ++$ix) {

    my @temp;
    for my $sublist (@{ $self->{partitioner}{sublists} }) {
      my %h;
      for my $item (@{ $sublist }) {
        local $_ = $item;
        my $key = $self->{subs}[$ix][1]->($item);
        push @{ $h{$key} }, $item;
      }
      push @temp, values %h;
    }

    #################################################################
    #
    #################################################################
    my %occupied;
    my @new_list;
    
    for (my $ix = 0; $ix < @temp; ++$ix) {
      my $first = $temp[$ix]->[0];
      my $first_id = $self->{partitioner}->partition_of($first) // 0;
      if (not $occupied{ $first_id }++) {
        $new_list[ $first_id ] = $temp[$ix];
        next;
      }
      my $new_id = $next_id++;
      $new_list[ $new_id ] = $temp[$ix];
      $self->{partitioner}{by_string}{$_} = $new_id
        for @{ $temp[$ix] };
    }