view release on metacpan or  search on metacpan

t/hop.t  view on Meta::CPAN

sub check_move:
    my $i
    my ($disk, $start, $end) = @_
    if $disk < 1 || $disk > $#position:
        die "Bad disk number $disk. Should be 1..$#position.\n"
    unless $position[$disk] eq $start:
        die "Tried to move disk $disk from $start, but it is on peg $position[$disk].\n"
    for $i in 1 .. $disk-1:
        if $position[$i] eq $start:
            die "Can't move disk $disk from $start because $i is on top of it.\n"
        elsif $position[$i] eq $end:
            die "Can't move disk $disk to $end because $i is already there.\n"
    push @$computed, [$disk, $start, $end]
    $position[$disk] = $end

sub hanoi:
    my ($n, $start, $end, $extra, $move_disk) = @_
    if $n == 1:
        $move_disk->(1, $start, $end)
    else:
        hanoi($n-1, $start, $extra, $end, $move_disk)
        $move_disk->($n, $start, $end)
        hanoi($n-1, $extra, $end, $start, $move_disk)

hanoi(3, 'A', 'C', 'B', \&check_move)
is_deeply($computed, [[1, 'A', 'C'],
                      [2, 'A', 'B'],
                      [1, 'C', 'B'],
                      [3, 'A', 'C'],
                      [1, 'B', 'A'],
                      [2, 'B', 'C'],
                      [1, 'A', 'C']])


#
# ---[ Chapter 4: Iterators ]-------------------------------------------
#

# Defined on page 121
sub upto:
    my ($mx, $nx) = @_
    return sub:
        return $mx <= $nx ? $mx++ : undef

$it = upto 2, 5
my $n = 2
while defined(my $val = $it->()):
    is $val, $n++
is $n, 6

# Defined on page 122
sub NEXTVAL:
    $_[0]->()

# Defined on page 123
sub Iterator(&):
    return $_[0]

# Defined on page 160
sub imap(&$):
    my ($transform, $it) = @_
    return Iterator:
        local $_ = NEXTVAL($it)
        return unless defined $_
        return $transform->()

$it = imap:
         $_ *= 2
         $_ += 1
         $_
      upto(2, 5)

$expected = [5, 7, 9, 11]
$computed = []
while my $val = NEXTVAL($it):
    push @$computed, $val
is_deeply $expected, $computed

# Defined on page 160
sub igrep(&$):
    my ($is_interesting, $it) = @_
    return Iterator:
        local $_
        while defined($_ = NEXTVAL($it)):
            return $_ if $is_interesting->()
        return

$it = igrep:
          $_ % 2
      upto(2, 11)
$expected = [3, 5, 7, 9, 11]
$computed = []
while my $val = NEXTVAL($it):
    push @$computed, $val
is_deeply $expected, $computed


# Defined on page 136
sub make_genes:
    my $pat = shift
    my @tokens = split /[()]/, $pat
    for my $i = 1; $i < @tokens; $i += 2:
        $tokens[$i] = [0, split(//, $tokens[$i])]
    my $FINISHED = 0
    return Iterator:
        return if $FINISHED
        my $finished_incrementing = 0
        my $result = ""
        for my $token in @tokens:
            if ref $token eq "":      # plain string
                $result .= $token
            else:                     # wildcard
                my ($n, @c) = @$token
                $result .= $c[$n]
                unless $finished_incrementing:
                    if $n == $#c:
                        $token->[0] = 0
                    else:
                        $token->[0]++
                        $finished_incrementing = 1
        $FINISHED = 1 unless $finished_incrementing
        return $result

my $seq = "A(CGT)CGT"
$expected = [qw(ACCGT AGCGT ATCGT)]
$computed = []
my $gene_iter = make_genes $seq