my $max = 10;
my @values = 1 .. $max;
my @values_mixed = shuffle(@values);
my @top = topNbsAB(5, sub { $a <=> $b }, \@values_mixed);
print join(" ",sort { $a <=> $b } @top),"\n";
[download]

I get a result like:

1 1 1 1 9
[download]

I'm also working out how to avoid the extra creation of zero-fill items. Ideally, I would replace them with the first n items of the input in reverse-sorted order. There are two reasons for this:

1) We cannot yet handle negative numbers.

2) We should be testing for the case that the input length is less than or equal to n, and in that case returning everything they gave us. Something like:

    // Special case -- too few values provided. Just return them.
    if (len+1 <= n) {
       for( i = 0; i < len; i++ ) {
          SV *val = *av_fetch( data, i, 0 );
          PUSHs( newSVsv( val ) );
       }
       PUTBACK;
       XSRETURN(len+1);
    }
[download]

If you reverse the order of $a and $b in the comparator, you'll see it works okay for the only case you have coded so far.

To be honest, I haven't been trying to fix up the algorithms, that's your department :) I've been concentrating on how to make the callback from C to Perl.

I'm also working out how to avoid the extra creation of zero-fill items.

1) We cannot yet handle negative numbers.

2) We should be testing for the case that the input length is less than or equal to n, and in that case returning everything they gave us. Something like:

These becomes a non-issues once we fix the main problem--that of handling building the list when you don't know what the sort order will be.

There is no useful value that we can use to initialise the list. Even undef is a legitimate value for the caller to pass us as a part of the list, and their comparator function can choose to order that in whatever way they see fit.

Hence, the problem moves from how to initialise the list, to one of deciding when to add a new value to the list. We don't need to pre-initialise the list with a sorted list. We just build it as we go and the algorithm will take care of the sorting.

Essentially, we just stick each new value on the end of the list until we reach the limit, and effectively ignore it's presence when doing the binary search. Once we find the legitimate position, the new, unsorted value we tacked on the end will get shifted off when we insert that same value into it's proper place.

Harder to describe than code--though the ternary fudge on the initialisation of $right took me a while to see. It also means that we need to remember to remove the last value from the list before returning it.

Here it is coded in Perl. I'm not ready to get back into Inline C again yet. Man, that makes you remember just why you like Perl so much :)

#! perl -slw
use strict;
use List::Util qw[ shuffle ];

our $MAX    ||= 20;
our $N         = defined $N ? $N : 5;

my @values = shuffle( 1 .. $MAX );
my @top = topNbsAB_p( $N, sub { $_[ 0 ] <=> $_[ 1 ] }, \@values );
print join(" ", @top);

   @top = topNbsAB_p( $N, sub { $_[ 1 ] <=> $_[ 0 ] }, \@values );
print join(" ", @top);

  @values = shuffle( 'A' .. 'Z' );
  @top = topNbsAB_p( $N, sub { $_[ 0 ] cmp $_[ 1 ] }, \@values );
print join(" ", @top);

   @top = topNbsAB_p( $N, sub { $_[ 1 ] cmp $_[ 0 ] }, \@values );
print join(" ", @top);

sub topNbsAB_p {
    my( $n, $CMP, $data )  = @_;    
    return unless $n > 0;
    my @ST;
    my $selected = 0;

    for my $val ( @$data ) {  
        $ST[ $selected++ ] = $val if $selected < $n;
        next if( $CMP->( $val, $ST[ $selected-1 ] ) < 0 );     

        my $left = 0;                                                 
+  
        my $right = ($selected >1) ? $selected -1 : $selected;
        while( $left < $right ) {                                     
+ 
            my $middle = ( $left + $right ) >> 1;                     
+ 
            if( $CMP->( $val, $ST[ $middle ] ) <= 0 ) {      
                $left = $middle + 1;                                  
+  
            } else {                                                 
                $right = $middle;                                     
+  
            }                                                        
        } 
        for( my $k = $selected; $k >= $left; $k-- ) { $ST[ $k ] = $ST[
+ $k - 1 ] };     
        $ST[ $left ] = $val;                                          
+ 
    }
    return @ST[ 0 .. $selected-1 ];                                 
}                                                 

__END__
P:\test>junk3 -MAX=10 -N=0





P:\test>junk3 -MAX=10 -N=1
10
1
Z
A

P:\test>junk3 -MAX=10 -N=2
10 9
1 2
Z Y
A B

P:\test>junk3 -MAX=10 -N=10
10 9 8 7 6 5 4 3 2 1
1 2 3 4 5 6 7 8 9 10
Z Y X W V U T S R Q
A B C D E F G H I J

P:\test>junk3 -MAX=10 -N=11
10 9 8 7 6 5 4 3 2 1
1 2 3 4 5 6 7 8 9 10
Z Y X W V U T S R Q P
A B C D E F G H I J K

P:\test>junk3 -MAX=10 -N=26
10 9 8 7 6 5 4 3 2 1
1 2 3 4 5 6 7 8 9 10
Z Y X W V U T S R Q P O N M L K J I H G F E D C B A
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z

P:\test>junk3 -MAX=10 -N=27
10 9 8 7 6 5 4 3 2 1
1 2 3 4 5 6 7 8 9 10
Z Y X W V U T S R Q P O N M L K J I H G F E D C B A
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
[download]

A similar mechanism should work for the heap sort version.

---

Examine what is said, not who speaks.

Silence betokens consent.

Love the truth but pardon error.

I still get a weird result when I reverse the $a and $b in the comparator. Now it's:

-1 0 0 0 7
[download]

Oh well, I think I'll keep the comparison caller in a separate subroutine for simplicity and maintainability anyway.

A similar mechanism should work for the heap sort version.

Actually, I don't need to do the same thing for the heap. All I need to do is call makeHeap on the first N items. That's O(N); building up the heap item-by-item is O(NlogN).

I'm thinking that this is good enough to go ahead with. If I implement the four simple cases (maxN, minN, maxNstr, minNstr) as you suggested, and also a user-supplied comparator, that will be fine.

We've been giving perl's sort an unfair advantage against our homemade comparator. I tried a benchmark against a call it didn't know how to optimize, { ($a < $b) ? -1 : (($a > $b) ? 1:0) }, and our partial sorts do better in many cases (5 in 1000, 5 in 10,000 etc.).