Ten numbers on a blackboard

In Ten numbers on a blackboard, someone asks about the largest number you can compute by reducing a set of numbers. I was surprised to see that someone spent quite a bit of time to brute force it and that their Python solution was so slow. So many of the things I write about in the “Benchmarking” and “Profiling” chapters come into play in this conversation.

The particular problem is to reduce a list of numbers by taking them off of the list and replacing them with the single value a*b + a + b. Expressed in Perl, I write:

my @array = 1 .. 10;

my $sum = 0;
foreach ( @array ) {
	$sum = $sum * $_ + $sum + $_;
	}
	
print "Sum is $sum\n";

The answer for that sequence is 39,916,799.

There’s a bit of a trick here by starting with $sum at 0. The first loop gets me back to the first item in the list. It’s a nice trick in programming to include a degenerate case and even nicer that Perl allows and even expects me to start with an undefined value. I could just as well start with the first element directly by shifting it into $sum:

my @array = 1 .. 10;

my $sum = shift @array;
foreach ( @array ) {
	$sum = $sum * $_ + $sum + $_;
	}
	
print "Sum is $sum\n";

Still, the question remains. Would I get the same answer no matter the order of the numbers in the sequence? I can generate all of the permutations of the list, something explained in the perlfaq4’s How do I permute N elements of a list? as well as StackOverflow’s How can I generate all permutations of an array in Perl?.

For this article, I’ll use Algorithm::Permute. It’s a bit of an odd interface because its permute function takes a code block where I get the permutation in an array variable of the same name:

use Algorithm::Permute ('permute');

my @array = 1 .. 10;

permute {
    print "@array\n";
	} @array;

Careful here! There are 10! permutations of the order of 10 distinct thingys. That’s 3,628,8000 lines of output. Let’s start with something a bit smaller. I’ll start with two items:

use Algorithm::Permute ('permute');

@ARGV = 1 unless @ARGV;

my @array = 1 .. $ARGV[0];

permute {
	print "S = [@array] ";
	my $sum = $array[0];
	foreach ( 1 .. $#array ) {
		$sum = $sum * $array[$_] + $sum + $array[$_];
		}

	print "sum is $sum\n";	
	} @array;

Here are a few runs where I see the sum is the same each time (more on that in a moment):

% permute 2
S = [1 2] sum is 5
S = [2 1] sum is 5

% permute 3
S = [1 2 3] sum is 23
S = [1 3 2] sum is 23
S = [3 1 2] sum is 23
S = [2 1 3] sum is 23
S = [2 3 1] sum is 23
S = [3 2 1] sum is 23

% permute 4
S = [1 2 3 4] sum is 119
S = [1 2 4 3] sum is 119
S = [1 4 2 3] sum is 119
S = [4 1 2 3] sum is 119
S = [1 3 2 4] sum is 119
S = [1 3 4 2] sum is 119
S = [1 4 3 2] sum is 119
S = [4 1 3 2] sum is 119
S = [3 1 2 4] sum is 119
S = [3 1 4 2] sum is 119
S = [3 4 1 2] sum is 119
S = [4 3 1 2] sum is 119
S = [2 1 3 4] sum is 119
S = [2 1 4 3] sum is 119
S = [2 4 1 3] sum is 119
S = [4 2 1 3] sum is 119
S = [2 3 1 4] sum is 119
S = [2 3 4 1] sum is 119
S = [2 4 3 1] sum is 119
S = [4 2 3 1] sum is 119
S = [3 2 1 4] sum is 119
S = [3 2 4 1] sum is 119
S = [3 4 2 1] sum is 119
S = [4 3 2 1] sum is 119

Rather than output every sum, I modify the program to find a sum that’s not the same. If I can find one that’s different I know that I might have to brute-force the problem to find the maximum:

use v5.10;

use Algorithm::Permute ('permute');

@ARGV = 1 unless @ARGV;

my @array = 1 .. $ARGV[0];

permute {
	my $sum = $array[0];
	foreach ( 1 .. $#array ) {
		$sum = $sum * $array[$_] + $sum + $array[$_];
		}

	state $last_sum = $sum;

	say "Sum for [@array] is special: $sum" 
		unless $last_sum eq $sum;
	} @array;

I like this trick with state where I initialize it with the first value of $sum, but with this code I don’t see any output. Instead, I can use a hash to count the sums that I compute. If I accumulate more than one sum, I do more work to find the minimum and maximum values:

use v5.10;
use Algorithm::Permute ('permute');
use List::Util qw(min max);

@ARGV = 1 unless @ARGV;

my @array = 1 .. $ARGV[0];

