diff options
| author | pme <hauptadler@gmail.com> | 2023-04-23 00:28:15 +0200 |
|---|---|---|
| committer | pme <hauptadler@gmail.com> | 2023-04-23 00:28:15 +0200 |
| commit | cb78931b14554c7df95b5ec55edf3d6189f5282f (patch) | |
| tree | 89623991919a07bc8249bec9a6e5e8f6f56681cd | |
| parent | d05a80fe8d4784a811418dd89c269fe25e4623f4 (diff) | |
| download | perlweeklychallenge-club-cb78931b14554c7df95b5ec55edf3d6189f5282f.tar.gz perlweeklychallenge-club-cb78931b14554c7df95b5ec55edf3d6189f5282f.tar.bz2 perlweeklychallenge-club-cb78931b14554c7df95b5ec55edf3d6189f5282f.zip | |
challenge-213
| -rwxr-xr-x | challenge-213/peter-meszaros/perl/ch-1.pl | 50 | ||||
| -rwxr-xr-x | challenge-213/peter-meszaros/perl/ch-2.pl | 132 |
2 files changed, 182 insertions, 0 deletions
diff --git a/challenge-213/peter-meszaros/perl/ch-1.pl b/challenge-213/peter-meszaros/perl/ch-1.pl new file mode 100755 index 0000000000..73ad8644c9 --- /dev/null +++ b/challenge-213/peter-meszaros/perl/ch-1.pl @@ -0,0 +1,50 @@ +#!/usr/bin/perl +# Example 1 +# +# Input: @list = (1,2,3,4,5,6) +# Output: (2,4,6,1,3,5) +# +# Example 2 +# +# Input: @list = (1,2) +# Output: (2,1) +# +# Example 3 +# +# Input: @list = (1) +# Output: (1) + +use strict; +use warnings; +use Test::More; + +my $cases = [ + [1, 2, 3, 4, 5, 6], + [1, 2], + [1], +]; + +sub odd_even_sort +{ + my $aref = shift; + + my @sorted = sort { + my $aodd = $a % 2; + my $bodd = $b % 2; + if ($aodd and !$bodd) { + return 1; + } elsif ($bodd and !$aodd) { + return -1; + } else { + return $a <=> $b; + } + } @$aref; + return \@sorted; +} + +is_deeply(odd_even_sort($cases->[0]), [2,4,6,1,3,5], '[2,4,6,1,3,5]'); +is_deeply(odd_even_sort($cases->[1]), [2,1], '[2,1]'); +is_deeply(odd_even_sort($cases->[2]), [1], '[1]'); +done_testing(); + +exit 0; diff --git a/challenge-213/peter-meszaros/perl/ch-2.pl b/challenge-213/peter-meszaros/perl/ch-2.pl new file mode 100755 index 0000000000..ccc6c3732f --- /dev/null +++ b/challenge-213/peter-meszaros/perl/ch-2.pl @@ -0,0 +1,132 @@ +#!/usr/bin/perl +# Example 1: +# +# Input: @routes = ([1,2,6], [5,6,7]) +# $source = 1 +# $destination = 7 +# +# Output: (1,2,6,7) +# +# Source (1) is part of route [1,2,6] so the journey looks like 1 -> 2 -> 6 +# then jump to route [5,6,7] and takes the route 6 -> 7. +# So the final route is (1,2,6,7) +# +# Example 2: +# +# Input: @routes = ([1,2,3], [4,5,6]) +# $source = 2 +# $destination = 5 +# +# Output: -1 +# +# Example 3: +# +# Input: @routes = ([1,2,3], [4,5,6], [3,8,9], [7,8]) +# $source = 1 +# $destination = 7 +# Output: (1,2,3,8,7) +# +# Source (1) is part of route [1,2,3] so the journey looks like 1 -> 2 -> 3 +# then jump to route [3,8,9] and takes the route 3 -> 8 +# then jump to route [7,8] and takes the route 8 -> 7 +# So the final route is (1,2,3,8,7) + +use strict; +use warnings; +use Test::More; +use Data::Dumper; + +my $cases = [ + [[1,2,6], [5,6,7]], + [[1,2,3], [4,5,6]], + [[1,2,3], [4,5,6], [3,8,9], [7,8]], +]; + +# Based on https://www.geeksforgeeks.org/find-paths-given-source-destination/ +package Graph { + use Data::Dumper; + + sub new + { + my ($class, $size) = @_; + + my $self = bless {}, $class; + + $self->{size} = $size; + $self->{vert} = {}; + + return $self; + } + + sub addEdge + { + my ($self, $u, $v) = @_; + + push $self->{vert}->{$u}->@*, $v; + } + + sub _printAllPathsUtil + { + my ($self, $u, $d, $visited, $path) = @_; + $visited->[$u] = 1; + push @$path, $u; + + if ($u == $d) { + push $self->{path}->@*, [$path->@*]; + #print Dumper($self->{path}), '[', join(', ', @$path), "]\n"; + } else { + for my $i ($self->{vert}->{$u}->@*) { + if (not defined $visited->[$i] or $visited->[$i] == 0) { + $self->_printAllPathsUtil($i, $d, $visited, $path); + } + } + } + + pop(@$path); + $visited->[$u] = 0; + } + + sub printAllPaths + { + + my ($self, $s, $d) = @_; + + my $visited = []; + my $path = []; + + $self->{path} = []; + $self->_printAllPathsUtil($s, $d, $visited, $path); + return ($self->{path}->@* == 0) ? -1 : $self->{path}; + } +}; + +sub pathstoedges +{ + my $paths = shift; + + my $edges = []; + for my $path (@$paths) { + my $p = shift @$path; + for my $v (@$path) { + push @$edges, [$p, $v], [$v, $p]; + $p = $v; + } + } + return $edges; +} + +sub testcase +{ + my ($case, $fm, $to) = @_; + my $edges = pathstoedges($case); + my $g = Graph->new(scalar @$edges); + $g->addEdge(@$_) for (@$edges); + return $g->printAllPaths($fm, $to); +} + +is_deeply(testcase($cases->[0], 1, 7), [[1,2,6,7]], '[[1,2,6], [5,6,7]]'); +is_deeply(testcase($cases->[1], 2, 5), -1, '[[1,2,3], [4,5,6]]'); +is_deeply(testcase($cases->[2], 1, 7), [[1,2,3,8,7]], '[[1,2,3], [4,5,6], [3,8,9], [7,8]]'); +done_testing(); + +exit 0; |
