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) = @_;