Re: Algorithm for cancelling common factors between two lists of multiplicands

in reply to Algorithm for cancelling common factors between two lists of multiplicands

BrowserUk,
The order and pairings you choose to cancel out affect the result. This may prevent optimizations that seek to cancel out terms in a different order (such as largest terms first). For instance in your example, it took 6 cancelings to get the resut. Here is another possibility that doesn't result in prime factorization but only takes 3 pairings:

# After duplicates have been removed
# @a = ( 20, 33, 60 );
# @b = ( 2, 5, 12, 16, 23 ); 

60 / 12 = 5 / 1

# @a = ( 20, 33, 5 );
# @b = ( 2, 5, 16, 23 );

20 / 5 = 4 / 1

# @a = ( 4, 33, 5 );
# @b = ( 2, 16, 23 );

16 / 4 = 4 / 1

# @a = ( 33, 5 );
# @b = ( 2, 4, 23 );
[download]

My algorithm doesn't require prime factorization (just GCD).

#!/usr/bin/perl
use strict;
use warnings;
use Inline 'C';

my (%set_a, %set_b);
++$set_a{$_} for 10, 20, 33, 45, 60;
++$set_b{$_} for 2, 5, 10, 12, 16, 23, 45;

cancel_out(); # Assume %set_a and %set_b at package scope

print "$_\t$set_a{$_}\n" for keys %set_a;
print "\n\n\n";
print "$_\t$set_b{$_}\n" for keys %set_b;

sub cancel_out {
    my $finished;
    while ( ! $finished ) {
        $finished = 1;
        for ( keys %set_a ) {
            if ( exists $set_b{$_} ) {
                my $res = $set_a{$_} <=> $set_b{$_};
                if ( ! $res ) {
                    delete $set_a{$_}, delete $set_b{$_}
                }
                elsif ( $res < 0 ) {
                    $set_b{$_} -= delete($set_a{$_});
                }
                else {
                    $set_a{$_} -= delete($set_b{$_});
                }
            }
            next if ! exists $set_a{$_};
            my $m = $_;
            for my $n ( keys %set_b ) {
                my $gcd = gcd($m, $n);
                if ($gcd > 1 ) {
                    ++$set_a{$m / $gcd} if $m != $gcd;
                    ++$set_b{$n / $gcd} if $n != $gcd;
                    ! --$set_a{$m} && delete $set_a{$m};
                    ! --$set_b{$n} && delete $set_b{$n};
                    $finished = 0, last;
                }
            }
        }
    }
}
__END__
__C__

/* Implementation of Euclid's Algorithm by fizbin */
int gcd(int m, int n) {
    while( 1 ) {
        if (n==0) {return m;}
        m %= n;
        if (m==0) {return n;}
        n %= m;
    }
}
[download]

It doesn't produce the output you wanted so I didn't bother trying to optimize it WRT choosing pairings. With the lack of optimizations it is likely not that efficient - but it was fun.

Cheers - L~R

In Section Seekers of Perl Wisdom