use strict;

my @list = qw/ box cow dog apple ant/;

{
    my $count = 0;

    sub get_count { return $count } # an inspector as a closure

    # and another closure
    sub compare 
    { 
        $count++;
        return $_[0] cmp $_[1];
    }
}

print sort { compare( $a, $b ) } @list;
print "\n";
print get_count();
[download]

Hmmm, it seems as though this solution does not make count unique to each sort. Thus $count contains a cumulative count as opposed to a count for each sort. I guess I should have stated my goals at the beginning.

--traveler

The obvious answer would be to add a method reset_count() in the block, but you would have to explicitly call it before sorting, which is prone to errors.

Another way is to put together a state and a behaviour, building an object.

But if you want to go on in a functional way, you may want to build a composition of a behaviour and a state, i.e. a closure. Here a short demonstration:

use strict;

my @list1 = qw/ box cow dog apple ant/;
my @list2 = qw/ ant apple box cow dog/;

sub make_a_profilable_sorter
{
    my $criterion = shift;
    
    return sub {
        my $counter = 0;

        my @list = @_;

        @list = sort { $counter++; $criterion->( $a, $b ) } @list; 

        return ( $counter, @list );
    }
}

my $sorter1 = make_a_profilable_sorter( sub{ $_[0] cmp $_[1] } );
my $sorter2 = make_a_profilable_sorter( sub{ $_[0] cmp $_[1] } );

my ($count, @res) = $sorter1->( @list1 );
print "I sorted /@list1/ in $count steps producing /@res/\n";

my ($count, @res) = $sorter2->( @list2 );
print "I sorted /@list2/ in $count steps producing /@res/\n";
[download]

In order to learn more about this subject (very interesting, in my opinion) you could refer to the following online resources:
• Frames as repository of local state in Structure and Interpretation of Computer Programs
• On Lisp by Paul Graham. Start at page 30 (in the free pdf file)

That's becauase this is a closure and $count retains its value between calls, since there is actually an instance of $count being carried around in the coderef.

Either move $count into the outer scope, so you can clear it between calls, or generate a new set closures, modding the previous poster's code Re: Closures and sort :

use strict;

my @list = qw/ box cow dog apple ant/;

sub mksub
{
    my $count = 0;

    my $s1 = sub  { return $count }; # an inspector as a closure

    # and another closure
    my $s2 = sub
    {
        $count++;
        return $_[0] cmp $_[1];
    };

    return ( $s1, $s2 );
}

my ( $get_count, $compare, );
( $get_count, $compare, ) =  mksub();
print sort { $compare->( $a, $b ) } @list;
print "\n";
print $get_count->(), "\n";
print "\n";

print sort { $compare->( $a, $b ) } @list;
print "\n";
print $get_count->(), "\n";
print "\n";

( $get_count, $compare, ) =  mksub();
print sort { $compare->( $a, $b ) } @list;
print "\n";
print $get_count->(), "\n";
print "\n";
[download]

Which produces:

antappleboxcowdog
9

antappleboxcowdog
18

antappleboxcowdog
9

Update: as someone else said, creating a reset_count coderef inside the same scope would do this and be cleaner than what I did.
--Bob Niederman, http://bob-n.com

You're right, this is much easier than returning a list. I should have thought of an inspector and a block. Thanks.

--traveler

use strict;

my @list = qw/ box cow dog apple ant/;

# A "normal" use of sort
my @sorted = sort {$a cmp $b} @list;
print join (',', @sorted), "\n";

#return the sort sub and count in a list
sub mcc {
    my $count = 0;
    return (sub {$count++; $_[0] cmp $_[1] }, $count);
}
# why can't I say something like mcc()[0] ???
print join ',',sort { &{(mcc())[0]}($a,$b) } @list;
[download]

The main problem is that the sort function should be written in terms of $a and $b. What you have ought to work if you call the coderef in @f as, print sort { $f[0]->($a, $b) } @list; I don't understand why you are counting calls to the comparison function after you read the counter. Does the real code have another sub clotted on $count, or do you call mcc() again to read it?

After Compline,
Zaxo

use strict;
$|=1;

my @list = qw/ box cow dog apple ant/;

sub xcmp{
    my $count = 0;
  
    sub get_count { return $count } # an inspector as a closure

    # and another closure
    sub compare 
    { 
        $count++;
        return $_[0] cmp $_[1];
    }
    return(\&compare, \&get_count);
}

my @funcs = xcmp();

print sort { $funcs[0]( $a, $b ) } @list;
print "\n";
print $funcs[1](), "\n";

@funcs = xcmp();
print sort { $funcs[0]( $a, $b ) } @list;
print "\n";
print $funcs[1](), "\n";
[download]

Because your sub get_count {} and sub compare {} are run once, at compile time, no matter how many times you call xcmp. So the subroutines are the same each time, even after callin xcmp in between. TO show this, do a print $funcs[1](), "\n"; after the first and second callst to xcmp() - they're the same. If you look at Re: Re: Re: Closures and sort and add a print "$compare\n"; after each call to mksubs(), you'll see these are different.

So your functions continue to carry around the same instance of $count, but, each time xcmp is run, it is a new instance of $count which is being set to zero.

Looked at another way,

sub xcmp
{
  my $count;
  $x = sub { return $count };
  return $x;
}
[download]

returns a new coderef each time it run, each with it's own instance of count.

Whereas

sub xcmp
{
   my $count;
   sub get_count { return $count }
   return &get_count;
}
[download]

returns a coderef, but it's always the same coderef, carrying aroun the same instance of $count.
--Bob Niederman, http://bob-n.com