File Coverage

blib/lib/List/Rank.pm

Criterion	Covered	Total	%
statement	136	136	100.0
branch	24	24	100.0
condition			n/a
subroutine	11	11	100.0
pod	6	6	100.0
total	177	177	100.0

package List::Rank;

use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-23'; # DATE
our $DIST = 'List-Rank'; # DIST
our $VERSION = '0.004'; # VERSION

our @EXPORT_OK = qw(rank rankstr rankby sortrank sortrankstr sortrankby);

sub rank(@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my @ary;
    my $i = 0;
    for (@_) { push @ary, [$_, $i++, undef] }
    @ary = sort { $a->[0] <=> $b->[0] } @ary;
    my $j = 1;
    for ($i=0; $i<@ary; $i++) {
        if ($i == 0) {
            $ary[$i][2] = $j;
        } else {
            if ($ary[$i-1][0] == $ary[$i][0]) {
                $ary[$i-1][2] = $ary[$i][2] = "$j=";
            } else {
                $j = $i+1;
                $ary[$i][2] = $j;
            }
        }
    }
    map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
}

sub rankstr(@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my @ary;
    my $i = 0;
    for (@_) { push @ary, [$_, $i++, undef] }
    @ary = sort { $a->[0] cmp $b->[0] } @ary;
    my $j = 1;
    for ($i=0; $i<@ary; $i++) {
        if ($i == 0) {
            $ary[$i][2] = $j;
        } else {
            if ($ary[$i-1][0] eq $ary[$i][0]) {
                $ary[$i-1][2] = $ary[$i][2] = "$j=";
            } else {
                $j = $i+1;
                $ary[$i][2] = $j;
            }
        }
    }
    map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
}

sub rankby(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict

    my $cmp = shift;

    my $caller = caller();

    my @ary;
    my $i = 0;
    for (@_) { push @ary, [$_, $i++, undef] }
    @ary = sort {
        local ${"$caller\::a"} = $a->[0];
        local ${"$caller\::b"} = $b->[0];
        $cmp->();
    } @ary;
    my $j = 1;
    for ($i=0; $i<@ary; $i++) {
        if ($i == 0) {
            $ary[$i][2] = $j;
        } else {
            if (do {
                local ${"$caller\::a"} = $ary[$i-1][0];
                local ${"$caller\::b"} = $ary[$i][0];
                !$cmp->();
            }) {
                $ary[$i-1][2] = $ary[$i][2] = "$j=";
            } else {
                $j = $i+1;
                $ary[$i][2] = $j;
            }
        }
    }
    map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
}

sub sortrank(@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my @ary;
    my $i = 0;
    for (@_) { push @ary, [$_, $i++, undef] }
    @ary = sort { $a->[0] <=> $b->[0] } @ary;
    my $j = 1;
    for ($i=0; $i<@ary; $i++) {
        if ($i == 0) {
            $ary[$i][2] = $j;
        } else {
            if ($ary[$i-1][0] == $ary[$i][0]) {
                $ary[$i-1][2] = $ary[$i][2] = "$j=";
            } else {
                $j = $i+1;
                $ary[$i][2] = $j;
            }
        }
    }
    map { ($_->[0], $_->[2]) } @ary;
}

sub sortrankstr(@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    my @ary;
    my $i = 0;
    for (@_) { push @ary, [$_, $i++, undef] }
    @ary = sort { $a->[0] cmp $b->[0] } @ary;
    my $j = 1;
    for ($i=0; $i<@ary; $i++) {
        if ($i == 0) {
            $ary[$i][2] = $j;
        } else {
            if ($ary[$i-1][0] eq $ary[$i][0]) {
                $ary[$i-1][2] = $ary[$i][2] = "$j=";
            } else {
                $j = $i+1;
                $ary[$i][2] = $j;
            }
        }
    }
    map { ($_->[0], $_->[2]) } @ary;
}

sub sortrankby(&;@) { ## no critic: Subroutines::ProhibitSubroutinePrototypes
    no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict

    my $cmp = shift;

    my $caller = caller();

    my @ary;
    my $i = 0;
    for (@_) { push @ary, [$_, $i++, undef] }
    @ary = sort {
        local ${"$caller\::a"} = $a->[0];
        local ${"$caller\::b"} = $b->[0];
        $cmp->();
    } @ary;
    my $j = 1;
    for ($i=0; $i<@ary; $i++) {
        if ($i == 0) {
            $ary[$i][2] = $j;
        } else {
            if (do {
                local ${"$caller\::a"} = $ary[$i-1][0];
                local ${"$caller\::b"} = $ary[$i][0];
                !$cmp->();
            }) {
                $ary[$i-1][2] = $ary[$i][2] = "$j=";
            } else {
                $j = $i+1;
                $ary[$i][2] = $j;
            }
        }
    }
    map { ($_->[0], $_->[2]) } @ary;
}

1;
# ABSTRACT: Ranking of list elements

__END__