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


line stmt bran cond sub pod time code
1             package List::Rank;
2              
3             our $DATE = '2018-01-26'; # DATE
4             our $VERSION = '0.002'; # VERSION
5              
6 1     1   51852 use strict;
  1         8  
  1         24  
7 1     1   3 use warnings;
  1         2  
  1         22  
8              
9 1     1   3 use Exporter qw(import);
  1         2  
  1         347  
10             our @EXPORT_OK = qw(rank rankstr rankby sortrank sortrankstr sortrankby);
11              
12             sub rank(@) {
13 3     3 1 919 my @ary;
14 3         4 my $i = 0;
15 3         6 for (@_) { push @ary, [$_, $i++, undef] }
  5         8  
16 3         7 @ary = sort { $a->[0] <=> $b->[0] } @ary;
  5         7  
17 3         4 my $j = 1;
18 3         8 for ($i=0; $i<@ary; $i++) {
19 5 100       7 if ($i == 0) {
20 2         6 $ary[$i][2] = $j;
21             } else {
22 3 100       8 if ($ary[$i-1][0] == $ary[$i][0]) {
23 1         3 $ary[$i-1][2] = $ary[$i][2] = "$j=";
24             } else {
25 2         3 $j = $i+1;
26 2         4 $ary[$i][2] = $j;
27             }
28             }
29             }
30 3         9 map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
  5         15  
  5         17  
31             }
32              
33             sub rankstr(@) {
34 3     3 1 2077 my @ary;
35 3         4 my $i = 0;
36 3         7 for (@_) { push @ary, [$_, $i++, undef] }
  5         9  
37 3         6 @ary = sort { $a->[0] cmp $b->[0] } @ary;
  5         8  
38 3         5 my $j = 1;
39 3         7 for ($i=0; $i<@ary; $i++) {
40 5 100       7 if ($i == 0) {
41 2         6 $ary[$i][2] = $j;
42             } else {
43 3 100       8 if ($ary[$i-1][0] eq $ary[$i][0]) {
44 1         3 $ary[$i-1][2] = $ary[$i][2] = "$j=";
45             } else {
46 2         3 $j = $i+1;
47 2         3 $ary[$i][2] = $j;
48             }
49             }
50             }
51 3         8 map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
  5         14  
  5         6  
52             }
53              
54             sub rankby(&;@) {
55 1     1   6 no strict 'refs';
  1         1  
  1         502  
56              
57 3     3 1 1882 my $cmp = shift;
58              
59 3         6 my $caller = caller();
60              
61 3         3 my @ary;
62 3         4 my $i = 0;
63 3         6 for (@_) { push @ary, [$_, $i++, undef] }
  5         9  
64             @ary = sort {
65 3         5 local ${"$caller\::a"} = $a->[0];
  4         9  
  4         6  
66 4         5 local ${"$caller\::b"} = $b->[0];
  4         7  
67 4         5 $cmp->();
68             } @ary;
69 3         5 my $j = 1;
70 3         9 for ($i=0; $i<@ary; $i++) {
71 5 100       7 if ($i == 0) {
72 2         5 $ary[$i][2] = $j;
73             } else {
74 3 100       3 if (do {
75 3         4 local ${"$caller\::a"} = $ary[$i-1][0];
  3         4  
76 3         4 local ${"$caller\::b"} = $ary[$i][0];
  3         6  
77 3         5 !$cmp->();
78             }) {
79 1         7 $ary[$i-1][2] = $ary[$i][2] = "$j=";
80             } else {
81 2         6 $j = $i+1;
82 2         4 $ary[$i][2] = $j;
83             }
84             }
85             }
86 3         9 map { $_->[2] } sort { $a->[1] <=> $b->[1] } @ary;
  5         13  
  4         6  
87             }
88              
89             sub sortrank(@) {
90 3     3 1 1840 my @ary;
91 3         5 my $i = 0;
92 3         6 for (@_) { push @ary, [$_, $i++, undef] }
  5         8  
93 3         6 @ary = sort { $a->[0] <=> $b->[0] } @ary;
  5         7  
94 3         4 my $j = 1;
95 3         9 for ($i=0; $i<@ary; $i++) {
96 5 100       16 if ($i == 0) {
97 2         4 $ary[$i][2] = $j;
98             } else {
99 3 100       7 if ($ary[$i-1][0] == $ary[$i][0]) {
100 1         4 $ary[$i-1][2] = $ary[$i][2] = "$j=";
101             } else {
102 2         3 $j = $i+1;
103 2         5 $ary[$i][2] = $j;
104             }
105             }
106             }
107 3         6 map { ($_->[0], $_->[2]) } @ary;
  5         15  
108             }
109              
110             sub sortrankstr(@) {
111 3     3 1 1962 my @ary;
112 3         5 my $i = 0;
113 3         6 for (@_) { push @ary, [$_, $i++, undef] }
  5         10  
114 3         8 @ary = sort { $a->[0] cmp $b->[0] } @ary;
  5         7  
115 3         4 my $j = 1;
116 3         8 for ($i=0; $i<@ary; $i++) {
117 5 100       8 if ($i == 0) {
118 2         6 $ary[$i][2] = $j;
119             } else {
120 3 100       8 if ($ary[$i-1][0] eq $ary[$i][0]) {
121 1         4 $ary[$i-1][2] = $ary[$i][2] = "$j=";
122             } else {
123 2         3 $j = $i+1;
124 2         3 $ary[$i][2] = $j;
125             }
126             }
127             }
128 3         8 map { ($_->[0], $_->[2]) } @ary;
  5         18  
129             }
130              
131             sub sortrankby(&;@) {
132 1     1   6 no strict 'refs';
  1         1  
  1         221  
133              
134 3     3 1 1984 my $cmp = shift;
135              
136 3         5 my $caller = caller();
137              
138 3         5 my @ary;
139 3         3 my $i = 0;
140 3         6 for (@_) { push @ary, [$_, $i++, undef] }
  5         9  
141             @ary = sort {
142 3         8 local ${"$caller\::a"} = $a->[0];
  4         9  
  4         7  
143 4         6 local ${"$caller\::b"} = $b->[0];
  4         6  
144 4         5 $cmp->();
145             } @ary;
146 3         6 my $j = 1;
147 3         8 for ($i=0; $i<@ary; $i++) {
148 5 100       10 if ($i == 0) {
149 2         5 $ary[$i][2] = $j;
150             } else {
151 3 100       4 if (do {
152 3         5 local ${"$caller\::a"} = $ary[$i-1][0];
  3         6  
153 3         3 local ${"$caller\::b"} = $ary[$i][0];
  3         5  
154 3         5 !$cmp->();
155             }) {
156 1         8 $ary[$i-1][2] = $ary[$i][2] = "$j=";
157             } else {
158 2         7 $j = $i+1;
159 2         4 $ary[$i][2] = $j;
160             }
161             }
162             }
163 3         10 map { ($_->[0], $_->[2]) } @ary;
  5         37  
164             }
165              
166             1;
167             # ABSTRACT: Ranking of list elements
168              
169             __END__