diff options
| -rw-r--r-- | challenge-215/jeanluc2020/blog-1.txt | 1 | ||||
| -rw-r--r-- | challenge-215/jeanluc2020/blog-2.txt | 1 | ||||
| -rwxr-xr-x | challenge-215/jeanluc2020/perl/ch-1.pl | 70 | ||||
| -rwxr-xr-x | challenge-215/jeanluc2020/perl/ch-2.pl | 117 |
4 files changed, 189 insertions, 0 deletions
diff --git a/challenge-215/jeanluc2020/blog-1.txt b/challenge-215/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..1cd27ff2eb --- /dev/null +++ b/challenge-215/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-215-1.html diff --git a/challenge-215/jeanluc2020/blog-2.txt b/challenge-215/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..5e02beed19 --- /dev/null +++ b/challenge-215/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-215-2.html diff --git a/challenge-215/jeanluc2020/perl/ch-1.pl b/challenge-215/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..e7db19a229 --- /dev/null +++ b/challenge-215/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,70 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-215/#TASK1 +# +# Task 1: Odd one Out +# =================== +# +# You are given a list of words (alphabetic characters only) of same size. +# +# Write a script to remove all words not sorted alphabetically and print the +# number of words in the list that are not alphabetically sorted. +# +## Example 1 +## +## Input: @words = ('abc', 'xyz', 'tsu') +## Output: 1 +## +## The words 'abc' and 'xyz' are sorted and can't be removed. +## The word 'tsu' is not sorted and hence can be removed. +# +## Example 2 +## +## Input: @words = ('rat', 'cab', 'dad') +## Output: 3 +## +## None of the words in the given list are sorted. +## Therefore all three needs to be removed. +# +## Example 3 +## +## Input: @words = ('x', 'y', 'z') +## Output: 0 +# +############################################################ +## +## discussion +## +############################################################ +# +# We look at each word in the list. If it's sorted, we keep it. +# At the end, the amount of removed words is the difference +# in length of the original list and the "keep" list. + +use strict; +use warnings; + +odd_one_out('abc', 'xyz', 'tsu'); +odd_one_out('rat', 'cab', 'dad'); +odd_one_out('x', 'y', 'z'); + +sub odd_one_out { + my @words = @_; + print "Input: (" . join(",", @words) . ")\n"; + my @keep = (); + foreach my $word (@words) { + push @keep, $word if is_sorted($word); + } + my $removed = scalar(@words) - scalar(@keep); + print "Output: $removed\n"; +} + +# a word is sorted if it is the same after sorting +# all of its characters, so we split each word into +# its characters, sort them, and join them back into +# a word again +sub is_sorted { + my $word = shift; + my $sorted_word = join("", sort(split //, $word)); + return $word eq $sorted_word; +} + diff --git a/challenge-215/jeanluc2020/perl/ch-2.pl b/challenge-215/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..ee0da2108b --- /dev/null +++ b/challenge-215/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,117 @@ +#!/usr/bin/perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-215/#TASK2 +# +# Task 2: Number Placement +# ======================== +# +# You are given a list of numbers having just 0 and 1. You are also +# given placement count (>=1). +# +# Write a script to find out if it is possible to replace 0 with 1 +# in the given list. The only condition is that you can only replace +# when there is no 1 on either side. Print 1 if it is possible +# otherwise 0. +# +## Example 1: +## +## Input: @numbers = (1,0,0,0,1), $count = 1 +## Output: 1 +## +## You are asked to replace only one 0 as given count is 1. +## We can easily replace middle 0 in the list i.e. (1,0,1,0,1). +# +## Example 2: +## +## Input: @numbers = (1,0,0,0,1), $count = 2 +## Output: 0 +## +## You are asked to replace two 0's as given count is 2. +## It is impossible to replace two 0's. +# +## Example 3: +## +## Input: @numbers = (1,0,0,0,0,0,0,0,1), $count = 3 +## Output: 1 +# +############################################################ +## +## discussion +## +############################################################ +# +# So, if we can replace $count 0's with 1's, we should print 1, +# otherwise 0. number_placement() will do that, calling the +# can_replace() function to check the possibility. +# can_replace() replaces one 0 with a 1 via the replace() function, +# and if that worked, calls itself recursively with the new array +# and $count - 1. +# replace() short-circuits its execution by replacing the first +# possible 0 that can be replaced and then returning the resulting +# new array, leaving everything else for the recursive calls of the +# can_replace() function and subsequent replace() calls + +use strict; +use warnings; + +number_placement( [1,0,0,0,1], 1); +number_placement( [1,0,0,0,1], 2); +number_placement( [1,0,0,0,0,0,0,0,1], 3); + +sub number_placement { + my ($numbers, $count) = @_; + print "Input: (" . join(",", @$numbers), "), $count\n"; + die "Illegal count" unless $count > 0; + print "Output: "; + if(can_replace($numbers, $count)) { + print "1\n"; + } else { + print "0\n"; + } +} + +sub can_replace { + my ($numbers, $count) = @_; + return 1 unless $count; # nothing left to do, all replacements done + my $new_numbers = replace($numbers); + if($new_numbers) { + return can_replace($new_numbers, $count - 1); + } + return 0; +} + +# replace one 0 with a 1 in the given array. +# We do this by finding the first 0 that we can +# replace. Once that is replaced, we return the +# new array with the replacement in place. If we +# can't replace a 0 with a 1, we return undef +# to signal this fact +sub replace { + my $numbers = shift; + my $new_numbers = [ @$numbers ]; + my $last_idx = scalar(@$numbers) - 1; + foreach my $i (0..$last_idx) { + my $can_replace = 0; + if($numbers->[$i] == 0) { + $can_replace = 1; + if($i > 0) { + if($numbers->[$i-1] == 0) { + $can_replace = 1; + } else { + $can_replace = 0; + } + } + if($i < $last_idx && $can_replace) { + if($numbers->[$i+1] == 0) { + $can_replace = 1; + } else { + $can_replace = 0; + } + } + if($can_replace) { + $new_numbers->[$i] = 1; + return $new_numbers; + } + } + } + return undef; +} |