# -*- perl -*-
#
# $Id: SortedList.pm,v 1.3 1995/07/24 16:15:46 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/SortedList.pm,v $
# $Author: ejb $
#
# Sorted list package.  Takes an array reference and an optional compare
# function.  The default compare function is { $a <=> $b }, suitable
# for lists of integers.  Input list does not need to be sorted.
# find and find_range functions are supplied.  See functions below
# for descriptions of how to use them.
#

require 5.000;
use strict qw(refs subs);

package SortedList;
$package = "SortedList";

# Allow sort to work on functions in the main package
*a = *main::a;
*b = *main::b;

# Field names
$f_list = "list";
$f_compare = "compare";

# Static Variables
$linear_search_threshold = 8;

# Routines

#
# Private functions
# 
sub p_call_compare
{
    # Compare function uses $a and $b for args instead of @_
    local($compare, $a, $b) = @_;
    &$compare;
}

sub p_in_range
{
    # Use $a and $b for args rather than @_ (like sort compare function).
    # Return 0 if in range, 1 if below lower bound, or -1 if above
    # (-1 means range is below val; 1 means range is above val)
    # upper bound
    local($range, $val) = ($a, $b);
    local($compare, $lower, $upper) = @$range;
    local($cmp_lower) = &p_call_compare($compare, $lower, $val);
    local($cmp_upper) = &p_call_compare($compare, $upper, $val);

    (($cmp_upper < 0) ? -1 :
     ($cmp_lower > 0) ? 1 :
     0);
}

#
# Public functions
#

sub new
{
    shift;
    my $rep = +{$package => {} };
    local($usage) = "$package: usage: new $package(ARRAY-ref[, compare])\n";

    if (@_ < 1)
    {
	die $usage;
    }
    local($list) = shift;
    local($t);
    if (! (($t = ref $list) && ($t eq "ARRAY")))
    {
	die "$package: argument to new must be an ARRAY reference\n";
    }
    if (@_ > 1)
    {
	die $usage;
    }
    local($compare);
    if (@_ == 1)
    {
	$compare = shift;
    }
    else
    {
	$compare = sub { $a <=> $b };
    }

    local(@b) = sort { &$compare } @$list;
    $rep->{$package}{$f_list} = [@b];
    $rep->{$package}{$f_compare} = $compare;

    bless $rep;
}

sub find
{
    # Return the index in list of item or undef if item is not in list.

    my $rep = shift;
    local($item) = shift;
    local($compare);
    if (scalar(@_))
    {
	$compare = shift;
    }
    else
    {
	$compare = $rep->{$package}{$f_compare};
    }
    local($list) = $rep->{$package}{$f_list};
    local($n) = scalar(@$list);
    local($max) = 1;
    while ($max < $n)
    {
	$max <<= 1;
    }

    local($step) = $max >> 1;
    local($i) = $step;
    local($result);
    local($checks) = $max;

    if ($n < $linear_search_threshold)
    {
	for ($i = 0; $i < $n; $i++)
	{
	    if (&p_call_compare($compare, $item, $list->[$i]) == 0)
	    {
		return $i;
	    }
	}
    }
    else
    {
	while ($checks > 0)
	{
	    if ($i < $n)
	    {
		$result = &p_call_compare($compare, $item, $list->[$i]);
	    }
	    else
	    {
		$result = -1;
	    }
	    if ($result == 0)
	    {
		return $i;
	    }
	    else
	    {
		$step >>= 1;
		if ($step == 0)
		{
		    $step = 1;
		}
		
		if ($result < 0)
		{
		    $i -= $step;
		}
		else
		{
		    $i += $step;
		}
	    }
	    $checks >>= 1;
	}
    }

    # If we got here, we didn't find it.
    undef;
}

sub find_range
{
    # Return a list of indices of elements between lower and upper.
    # If no elements are found, an empty list is returned.

    my $rep = shift;
    local($list) = $rep->{$package}{$f_list};
    local($compare) = $rep->{$package}{$f_compare};
    local($lower, $upper) = @_;
    local($range) = [$compare, $lower, $upper];
    local($i) = $rep->find($range, \&p_in_range);
    local(@indices) = ();

    if (defined($i))
    {
	# $i is in range.  Find first and last elements in range.
	local($l, $u) = ($i, $i);

	while (($l - 1) >= 0)
	{
	    last if (&p_call_compare(\&p_in_range,
				     $range, $list->[$l - 1]) != 0);
	    $l--;
	}

	while (($u + 1) < scalar(@$list))
	{
	    last if (&p_call_compare(\&p_in_range,
				     $range, $list->[$u + 1]) != 0);
	    $u++;
	}

	@indices = ($l..$u);
    }

    @indices;
}

sub elements
{
    my $rep = shift;
    local($list) = $rep->{$package}{$f_list};
    (@$list)[@_];
}


sub test
{
    shift;
    eval { new SortedList() };
    print $@ ? $@ : "ok\n";
    eval { new SortedList(1, 2) };
    print $@ ? $@ : "ok\n";
    eval { new SortedList("") };
    print $@ ? $@ : "ok\n";
    eval { new SortedList([1, 2]) };
    print $@ ? $@ : "ok\n";
    $s = sub
    {
	local($i) = shift;
	local($r) = $l->find($i);
	local($x) = (defined($r) ? $r : "not found");
	print "$i: $x\n";
    };

    $l = new SortedList([1, 3, 4, 6, 7, 9, 11, 15]);
    map { &$s($_) } (1, 15, 6, 7, 3, 5);
    print "\n";

    $l = new SortedList([1, 3, 4, 6, 7, 9, 11]);
    map { &$s($_) } (1, 15, 6, 7, 3, 5);
    print "\n";

    $l = new SortedList([1, 3, 4, 7, 6, 9, 15, 11, 22]);
    map { &$s($_) } (1, 15, 6, 7, 3, 5, 22, 25, -3);
    print "\n";

    $s = sub
    {
	local($r) = shift;
	local($lower, $upper) = @$r;
	local(@r) = $l->find_range($lower, $upper);
	print +("[$lower, $upper]: ", join(' ', @r), " = ",
		join(' ', $l->elements(@r)), "\n");
    };

    map { &$s($_) } ([0, 50], [50, 60], [4, 6], [4, 8], [2, 8], [4, 4]);
    print "\n";
}

1;