view release on metacpan or  search on metacpan

bin/algorithm-networksort-chooser  view on Meta::CPAN

);

my $opt = {
  'opt' => 'comparators',
  'swap-mode' => 'zero-one',
};

GetOptions($opt, @opt_spec) || die "GetOptions failed";

if ($opt->{help}) {
  require Pod::Perldoc;
  @ARGV = ('-F', $0);
  Pod::Perldoc->run();
}


my $network_size = shift || die "need network size";


die "unknown swap-mode: $opt->{'swap-mode'}"
  if $opt->{'swap-mode'} ne 'zero-one' && $opt->{'swap-mode'} ne 'permutation';

die "validate not implemented yet" if $opt->{validate};



#### Generate candidate networks

my @algos;

if ($opt->{algorithms}) {
  @algos = split ',', $opt->{algorithms};
} else {
  @algos = Algorithm::Networksort::nw_algorithms();
}

my @candidates;

foreach my $algo (@algos) {
  die "unknown algorithm: $algo"
    if !Algorithm::Networksort::nw_algorithm_name($algo);

  my @network = Algorithm::Networksort::Chooser::silence_carps(sub {
    Algorithm::Networksort::nw_comparators($network_size, algorithm => $algo)
  });

  if (!@network) {
    warn "network $algo returned empty comparator list, skipping\n";
    next;
  }

  push @candidates, {
    algo => $algo,
    network => \@network,
  };
}




#### Selection network processing

if ($opt->{median}) {
  die "--selection and --median are incompatible" if defined $opt->{selection};

  $opt->{selection} = int($network_size / 2);
}


if (defined $opt->{selection}) {
  my $selection = [ split(',', $opt->{selection}) ];

  foreach my $ind (@$selection) {
    die "badly formed selection index: $ind" unless $ind =~ /^\d+$/;
    die "selection index $ind is too large for the network size" if $ind >= $network_size;
  }

  foreach my $candidate (@candidates) {
    $candidate->{network} = Algorithm::Networksort::Chooser::build_selection_network($candidate->{network}, $selection);
  }
}




#### Score the generated networks

foreach my $candidate (@candidates) {
  my @network = @{ $candidate->{network} };
  my @grouped_network = Algorithm::Networksort::nw_group(\@network, $network_size, grouping=>'parallel');

  $candidate->{comparators} = (0+@network);
  $candidate->{stages} = (0+@grouped_network);
}




#### Remove 'best' network if it's the same as batcher

my $batcher = [grep { $_->{algo} eq 'batcher' } @candidates]->[0];
my $best = [grep { $_->{algo} eq 'best' } @candidates]->[0];

if ($batcher->{comparators} == $best->{comparators} && $batcher->{stages} == $best->{stages}) {
  @candidates = grep { $_->{algo} ne 'best' } @candidates;
}




#### Sort by optimisation criteria

my @sorted_candidates;

if ($opt->{opt} eq 'comparators') {
  @sorted_candidates = sort {
     ($a->{comparators} <=> $b->{comparators}) || ($a->{stages} <=> $b->{stages})
  } @candidates;
} elsif ($opt->{opt} eq 'stages') {
  @sorted_candidates = sort {
     ($a->{stages} <=> $b->{stages}) || ($a->{comparators} <=> $b->{comparators})