my %Sums;

permute {
	my $sum = $array[0];
	foreach ( 1 .. $#array ) {
		$sum = $sum * $array[$_] + $sum + $array[$_];
		}

	$Sums{$sum}++;
	} @array;

if( 1 < values %Sums ) {
	print "There is more than one sum for n=$ARGV[0]!";
	my $min = min( keys %Sums );
	my $max = max( keys %Sums );
	
	say "Min: $min Max: $max";
	}
else {
	say "There is only one sum for n=$ARGV[0]" . (keys %Sums)[0];
	}

Now for the brute-force. This is the part that caught my eye about imallett's Python solution, which he says:

For what it's worth, after reading the answers I decided to see how long a brute force program would take. My solution takes 0.43 seconds on the analogous problem of length 7, 12.3 seconds for length 8, and 442.1 seconds for length 9. I didn't let it run for length 10.

There are so many odd things about that statement? Twelve seconds? Doesn't that seem odd for 7! (=5040) operations? Remember in Mastering Perl that I strongly emphasized that we can only compare times on the same setups. But, even without trying very hard, my solution is three orders of magnitude faster:

% time perl permute 7
There is only one sum: 40319

real    0m0.033s
user    0m0.027s
sys     0m0.005s

One of imallett's problems is his use of recursion, a popular technique that's great for high-level languages that can compile it into something that isn't recursive. This isn't a problem that needs it. Mark Jason Dominus talks about this quite a bit in Higher-Order Perl too.

Here's imallett Python solution, which I find hard to unravel:

#!/usr/bin/python

import time

def rem_comb(i,j, l):
	l2 = []
	for index in range(len(l)):
		if index == i or index == j: continue
		l2.append(l[index])
	a,b = l[i],l[j]
	l2.append(a*b + a + b)
	return l2

def experiment(l):
	if len(l) == 1:
		return l[0]
	else:
		best = (0, None,None)
		for i in range(len(l)):
			for j in range(i+1,len(l),1):
				value = experiment(rem_comb(i,j, l))
				if value > best[0]:
					best = (value, i,j)
		return best[0]

for length in range(1,10+1,1):
	t0 = time.time()
	value = experiment(list(range(1,length+1,1)))
	t1 = time.time()
	print("Length % 2d best %d (time %f)"%(length,value,t1-t0))

For N=7, it takes less than a second, but then it blows up at N=8 on my machine. These are roughly the same times he reports, but this is awful performance:

Length  1 best 1 (time 0.000006)
Length  2 best 5 (time 0.000015)
Length  3 best 23 (time 0.000043)
Length  4 best 119 (time 0.000223)
Length  5 best 719 (time 0.002201)
Length  6 best 5039 (time 0.032876)
Length  7 best 40319 (time 0.674944)
Length  8 best 362879 (time 18.632982)
Length  9 best 3628799 (time 683.095185)

I also strongly emphasized that in these sorts of issues, it's the algorithm that's usually the problem, not the language or the interpreter. I haven't written Python in a long time (and now I remember why), but this solution is much faster:

#!/usr/bin/python

import time
from itertools import permutations

def add_it_up(p):
	sum = 0;
	for i in p:
		sum = sum * i + sum + i
	return sum

def experiment(l):
	sum = 1;

	last_sum = 0	
	for p in permutations( range( 1, l+1 ) ):
		sum = add_it_up( p )
		if last_sum > 0 and sum != last_sum:
			print( p )
			print( "For %d, found two sums: %d %d" % ( l, sum, last_sum ) )
		last_sum = sum
	return last_sum    	

for length in range(1, 10+1, 1):
	t0 = time.time()
	value = experiment( length )
	t1 = time.time()
	print( "Length % 2d best %s (time %f)" % (length,value,t1-t0) )

This leads to the advice I gave in Mastering Perl. Better algorithms are better than optimization. The accepted answer for this puzzle shows that for 1 .. N, the sum is N! - 1. More importantly, it shows that since all of the operations are commutative, the order doesn't matter so I don't have to compute every sum.

