File Coverage

blib/lib/NumSeq/Iter.pm

Criterion	Covered	Total	%
statement	91	100	91.0
branch	50	64	78.1
condition	23	26	88.4
subroutine	7	8	87.5
pod	2	2	100.0
total	173	200	86.5

package NumSeq::Iter;

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-11-21'; # DATE
our $DIST = 'NumSeq-Iter'; # DIST
our $VERSION = '0.008'; # VERSION

our @EXPORT_OK = qw(numseq_iter numseq_parse);

my $re_num = qr/(?:[+-]?[0-9]+(?:\.[0-9]+)?)/;

sub _numseq_parse_or_iter {
    my $which = shift;
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    my $numseq = shift;

    my @nums;
    while ($numseq =~ s/\A(\s*,\s*)?($re_num)//) {
        die "Number sequence must not start with comma" if $1 && !@nums;
        push @nums, $2;
    }
    die "Please specify one or more number in number sequence: '$numseq'" unless @nums;

    my $has_ellipsis = 0;
    if ($numseq =~ s/\A\s*,\s*\.\.\.//) {
        die "Please specify at least three number in number sequence before ellipsis" unless @nums >= 3;
        $has_ellipsis++;
    }

    my $last_num;
    if ($numseq =~ s/\A\s*,\s*($re_num|[+-]?Inf)//) {
        $last_num = $1;
    }
    die "Extraneous token in number sequence: $numseq, please only use 'a,b,c, ...' or 'a,b,c,...,z'" if length $numseq;

    my $type = '';
    my $inc;
  CHECK_SEQ_TYPE: {
        last unless $has_ellipsis;

      CHECK_ARITHMETIC: {
            my $inc0;
            for (1..$#nums) {
                if ($_ == 1) { $inc0 = $nums[1] - $nums[0] }
                elsif ($inc0 != ($nums[$_] - $nums[$_-1])) {
                    last CHECK_ARITHMETIC;
                }
            }
            $type = 'arithmetic';
            $inc = $inc0;
            last CHECK_SEQ_TYPE;
        }

      CHECK_GEOMETRIC: {
            last if $nums[0] == 0;
            my $inc0;
            for (1..$#nums) {
                if ($_ == 1) { $inc0 = $nums[1] / $nums[0] }
                else {
                    last CHECK_GEOMETRIC if $nums[$_-1] == 0;
                    if ($inc0 != ($nums[$_] / $nums[$_-1])) {
                        last CHECK_GEOMETRIC;
                    }
                }
            }
            $type = 'geometric';
            $inc = $inc0;
            last CHECK_SEQ_TYPE;
        }

      CHECK_FIBONACCI: {
            last if @nums < 3;
            last if defined $last_num; # currently not supported
            for (2..$#nums) {
                last unless $nums[$_] == $nums[$_-1]+$nums[$_-2];
            }
            $type = 'fibonacci';
            last CHECK_SEQ_TYPE;
        }

        die "Can't determine the pattern from number sequence: ".join(", ", @nums);
    }

    if ($which eq 'parse') {
        return {
            numbers => \@nums,
            has_ellipsis => $has_ellipsis,
            ($has_ellipsis ? (last_number => $last_num) : ()),
            type => $type || 'itemized',
            (defined $inc ? (inc => $inc) : ()),
        };
    }

    my $i = 0;
    my $cur;
    my $ends;
    my @buf;
    return sub {
        return undef if $ends; ## no critic: Subroutines::ProhibitExplicitReturnUndef
        return $nums[$i++] if $i <= $#nums;
        if (!$has_ellipsis) { $ends++; return undef } ## no critic: Subroutines::ProhibitExplicitReturnUndef

        $cur //= $nums[-1];
        if ($type eq 'arithmetic') {
            $cur += $inc;
            if (defined $last_num) {
                if ($inc >= 0 && $cur > $last_num || $inc < 0 && $cur < $last_num) {
                    $ends++;
                    return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
                }
            }
            return $cur;
        } elsif ($type eq 'geometric') {
            $cur *= $inc;
            if (defined $last_num) {
                if ($inc >= 1 && $cur > $last_num || $inc < 1 && $cur < $last_num) {
                    $ends++;
                    return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
                }
            }
            return $cur;
        } elsif ($type eq 'fibonacci') {
            @buf = ($nums[-1], $nums[-2]) unless @buf;
            $cur = $buf[1] + $buf[0];
            unshift @buf, $cur; pop @buf;
            return $cur;
        } else {
            die "BUG: Can't generate items for sequence of type '$type'";
        }
    };
}

sub numseq_iter {
    _numseq_parse_or_iter('iter', @_);
}

sub numseq_parse {
    my $res;
    eval {
        $res = _numseq_parse_or_iter('parse', @_);
    };
    if ($@) {
        my $errmsg = $@;
        $errmsg =~ s/(.+) at .+/$1/s; # ux: remove file+line number information from error message
        return [400, "Parse fail: $errmsg"];
    }
    [200, "OK", $res];
}

1;
# ABSTRACT: Generate a coderef iterator from a number sequence specification (e.g. '1,3,5,...,101')

__END__