diff options
| -rw-r--r-- | challenge-203/kjetillll/perl/ch-1.pl | 46 | ||||
| -rw-r--r-- | challenge-203/kjetillll/perl/ch-2.pl | 62 |
2 files changed, 108 insertions, 0 deletions
diff --git a/challenge-203/kjetillll/perl/ch-1.pl b/challenge-203/kjetillll/perl/ch-1.pl new file mode 100644 index 0000000000..354a6666c0 --- /dev/null +++ b/challenge-203/kjetillll/perl/ch-1.pl @@ -0,0 +1,46 @@ +#!/usr/bin/perl +use strict; use warnings; #yes mom + +=pod + +Run with arguments to use those as the input list or +run without to run the included tests with this output: + +ok input: 1 2 3 6 expected: 1 got: 1 +ok input: 1 1 1 3 5 expected: 4 got: 4 +ok input: 3 3 6 4 5 expected: 0 got: 0 +ok input: 1 2 3 4 5 6 7 8 9 10 expected: 11 got: 11 + +For large input lists, use Algorithm::Combinatorics::combinations() +instead of sub comb. It's faster, otherwise they are compatible. +Install this with `sudo apt install libalgorithm-combinatorics-perl` +or `cpanm Algorithm::Combinatorics` or manually. + +=cut + +if( @ARGV ){ printf "Special quadruplets: %d\n", count_special_quad(@ARGV) } +else { run_tests() } +exit; + +sub comb { my($l,$k,$s)=(@_,0); $k ? map {my $i=$_; map[$$l[$i],@$_], comb($l,$k-1,$i+1) } $s..@$l-$k : [] } +sub is_special_quad { my( $a, $b, $c, $d ) = @_; $a + $b + $c == $d } +sub count_special_quad { 0 + grep is_special_quad(@$_), comb([ @_ ], 4) } + +sub run_tests { + for my $test ( + [1,2,3,6 => 1], + [1,1,1,3,5 => 4], + [3,3,6,4,5 => 0], + [1..10 => 11], + ){ + my $exp = pop @$test; + my @input = @$test; + my $got = count_special_quad(@input); + printf "%-6s input: %-20s expected: %d got: %d\n", + $exp==$got ? 'ok': 'NOT OK', + "@input", + $exp, + $got + } +} + diff --git a/challenge-203/kjetillll/perl/ch-2.pl b/challenge-203/kjetillll/perl/ch-2.pl new file mode 100644 index 0000000000..4e72f888ea --- /dev/null +++ b/challenge-203/kjetillll/perl/ch-2.pl @@ -0,0 +1,62 @@ +#!/usr/bin/perl +use strict; use warnings; + +=pod + +Run with arguments to use those as the input list or +run without to run the included tests with this output: + +Uses File::Find, a core module (included in all normal Perl installations), +to traverse down the source directory to get all directories. + +=cut + +use File::Find qw(find); +use File::Path qw(make_path remove_tree); +use Carp qw(croak); + +if( @ARGV ){ copydir(@ARGV) } +else { run_test('/tmp/challenge-203') } +exit; + +sub copydir { + my($src, $trg) = @_; + my @d = dirs( $src ); + s/^$src/$trg/ for @d; + my @e = grep -d, @d; + croak "ERR: @e already exists! Did nothing!" if @e; + make_path(@d); +} + +sub run_test { + + #-- setup work dir + my $dir = shift; + die if $dir ne '/tmp/challenge-203'; #you'd better + remove_tree($dir); #cleanup if need be + make_path( map "$dir/a/b/c/$_", 1..5 ); + sub touch { open my $fh, '>', $_ or die"ERR: $!"; close $fh }; + touch for map "$dir/a/b/c/$_/$_.txt", 1,2,3, 5; + + #-- copy directory structure + copydir( "$dir/a/b/c", "$dir/x/y" ); + + #--check + my @dirs = dirs($dir); + my @files = files($dir); + my @dirs_wanted = glob $dir.'{,/a{,/b{,/c{,/{1,2,3,4,5}}}},/x{,/y{,/{1,2,3,4,5}}}}'; + my @files_wanted = map "$dir/a/b/c/$_/$_.txt", 1,2,3, 5; + print "Checking ".@dirs. " dirs: ", join(';',@dirs) eq join(';',@dirs_wanted) ? 'ok' : 'NOT OK', "\n"; + print "Checking ".@files." files: ", join(';',@files) eq join(';',@files_wanted) ? 'ok' : 'NOT OK', "\n"; + + #-- cleanup + remove_tree($dir); +} + +sub dirs { _traverse(shift,sub{-d}) } +sub files { _traverse(shift,sub{-f}) } +sub _traverse { + my($dir, $cond, @lst) = @_; + find( { no_chdir=>1, wanted=>sub{ push @lst, $_ if &$cond } }, $dir ); + sort @lst +} |