diff options
| -rw-r--r-- | challenge-211/peter-campbell-smith/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-211/peter-campbell-smith/perl/ch-1.pl | 79 | ||||
| -rwxr-xr-x | challenge-211/peter-campbell-smith/perl/ch-2.pl | 81 |
3 files changed, 161 insertions, 0 deletions
diff --git a/challenge-211/peter-campbell-smith/blog.txt b/challenge-211/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..8ca8f03329 --- /dev/null +++ b/challenge-211/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/211 diff --git a/challenge-211/peter-campbell-smith/perl/ch-1.pl b/challenge-211/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..bd20e4b8ce --- /dev/null +++ b/challenge-211/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,79 @@ +#!/usr/bin/perl + +use v5.16; # The Weekly Challenge - 2023-04-03 +use utf8; # Week 211 task 1 - Toeplitz matrix +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +toeplitz_matrix( [[4, 3, 2, 1], + [5, 4, 3, 2], + [6, 5, 4, 3]] ); + +toeplitz_matrix( [[4, 3, 2, 1], + [5, 4, 3, 2], + [6, 5, 4, 7]] ); + +toeplitz_matrix( [[37.1, 114, 0, -23.65, 5, 3], + [-40, 37.1, 114, 0, -23.65, 5], + [-19, -40, 37.1, 114, 0, -23.65], + [3, -19, -40, 37.1, 114, 0], + [55, 3, -19, -40, 37.1, 114], + [0, 55, 3, -19, -40, 37.1], + [999, 0, 55, 3, -19, -40]] ); + +toeplitz_matrix( [[6, 0, 0, 0, 6], + [0, 0, 6, 0, 0], + [6, 0, 0, 0, 6]] ); + +sub toeplitz_matrix { + + my($m, $r, $c, $x, $good); + + $m = $_[0]; + + # loop over rows and then columns + ROW: for $r (1 .. scalar @$m - 1) { + for $c (1. .. scalar @{$m->[0]} - 1) { + + # check each element against the appropriate edge element + $x = $m->[$r]->[$c]; + if ($r >= $c) { + $good = $x == $m->[$r - $c]->[0] ? 1 : 0; + last ROW unless $good; + } else { + $good = $x == $m->[0]->[$c - $r] ? 1 : 0; + last ROW unless $good; + } + } + } + + # format the output + my ($w, $width, $rubric, $prefix, $spaces); + + # find maximum width of element (as printed by Perl) + $w = 0; + for $r (0 .. scalar @$m - 1) { + for $c (0. .. scalar @{$m->[0]} - 1) { + $width = length($m->[$r]->[$c]); + $w = $width if $width > $w; + } + } + + # construct and output each row of matrix + $rubric = ''; + $prefix = qq{\nInput: \@matrix = [ [ }; + for $r (0 .. scalar @$m - 1) { + $rubric .= $prefix; + for $c (0. .. scalar @{$m->[0]} - 1) { + $spaces = $w + 1 - length($m->[$r]->[$c]); + $rubric .= (' ' x $spaces) . $m->[$r]->[$c] . ','; + } + $rubric =~ s|.$| ]|s; + $rubric .= ' ]' if $r == scalar @$m - 1; + say $rubric; + $rubric = ''; + $prefix = ' [ '; + } + say qq[Output: ] . ($good ? 'true' : 'false'); +} + diff --git a/challenge-211/peter-campbell-smith/perl/ch-2.pl b/challenge-211/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..ad289c91af --- /dev/null +++ b/challenge-211/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,81 @@ +#!/usr/bin/perl + +use v5.16; # The Weekly Challenge - 2023-04-03 +use utf8; # Week 211 task 2 - Split same average +use strict; # Peter Campbell Smith +use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +use Algorithm::Combinatorics ('combinations'); + +my ($j, @data); + +equal_means(1, 2, 3, 4, 5, 6, 7, 8); +equal_means(1, 3); +equal_means(10, 1, 7, 5, 3, 11, 8, 4, 2, 9); +equal_means(6, 3, 1, 9, 12, 25, 18, 20); +equal_means(8, 6, 3, 5, 1, 4, 2, 7); + +for $j (0 .. 20) { + $data[$j] = int(rand(15)); +} +equal_means(@data); + +sub equal_means { + + my (@array, $count, $mean, $sum, $count1, @array1, $mean1, $sum1, + $count2, $sum2, $mean2, $comb, $iter, $d, $array2p, $combs); + + # initialise + @array = @_; + ($count, $sum, $mean) = stats(@array); + + # loop over sizes of @array1 to consider + OUTER: for $count1 (1 .. int($count / 2)) { + + # loop over combinations from @array of that size + $iter = combinations(\@array, $count1); + while ($comb = $iter->next) { + + # calculate @array1 data + $combs ++; + @array1 = @$comb; + ($count1, $sum1, $mean1) = stats(@array1); + + # deduce @array2 data + $count2 = $count - $count1; + $sum2 = $sum - $sum1; + $mean2 = $sum2 / $count2; + + # means match - result! + if ($mean1 == $mean2) { + + # format and print + $array2p = ', ' . join(', ', @array) . ', '; + for $d (@array1) { + $array2p =~ s|, $d,|,|; + } + say qq[\nInput: (] . join(', ', @array) . q[)]; + say qq[Output: true]; + say qq[ array1: (] . join(', ', @array1) . q[)]; + say qq[ array2: (] . substr($array2p, 2, -2) . q[)]; + say qq[ mean = $mean1 (after $combs combinations tested)]; + return; + } + } + } + say qq[\nInput: (] . join(', ', @array) . q[)]; + say qq[Output: false (after $combs combinations tested)]; +} + +sub stats { + + my ($sum, $count, $d); + + $sum = $count = 0; + for $d (@_) { + $sum += $d; + $count ++; + } + return ($count, $sum, $sum / $count); +} +
\ No newline at end of file |