You're right. I had an erroneous understanding: that the closest factor that included top_factor would be paired with the closest factor that didn't. Instead, it's paired with the closest factor on the other side of root that doesn't include top_factor. So you have to check both sides of root. Here's a fixed version:

use strict; 
use warnings;
use List::Util qw[ reduce ];

my $num;  # Used in sub, but could be passed if you wanted

sub closest {
    # Args are target and factor-list
    my ($target, @factors) = @_;
    # Take the biggest factor
    my $top_factor = pop @factors;
    # Find multiple of that factor closest to (and above) target
    my $guess = int($target) - $target % $top_factor + $top_factor;
    # Oscillate around the target, looking at multiples of top_factor
    #  until you get one that divides the product
    my $i;
    for ($i = $top_factor; $num % $guess; $i += $top_factor) {
        $guess += ( $target <=> $guess ) * $i;
    }
    # Check the complementary factor
    my $complement = $num / $guess;
    # Look for a multiple of $top_factor between the last guess on the
    # other side of sqrt and $complement
    my $direction = ($target <=> $guess);
    my $new_guess = $guess + $direction * $i;
    while (($complement <=> $new_guess) == $direction and $num % $new_
+guess) {
        $new_guess += $top_factor * $direction;
    }
    if ($new_guess and $num % $new_guess == 0
        and (($complement <=> $new_guess) == $direction)) {
        $guess = $new_guess;
        $complement = $num/ $guess;
    }
    abs($target - $complement) < abs($target - $guess)
      ? $complement
      : $guess
    ;
}

my @pfs = (3, 5, 16381, 77951);
# Compute product of factors
our ($a, $b);
$num = reduce { $a * $b } @pfs;
my $root = sqrt $num;
print "N=$num, R=$root\n";

print closest($root, 1, @pfs), "\n";
[download]