view release on metacpan or  search on metacpan

lib/Sidef/Types/Array/Array.pm  view on Meta::CPAN

        }

        bless [grep { defined } @unique], ref($self);
    }

    *last_unique_by = \&last_uniq_by;

    sub abbrev {
        my ($self, $pattern) = @_;

        if (defined($pattern)) {
            if (ref($pattern) eq 'Sidef::Types::Regex::Regex') {
                $pattern = $pattern->get_value;
            }
            else {
                $pattern = qr/\Q$pattern\E/;
            }
        }

        my (%seen, %table);
        foreach my $item (@$self) {
            my $word   = "$item";
            my $length = CORE::length($word) || next;

            for (my $len = $length ; $len >= 1 ; --$len) {
                my $abbrev = substr($word, 0, $len);

                if (defined($pattern)) {
                    ($abbrev =~ $pattern) || next;
                }

                my $count = ++$seen{$abbrev};

                if ($count == 1) {
                    $table{$abbrev} = $item;
                }
                elsif ($count == 2) {
                    CORE::delete($table{$abbrev});
                }
                else {
                    last;
                }
            }
        }

        foreach my $item (@$self) {
            my $word = "$item";

            if (defined($pattern)) {
                ($word =~ $pattern) || next;
            }

            $table{$word} = $item;
        }

        Sidef::Types::Hash::Hash->new(\%table);
    }

    *abbreviations = \&abbrev;

    sub uniq_prefs {
        my ($self, $block) = @_;

        my $tail     = {};                # some unique value
        my $callback = defined($block);

        my %table;
        foreach my $sub_array (@$self) {
            my $ref = \%table;
            foreach my $item (@$sub_array) {
                $ref = $ref->{$item} //= {};
            }
            $ref->{$tail} = $sub_array;
        }

        my @abbrev;
        sub {
            my ($hash) = @_;

            foreach my $key (my @keys = CORE::sort(keys(%{$hash}))) {
                next if $key eq $tail;
                __SUB__->($hash->{$key});

                if ($#keys > 0) {
                    my $count = 0;
                    my $ref   = delete $hash->{$key};
                    while (my ($key) = CORE::each %{$ref}) {
                        if ($key eq $tail) {

                            if ($callback) {
                                $block->run(@{$ref->{$key}}[0 .. $#{$ref->{$key}} - $count]);
                            }
                            else {
                                CORE::push(@abbrev, bless([@{$ref->{$key}}[0 .. $#{$ref->{$key}} - $count]]));
                            }

                            last;
                        }
                        $ref = $ref->{$key};
                        $count++;
                    }
                }
            }
          }
          ->(\%table);

        bless \@abbrev;
    }

    *unique_prefixes = \&uniq_prefs;

    sub contains {
        my ($self, $obj, @extra) = @_;

        if (ref($obj) eq 'Sidef::Types::Block::Block') {
            foreach my $item (@$self) {
                if ($obj->run($item)) {
                    return (Sidef::Types::Bool::Bool::TRUE);
                }
            }

            return (Sidef::Types::Bool::Bool::FALSE);
        }

        my $end = $#$self;

        foreach my $i (0 .. $end) {
            if ($self->[$i] eq $obj) {

                my $ok = 1;
                my $j  = $i;

                foreach my $obj (@extra) {
                    if (++$j <= $end and $self->[$j] eq $obj) {
                        ## ok
                    }
                    else {
                        $ok = 0;
                        last;
                    }
                }

                $ok && return (Sidef::Types::Bool::Bool::TRUE);
            }
        }

        (Sidef::Types::Bool::Bool::FALSE);
    }

    *has      = \&contains;
    *contain  = \&contains;
    *include  = \&contains;
    *includes = \&contains;

    sub contains_type {
        my ($self, $obj) = @_;

        my $ref = ref($obj);

        foreach my $item (@$self) {
            if (ref($item) eq $ref || UNIVERSAL::isa($item, $ref)) {
                return (Sidef::Types::Bool::Bool::TRUE);
            }
        }

        return (Sidef::Types::Bool::Bool::FALSE);
    }

    sub contains_any {
        my ($self, $array) = @_;