binary-trees Perl #3 program

# The Computer Language Benchmarks Game
# https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
#
# contributed by Emanuele Zeppieri
# modified by Christian Walde (threads)
# *reset* by A. Sinan Unur

use threads;

run( @ARGV );

sub bottomup_tree {
    my $depth = shift;
    return 0 unless $depth;
    --$depth;
    [ bottomup_tree($depth), bottomup_tree($depth) ];
}

sub check_tree {
    return 1 unless ref $_[0];
    1 + check_tree($_[0][0]) + check_tree($_[0][1]);
}

sub stretch_tree {
    my $stretch_depth = shift;
    my $stretch_tree = bottomup_tree($stretch_depth);
    print "stretch tree of depth $stretch_depth\t check: ",
    check_tree($stretch_tree), "\n";
}

sub depth_iteration {
    my ( $depth, $max_depth, $min_depth ) = @_;

    my $iterations = 2**($max_depth - $depth + $min_depth);
    my $check      = 0;

    foreach ( 1 .. $iterations ) {
        $check += check_tree( bottomup_tree( $depth ) );
    }

    return ( $depth => [ $iterations, $depth, $check ] );
}

sub run {
    my $max_depth = shift;
    my $min_depth = 4;

    $max_depth = $min_depth + 2 if $min_depth + 2 > $max_depth;

    stretch_tree( $max_depth + 1 );

    my $longlived_tree = bottomup_tree( $max_depth );

    my @results;
    for ( my $depth = $min_depth ; $depth <= $max_depth ; $depth += 2 ) {
        while ( 1 ) {
            last if threads->list < 4;
            push @results, $_->join for threads->list( threads::joinable );
        }
        threads->create(
            { 'context' => 'list', 'stack_size' => 64 },
            sub { depth_iteration( $depth, $max_depth, $min_depth ) }
        );
    }
    while ( threads->list ) {
        push @results, $_->join for threads->list( threads::joinable );
    }

    my %results = @results;
    for my $key ( sort { $a <=> $b } keys %results ) {
        my ( $iterations, $depth, $check ) = @{ $results{$key} };
        print $iterations, "\t trees of depth $depth\t check: ", $check, "\n";
    }

    print "long lived tree of depth $max_depth\t check: ",
        check_tree( $longlived_tree ), "\n";
}
    

NOTES:
64-bit Ubuntu quad core
This is perl 5, version 40
subversion 0 (v5.40.0)
x86_64-linux-thread-multi


 Mon, 10 Jun 2024 17:37:59 GMT

COMMAND LINE:
 /opt/src/perl-5.40.0/bin/perl binarytrees.perl-3.perl 21

PROGRAM OUTPUT:
stretch tree of depth 22	 check: 8388607
2097152	 trees of depth 4	 check: 65011712
524288	 trees of depth 6	 check: 66584576
131072	 trees of depth 8	 check: 66977792
32768	 trees of depth 10	 check: 67076096
8192	 trees of depth 12	 check: 67100672
2048	 trees of depth 14	 check: 67106816
512	 trees of depth 16	 check: 67108352
128	 trees of depth 18	 check: 67108736
32	 trees of depth 20	 check: 67108832
long lived tree of depth 21	 check: 4194303