diff options
| author | Thomas Köhler <jean-luc@picard.franken.de> | 2025-10-03 10:48:50 +0200 |
|---|---|---|
| committer | Thomas Köhler <jean-luc@picard.franken.de> | 2025-10-03 10:48:50 +0200 |
| commit | 6b833c9b20ab2398adda8df873a8f4b90f8e2ff3 (patch) | |
| tree | 52a5bbf14739e38350289083a2719ce0e28682e7 | |
| parent | 9a2f46d9a9e4f732005b98a7dde7d75c31df77de (diff) | |
| download | perlweeklychallenge-club-6b833c9b20ab2398adda8df873a8f4b90f8e2ff3.tar.gz perlweeklychallenge-club-6b833c9b20ab2398adda8df873a8f4b90f8e2ff3.tar.bz2 perlweeklychallenge-club-6b833c9b20ab2398adda8df873a8f4b90f8e2ff3.zip | |
Add solution 341.
Signed-off-by: Thomas Köhler <jean-luc@picard.franken.de>
| -rw-r--r-- | challenge-341/jeanluc2020/blog-1.txt | 1 | ||||
| -rw-r--r-- | challenge-341/jeanluc2020/blog-2.txt | 1 | ||||
| -rwxr-xr-x | challenge-341/jeanluc2020/perl/ch-1.pl | 79 | ||||
| -rwxr-xr-x | challenge-341/jeanluc2020/perl/ch-2.pl | 67 |
4 files changed, 148 insertions, 0 deletions
diff --git a/challenge-341/jeanluc2020/blog-1.txt b/challenge-341/jeanluc2020/blog-1.txt new file mode 100644 index 0000000000..a9c2ab303b --- /dev/null +++ b/challenge-341/jeanluc2020/blog-1.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-341-1.html diff --git a/challenge-341/jeanluc2020/blog-2.txt b/challenge-341/jeanluc2020/blog-2.txt new file mode 100644 index 0000000000..e2a5f835ab --- /dev/null +++ b/challenge-341/jeanluc2020/blog-2.txt @@ -0,0 +1 @@ +http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-341-2.html diff --git a/challenge-341/jeanluc2020/perl/ch-1.pl b/challenge-341/jeanluc2020/perl/ch-1.pl new file mode 100755 index 0000000000..0e319f6c22 --- /dev/null +++ b/challenge-341/jeanluc2020/perl/ch-1.pl @@ -0,0 +1,79 @@ +#!/usr/bin/env perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-341/#TASK1 +# +# Task 1: Broken Keyboard +# ======================= +# +# You are given a string containing English letters only and also you are given +# broken keys. +# +# Write a script to return the total words in the given sentence can be typed +# completely. +# +## Example 1 +## +## Input: $str = 'Hello World', @keys = ('d') +## Output: 1 +## +## With broken key 'd', we can only type the word 'Hello'. +# +# +## Example 2 +## +## Input: $str = 'apple banana cherry', @keys = ('a', 'e') +## Output: 0 +# +# +## Example 3 +## +## Input: $str = 'Coding is fun', @keys = () +## Output: 3 +## +## No keys broken. +# +# +## Example 4 +## +## Input: $str = 'The Weekly Challenge', @keys = ('a','b') +## Output: 2 +# +# +## Example 5 +## +## Input: $str = 'Perl and Python', @keys = ('p') +## Output: 1 +# +############################################################ +## +## discussion +## +############################################################ +# +# Create a list of the words in $str. Then for each of the words, +# check if any of the characters in the word is a broken key, we remove +# it from the list. Count the remaining words as the result + +use v5.36; + + +broken_keyboard('Hello World', 'd'); +broken_keyboard('apple banana cherry', 'a', 'e'); +broken_keyboard('Coding is fun' ); +broken_keyboard('The Weekly Challenge', 'a','b'); +broken_keyboard('Perl and Python', 'p'); + +sub broken_keyboard($str, @keys) { + say "Input: '$str', (" . join(", ", @keys) . ")"; + my @words = split /\s+/, $str; + my $count = scalar(@words); + OUTER: + foreach my $w (@words) { + foreach my $key (@keys) { + if($w =~ m/$key/i) { + $count--; + next OUTER; + } + } + } + say "Output: $count"; +} diff --git a/challenge-341/jeanluc2020/perl/ch-2.pl b/challenge-341/jeanluc2020/perl/ch-2.pl new file mode 100755 index 0000000000..068d80869b --- /dev/null +++ b/challenge-341/jeanluc2020/perl/ch-2.pl @@ -0,0 +1,67 @@ +#!/usr/bin/env perl +# https://theweeklychallenge.org/blog/perl-weekly-challenge-341/#TASK2 +# +# Task 2: Reverse Prefix +# ====================== +# +# You are given a string, $str and a character in the given string, $char. +# +# Write a script to reverse the prefix upto the first occurrence of the given +# $char in the given string $str and return the new string. +# +## Example 1 +## +## Input: $str = "programming", $char = "g" +## Output: "gorpramming" +## +## Reverse of prefix "prog" is "gorp". +# +# +## Example 2 +## +## Input: $str = "hello", $char = "h" +## Output: "hello" +# +# +## Example 3 +## +## Input: $str = "abcdefghij", $char = "h" +## Output: "hgfedcbaij" +# +# +## Example 4 +## +## Input: $str = "reverse", $char = "s" +## Output: "srevere" +# +# +## Example 5 +## +## Input: $str = "perl", $char = "r" +## Output: "repl" +# +############################################################ +## +## discussion +## +############################################################ +# +# This is a simple s/old/new/ thanks to perl's s///e feature. +# We just need a regular expression that collects everything from +# the beginning of the string up until the first appearance of $char. +# The rest is applying reverse() to it which does exactly what we +# need in scalar context. + +use v5.36; + +reverse_prefix("programming", "g"); +reverse_prefix("hello", "h"); +reverse_prefix("abcdefghij", "h"); +reverse_prefix("reverse", "s"); +reverse_prefix("perl", "r"); + +sub reverse_prefix($str, $char) { + say "Input: '$str', '$char'"; + $str =~ s/^([^$char]*$char)/reverse($1)/e; + say "Output: $str"; +} |
