|
|
|
|
@ -72,30 +72,29 @@ sub itemcount {
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub grouparray {
|
|
|
|
|
my ($array_ptr, $case_insensitive) = @_;
|
|
|
|
|
|
|
|
|
|
my ($array_ptr,$case_insensitive) = @_;
|
|
|
|
|
my $result = NGCP::BulkProcessor::Table->new();
|
|
|
|
|
my $reducedarray = removeduplicates($array_ptr,$case_insensitive);
|
|
|
|
|
my $sort_occurencecount_desc;
|
|
|
|
|
if ($case_insensitive) {
|
|
|
|
|
$sort_occurencecount_desc = sub {
|
|
|
|
|
|
|
|
|
|
return ((lc($NGCP::BulkProcessor::Table::b->[1]) <=> lc($NGCP::BulkProcessor::Table::a->[1])) or (lc($NGCP::BulkProcessor::Table::a->[0]) cmp lc($NGCP::BulkProcessor::Table::b->[0])));
|
|
|
|
|
|
|
|
|
|
};
|
|
|
|
|
} else {
|
|
|
|
|
$sort_occurencecount_desc = sub {
|
|
|
|
|
|
|
|
|
|
return (($NGCP::BulkProcessor::Table::b->[1] <=> $NGCP::BulkProcessor::Table::a->[1]) or ($NGCP::BulkProcessor::Table::a->[0] cmp $NGCP::BulkProcessor::Table::b->[0]));
|
|
|
|
|
my $result = NGCP::BulkProcessor::Table->new();
|
|
|
|
|
my $reducedarray = removeduplicates($array_ptr, $case_insensitive);
|
|
|
|
|
my $sort_occurencecount_desc;
|
|
|
|
|
|
|
|
|
|
};
|
|
|
|
|
}
|
|
|
|
|
foreach my $element (@$reducedarray) {
|
|
|
|
|
$result->addrow_ref([$element,itemcount($element,$array_ptr,$case_insensitive)]);
|
|
|
|
|
}
|
|
|
|
|
$result->sortrows($sort_occurencecount_desc);
|
|
|
|
|
return $result;
|
|
|
|
|
if ($case_insensitive) {
|
|
|
|
|
$sort_occurencecount_desc = sub {
|
|
|
|
|
return ((lc($NGCP::BulkProcessor::Table::b->[1]) <=> lc($NGCP::BulkProcessor::Table::a->[1])) or
|
|
|
|
|
(lc($NGCP::BulkProcessor::Table::a->[0]) cmp lc($NGCP::BulkProcessor::Table::b->[0])));
|
|
|
|
|
};
|
|
|
|
|
} else {
|
|
|
|
|
$sort_occurencecount_desc = sub {
|
|
|
|
|
return (($NGCP::BulkProcessor::Table::b->[1] <=> $NGCP::BulkProcessor::Table::a->[1]) or
|
|
|
|
|
($NGCP::BulkProcessor::Table::a->[0] cmp $NGCP::BulkProcessor::Table::b->[0]));
|
|
|
|
|
};
|
|
|
|
|
}
|
|
|
|
|
foreach my $element (@{$reducedarray}) {
|
|
|
|
|
$result->addrow_ref([ $element, itemcount($element, $array_ptr, $case_insensitive) ]);
|
|
|
|
|
}
|
|
|
|
|
$result->sortrows($sort_occurencecount_desc);
|
|
|
|
|
|
|
|
|
|
return $result;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub reversearray {
|
|
|
|
|
@ -136,7 +135,7 @@ sub _array_last {
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub arrayeq {
|
|
|
|
|
my ($array_ptr1,$array_ptr2,$case_insensitive) = @_;
|
|
|
|
|
my ($array_ptr1, $array_ptr2, $case_insensitive) = @_;
|
|
|
|
|
|
|
|
|
|
my $ubound1 = _array_last($array_ptr1) // -1;
|
|
|
|
|
my $ubound2 = _array_last($array_ptr2) // -1;
|
|
|
|
|
@ -144,162 +143,148 @@ sub arrayeq {
|
|
|
|
|
return 0 if $ubound1 != $ubound2;
|
|
|
|
|
|
|
|
|
|
if ($case_insensitive) {
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
if (lc($array_ptr1->[$i]) ne lc($array_ptr2->[$i])) {
|
|
|
|
|
return 0;
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
return 0 if lc $array_ptr1->[$i] ne lc $array_ptr2->[$i];
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
if ($array_ptr1->[$i] ne $array_ptr2->[$i]) {
|
|
|
|
|
return 0;
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
return 0 if $array_ptr1->[$i] ne $array_ptr2->[$i];
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub seteq {
|
|
|
|
|
|
|
|
|
|
my ($array_ptr1,$array_ptr2,$case_insensitive) = @_;
|
|
|
|
|
my ($array_ptr1, $array_ptr2, $case_insensitive) = @_;
|
|
|
|
|
|
|
|
|
|
my $ubound1 = _array_last($array_ptr1) // -1;
|
|
|
|
|
my $ubound2 = _array_last($array_ptr2) // -1;
|
|
|
|
|
|
|
|
|
|
# every element of array1 must be existent in array2 ...
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
if (not contains($array_ptr1->[$i],$array_ptr2,$case_insensitive)) {
|
|
|
|
|
return 0;
|
|
|
|
|
# every element of array1 must be existent in array2 ...
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
return 0 if not contains($array_ptr1->[$i], $array_ptr2, $case_insensitive);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
# ... and every element of array2 must be existent in array1
|
|
|
|
|
foreach my $i (0 .. $ubound2) {
|
|
|
|
|
if (not contains($array_ptr2->[$i],$array_ptr1,$case_insensitive)) {
|
|
|
|
|
return 0;
|
|
|
|
|
# ... and every element of array2 must be existent in array1
|
|
|
|
|
foreach my $i (0 .. $ubound2) {
|
|
|
|
|
return 0 if not contains($array_ptr2->[$i], $array_ptr1, $case_insensitive);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub setcontains {
|
|
|
|
|
|
|
|
|
|
my ($array_ptr1,$array_ptr2,$case_insensitive) = @_;
|
|
|
|
|
my ($array_ptr1, $array_ptr2, $case_insensitive) = @_;
|
|
|
|
|
|
|
|
|
|
my $ubound1 = _array_last($array_ptr1) // -1;
|
|
|
|
|
|
|
|
|
|
# every element of array1 must be existent in array2:
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
if (not contains($array_ptr1->[$i],$array_ptr2,$case_insensitive)) {
|
|
|
|
|
return 0;
|
|
|
|
|
# every element of array1 must be existent in array2:
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
return 0 if not contains($array_ptr1->[$i], $array_ptr2, $case_insensitive);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
|
|
|
|
|
return 1;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub filter {
|
|
|
|
|
my ($array_ptr1, $array_ptr2, $case_insensitive) = @_;
|
|
|
|
|
|
|
|
|
|
my ($array_ptr1,$array_ptr2,$case_insensitive) = @_;
|
|
|
|
|
my $ubound1 = _array_last($array_ptr1);
|
|
|
|
|
my $ubound2 = _array_last($array_ptr2);
|
|
|
|
|
|
|
|
|
|
return [] if not defined $ubound1;
|
|
|
|
|
return $array_ptr1 if not defined $ubound2;
|
|
|
|
|
|
|
|
|
|
my @result = ();
|
|
|
|
|
# every element of array1 must be existent in array2 ...
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
if (contains($array_ptr1->[$i],$array_ptr2,$case_insensitive)) {
|
|
|
|
|
push @result,$array_ptr1->[$i];
|
|
|
|
|
my @result = ();
|
|
|
|
|
# every element of array1 must be existent in array2 ...
|
|
|
|
|
foreach my $i (0 .. $ubound1) {
|
|
|
|
|
if (contains($array_ptr1->[$i], $array_ptr2, $case_insensitive)) {
|
|
|
|
|
push @result, $array_ptr1->[$i];
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return \@result;
|
|
|
|
|
|
|
|
|
|
return \@result;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub getroundrobinitem {
|
|
|
|
|
my ($array_ptr, $recentindex) = @_;
|
|
|
|
|
|
|
|
|
|
my ($array_ptr,$recentindex) = @_;
|
|
|
|
|
if (defined $array_ptr and ref $array_ptr eq 'ARRAY') {
|
|
|
|
|
my $size = (scalar @$array_ptr);
|
|
|
|
|
if ($size == 1) {
|
|
|
|
|
return (@{$array_ptr}[0],0);
|
|
|
|
|
} elsif ($size > 1) {
|
|
|
|
|
if (!defined $recentindex or $recentindex < 0) {
|
|
|
|
|
$recentindex = -1;
|
|
|
|
|
}
|
|
|
|
|
my $newindex = ($recentindex + 1) % $size;
|
|
|
|
|
return (@{$array_ptr}[$newindex],$newindex);
|
|
|
|
|
if (defined $array_ptr and ref $array_ptr eq 'ARRAY') {
|
|
|
|
|
my $size = scalar @{$array_ptr};
|
|
|
|
|
|
|
|
|
|
if ($size == 1) {
|
|
|
|
|
return (@{$array_ptr}[0], 0);
|
|
|
|
|
} elsif ($size > 1) {
|
|
|
|
|
if (not defined $recentindex or $recentindex < 0) {
|
|
|
|
|
$recentindex = -1;
|
|
|
|
|
}
|
|
|
|
|
my $newindex = ($recentindex + 1) % $size;
|
|
|
|
|
return (@{$array_ptr}[$newindex], $newindex);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return (undef,undef);
|
|
|
|
|
|
|
|
|
|
return (undef, undef);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub getrandomitem {
|
|
|
|
|
my ($array_ptr) = @_;
|
|
|
|
|
|
|
|
|
|
my ($array_ptr) = @_;
|
|
|
|
|
if (defined $array_ptr and ref $array_ptr eq 'ARRAY') {
|
|
|
|
|
my $size = (scalar @$array_ptr);
|
|
|
|
|
if ($size == 1) {
|
|
|
|
|
return (@{$array_ptr}[0],0);
|
|
|
|
|
} elsif ($size > 1) {
|
|
|
|
|
my $newindex = int(rand($size));
|
|
|
|
|
return (@{$array_ptr}[$newindex],$newindex);
|
|
|
|
|
if (defined $array_ptr and ref $array_ptr eq 'ARRAY') {
|
|
|
|
|
my $size = (scalar @{$array_ptr});
|
|
|
|
|
|
|
|
|
|
if ($size == 1) {
|
|
|
|
|
return (@{$array_ptr}[0], 0);
|
|
|
|
|
} elsif ($size > 1) {
|
|
|
|
|
my $newindex = int rand $size;
|
|
|
|
|
return (@{$array_ptr}[$newindex], $newindex);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return (undef,undef);
|
|
|
|
|
|
|
|
|
|
return (undef, undef);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub array_to_map {
|
|
|
|
|
my ($array_ptr, $get_key_code, $get_value_code, $mode) = @_;
|
|
|
|
|
|
|
|
|
|
my ($array_ptr,$get_key_code,$get_value_code,$mode) = @_;
|
|
|
|
|
my $map = {};
|
|
|
|
|
my @keys = ();
|
|
|
|
|
my @values = ();
|
|
|
|
|
|
|
|
|
|
if (defined $array_ptr and ref $array_ptr eq 'ARRAY' and
|
|
|
|
|
defined $get_key_code and ref $get_key_code eq 'CODE') {
|
|
|
|
|
if (not (defined $get_value_code and ref $get_value_code eq 'CODE')) {
|
|
|
|
|
$get_value_code = sub { return shift; };
|
|
|
|
|
$get_value_code = sub { return shift; };
|
|
|
|
|
}
|
|
|
|
|
$mode = lc($mode);
|
|
|
|
|
$mode = lc $mode;
|
|
|
|
|
if (not ($mode eq 'group' or $mode eq 'first' or $mode eq 'last')) {
|
|
|
|
|
$mode = 'group';
|
|
|
|
|
$mode = 'group';
|
|
|
|
|
}
|
|
|
|
|
foreach my $item (@$array_ptr) {
|
|
|
|
|
my $key = &$get_key_code($item);
|
|
|
|
|
|
|
|
|
|
next unless defined $key;
|
|
|
|
|
foreach my $item (@{$array_ptr}) {
|
|
|
|
|
my $key = &$get_key_code($item);
|
|
|
|
|
next unless defined $key;
|
|
|
|
|
|
|
|
|
|
my $value = &$get_value_code($item);
|
|
|
|
|
next unless defined $value;
|
|
|
|
|
|
|
|
|
|
if (not exists $map->{$key}) {
|
|
|
|
|
if ($mode eq 'group') {
|
|
|
|
|
$map->{$key} = [ $value ];
|
|
|
|
|
} else {
|
|
|
|
|
$map->{$key} = $value;
|
|
|
|
|
}
|
|
|
|
|
push(@keys,$key);
|
|
|
|
|
} else {
|
|
|
|
|
if ($mode eq 'group') {
|
|
|
|
|
push(@{$map->{$key}}, $value);
|
|
|
|
|
} elsif ($mode eq 'last') {
|
|
|
|
|
$map->{$key} = $value;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
push(@values,$value);
|
|
|
|
|
if (not exists $map->{$key}) {
|
|
|
|
|
if ($mode eq 'group') {
|
|
|
|
|
$map->{$key} = [ $value ];
|
|
|
|
|
} else {
|
|
|
|
|
$map->{$key} = $value;
|
|
|
|
|
}
|
|
|
|
|
push @keys, $key;
|
|
|
|
|
} else {
|
|
|
|
|
if ($mode eq 'group') {
|
|
|
|
|
push @{$map->{$key}}, $value;
|
|
|
|
|
} elsif ($mode eq 'last') {
|
|
|
|
|
$map->{$key} = $value;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
push @values, $value;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return ($map,\@keys,\@values);
|
|
|
|
|
|
|
|
|
|
return ($map, \@keys, \@values);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
sub _hash_size {
|
|
|
|
|
@ -318,9 +303,7 @@ sub mapeq {
|
|
|
|
|
my $key_count1 = _hash_size($map_ref1);
|
|
|
|
|
my $key_count2 = _hash_size($map_ref2);
|
|
|
|
|
|
|
|
|
|
if ($key_count1 != $key_count2) {
|
|
|
|
|
return 0;
|
|
|
|
|
}
|
|
|
|
|
return 0 if $key_count1 != $key_count2;
|
|
|
|
|
|
|
|
|
|
if ($case_insensitive) {
|
|
|
|
|
for my $key (keys %{$map_ref2}) {
|
|
|
|
|
|
Guillem Jover
6 years ago