diff options
73 files changed, 5970 insertions, 3016 deletions
diff --git a/challenge-270/jeanluc2020/blog-1.txt b/challenge-270/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..1a681fc017 --- /dev/null +++ b/challenge-270/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-270-1.html diff --git a/challenge-270/jeanluc2020/blog-2.txt b/challenge-270/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..f66639beef --- /dev/null +++ b/challenge-270/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-270-2.html diff --git a/challenge-270/jeanluc2020/perl/ch-1.pl b/challenge-270/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..cb60160887 --- /dev/null +++ b/challenge-270/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,90 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-270/#TASK1 +# +# Task 1: Special Positions +# ========================= +# +# You are given a m x n binary matrix. +# +# Write a script to return the number of special positions in the given binary matrix. +# +## A position (i, j) is called special if $matrix[i][j] == 1 and all other elements in the row i and column j are 0. +# +## Example 1 +## +## Input: $matrix = [ [1, 0, 0], +## [0, 0, 1], +## [1, 0, 0], +## ] +## Output: 1 +## +## There is only one special position (1, 2) as $matrix[1][2] == 1 +## and all other elements in row 1 and column 2 are 0. +# +## Example 2 +## +## Input: $matrix = [ [1, 0, 0], +## [0, 1, 0], +## [0, 0, 1], +## ] +## Output: 3 +## +## Special positions are (0,0), (1, 1) and (2,2). +# +############################################################ +## +## discussion +## +############################################################ +# +# We walk the matrix and for each position we check whether +# the position is special. +# For this we use a function that just checks the same column +# in all rows, and checks the same row for all columns. If +# row and column are the target row and column, we conclude the +# point is not special if it isn't 1, for all other values we +# conclude the point is not special if it isn't 0. If we reach +# the end and we didn't eliminate the point as not special, then +# we conclude this point is special. + +use strict; +use warnings; + +special_positions( [ [1, 0, 0], [0, 0, 1], [1, 0, 0], ] ); +special_positions( [ [1, 0, 0], [0, 1, 0], [0, 0, 1], ] ); + +sub special_positions { + my $matrix = shift; + my @rows = @$matrix; + my $num_rows = scalar(@rows); + my $num_columns = scalar(@{$rows[0]}); + my $special = 0; + foreach my $i (0..$num_rows-1) { + foreach my $j (0..$num_columns-1) { + if(is_special($i, $j, $num_rows, $num_columns, $matrix)) { + $special++; + } + } + } + print "Output: $special\n"; +} + +sub is_special { + my ($i, $j, $num_rows, $num_columns, $matrix) = @_; + foreach my $row (0..$num_rows-1) { + if($i == $row) { + return 0 if $matrix->[$row]->[$j] != 1; + } else { + return 0 if $matrix->[$row]->[$j] != 0; + } + } + foreach my $column (0..$num_columns-1) { + if($j == $column) { + return 0 if $matrix->[$i]->[$column] != 1; + } else { + return 0 if $matrix->[$i]->[$column] != 0; + } + } + return 1; +} + diff --git a/challenge-270/jeanluc2020/perl/ch-2.pl b/challenge-270/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..8356ab0209 --- /dev/null +++ b/challenge-270/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,149 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-270/#TASK2 +# +# Task 2: Distribute Elements +# =========================== +# +# You are give an array of integers, @ints and two integers, $x and $y. +# +# Write a script to execute one of the two options: +# +## Level 1: +## Pick an index i of the given array and do $ints[i] += 1 +## +## Level 2: +## Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1. +# +# You are allowed to perform as many levels as you want to make every elements +# in the given array equal. There is cost attach for each level, for Level 1, +# the cost is $x and $y for Level 2. +# +# In the end return the minimum cost to get the work done. +# +## Example 1 +## +## Input: @ints = (4, 1), $x = 3 and $y = 2 +## Output: 9 +## +## Level 1: i=1, so $ints[1] += 1. +## @ints = (4, 2) +## +## Level 1: i=1, so $ints[1] += 1. +## @ints = (4, 3) +## +## Level 1: i=1, so $ints[1] += 1. +## @ints = (4, 4) +## +## We perforned operation Level 1, 3 times. +## So the total cost would be 3 x $x => 3 x 3 => 9 +# +## Example 2 +## +## Input: @ints = (2, 3, 3, 3, 5), $x = 2 and $y = 1 +## Output: 6 +## +## Level 2: i=0, j=1, so $ints[0] += 1 and $ints[1] += 1 +## @ints = (3, 4, 3, 3, 5) +## +## Level 2: i=0, j=2, so $ints[0] += 1 and $ints[2] += 1 +## @ints = (4, 4, 4, 3, 5) +## +## Level 2: i=0, j=3, so $ints[0] += 1 and $ints[3] += 1 +## @ints = (5, 4, 4, 4, 5) +## +## Level 2: i=1, j=2, so $ints[1] += 1 and $ints[2] += 1 +## @ints = (5, 5, 5, 4, 5) +## +## Level 1: i=3, so $ints[3] += 1 +## @ints = (5, 5, 5, 5, 5) +## +## We perforned operation Level 1, 1 time and Level 2, 4 times. +## So the total cost would be (1 x $x) + (3 x $y) => (1 x 2) + (4 x 1) => 6 +# +############################################################ +## +## discussion +## +############################################################ +# +# We find the index of the biggest number in the array, and the +# indices of the two smallest ones. As long as the smallest number +# is still smaller than the biggest one, we check: +# - if the second smallest number is still smaller than the biggest +# AND the cost of incrementing two numbers is less than twice the +# cost of incrementing one number, increment the two smallest +# numbers +# - else increment the smallest number +# +# Two helper functions are used: max_at() returns the index of the +# biggest number in the array, min_at() returns the indices of the +# two smallest numbers in the array (first one wins if two numbers have +# the same value) + +use strict; +use warnings; + +distribute_elements( [4, 1], 3, 2); +distribute_elements( [2, 3, 3, 3, 5], 2, 1); + +sub distribute_elements { + my ($array, $x, $y) = @_; + my @ints = @$array; + print "Input: (", join(", ", @ints), "), \$x = $x, \$y = $y\n"; + my $result = 0; + my $max_pos = max_at(@ints); + my ($min1_pos, $min2_pos) = min_at(@ints); + while($ints[$min1_pos] < $ints[$max_pos]) { + if($ints[$min2_pos] < $ints[$max_pos] && 2*$x > $y) { + $ints[$min2_pos]++; + $ints[$min1_pos]++; + $result += $y; + } else { + $ints[$min1_pos]++; + $result += $x; + } + ($min1_pos, $min2_pos) = min_at(@ints); + } + print "Output: $result\n"; +} + +sub max_at { + my @ints = @_; + my $max_pos = 0; + my $max = $ints[0]; + foreach my $i (1..$#ints) { + if($ints[$i] > $max) { + $max = $ints[$i]; + $max_pos = $i; + } + } + return $max_pos; +} + +sub min_at { + my @ints = @_; + my ($min1_pos, $min2_pos, $min1, $min2); + if($ints[0] > $ints[1]) { + $min1_pos = 1; + $min2_pos = 0; + $min1 = $ints[1]; + $min2 = $ints[0]; + } else { + $min1_pos = 0; + $min2_pos = 1; + $min1 = $ints[0]; + $min2 = $ints[1]; + } + foreach my $i (2..$#ints) { + next unless $ints[$i] < $min2; + if($ints[$i] < $min1) { + ($min1, $min2) = ($ints[$i], $min1); + ($min1_pos, $min2_pos) = ($i, $min1_pos); + } else { + $min2 = $ints[$i]; + $min2_pos = $i; + } + } + return ($min1_pos, $min2_pos); +} + diff --git a/challenge-270/mark-anderson/raku/ch-1.raku b/challenge-270/mark-anderson/raku/ch-1.raku index bc0a28297c..99db6da982 100644 --- a/challenge-270/mark-anderson/raku/ch-1.raku +++ b/challenge-270/mark-anderson/raku/ch-1.raku @@ -15,9 +15,8 @@ is special-positions([ sub special-positions(@m) { - my @ones = (^@m X ^@m[0]).grep({ @m[.[0];.[1]] }); + my @rows = @m .map({ ($++, .grep(1, :k)).join("|") }); + my @cols = ([Z] @m).map({ (.grep(1, :k), $++ ).join("|") }); - + @ones.grep({ all .[0] == one(@ones>>.[0]), - .[1] == one(@ones>>.[1]) - }) + + (@rows (&) @cols) } diff --git a/challenge-270/perlboy1967/perl/ch-1.pl b/challenge-270/perlboy1967/perl/ch-1.pl new file mode 100755 index 0000000000..35b0562873 --- /dev/null +++ b/challenge-270/perlboy1967/perl/ch-1.pl @@ -0,0 +1,53 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 270 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-270 + +Author: Niels 'PerlBoy' van Dijke + +Task 1: Special Positions +Submitted by: Mohammad Sajid Anwar + +You are given a m x n binary matrix. + +Write a script to return the number of special positions in the given binary matrix. + +|| A position (i, j) is called special if $matrix[i][j] == 1 and all other elements +|| in the row i and column j are 0. + +=cut + +use v5.32; +use feature qw(signatures); +use common::sense; + +use Test2::V0;; + +# Task 1 +sub specialPositions ($ar) { + sub _isSpecial (@ints) { + my %i; $i{$_}++ for (@ints); + return (keys %i == 2 && $i{1} == 1 && exists $i{0} ? 1 : 0); + } + my @r = map { _isSpecial(@$_) } @$ar; + my @c = map { my $c = $_; + _isSpecial(map{$$ar[$_][$c]} 0 .. $#{$$ar[0]}) + } 0 .. $#$ar; + my $n = 0; + for my $r (0 .. $#r) { + for my $c (0 .. $#c) { + $n++ if $$ar[$r][$c] & $r[$r] & $c[$c]; + } + } + return $n; +} + +is(specialPositions([[1,0,0,], + [0,0,1,], + [1,0,0]]),1,'Example 1'); +is(specialPositions([[1,0,0], + [0,1,0], + [0,0,1]]),3,'Example 2'); +done_testing; diff --git a/challenge-270/perlboy1967/perl/ch-2.pl b/challenge-270/perlboy1967/perl/ch-2.pl new file mode 100755 index 0000000000..a0dd1e62ac --- /dev/null +++ b/challenge-270/perlboy1967/perl/ch-2.pl @@ -0,0 +1,60 @@ +#!/bin/perl + +=pod + +The Weekly Challenge - 270 +- https://theweeklychallenge.org/blog/perl-weekly-challenge-270 + +Author: Niels 'PerlBoy' van Dijke + +ask 2: Distribute Elements +Submitted by: Mohammad Sajid Anwar + +You are give an array of integers, @ints and two integers, $x and $y. + +Write a script to execute one of the two options: + +Level 1: +Pick an index i of the given array and do $ints[i] += 1 + +Level 2: +Pick two different indices i,j and do $ints[i] +=1 and $ints[j] += 1. + +You are allowed to perform as many levels as you want to make every elements in +the given array equal. There is cost attach for each level, for Level 1, the +cost is $x and $y for Level 2. + +In the end return the minimum cost to get the work done. + +=cut + +use v5.32; +use feature qw(signatures); +use common::sense; + +use Test2::V0; + +# Task 2 +use List::AllUtils qw(max); + +sub distributeElements ($ar,$c1,$c2) { + my ($m,$c) = (max(@$ar),0); + my @i = grep { $_ < $m } @$ar; + while (@i) { + my @n = (0); + if ($c2 < 2 * $c1 && $#i) { + $c += $c2; unshift(@n,1); + } else { + $c += $c1; + } + $i[$_]++ for (@n); + @i = grep { $_ < $m } @i; + } + return $c; +} + +is(distributeElements([4,1],3,2),9,'Example 1'); +is(distributeElements([2,3,3,3,5],2,1),6,'Example 2'); +is(distributeElements([3,3,4,4],1,2),2,'Own test'); + +done_testing; diff --git a/challenge-270/peter-campbell-smith/blog.txt b/challenge-270/peter-campbell-smith/blog.txt new file mode 100644 index 0000000000..6fa0ae55be --- /dev/null +++ b/challenge-270/peter-campbell-smith/blog.txt @@ -0,0 +1 @@ +http://ccgi.campbellsmiths.force9.co.uk/challenge/270 diff --git a/challenge-270/peter-campbell-smith/perl/ch-1.pl b/challenge-270/peter-campbell-smith/perl/ch-1.pl new file mode 100755 index 0000000000..3a478a9bc8 --- /dev/null +++ b/challenge-270/peter-campbell-smith/perl/ch-1.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +use v5.26; # The Weekly Challenge - 2024-05-20 +use utf8; # Week 270 - task 1 - Special positions +use warnings; # Peter Campbell Smith +binmode STDOUT, ':utf8'; + +special_positions([[1, 0, 0], + [0, 0, 1], + [1, 0, 0]]); + +special_positions([[1, 0, 0], + [0, 0, 1], + [0, 0, 1]]); + +special_positions([[1, 0, 1], + [0, 0, 0], + [1, 0, 1]]); + +special_positions([[1, 0, 0, 0, 0, 0], + [0, 1, 0, 0, 0, 0], + [0, 0, 1, 0, 0, 0], + [0, 0, 0, 1, 0, 0], + [0, 0, 0, 0, 1, 1]]); + +sub special_positions { + + my ($matrix, $ones, $r, $c, $special, $r1, $c1, $count); + + $matrix = shift; + $special = ''; + + # look for 1s + ROW: for $r (0 .. @$matrix - 1) { + COL: for $c (0 .. @{$matrix->[$r]} - 1) { + next COL unless $matrix->[$r]->[$c] == 1; + + # check that it's the only 1 in its row + for $r1 (0 .. @$matrix - 1) { + next COL if ($matrix->[$r1]->[$c] != 0 and $r1 != $r); + } + + # and in its column + for $c1 (0 .. @{$matrix->[$r]} - 1) { + next COL if ($matrix->[$r]->[$c1] != 0 and $c1 != $c); + } + + # found one! + $special .= qq[r$r c$c, ]; + } + } + + # count the commas and show answer + $count = $special =~ s|,|,|g + 0; + print_matrix(q[Input: ], $matrix); + say qq[Output: $count] . ($count > 0 ? ' - ' . substr($special, 0, -2) : ''); +} + +sub print_matrix { + + my ($legend, $matrix, $j); + + # format matrix + ($legend, $matrix) = @_; + say ''; + for $j (0 .. @$matrix - 1) { + say qq{$legend [} . join(', ', @{$matrix->[$j]}) . qq(]); + $legend = ' ' x length($legend); + } +} diff --git a/challenge-270/peter-campbell-smith/perl/ch-2.pl b/challenge-270/peter-campbell-smith/perl/ch-2.pl new file mode 100755 index 0000000000..356a009180 --- /dev/null +++ b/challenge-270/peter-campbell-smith/perl/ch-2.pl @@ -0,0 +1,51 @@ +#!/usr/bin/perl + +# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge + +use v5.26; # The Weekly Challenge - 2024-05-20 +use utf8; # Week 270 - task 2 - Distribute elements +use warnings; # Peter Campbell Smith +binmode STDOUT, ':utf8'; + +distribute_elements([4, 1], 3, 2); +distribute_elements([2, 3, 3, 3, 5], 2, 1); +distribute_elements([2, 3, 3, 3, 5], 2, 5); +distribute_elements([7, 7, 7, 7, 7], 2, 1); +distribute_elements([2, 3, 3, 3, 5], 2, 5); + +sub distribute_elements { + + my ($list_ref, @list, $x, $y, $largest, $bought_x, $bought_y); + + # initialise + ($list_ref, $x, $y) = @_; + @list = sort {$a <=> $b} @$list_ref; |