my ($x, $y)
  = find_best_partition(map int(rand(1000)), 1..100);

##</code><code>##

sub find_best_partition {
  # We're going to try to find partitions that add up to each possible
  # number that can be added up to.
  my $old;
  my $new = {0 => [[], []]};

  for my $n (sort {$a <=> $b} @_) {
    $old = $new;
    $new = {};
    while (my ($key, $value) = each %$old) {
      my ($p1, $p2) = @$value;
      $new->{$key + $n} ||= [[$n, $p1], $p2];
      $new->{$key - $n} ||= [$p1, [$n, $p2]];
    }
  }

  my $best = each %$new;
  while (my $difference = each %$new) {
    if (abs($difference) < abs($best)) {
      $best = $difference;
    }
  }

  # We need to flatten our nested arrays.
  my ($p1, $p2) = @{ $new->{$best} };

  my @part_1;
  while (@$p1) {
    push @part_1, $p1->[0];
    $p1 = $p1->[1];
  }

  my @part_2;
  while (@$p2) {
    push @part_2, $p2->[0];
    $p2 = $p2->[1];
  }

  return (\@part_1, \@part_2);
}

##</code><code>##

sub find_best_partition {
  my @numbers = sort {abs($b) <=> abs($a) or $a <=> $b} @_;

  # First we're going to find a "pretty good" partition.
  # If we can, we'll look for a partition that finishes off
  # like this one does.  That can short-cut the full
  # algorithm.
  my @in_partition;
  my $current_remaining = 0;
  for my $n (@numbers) {
    if ($current_remaining < 0) {
      if ($n > 0) {
        push @in_partition, 1;
        $current_remaining += $n;
      }
      else {
        push @in_partition, 0;
        $current_remaining -= $n;
      }
    }
    else {
      if ($n > 0) {
        push @in_partition, 0;
        $current_remaining -= $n;
      }
      else {
        push @in_partition, 1;
        $current_remaining += $n;
      }
    }
  }

  my $known_solution = $current_remaining;

  # Cheat, we're going to find out the extremes.
  my @max_sum_of_previous = 0;
  my $sum = 0;
  for my $n (@numbers) {
    $sum += abs($n);
    push @max_sum_of_previous, $sum;
  }

  # We're going to try to find partitions that add up to
  # each possible number that can be added up to.
  my $old;
  my $new = {0 => [[], []]};

  my $i = -1;
  my $answer;
N:  for my $n (@numbers) {
    $old = $new;
    $new = {};
    $i++;

    while (my ($key, $value) = each %$old) {
      if ($key == -$current_remaining) {
        # We've found our match!
        $answer = $value;
        last N;
      }

      if (
        abs($key)
          > $sum - $max_sum_of_previous[$i] + abs($known_solution)
      ) {
        # We're too far away from 0 to possibly beat the
        # "pretty good" partition.  So skip.
        next;
      }

      my ($p1, $p2) = @$value;
      $new->{$key + $n} ||= [[$n, $p1], $p2];
      $new->{$key - $n} ||= [$p1, [$n, $p2]];
    }

    # Adjust $current_remaining for the fact we're skipping
    # the $i'th element.
    if ($in_partition[$i]) {
      $current_remaining -= $n;
    }
    else {
      $current_remaining += $n;
    }
  }

  if (not $answer) {
    $i++; # We need to not append the tail!
    my $best = each %$new;

    while (my $difference = each %$new) {
      if (abs($difference) < abs($best)) {
        $best = $difference;
      }
    }

    $answer = $new->{$best};
  }

  # We need to flatten our nested arrays and add the tail.
  my ($p1, $p2) = @$answer;

  my @part_1;
  while (@$p1) {
    push @part_1, $p1->[0];
    $p1 = $p1->[1];
  }
  push @part_1
    , map {
        $in_partition[$_] ? $numbers[$_] : ()
      } $i..$#numbers;

  my @part_2;
  while (@$p2) {
    push @part_2, $p2->[0];
    $p2 = $p2->[1];
  }
  push @part_2
    , map {
        $in_partition[$_] ? () : $numbers[$_]
      } $i..$#numbers;

  return (\@part_1, \@part_2);
}