Re^3: OT: Finding Factor Closest To Square Root

[BrowserUk]

One testcase was never going to hack it. I should have thought of your method, but I was too busy trying to figure out why CPAN would install M::B::F.

[Roy Johnson]

Mine isn't perfect, either. Try 2,2,2,7,19,19, for example. I'm pretty sure the problem requires an exhaustive search of all combinations.

[BrowserUk]

Yeah! I'm reaching a similar conclusion..now if only I could work out to use Algorithm::Loops, it'd be done in a trice :)

[Roy Johnson]

Here's a recursive solution to find the closest set of factors to a target (with wrapper script). I think it's solid.

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

my @pfs = ( 2,3,3,3,7, 997 );
my $num = reduce { $a * $b } @pfs;
my $root = sqrt $num;
print "N=$num, R=$root\n";

sub closest {
  # Args are target and factor-list
  my ($target, $car, @cdr) = @_;
  @cdr or return $car;
  reduce { abs($target - $a) < abs($target - $b) ? $a : $b }
         ($car*closest($target/$car, @cdr), closest($target, @cdr), $c
+ar);
}

print closest($root, @pfs), "\n";

[Limbic~Region]

BrowserUk,
The following code demonstrates that this is not actually true:
Read more... (2 kB)
• If a subset has been seen before, it is skipped prior to determining the product of the subset
• If a subset is the start of a progression of subsets previously seen, the entire progression is skipped
• If a factor is determined to be larger than the sqrt, determining if it is the closest is skipped
Unfortunately, I do not know if this is the fastest implementation. I have several variations ranging from bitstrings to avoiding push/slice. The trouble is that I have found an apparent bug in Math::Pari so I am not sure which solution should be fastest. The bug only seems to manifest itself when I add the sqrt() code. To see the bug for yourself using 24777695232, add print "$_\n" for @factor; right after the array is created. To see it go away, comment out the $sqrt definition and change the return statement to return $f.

[Roy Johnson]

Here's an Algorithm::Loops solution, then, based on lidden's nifty solution:

use strict; 
use warnings;
use List::Util qw[ reduce ];
use Algorithm::Loops 'NextPermuteNum';

sub closest{
    my $exact = sqrt(shift);
    my $best = 1;
    do {
        my $guess = 1;
        for (@_) {
        $guess *= $_;
            $best = $guess if (abs($exact - $guess) < abs($exact - $be
+st));
            last if $guess > $exact;
        }
    } while NextPermuteNum(@_);
    $best;
}

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

print closest($num, @pfs), "\n";

[Limbic~Region]

Roy Johnson,
I am pretty sure that all combinations need to be considered initially as you can see by my contributions elsewhere in this thread. It is possible to short-circuit early in some cases though, which may be a significant improvement. For instance - here are some ideas:
• Prior to determining the product of each combination, you can abort if you have already seen this combination
• When determining the product of each combination, you can abort if the value is greater than the sqrt
• If combinations are gathered left to right, once you have determined that the product of a given combination is greater than the sqrt() all future combinations that include this combination can be skipped
I have only chosen to implement the first 1 in my Perl code. This is because my combinations aren't gathered left to right. I will see if I can't modify the code to take advantage of all 3 of these short cuts.