Now I divert from the question, which already has its answer. Now I merely want to make the sums to see how fast I can do it. I already show in the "Profiling" chapter how to compute factorials while saving the result from previous computations (you can see all of the book's programs on the Downloads page:

#!/usr/bin/perl
# factorial_iterate_bignum_memo.pl

use bignum;

{
my @Memo      = (1);

sub factorial {
	my $number = shift;

	return unless int( $number ) == $number;
	return $Memo[$number] if $Memo[$number];

	foreach ( @Memo .. $number ) {
		$Memo[$_] = $Memo[$_ - 1] * $_;
		}

	$Memo[ $number ];
	}
}

{
print "Enter a number> ";
chomp( my $number = <STDIN> );
exit unless defined $number;

print factorial( $number ), "\n";
redo;
}

As I continued to brute-force the problem, I would have to redo quite a bit of work to compute factorials I already know the answer to, but there's no reason to do all that extra work. I modify the factorial program a little (and add some v5.10 features):

use v5.10;

sub factorial {
	my $number = shift;
	state $Memo = [1];

	return unless int( $number ) == $number;
	return $Memo->[$number] if $Memo->[$number];

	foreach ( @$Memo .. $number ) {
		$Memo->[$_] = $Memo->[$_ - 1] * $_;
		}

	$Memo->[ $number ];
	}

foreach ( 1 .. $ARGV[0] ) {
	say "N = $_, sum is ", factorial( $_ ) - 1;
	}

Now I know the sums virtually instantly:

% time perl factorial 100
N = 1, sum is 0
N = 2, sum is 1
N = 3, sum is 5
N = 4, sum is 23
N = 5, sum is 119
N = 6, sum is 719
N = 7, sum is 5039
N = 8, sum is 40319
N = 9, sum is 362879
N = 10, sum is 3628799
...
N = 99, sum is 9.33262154439441e+155
N = 100, sum is 9.33262154439441e+157

real    0m0.007s
user    0m0.003s
sys     0m0.003s

Suppose now, that I did have to check every sum because the operations weren't commutative and the order mattered. How would I make everything faster? I'd do the same thing I did with the factorial example. I would save the result of previous operations, even across different-sized inputs. First, I'll comment out the meat (at line 15) and count the number of calls for each input length:

use v5.10;
use Algorithm::Permute;

my $Memo;
my %Calls;

sub make_key { join "\000", @_ }

sub in_order {
	my $key = make_key( @_ );

	$Calls{ scalar @_ }++;
	
	if( exists $Memo->{$key} ) {
		#return $Memo->{$key};
		}

	if( @_ == 2 ) {
		return $Memo->{$key} = $_[0]*$_[1] + $_[0] + $_[1];
		}
	elsif( @_ == 1 ) {
		return $_[0]
		}		
	
	$Memo->{$key} = in_order(
		in_order( @_[0 .. $#_-2] ),
		in_order( @_[-2, -1] )
		);
	}
	
N: foreach my $n ( 2 .. $ARGV[0] ) {
	my $p = Algorithm::Permute->new( [ 1 .. $n ], $n );
	
	my $last_sum;
	PERMUTE: while( my @res = $p->next ) {
		my $key = make_key( @_ );
		$Memo{ $key } = in_order( @res );
		if( defined $last_sum and $Memo{ $key } != $last_sum ) {
			say "For (@res), sum is different [$last_sum != $Memo{ $key }]";
			next N;
			}
		$last_sum = $Memo{ $key };
		}
		
	say "N = $n: sum is $last_sum";
	}

say Dumper( \%Calls ); use Data::Dumper;

This is still pretty slow, but much faster than the recursive solution in Python:

% time perl memo 10
N = 2: sum is 5
N = 3: sum is 23
N = 4: sum is 119
N = 5: sum is 719
N = 6: sum is 5039
N = 7: sum is 40319
N = 8: sum is 362879
N = 9: sum is 3628799
N = 10: sum is 39916799
$VAR1 = {
          '3' => 368046,
          '1' => 368046,
          '6' => 3669840,
          '5' => 368040,
          '10' => 3628800,
          '8' => 3669120,
          '9' => 362880,
          '4' => 3669864,
          '2' => 35878886,
          '7' => 367920
        };


real    2m53.379s
user    2m51.615s
sys 0m1.697s

Now, I'll uncomment that line and try again. I cut the time in half, roughly, and see there are fewer calls. I strongly emphasize this in the Mastering Perl too. If I think I know the situation, I should make a change to ensure what I understand to happen actually does:

% time perl memo 10
N = 2: sum is 5
N = 3: sum is 23
N = 4: sum is 119
N = 5: sum is 719
N = 6: sum is 5039
N = 7: sum is 40319
N = 8: sum is 362879
N = 9: sum is 3628799
N = 10: sum is 39916799
$VAR1 = {
          '8' => 3669120,
          '2' => 12323810,
          '6' => 1815120,
          '5' => 181560,
          '1' => 504,
          '9' => 362880,
          '3' => 15126,
          '7' => 367920,
          '10' => 3628800,
          '4' => 151224
        };


real    1m27.931s
user    1m26.666s
sys 0m1.251s