Algorithm::SISort - Select And Insert sorting algorithm

Algorithm-SISort documentation Contained in the Algorithm-SISort distribution.

Index

Code Index:

NAME

Top

Algorithm::SISort - Select And Insert sorting algorithm

SYNOPSIS

Top

  use Algorithm::SISort qw(Sort Sort_inplace);

  @sorted_list = Sort {$_[0] <=> $_[1]} @unsorted_list;
  # ... or ...
  $number_of_comparisons = Sort_inplace {$_[0] <=> $_[1]} @unsorted_list;

DESCRIPTION

Top

This module implements a sorting algorithm I saw in BIT 28 (1988) by István Beck and Stein Krogdahl. This implementation is mainly intended to try out the Inline module by Brian Ingerson. The algorithm is a combination of Straight Insertion Sort and Selection Sort. While Insertion Sort and Selection Sort both are of complexity O(n**2), Select and Insert Sort should have complexity O(n**1.5).

This module defines the functions Sort and Sort_inplace, which have signatures similar to the internal sort function. The difference is that a codref defining a comparison is always required and that the two values to compare are always passed in @_ and not as $a and $b. (Although I might change that later.)

Sort returns a sorted copy if the array, but Sort_inplace sorts the array in place (as the name suggests) and returns the number of comparisons done. (Note that the sorting is always done in place, Sort just copies the array before calling the internal sort routine.)

BUGS

Top

Bug-reports are very welcome on the CPAN Request Tracker at:

    http://rt.cpan.org/NoAuth/Bugs.html?Dist=Algorithm-SISort

SEE ALSO

Top

Inline, Inline::C, and A Select And Insert Sorting Algorithm by István Beck and Stein Krogdahl in BIT 28 (1988), 726-735.

AUTHOR

Top

Hrafnkell F. Hlodversson, keli@panmedia.dk

COPYRIGHT

Top

Copyright 2001, Hrafnkell F Hlodversson

All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License.

See http://www.perl.com/perl/misc/Artistic.html

Algorithm-SISort documentation Contained in the Algorithm-SISort distribution. 
package Algorithm::SISort;

require 5.005_62;
use strict;
use warnings;
use Inline C => 'DATA', NAME => 'Algorithm::SISort', VERSION => '0.14';

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
	Sort
	Sort_inplace
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

our $VERSION = '0.14';

sub Sort(&@) {
	my $callback=shift;
	_sort($callback, \@_);
	return @_;
}

sub Sort_inplace(&\@) {
	my $callback=shift;
	return _sort($callback, $_[0]);
}

1;

__DATA__



__C__

static int compare( SV* callback,  SV* a, SV* b) {
	int retnum,numres;
	dSP;
	SvREFCNT_inc(a);
	SvREFCNT_inc(b);
	
	ENTER;
	SAVETMPS;
	
	PUSHMARK(sp);
	XPUSHs(a);
	XPUSHs(b);
	PUTBACK;
	
	numres=call_sv(SvRV(callback), G_SCALAR);
	
	SPAGAIN;
	
	if(numres==1) {
		retnum = POPi;
	} else {
		retnum = 0;
	}
	
	PUTBACK;
	FREETMPS;
	LEAVE;
	return retnum;
}

int _sort (SV* callback, SV* arrayref) {
	int n; /* last element of array */
	int i, j,  step, ncompares;
	SV *min, **minp, **A_i, **A_j, **ptr;
	AV* A;
	
	if (! SvROK(arrayref))
		croak("arrayref is not a reference");
	if (! SvROK(callback))
		croak("callback is not a reference");

	ncompares=0;
	A=(AV*)SvRV(arrayref);
	
	n=av_len(A);

	for(i=0;i<=n;i++) {
		A_i=av_fetch(A,i,0);
		min  = *A_i;
		minp = A_i;
		step = 1;
		j	 = i+step;
		
		/* Select a "minimalish" element: */
		while ( j <= n ) {
			A_j=av_fetch(A,j,0);
			ncompares++;
			if( compare(callback, *A_j, min ) < 0 )  {
				min=*A_j;
				minp=A_j;
			}
			step++;
			j+=step;
		}
		
	
		/* Start insertion: */
		*minp=*A_i;
		
		j = i-1;
		A_j=av_fetch(A,j,0);
		while ( j>-1 && compare(callback, *A_j, min ) > 0 ) {
			ncompares++;
			ptr=av_fetch(A,j+1,0);
			*ptr=*A_j;
			
			j--;
			A_j=av_fetch(A,j,0);
		}
		ncompares++;
		ptr=av_fetch(A,j+1,0);
		*ptr=min;
	}

	return ncompares;

}