Closures take a while to figure out, and most examples that are given are quite abstract, making it difficult to understand just how useful a concept they are. I recently used a closure as a neat way to write data to a spreadsheet, so I thought I'd present it here as an explanation.

First, what is a closure?

perlref explains a closure as follows:

Closure is a notion out of the Lisp world that says if you define an anonymous function in a particular lexical context, it pretends to run in that context even when it's called outside the context. In human terms, it's a funny way of passing arguments to a subroutine when you define it as well as when you call it. It's useful for setting up little bits of code to run later, such as callbacks.
So, a simple example would be this: 

    sub make_fruit_counter {
        my $fruit  = shift;
        my $total  = 0;

        return sub {
           my $number = shift;
           $total = $total + $number;
           return "$total $fruit".($total > 1 ? 's' : '');
        };
    }

    my $apple = make_fruit_counter('apple');
    my $orange = make_fruit_counter('orange');

    print $apple->(1)."\n";
    print $apple->(3)."\n";
    print $orange->(1)."\n";
    print $apple->(5)."\n";
    print $orange->(1)."\n";

[download]
When run, this outputs: 

    1 apple
    4 apples
    1 orange
    9 apples
    2 oranges

[download]

The sub make_fruit_counter returns a closure, which uses lexical variables ($fruit and $number) which have been declared outside the anonymous subroutine. So the closure has its own PRIVATE copies of these variables and remembers them. This is why, when you increase the total number of apples ( $total = $total + $number), it increases only the $total variable related to the closure stored in $apples.

But this example isn't very useful, so back to the spreadsheet.

The typical process of creating a simple spreadsheet (and setting the column widths wide enough to display each column in full) involves these steps: 

    #!/usr/bin/perl

    use strict;
    use warnings;
    use Spreadsheet::WriteExcel();

    my $book = Spreadsheet::WriteExcel->new('example.xls')
        or die "Couldn't create spreadsheet : $!";
    my $sheet  = $book->add_worksheet('Example sheet');

    ## Create the title format 'bold'
    my $bold = $book->add_format();
       $bold->set_bold();

    my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @max_col_width;
    my $row = my $col = 0;

    ## Write titles
    $sheet->write( $row, $col++, $_, $bold ) for ('Year',@months);

    ## Move to beginning of next row
    $col = 0;
    $row++;

    ## Write arbitrary values
    my $val = 0;
    for my $year ( 2003 .. 2007 ) {
    
        ## Decide whether to increase the max width for the year colum
+n 
        my $width = length($val);
        $max_col_width[$col] = $width
            if !defined $max_col_width[$col]
            || $width > $max_col_width[$col];
        $sheet->write($row,$col++,$year);
        
        for ( 1..@months) {
            ## Decide whether to increase the max width for this colum
+n 
            my $width = length($val);
            $max_col_width[$col] = $width
                if !defined $max_col_width[$col]
                || $width > $max_col_width[$col];

            $sheet->write( $row, $col++, $val );
            $val = $val + 50;
        }
        ## Move to the beginning of the next row
        $row++;
        $col = 0;
    }

    ## Set the width of each column to the width of the longest value
    foreach my $column (0..$#max_col_width) {
        $sheet->set_column($column,$column,$max_col_width[$column]);
    }

    $book->close 
        or die "Couldn't close spreadsheet : $!";

[download]

This is fine if all you want to do is to write one spreadsheet. But for the next spreadsheet you want to write, you need to use a lot of the same code. Or maybe you want to write the same data to two different sheets, but on one sheet, you need to have an extra column on each row before the other columns. It quickly becomes a maintenance nightmare.

Really, all you want to be able to do is:

In this solution, I use the sub make_writer($sheet) to create a closure which handles these three functions (write, next_row, and set_col_widths):


    #!/usr/bin/perl

    use strict;
    use warnings;
    use Spreadsheet::WriteExcel();

    my $book = Spreadsheet::WriteExcel->new('example.xls')
        or die "Couldn't create spreadsheet : $!";

    my $bold = $book->add_format();
    $bold->set_bold();

    ## Create an anonymous sub for writing to a new worksheet
    my $writer = make_writer($book->add_worksheet('Example sheet'));

    my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

    $writer->( 'write', $_, $bold ) for ('Year',@months);
    $writer->('next_row');

    my $val = 0;
    for my $year (2003..2007 ) {
        $writer->('write',$year);
        for (1..@months) {
            $writer->( 'write', $val );
            $val = $val + 50;
        }        
        $writer->('next_row');
    }

    $writer->('set_col_widths');

    $book->close
        or die "Couldn't close spreadsheet : $!";

    #===================================
    sub make_writer {
    #===================================
        ## These lexical variables will be remembered inside the anony
+mous sub
        my $sheet = shift;
        my $col   = 0;
        my $row   = 0;
        my @max_col_width;

        return sub {
            my $action = shift;
            
            ## Write to the current cell and move to the next cell
            if ( $action eq 'write' ) {
                my ( $value, $format ) = @_;

                ## Set the max_col_width
                my $width = length($value);
                $max_col_width[$col] = $width
                    if !defined $max_col_width[$col]
                    || $width > $max_col_width[$col];

                $sheet->write( $row, $col, $value, $format );
                return $col++;
            }
            
            ## Move to the beginning of the next row
            elsif ( $action eq 'next_row' ) {
                $row++;
                my $orig_col = $col;
                $col = 0;
                return $orig_col;
            }
            
            ## Set the column widths to the width of the widest value
            elsif ( $action eq 'set_col_widths' ) {
                for ( my $col = 0; $col < @max_col_width; $col++ ) {
                    $sheet->set_column( $col, $col, $max_col_width[$co
+l] );
                }
                return;
            }
            
            $action ||= '';
            die "Unknown action '$action'";
        };

    }

