Home

---

Don't leave home without them - Perl version

I have reworked these functions for the Perl environment. Because Perl also treats functions as first class objects the implementation is actual very similar to the JavaScript versions.

The range function takes as arguments a length and an optional starting value. It returns an array reference with consecutive integers beginning from the starting argument value and counting up from there by the length argument. i.e. range(10,2) will return [2,3,4,5,6,7,8,9,10,11].

I use this function with my calls to the foreach statement in Perl. I prefer its syntax to the standard for statement syntax borrowed from C.

The count function will recursively search the tree. It takes a list and an optional test function. Each element is passed to the test function. If a true value is returned by the function, one is added to the count.

use strict;
use Data::Dumper;

sub is_array {
    my $v = shift;
    return (ref($v) eq 'ARRAY');
}

sub range {
    my ( $len, $start ) = @_;
    return () unless $len;
    $start ||= 0;
    ( $start .. $start + $len - 1 );
}

sub apply {
    my ($func, $lst) = @_;
    my $ret = [];
    my $idx;
    for $idx (range(scalar(@$lst))) {
        if (is_array($lst->[$idx])) {
            push @$ret, apply($func, $lst->[$idx]);
        } else {
            push @$ret, $func->($lst->[$idx]);
        }
    }
    return $ret;
}

sub filter {
    my ($func, $lst) = @_;
    my $ret = [];
    my $idx;
    for $idx (range(scalar(@$lst))) {
        if (is_array($lst->[$idx])) {
            push @$ret, filter($func, $lst->[$idx]);
        } else {
            if ($func->($lst->[$idx])) {
                push @$ret, $lst->[$idx];
            }
        }
    }
    return $ret;
}

sub reduce {
    my ($func, $lst, $initial) = @_;
    $initial = $initial || 0;
    my $ret = [];
    my $idx;
    for $idx (range(scalar(@$lst))) {
        if (is_array($lst->[$idx])) {
            $initial = reduce($func, $lst->[$idx], $initial);
        } else {
            $initial = $func->($initial, $lst->[$idx]);
        }
    }
    return $initial;
}

sub count {
    my ($lst, $func, $count) = @_;
    $func = $func || sub { return 1; };
    $count = $count || 0;
    my $ret = [];
    my $idx;
    for $idx (range(scalar(@$lst))) {
        if (is_array($lst->[$idx])) {
            $count = count($lst->[$idx], $func, $count);
        } else {
            $count += 1 if $func->($lst->[$idx]);
        }
    }
    return $count;
}

#   The list to operate on
my $lst = [1,2,3,[1,2,3],4,[1,2,3,[4,5]],5];

#   Double every item in the tree structure
print Dumper(apply(sub { my $v = shift; return $v * 2 }, $lst));

#   Retain only elements that are greater than 2 in the tree structure
print Dumper(filter(sub { my $v = shift; return $v > 2 }, $lst));

#   Sum of the value of the entire tree
print Dumper(reduce(sub { my ($a, $b) = @_; return $a + $b; }, $lst));

#   Count the number of items that value is greater than 2
print count($lst, sub { my $v = shift; return $v > 2; } );