use strict;
use warnings;

package Tie::Scalar::Count;

use vars qw( $Count );

$Count = 0;

sub TIESCALAR { bless \my $x, shift }
sub STORE { ${ $_[0] } = $_[1] }

sub FETCH {
    $Count++;
    return ${ $_[0] };
}

package main;

use Test::More 'no_plan';
use List::Util 'shuffle';
use Heap::Simple;

sub scalars2counters {
    foreach my $m ( @_ ) {
        my $x = $m;
        tie $m, 'Tie::Scalar::Count';
        $m = $x;
    }
}

sub median_sort {
    my @s = sort { $a <=> $b } @_;
    my $i = scalar @s / 2;
    return   ( $i == int $i )
           ? ( $s[ $i-1 ] + $s[ $i ] ) / 2
           : $s[ int $i ];
}

sub median_heap {
    my $heap;
    my $tied = !!(tied $_[0]);
    if ( $tied ) {
        $heap = Heap::Simple->new( elements => ['Method' => 'FETCH'] );
        $heap->insert( map { tied $_ } @_ );
    }
    else {
        $heap = Heap::Simple->new();
        $heap->insert( @_ );
    }

    my $i = scalar @_ / 2;
    for ( 0 .. int $i - 2 ) {
        $heap->extract_top;
    }
    if ( $i == int $i ) {
        my $v1 = $heap->extract_top;  # $i - 1
        my $v2 = $heap->extract_top;  # $i
        if ( $tied ) {
            $v1 = $v1->FETCH();
            $v2 = $v2->FETCH();
        }
        return ( $v1 + $v2 ) / 2;
    }
    else {
        $heap->extract_top;  # $i - 1
        return $tied ? $heap->extract_top->FETCH() : $heap->extract_top;
    }
}

# Confirm that Tie::Scalar::Count works as advertised
{
    tie my $foo, 'Tie::Scalar::Count';
    is( $Tie::Scalar::Count::Count, 0, 'count is zero initially' );
    $foo = 10;
    is( $Tie::Scalar::Count::Count, 0, 'count is zero after STORE' );
    is( $foo, 10, 'FETCH works' );
    is( $Tie::Scalar::Count::Count, 1, 'count is 1 after FETCH' );
}

# Confirm that median_sort and median_heap get the right medians
{
    my @odd = ( 1, 2, 3 );
    my @even = ( 2, 4 );

    is( median_sort( @odd ), 2, 'odd median_sort is correct' );
    is( median_sort( @even ), 3, 'even median_sort is correct' );

  TODO: {
        local $TODO = 'heap method not ready for a short list';
        is( median_heap( @odd ), 2, 'odd median_heap is correct' );
    }
    is( median_heap( @even ), 3, 'even median_heap is correct' );

    my @bonus1 = shuffle 0 .. 100;
    my @bonus2 = shuffle 1 .. 100;
    is( median_heap( @bonus1 ), median_sort( @bonus1 ),
        'larger odd list is correct' );
    is( median_heap( @bonus2 ), median_sort( @bonus2 ),
        'larger even list is correct' );
}

# Check that scalars2counters works
{
    my @scalars = 0 .. 10;
    scalars2counters( @scalars );

    my $tied = grep { tied $_ } @scalars;
    is( $tied, scalar @scalars, 'all elements tied' );
}

# Confirm that counting works when using median_sort
{
    $Tie::Scalar::Count::Count = 0;

    my @m = shuffle 0 .. 10;
    scalars2counters( @m );
    
    is( median_sort( @m ), 5, 'median_sort is correct' );
    ok( $Tie::Scalar::Count::Count > scalar @m,
        "count ($Tie::Scalar::Count::Count) is > @{[ scalar @m ]}" );
}

# Confirm that counting works when using median_heap
{
    $Tie::Scalar::Count::Count = 0;

    my @m = shuffle 0 .. 10;
    scalars2counters( @m );

    is( median_heap( @m ), 5, 'median_heap is correct' );
    ok( $Tie::Scalar::Count::Count > scalar @m,
        "count ($Tie::Scalar::Count::Count) is > @{[ scalar @m ]}" );
}

{
    $Tie::Scalar::Count::Count = 0;

    my @m = shuffle 0 .. 100;
    scalars2counters( @m );

    my $heap_median = median_heap( @m );
    my $heap_compares = $Tie::Scalar::Count::Count;

    $Tie::Scalar::Count::Count = 0;

    my $sort_median = median_sort( @m );
    my $sort_compares = $Tie::Scalar::Count::Count;
    is( $heap_median, $sort_median, 'Heap answer same as sort' );
    ok( $heap_compares < $sort_compares,
        "fewer heap compares ($heap_compares < $sort_compares)" );
}