#!/usr/bin/perl

sub najblizsze_punkty {
    my ( @p ) = @_;

    return () unless @p and @p % 2 == 0;

    my $nieposortowane_x = [ map { $p[ 2 * $_     ] } 0..$#p/2 ];
    my $nieposortowane_y = [ map { $p[ 2 * $_ + 1 ] } 0..$#p/2 ];

    # Oblicza permutacje i indeksy porzadkowe.

    # Indeks permutacji wspolrzednej x.
    #
    # Jesli tablica @$nieposortowane_x to (18, 7, 25, 11), to tablica @xpi 
    # bedzie zawierala (1, 3, 0, 2), np. $xpi[0] == 1 oznacza, ze $posortowane_x[0]
    # znajduje sie w $nieposortowane_x->[1].
    #
    # Ta operacja jest wykonywana, aby umozliwic sortowanie @$nieposortowane_x 
    # do @posortowane_x z zachowaniem mozliwosci przywrocenia oryginalnej kolejnosci
    # w postaci @posortowane_x[@xpi].
    # Jest to niezbedne ze wzgledu na koniecznosc sortowania punktow wedlug
    # wspolrzednych x i y oraz identyfikacji wyniku na podstawie oryginalnych
    # indeksow punktow: "12 punkt i 45 punkt to najblizsza para ".

    my @xpi = sort { $nieposortowane_x->[ $a ] <=> $nieposortowane_x->[ $b ] }
                   0..$#$nieposortowane_x;

    # Indeks permutacji wspolrzednych y.
    #
    my @ypi = sort { $nieposortowane_y->[ $a ] <=> $nieposortowane_y->[ $b ] }
                   0..$#$nieposortowane_y;

    # Indeks porzadkowy wspolrzednych y.
    #
    # Indeks porzadkowy to odwrotnosc indeksu permutacji. Jesli tablica
    # @$nieposortowane_y to (16, 3, 42, 10) a @ypi to (1, 3, 0, 2), to tablica @yoi
    # bedzie miala postac (2, 0, 3, 1), na przyklad $yoi[0] == 1 oznacza, ze
    # $nieposortowane_y->[0] to $posortowane_y[1].

    my @yoi;
    @yoi[ @ypi ] = 0..$#ypi;

    # Rekurencja w celu odnalezienia najblizszych punktow.
    my ( $p, $q, $d ) = _najblizsze_punkty_rekurencja( [ @$nieposortowane_x[@xpi] ],
                                                       [ @$nieposortowane_y[@xpi] ],
                                                       \@xpi, \@yoi, 0, $#xpi
                                                    );

    my $pi = $xpi[ $p ];                           # Odwrotna permutacja.
    my $qi = $xpi[ $q ];

    ( $pi, $qi ) = ( $qi, $pi ) if $pi > $qi;      # Najpierw mniejszy identyfikator.
    return ( $pi, $qi, $d );
}

sub _najblizsze_punkty_rekurencja {
    my ( $x, $y, $xpi, $yoi, $x_l, $x_r ) = @_;

    # $x, $y:  odwolania tablicowe do wspolrzednych x i y punktow
    # $xpi:    indeksy permutacji x: obliczone przez najblizsze_punkty_rekurencja()
    # $yoi:    indeksy kolejnosci y: obliczone przez najblizsze_punkty_rekurencja()
    # $x_l:    lewa granica aktualnie sprawdzanego zbioru punktow
    # $x_r:    prawa granica aktualnie sprawdzanego zbioru punktow
    #          Oznacza to, iz sprawdzane beda tylko punkty $x->[$x_l..$x_r] 
    #          i $y->[$x_l..$x_r].

    my $d;     # Odnaleziona najblizsza odleglosc.
    my $p;     # Indeks drugiego konca minimalnej odleglosci.
    my $q;     # Jak wyzej.

    my $N = $x_r - $x_l + 1;      # Liczba interesujacych punktow.

    if ( $N > 3 ) {               # Duza liczba punktow. Rekurencja!
        my $x_lr = int( ( $x_l + $x_r ) / 2 ); # Prawa granica lewej polowki.
        my $x_rl = $x_lr + 1;                  # Lewa granica prawej polowki.

        # Najpierw rekurencja w celu zbadania polowek.

        my ( $p1, $q1, $d1 ) =
            _najblizsze_punkty_rekurencja( $x, $y, $xpi, $yoi, $x_l, $x_lr );
        my ( $p2, $q2, $d2 ) =
            _najblizsze_punkty_rekurencja( $x, $y, $xpi, $yoi, $x_rl, $x_r );

        # Teraz polaczenie wynikow obu polowek.

        # Ustawienie $d, $p, $q na najkrotsza odleglosc oraz indeksy
        # odnalezionej najblizszej pary punktow.

        if ( $d1 < $d2 ) { $d = $d1;  $p = $p1;  $q = $q1 }
        else             { $d = $d2;  $p = $p2;  $q = $q2 }

        # Sprawdzenie obszaru laczenia.

        # Wspolrzedna x miedzy lewa i prawa polowka.
        my $x_d = ( $x->[ $x_lr ] + $x->[ $x_rl ] ) / 2;

        # Indeksy potencjalnych punktow: te pary punktow znajduja sie po obu
        # stronach linii podzialu i moga znajdowac sie blizej siebie, niz
        # dotychczasowa najlepsza para punktow.
        #
        my @xi;

        # Odnalezienie potencjalnych punktow z lewej polowki.

        # Lewa granica lewego segmentu z potencjalnymi punktami.
        my $x_ll;

        if ( $x_lr == $x_l ) { $x_ll = $x_l }
        else {                                     # Przeszukiwanie binarne.
            my $x_ll_lo = $x_l;
            my $x_ll_hi = $x_lr;
            do { $x_ll = int( ( $x_ll_lo + $x_ll_hi ) / 2 );
                 if ( $x_d - $x->[ $x_ll ] > $d ) {
                    $x_ll_lo = $x_ll + 1;
                 } elsif ( $x_d - $x->[ $x_ll ] < $d ) {
                    $x_ll_hi = $x_ll - 1;
                 }
            } until $x_ll_lo > $x_ll_hi
                or ( $x_d - $x->[ $x_ll ] < $d
                     and ( $x_ll == 0 or
                           $x_d - $x->[ $x_ll - 1 ] > $d ) );
        }
        push @xi, $x_ll..$x_lr;

        # Odnalezienie potencjalnych punktow z prawej polowki.

        # Prawa granica prawego segmentu z potencjalnymi punktami.
        my $x_rr;

        if ( $x_rl == $x_r ) { $x_rr = $x_r }
        else {                                     # Przeszukiwanie binarne.
            my $x_rr_lo = $x_rl;
            my $x_rr_hi = $x_r;
            do { $x_rr = int( ( $x_rr_lo + $x_rr_hi ) / 2 );
                 if ( $x->[ $x_rr ] - $x_d > $d ) {
                    $x_rr_hi = $x_rr - 1;
                 } elsif ( $x->[ $x_rr ] - $x_d < $d ) {
                    $x_rr_lo = $x_rr + 1;
                 }
            } until $x_rr_hi < $x_rr_lo
                or ( $x->[ $x_rr ] - $x_d < $d
                     and ( $x_rr == $x_r or
                           $x->[ $x_rr + 1 ] - $x_d > $d ) );
        }
        push @xi, $x_rl..$x_rr;

        # Uzyskano juz liste potencjalnych punktow. Czy spelnia one nasze warunki?
        # Sprawdzanie jest dosc skomplikowane.

        # Najpierw posortowanie punktow wedlug oryginalnych indeksow.

        my @x_by_y   = @$yoi[ @$xpi[ @xi ] ];
        my @i_x_by_y = sort { $x_by_y[ $a ] <=> $x_by_y[ $b ] }
                       0..$#x_by_y;
        my @xi_by_yi;
        @xi_by_yi[ 0..$#xi ] = @xi[ @i_x_by_y ];

        my @xi_by_y = @$yoi[ @$xpi[ @xi_by_yi ] ];
        my @x_by_yi = @$x[ @xi_by_yi ];
        my @y_by_yi = @$y[ @xi_by_yi ];

        # Zbadanie kazdej potencjalnej pary punktow (pierwszy punkt
        # z lewej polowki, drugi punkt z prawej polowki).

        for ( my $i = 0; $i <= $#xi_by_yi; $i++ ) {
            my $i_i = $xi_by_y[ $i ];
            my $x_i = $x_by_yi[ $i ];
            my $y_i = $y_by_yi[ $i ];
            for ( my $j = $i + 1; $j <= $#xi_by_yi; $j++ ) {
                # Pominiecie punktow, dla ktorych odleglosc nie moze byc mniejsza,
                # niz dla dotychczasowej najlepszej pary.
                last if $xi_by_y[ $j ] - $i_i > 7; # Zbyt daleko?
                my $y_j = $y_by_yi[ $j ];
                my $dy = $y_j - $y_i;
                last if $dy > $d;                  # Zbyt wysoko?
                my $x_j = $x_by_yi[ $j ];
                my $dx = $x_j - $x_i;
                next if abs( $dx ) > $d;           # Zbyt szeroko?
                # Program dotarl az tutaj?  Byc moze odnaleziono zwyciezce.
                # Nalezy sprawdzic odleglosc i zaktualizowac zmienne.
                my $d3 = sqrt( $dx**2 + $dy**2 );
                if ( $d3 < $d ) {
                    $d = $d3;
                    $p = $xi_by_yi[ $i ];
                    $q = $xi_by_yi[ $j ];
                }
            }
        }
    } elsif ( $N == 3 ) {      # Tylko trzy punkty? Rekurencja nie jest potrzebna.
        my $x_m = $x_l + 1;
        # Porownanie kwadrator sum. Pierwiastkowanie zostanie wykonane pozniej.
        my $s1 = ($x->[ $x_l ]-$x->[ $x_m ])**2 +
                 ($y->[ $x_l ]-$y->[ $x_m ])**2;
        my $s2 = ($x->[ $x_m ]-$x->[ $x_r ])**2 +
                 ($y->[ $x_m ]-$y->[ $x_r ])**2;
        my $s3 = ($x->[ $x_l ]-$x->[ $x_r ])**2 +
                 ($y->[ $x_l ]-$y->[ $x_r ])**2;
        if ( $s1 < $s2 ) {
            if ( $s1 < $s3 )  { $d = $s1;  $p = $x_l;  $q = $x_m }
            else              { $d = $s3;  $p = $x_l;  $q = $x_r }
        } elsif ( $s2 < $s3 ) { $d = $s2;  $p = $x_m;  $q = $x_r }
          else                { $d = $s3;  $p = $x_l;  $q = $x_r }

        $d = sqrt $d;
    } elsif ( $N == 2 ) {         # Tylko dwa punkty? Rekurencja nie jest potrzebna.
        $d = sqrt(($x->[ $x_l ]-$x->[ $x_r ])**2 +
                  ($y->[ $x_l ]-$y->[ $x_r ])**2);
        $p = $x_l;
        $q = $x_r;
    } else {                      # Mniej niz dwa punkty?  Dziwne.
        return ( );
    }

    return ( $p, $q, $d );
}

@para_punktow = najblizsze_punkty( 1, 2,  2, 5,  3, 1,  3, 3,  4, 5,
                                   5, 1,  5, 6,  6, 4,  7, 4,  8, 1 ), "\n";
print "@para_punktow \n";

