1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
package MDK::Common::DataStructure;
=head1 NAME
MDK::Common::DataStructure - miscellaneous list/hash manipulation functions
=head1 SYNOPSIS
use MDK::Common::DataStructure qw(:all);
=head1 EXPORTS
=over
=item sort_numbers(LIST)
numerical sort (small numbers at beginning)
=item ikeys(HASH)
aka I<sorted integer keys>, as simple as C<sort { $a E<lt>=E<gt> $b } keys>
=item add2hash(HASH REF, HASH REF)
adds to the first hash the second hash if the key/value is not already there
=item add2hash_
adds to the first hash the second hash if the key is not already there
=item put_in_hash
adds to the first hash the second hash, crushing existing key/values
=item member(SCALAR, LIST)
is the value in the list?
=item invbool(SCALAR REF)
toggles the boolean value
=item listlength(LIST)
returns the length of the list. Useful in list (opposed to array) context:
sub f { "a", "b" }
my $l = listlength f();
whereas C<scalar f()> would return "b"
=item deref(REF)
de-reference
=item deref_array(REF)
de-reference arrays:
deref_array [ "a", "b" ] #=> ("a", "b")
deref_array "a" #=> "a"
=item is_empty_array_ref(SCALAR)
is the scalar undefined or is the array empty
=item is_empty_hash_ref(SCALAR)
is the scalar undefined or is the hash empty
=item uniq(LIST)
returns the list with no duplicates (keeping the first elements)
=item uniq_ { CODE } LIST
returns the list with no duplicates according to the scalar results of CODE on each element of LIST (keeping the first elements)
uniq_ { $_->[1] } [ 1, "fo" ], [ 2, "fob" ], [ 3, "fo" ], [ 4, "bar" ]
gives [ 1, "fo" ], [ 2, "fob" ], [ 4, "bar" ]
=item difference2(ARRAY REF, ARRAY REF)
returns the first list without the element of the second list
=item intersection(ARRAY REF, ARRAY REF, ...)
returns the elements which are in all lists
=item next_val_in_array(SCALAR, ARRAY REF)
finds the value that follow the scalar in the list (circular):
C<next_val_in_array(3, [1, 2, 3])> gives C<1>
(do not use a list with duplicates)
=item group_by2(LIST)
interprets the list as an ordered hash, returns a list of [key,value]:
C<group_by2(1 => 2, 3 => 4, 5 => 6)> gives C<[1,2], [3,4], [5,6]>
=item list2kv(LIST)
interprets the list as an ordered hash, returns the keys and the values:
C<list2kv(1 => 2, 3 => 4, 5 => 6)> gives C<[1,3,5], [2,4,6]>
=back
=head1 SEE ALSO
L<MDK::Common>
=cut
use MDK::Common::Math;
use MDK::Common::Func;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(sort_numbers ikeys add2hash add2hash_ put_in_hash member invbool listlength deref deref_array is_empty_array_ref is_empty_hash_ref uniq uniq_ difference2 intersection next_val_in_array group_by2 list2kv);
our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
sub sort_numbers { sort { $a <=> $b } @_ }
sub ikeys { my %l = @_; sort { $a <=> $b } keys %l }
sub put_in_hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} = $v } $a }
sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } $a }
sub add2hash_ { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { exists $a->{$k} or $a->{$k} = $v } $a }
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
sub invbool { my $a = shift; $$a = !$$a; $$a }
sub listlength { scalar @_ }
sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] }
sub deref { ref($_[0]) eq "ARRAY" ? @{$_[0]} : ref($_[0]) eq "HASH" ? %{$_[0]} : $_[0] }
sub deref_array { ref($_[0]) eq "ARRAY" ? @{$_[0]} : $_[0] }
sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }
sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = () } keys %l }
sub uniq_(&@) {
my $f = shift;
my %l;
$l{$f->($_)} = 1 foreach @_;
grep { delete $l{$f->($_)} } @_;
}
sub next_val_in_array {
my ($v, $l) = @_;
my %l = MDK::Common::Func::mapn(sub { @_ }, $l, [ @$l[1..$#$l], $l->[0] ]);
$l{$v};
}
sub list2kv {
my (@k, @v);
for (my $i = 0; $i < @_; $i += 2) {
push @k, $_[$i + 0];
push @v, $_[$i + 1];
}
\@k, \@v;
}
sub group_by2 {
my @l;
for (my $i = 0; $i < @_; $i += 2) {
push @l, [ $_[$i], $_[$i+1] ];
}
@l;
}
1;
|
