#!/usr/bin/perl
use strict;
use warnings;
use Math::Pari qw/factorint PARImat/;

print nearest_sqrt( $ARGV[0] ), "\n";

sub prime_factors {
    my $num = shift;
    my %p_fact = PARImat( factorint( $num ) ) =~ /(\d+)/g;
    return map { ($_) x $p_fact{$_} } keys %p_fact; 
}


sub nearest_sqrt {
    my $num = shift;
    my @list = prime_factors( $num );
    my (%seen, @position, @stop, $end_pos, $done, $winner, $offset);
    my ($by, $next) = (0, 1);
    while ( ! $done ) {
        if ( $next ) {
            $by++;
            last if $by > @list;
            @position = (0 .. $by - 2, $by - 2);
            @stop     = @list - $by .. $#list;
            $end_pos  = $#position;
            $next = 0;
        }
        my $cur = $end_pos;
        {
            if ( ++$position[ $cur ] > $stop[ $cur ] ) {
                $position[ --$cur ]++;
                redo if $position[ $cur ] > $stop[ $cur ];
                my $new_pos = $position[ $cur ];
                @position[ $cur .. $end_pos ] = $new_pos .. $new_pos +
+ $by;
            }
        }
        if ( $position[0] == $stop[0] ) {
            $position[0] == @list ? $done = 1 : $next = 1;
        }
        next if $seen{"@list[ @position ]"}++;

        my $factor = 1; 
        $factor *= $_ for @list[ @position ];        

        my $diff = ($num / $factor) - $factor;
        if ( $diff >= 0 && (! defined $offset || $diff < $offset) ) {
            ($winner, $offset) = ($factor, $diff);
        }
    }
    return $winner ? $winner : 'prime';
}
[download]