1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
#!/usr/bin/perl -s
use v5.24;
use Test2::V0;
use experimental qw(signatures);
our ($tests, $examples);
run_tests() if $tests || $examples; # does not return
die <<EOS unless @ARGV;
usage: $0 [-examples] [-tests] [N]
-examples
run the examples from the challenge
-tests
run some tests
N
print vowel strings of length N
EOS
### Input and Output
# Create N counters, chain them, initialize the first counter with all
# vowels and step the last counter while there are values.
main: {
my @val;
my @counter;
my $n = shift;
for (1 .. $n) {
push @val, undef;
push @counter, Counter->new(\$val[-1]);
if (@counter > 1) {
$counter[-1]->parent($counter[-2]);
$counter[-2]->child($counter[-1]);
}
}
$counter[0]->set([qw(a e i o u)]);
while ($counter[0]) {
say @val;
$counter[-1]->next;
}
}
### Implementation
# Using "Counter" objects to solve this task.
#
# A counter has:
# - a reference to an (external) scalar that is updated on every state
# change.
# - an array of possible values
# - a "next" method that steps to the next value
# - a "set" method that initializes the array of possible values.
# Counters are chained as parent / child. On every state change, a
# child counter is initialized with the new possible values. If the
# values are exhausted, the parent's "next" method is called.
package Counter;
our %successors;
BEGIN {
%successors = (
a => [qw(e i)],
e => ['i'],
i => [qw(a e o u)],
o => [qw(a u)],
u => [qw(o e)]
);
}
use overload
bool => sub ($self, @) {!!$self->{vals}->@*};
sub new ($class, $ref) {
bless {ref => $ref}, $class;
}
sub parent ($self, $parent) {
$self->{parent} = $parent;
}
sub child ($self, $child) {
$self->{child} = $child;
}
sub set ($self, $vals) {
$self->{vals} = $vals;
$self->{cur} = 0;
_upd($self);
}
sub _upd ($self) {
my $val = $self->{vals}[$self->{cur}];
$self->{ref}->$* = defined $val ? $val : '';
$self->{child}->set($successors{$val})
if defined $val && defined $self->{child};
}
sub next ($self) {
if ($self->{cur}++ < $self->{vals}->$#*) {
_upd($self);
} else {
$self->{vals} = [];
$self->{cur} = -1;
_upd($self);
$self->{parent}->next if defined $self->{parent};
}
}
### Examples and tests
package main;
sub run_tests {
SKIP: {
skip "examples" unless $examples;
my @vstrings;
my @tmp;
my $counter0 = Counter->new(\$tmp[0]);
my $counter1 = Counter->new(\$tmp[1]);
$counter0->child($counter1);
$counter1->parent($counter0);
$counter0->set([qw(a e i o u)]);
while ($counter0) {
push @vstrings, join '', @tmp;
$counter1->next;
}
is [@vstrings], bag {item 'ae'; item 'ai'; item 'ei';
item 'ia'; item 'io'; item 'iu'; item 'ie'; item 'oa';
item 'ou'; item 'uo'; item 'ue'; end;},
'example';
}
SKIP: {
skip "tests" unless $tests;
}
done_testing;
exit;
}
|
