#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#define croak_msg(msg) \
croak ("median(): %s", msg)
#define croak_msg_internal(msg) \
croak ("median(): internal error: %s", msg)
enum { LESS_THAN = -1, EQUAL_TO, GREATER_THAN };
static int
quick_sort (const void *arg1, const void *arg2)
{
const long num1 = *(long *)arg1, num2 = *(long *)arg2;
if (num1 < num2)
return LESS_THAN;
else if (num1 == num2)
return EQUAL_TO;
else if (num1 > num2)
return GREATER_THAN;
else
croak_msg_internal ("quick sort did not return a long integer");
}
#define SWAP(num_curr, num_next) \
const long tmp = num_curr; \
num_curr = num_next; \
num_next = tmp;
static void
bubble_sort (long *numbers, unsigned int realitems)
{
bool sort;
do
{
unsigned int i;
sort = FALSE;
for (i = 0; i < (realitems - 1); i++)
{
if (i >= 1
&& (numbers[i - 1] <= numbers[i]) && (numbers[i] <= numbers[i + 1]))
continue; /* optimization */
else if (numbers[i] > numbers[i + 1])
{
SWAP (numbers[i], numbers[i + 1]);
sort = TRUE;
}
}
}
while (sort);
}
MODULE = Algorithm::MedianSelect::XS PACKAGE = Algorithm::MedianSelect::XS
void
xs_median (...)
PROTOTYPE: @\@
INIT:
long *numbers = NULL;
unsigned int median, realitems;
enum { BUBBLE_SORT = 1, QUICK_SORT };
PPCODE:
if (items == 1)
{
if (SvROK (ST(0)))
{
if (SvTYPE (SvRV(ST(0))) == SVt_PVAV)
{
AV *aref = (AV *)SvRV (ST(0));
unsigned int i;
realitems = av_len (aref) + 1;
Newx (numbers, realitems, long);
for (i = 0; i < realitems; i++)
numbers[i] = (long)SvIV (*av_fetch(aref, i, 0));
}
else
croak_msg ("reference is not an array reference");
}
else
croak_msg ("requires either list or reference to an array");
}
else
{
unsigned int i;
realitems = items;
Newx (numbers, realitems, long);
for (i = 0; i < realitems; i++)
numbers[i] = (long)SvIV (ST(i));
}
switch (SvIV (get_sv("Algorithm::MedianSelect::XS::ALGORITHM", FALSE)))
{
case BUBBLE_SORT:
bubble_sort (numbers, realitems);
break;
case QUICK_SORT:
qsort (numbers, realitems, sizeof (long), quick_sort);
break;
default:
croak_msg_internal ("no mode available");
}
if (realitems % 2 == 0)
median = realitems / 2;
else
median = (realitems - 1) / 2;
EXTEND (SP, 1);
PUSHs (sv_2mortal(newSViv(numbers[median])));
Safefree (numbers);