aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--challenge-018/e-choroba/blogs.txt1
-rwxr-xr-xchallenge-018/e-choroba/perl5/ch-1a.pl16
-rwxr-xr-xchallenge-018/e-choroba/perl5/ch-2.pl63
3 files changed, 51 insertions, 29 deletions
diff --git a/challenge-018/e-choroba/blogs.txt b/challenge-018/e-choroba/blogs.txt
new file mode 100644
index 0000000000..b5581348b2
--- /dev/null
+++ b/challenge-018/e-choroba/blogs.txt
@@ -0,0 +1 @@
+http://blogs.perl.org/users/e_choroba/2019/07/perl-weekly-challenge-0181-longest-common-substring.html
diff --git a/challenge-018/e-choroba/perl5/ch-1a.pl b/challenge-018/e-choroba/perl5/ch-1a.pl
index fcbdfc0972..d4fe7bba84 100755
--- a/challenge-018/e-choroba/perl5/ch-1a.pl
+++ b/challenge-018/e-choroba/perl5/ch-1a.pl
@@ -18,11 +18,11 @@ use feature qw{ say };
sub new {
my ($class) = @_;
- bless my $self = {position => -1,
- text => "",
- active_edge => 0,
+ bless my $self = {position => -1,
+ text => "",
+ active_edge => 0,
active_length => 0,
- current_node => -1,
+ current_node => -1,
}, $class;
$self->{root} = $self->new_node(-1, -1);
$self->{active_node} = $self->{root};
@@ -104,7 +104,8 @@ use feature qw{ say };
$self->{active_edge} = $self->{position}
unless $self->{active_length};
if (! exists
- $self->{nodes}[ $self->{active_node} ]{next}{ $self->active_edge }
+ $self->{nodes}[ $self->{active_node} ]
+ {next}{ $self->active_edge }
) {
$self->{nodes}[ $self->{active_node} ]
{next}{ $self->active_edge }
@@ -115,12 +116,13 @@ use feature qw{ say };
{next}{ $self->active_edge };
next if $self->walk_down($next); # Observation 2.
- # Observation 2.
+ # Observation 1.
if ($char eq substr $self->{text},
$self->{nodes}[$next]{start} + $self->{active_length}, 1
) {
++$self->{active_length};
- $self->_add_suffix_link($self->{active_node}); # Observation 3.
+ # Observation 3.
+ $self->_add_suffix_link($self->{active_node});
last
}
my $split = $self->new_node($self->{nodes}[$next]{start},
diff --git a/challenge-018/e-choroba/perl5/ch-2.pl b/challenge-018/e-choroba/perl5/ch-2.pl
index 79c11f00a0..dfa59b0bd6 100755
--- a/challenge-018/e-choroba/perl5/ch-2.pl
+++ b/challenge-018/e-choroba/perl5/ch-2.pl
@@ -1,6 +1,7 @@
#!/usr/bin/perl
use warnings;
use strict;
+use feature qw{ say };
{ package My::Queue::Priority::Array;
@@ -21,18 +22,23 @@ use strict;
}
{ package My::Queue::Priority::Heap;
- use enum qw( ELEMENT PRIORITY );
+ use enum qw( ELEMENT PRIORITY COUNTER );
sub new { bless [], shift }
sub is_empty { ! @{ $_[0] } }
+ my $i = 1;
sub insert_with_priority {
- my ($self, $element, $priority) = @_;
- push @$self, [$element, $priority];
+ my ($self, $element, $priority, $counter) = @_;
+ push @$self, [$element, $priority, ($counter // ++$i)];
my $i = $#$self;
my $p = int(($i - 1) / 2);
- while ($p >= 0 && $self->[$p][PRIORITY] < $self->[$i][PRIORITY]) {
+ while ($p >= 0
+ && ($self->[$p][PRIORITY] < $self->[$i][PRIORITY]
+ || ($self->[$p][PRIORITY] == $self->[$i][PRIORITY]
+ && $self->[$p][COUNTER] > $self->[$i][COUNTER]))
+ ) {
@$self[$i, $p] = @$self[$p, $i];
$i = $p;
$p = int(($i - 1) / 2);
@@ -43,13 +49,13 @@ use strict;
my ($self) = @_;
my $element = shift(@$self)->[ELEMENT];
my $new = ref($self)->new;
- $new->insert_with_priority(@$_) for reverse @$self;
+ $new->insert_with_priority(@$_) for @$self;
$_[0] = $new;
return $element
}
}
-use Test::More tests => 2 * 14;
+use Test::More tests => 2 + 2 * 14;
for my $class (qw(My::Queue::Priority::Array My::Queue::Priority::Heap)) {
my $q = $class->new();
@@ -59,33 +65,46 @@ for my $class (qw(My::Queue::Priority::Array My::Queue::Priority::Heap)) {
for [a => 10], [b => 4], [c => 2], [d=>8], [e => 4], [f => 3];
ok ! $q->is_empty;
- is $q->pull_highest_priority_element, 'a';
+ is $q->pull_highest_priority_element, 'a', $class.$#$q;
ok ! $q->is_empty;
- is $q->pull_highest_priority_element, 'd';
+ is $q->pull_highest_priority_element, 'd', $class.$#$q;
ok ! $q->is_empty;
- is $q->pull_highest_priority_element, 'b';
+ is $q->pull_highest_priority_element, 'b', $class.$#$q;
ok ! $q->is_empty;
- is $q->pull_highest_priority_element, 'e';
+ is $q->pull_highest_priority_element, 'e', $class.$#$q;
ok ! $q->is_empty;
- is $q->pull_highest_priority_element, 'f';
+ is $q->pull_highest_priority_element, 'f', $class.$#$q;
ok ! $q->is_empty;
- is $q->pull_highest_priority_element, 'c';
+ is $q->pull_highest_priority_element, 'c', $class.$#$q;
ok $q->is_empty;
}
use Benchmark qw{ cmpthese };
-cmpthese(-3, {
+use constant SIZE => 500;
+my @data = map [('a' .. 'z')[rand 26], int rand 100], 1 .. SIZE;
+
+my (@heap, @array);
+my %dispatch = (
+ array => sub {
+ @array = ();
+ my $q = My::Queue::Priority::Array->new;
+ $q->insert_with_priority(@$_)
+ for @data;
+ push @array, $q->pull_highest_priority_element for 1 .. SIZE;
+ },
heap => sub {
+ @heap = ();
my $q = My::Queue::Priority::Heap->new;
$q->insert_with_priority(@$_)
- for [a => 10], [b => 4], [c => 2], [d=>8], [e => 4], [f => 3];
- $q->pull_highest_priority_element for 1 .. 6;
+ for @data;
+
+ push @heap, $q->pull_highest_priority_element for 1 .. SIZE;
},
- array => sub {
- my $q = My::Queue::Priority::Array->new;
- $q->insert_with_priority(@$_)
- for [a => 10], [b => 4], [c => 2], [d=>8], [e => 4], [f => 3];
- $q->pull_highest_priority_element for 1 .. 6;
- }
+);
+cmpthese(-3, \%dispatch);
+
+my @sorted = map $_->[0], sort { $b->[1] <=> $a->[1] } @data;
+$_->() for values %dispatch;
-});
+is_deeply \@heap, \@array, 'same head - array';
+is_deeply \@sorted, \@array, 'same sorted - array';