From 88ae6df6667f3fd82c543ab157cd02d948dd4d51 Mon Sep 17 00:00:00 2001 From: "E. Choroba" Date: Fri, 26 Jul 2019 17:15:46 +0200 Subject: Fix solutions to 018 by E. Choroba, add a blog post (part 1) - small errors in the code translated from Java - use a counter instead of a float priority --- challenge-018/e-choroba/blogs.txt | 1 + challenge-018/e-choroba/perl5/ch-1a.pl | 16 +++++---- challenge-018/e-choroba/perl5/ch-2.pl | 63 ++++++++++++++++++++++------------ 3 files changed, 51 insertions(+), 29 deletions(-) create mode 100644 challenge-018/e-choroba/blogs.txt 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'; -- cgit