[download]

While, in this case, the total code is longer, the loop for writing a spreadsheet is a lot shorter and more readable, and thus easier to maintain.

If, for instance, we wanted to do a separate sheet for each deparment, and a combined sheet with the same data for the whole company, the main loop would look like this:


    #!/usr/bin/perl

    use strict;
    use warnings;
    use Spreadsheet::WriteExcel();

    my $book = Spreadsheet::WriteExcel->new('example.xls')
        or die "Couldn't create spreadsheet : $!";

    my $bold = $book->add_format();
    $bold->set_bold();

    my @months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

    ## Write titles for the company spreadsheet
    my $company = make_writer($book->add_worksheet('Company'));
    $company->('write',$_,$bold) for ('Department','Year',@months);
    $company->('next_row');   
    
    my $val = 0;
    for my $dept_name qw (North South West East) {

        ## Create a new worksheet for this department and add titles
        my $dept = make_writer($book->add_worksheet($dept_name));
        $dept->('write',$_,$bold) for ('Year',@months);
        $dept->('next_row');

        for my $year (2003..2007 ) {
            # The company sheet has the extra column "Department"
            $company->('write',$dept_name);
            $company->('write',$year);

            $dept->('write',$year);

            for (1..@months) {
                $dept->( 'write', $val );
                $company->( 'write', $val );
                $val = $val + 50;
            }        
            $dept->('next_row');
            $company->('next_row');
        }
        $dept->('set_col_widths');        
    }
    $company->('set_col_widths');

    $book->close
        or die "Couldn't close spreadsheet : $!";

[download]

With this solution, we don't need to keep track of the current row and column separately for each sheet, as this is all wrapped up in the closure

Note: I could have used a dispatch table rather than using the if/elsif in my anonymous sub, but I opted against it because

  1. I would need to pass too many variables around, making it more complicated than it needs to be
  2. The if options are listed in order of frequency, so the most commonly used option (write) is hit on the first if

See also: Closure on Closures, How A Function Becomes Higher Order, Currying--useful examples?

Replies are listed 'Best First'.
Re: RFC: Practical closure example: Spreadsheet writer
by GrandFather (Saint) on Aug 04, 2007 at 23:52 UTC

    Nice node, but why closures rather than light weight OO? Consider an OO variant of your first example:

    use strict;
use warnings;

package Fruit;

sub new {
    my ($class, $fruit) = @_;
    
    return bless {total => 0, fruit => $fruit}, $class;
}

sub Add {
   my ($self, $number) = @_;
   $self->{total} = $self->{total} + $number;
   return "$self->{total} $self->{fruit}" . ($self->{total} != 1 ? 's'
+ : '');
};

package main;

my $apple = Fruit->new ('apple');
my $orange = Fruit->new ('orange');

print $apple->Add (1)."\n";
print $apple->Add (3)."\n";
print $orange->Add (1)."\n";
print $apple->Add (5)."\n";
print $orange->Add (1)."\n";

    [download]

    Prints:

    1 apple
4 apples
1 orange
9 apples
2 oranges

    [download]

    Ok, a little more verbose, but now you can add more functionality to your fruit object by adding member functions or sub-classing Fruit.

    DWIM is Perl's answer to Gödel
[reply]
[d/l]
[select]
      Good point, and actually, while I was typing the node, I kept on writing $writer->write($value) rather than $writer->('write',$value). This made me ask myself the same question: why not OO?

      And really, no reason - I would say (and I stand under correction) that really it is just a question of scale. A small job may be more easily (less verbosely) achieved with closures, while OO gives you more room to expand. Also, I would guess that using references to anonymous subs avoids most of the penalty hit of using OO (micro-optimization anyone?).

      So I would say that it is probably a different technique to achieve the same thing.

      I'd be interested in differing opinions though

      Clint

[reply]
[d/l]
[select]
        Also, I would guess that using references to anonymous subs avoids most of the penalty hit of using OO (micro-optimization anyone?).

        There may be a tiny benefit from avoiding potential dispatch lookup, but the benefit is fairly small. If anything, you're more likely to see memory savings (in the order of a few kilobytes). (Closures save the same CV but use different lexpads. If you reuse the closure, all references share the CV rather than constructing their own.)

[reply]
Re: RFC: Practical closure example: Spreadsheet writer
by hilitai (Monk) on Aug 04, 2007 at 20:23 UTC
    Thanks for writing this - I found it interesting. I recently needed to write something that ended up including the first practical use of a closure that I've ever done - I needed to be able to look up a value from a hash table many times, in several different subroutines, but I didn't want to either (a) make the hash global, or (b) have the hash reloaded in each sub.

    It was the first time I realized that, hey, closures could be quite useful (my example below).

    Read more... (825 Bytes)
[reply]
[d/l]
Re: RFC: Practical closure example: Spreadsheet writer
by jmcnamara (Monsignor) on Aug 06, 2007 at 10:43 UTC
[reply]
[d/l]
Re: RFC: Practical closure example: Spreadsheet writer
by smahesh (Pilgrim) on Aug 06, 2007 at 03:45 UTC
[reply]

Back to Meditations