diff options
| -rw-r--r-- | challenge-166/peter-campbell-smith/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-166/peter-campbell-smith/perl/ch-01.pl | 76 | ||||
| -rwxr-xr-x | challenge-166/peter-campbell-smith/perl/ch-02.pl | 67 |
3 files changed, 144 insertions, 0 deletions
diff --git a/challenge-166/peter-campbell-smith/blog.txt b/challenge-166/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..ebf7adb518 --- /dev/null +++ b/challenge-166/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +https://pjcs-pwc.blogspot.com/2022/05/d00dle5-we-are-asked-for-list-of-2-8.html diff --git a/challenge-166/peter-campbell-smith/perl/ch-01.pl b/challenge-166/peter-campbell-smith/perl/ch-01.pl new file mode 100755 index 0000000000..e72ff6c1aa --- /dev/null +++ b/challenge-166/peter-campbell-smith/perl/ch-01.pl @@ -0,0 +1,76 @@ +#!/usr/bin/perl + +# Peter Campbell Smith - 2022-05-23 +# PWC 166 task 1 + +use v5.28; +use strict; +use warnings; +use utf8; + +# Write a program that will read from a dictionary and find 2- to 8-letter words +# that can be “spelled” in hexadecimal, with the addition of the following letter substitutions: +# o -> 0, i -> 1, l -> 1, s -> 7, t -> 7 + +# Blog: https://pjcs-pwc.blogspot.com/2022/05/d00dle5-we-are-asked-for-list-of-2-8.html + +my ($dictionary, $word, $count, $word2, $words); + +# fetch dictionary +$dictionary = `curl -s -L https://github.com/manwar/perlweeklychallenge-club/raw/master/data/dictionary.txt`; + +# as stated above +say qq[\nAs stated in challenge:]; +$count = 0; +WORD: while ($dictionary =~ m|(.*)?\n|g) { + $word = $1; + + # eliminate too short, too long or containing illegal lettes + next if (length($word) < 2 or length($word) > 8) or $word =~ m|[^abcdefolist]|i; + + # make 'special' substitutions + $word =~ y|oistlOISTL|0157101571|; + + # output + print sprintf('%9s', uc($word)); + print qq[\n] unless ++$count %10; +} +print qq[\n] if ++$count %10; +say qq[$count words]; + +#---------------------------------------------------------------------------------- + +# not allowing l -> 1 +say qq[\nOmitting l -> 1:]; +$count = 0; +WORD: while ($dictionary =~ m|(.*)?\n|g) { + $word = $1; + next if (length($word) < 2 or length($word) > 8) or $word =~ m|[^abcdefoist]|i; + $word =~ y|oistOIST|01570157|; + print sprintf('%9s', uc($word)); + print qq[\n] unless ++$count %10; +} +print qq[\n] if ++$count %10; +say qq[$count words]; + +#---------------------------------------------------------------------------------- + +# limiting 'specials' to 3 (optional extra 1) +say qq[\nLimiting 'specials' to 3:]; +$count = 0; +WORD: while ($dictionary =~ m|(.*)?\n|g) { + $word = $1; + next if (length($word) < 2 or length($word) > 8) or $word =~ m|[^abcdefoist]|i; + + # check number of specials + $word2 = $word; + $word2 =~ s|[^oist]||g; + next if length($word2) > 3; + + $word =~ y|oistOIST|01570157|; + print sprintf('%9s', uc($word)); + print qq[\n] unless ++$count %10; + +} +print qq[\n] if ++$count %10; +say qq[$count words]; diff --git a/challenge-166/peter-campbell-smith/perl/ch-02.pl b/challenge-166/peter-campbell-smith/perl/ch-02.pl new file mode 100755 index 0000000000..424df3d8ad --- /dev/null +++ b/challenge-166/peter-campbell-smith/perl/ch-02.pl @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +# Peter Campbell Smith - 2022-05-23 +# PWC 166 task 2 + +use v5.28; +use strict; +use warnings; +use utf8; + +# Given a few (three or more) directories (non-recursively), display a side-by-side +# difference of files that are missing from at least one of the directories. Do not +# display files that exist in every directory. + +# Blog: https://pjcs-pwc.blogspot.com/2022/05/d00dle5-we-are-asked-for-list-of-2-8.html + +my (@dirs, $dir, $file, $width, $header, $all, %files, $line1, $line2, $prefix); + +@dirs = ([qw[Arial.ttf Comic_Sans.ttf Georgia.ttf Helvetica.ttf Impact.otf Verdana.ttf Old_Fonts/]], + [qw[Arial.ttf Comic_Sans.ttf Courier_New.ttf Helvetica.ttf Impact.otf Tahoma.ttf Verdana.ttf]], + [qw[Arial.ttf Courier_New.ttf Helvetica.ttf Impact.otf Monaco.ttf Verdana.ttf]]); + +# loop over directories +$width = 0; +for $dir (0 .. scalar @dirs - 1) { + + # loop over files within directory + for $file (@{$dirs[$dir]}) { + $files{$file} .= qq[/$dir/]; # if file exists within directory n, $files{$file} matches /n/ + $width = length($file) if length($file) > $width; # get max file name length + } + $all .= qq[/$dir/]; # if $files{$file} eq /0//1//2/ (etc) then file exists in all directories and is skipped below +} + +# heading lines +$line1 = qq[\n]; +$prefix = ' '; +for $dir (0 .. scalar @dirs - 1) { + $line1 .= $prefix . 'dir_' . sprintf('%-' . ($width - 4) . 's', chr(ord('a') + $dir)) . ' '; + $line2 .= $prefix . ('-' x ($width)) . ' '; + $prefix = '| '; +} +say qq[$line1\n$line2]; + +# file lines +for $file (sort keys %files) { + next if $files{$file} eq $all; # skip file if in all directories + + # loop over directories + $prefix = ''; + for $dir (0 .. scalar @dirs - 1) { + + # file is in this directory + if ($files{$file} =~ m|/$dir/|) { + print sprintf($prefix . " %-${width}s", $file); + + # file isn't in this directory + } else { + print sprintf($prefix . " %-${width}s", ' '); + } + $prefix = ' |'; + } + print qq[\n]; +} +print qq[\n]; + +
\ No newline at end of file |