aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Köhler <jean-luc@picard.franken.de>2025-10-03 10:48:50 +0200
committerThomas Köhler <jean-luc@picard.franken.de>2025-10-03 10:48:50 +0200
commit6b833c9b20ab2398adda8df873a8f4b90f8e2ff3 (patch)
tree52a5bbf14739e38350289083a2719ce0e28682e7
parent9a2f46d9a9e4f732005b98a7dde7d75c31df77de (diff)
downloadperlweeklychallenge-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.txt1
-rw-r--r--challenge-341/jeanluc2020/blog-2.txt1
-rwxr-xr-xchallenge-341/jeanluc2020/perl/ch-1.pl79
-rwxr-xr-xchallenge-341/jeanluc2020/perl/ch-2.pl67
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";
+}