aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMohammad Sajid Anwar <Mohammad.Anwar@yahoo.com>2025-07-25 18:59:22 +0100
committerGitHub <noreply@github.com>2025-07-25 18:59:22 +0100
commitcd61656667a09b5e3d881b1733d430a016382f5e (patch)
treed5b4708f1fe8797f00a33fa30a0b063677687482
parent16b3084d799d0ae45315f2db5bb637d09bc4b9b5 (diff)
parent037ec9945b0221e18f45cc80e527994388c6ce4a (diff)
downloadperlweeklychallenge-club-cd61656667a09b5e3d881b1733d430a016382f5e.tar.gz
perlweeklychallenge-club-cd61656667a09b5e3d881b1733d430a016382f5e.tar.bz2
perlweeklychallenge-club-cd61656667a09b5e3d881b1733d430a016382f5e.zip
Merge pull request #12409 from wanderdoc/master
PWC 331 (wanderdoc)
-rw-r--r--challenge-331/wanderdoc/perl/ch-1.pl39
-rw-r--r--challenge-331/wanderdoc/perl/ch-2.pl83
2 files changed, 122 insertions, 0 deletions
diff --git a/challenge-331/wanderdoc/perl/ch-1.pl b/challenge-331/wanderdoc/perl/ch-1.pl
new file mode 100644
index 0000000000..7d213b6679
--- /dev/null
+++ b/challenge-331/wanderdoc/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given a string.
+Write a script to find the length of last word in the given string.
+
+Example 1
+
+Input: $str = "The Weekly Challenge"
+Output: 9
+
+
+Example 2
+
+Input: $str = " Hello World "
+Output: 5
+
+
+Example 3
+
+Input: $str = "Let's begin the fun"
+Output: 3
+=cut
+
+use Test2::V0 -no_srand => 1;
+is(last_word_length("The Weekly Challenge"), 9, "Example 1");
+is(last_word_length(" Hello World "), 5, "Example 2");
+is(last_word_length("Let's begin the fun"), 3, "Example 3");
+done_testing();
+
+
+sub last_word_length
+{
+ my $str = $_[0];
+ return length((grep {length($_) > 0}
+ split(/\s/,$str))[-1]);
+}
diff --git a/challenge-331/wanderdoc/perl/ch-2.pl b/challenge-331/wanderdoc/perl/ch-2.pl
new file mode 100644
index 0000000000..8ed60257fc
--- /dev/null
+++ b/challenge-331/wanderdoc/perl/ch-2.pl
@@ -0,0 +1,83 @@
+#!perl
+use strict;
+use warnings FATAL => qw(all);
+
+=prompt
+You are given two strings, source and target.
+Write a script to find out if the given strings are Buddy Strings.
+If swapping of a letter in one string make them same as the other then they are `Buddy Strings`.
+Example 1
+Input: $source = "fuck"
+ $target = "fcuk"
+Output: true
+
+The swapping of 'u' with 'c' makes it buddy strings.
+
+
+Example 2
+
+Input: $source = "love"
+ $target = "love"
+Output: false
+
+
+Example 3
+
+Input: $source = "fodo"
+ $target = "food"
+Output: true
+
+
+Example 4
+
+Input: $source = "feed"
+ $target = "feed"
+Output: true
+=cut
+
+# use feature 'state';
+
+
+use List::Util qw(first);
+use constant { true => 1, false => 0 };
+
+use Test2::V0 -no_srand => 1;
+
+is(buddy_strings("fuck", "fcuk"), true, 'Example 1');
+is(buddy_strings("love", "love"), false, 'Example 2');
+is(buddy_strings("fodo", "food"), true, 'Example 3');
+is(buddy_strings("feed", "feed"), true, 'Example 4');
+done_testing();
+
+sub buddy_strings
+{
+ my ($str_1, $str_2) = @_;
+ if ( length($str_1) != length($str_2) )
+ {
+ return false;
+ }
+ my (%ltr_1, %ltr_2);
+ $ltr_1{$_}++ for split(//, $str_1);
+ $ltr_2{$_}++ for split(//, $str_2);
+ my @standard = sort {$a cmp $b} keys %ltr_1;
+ if ( join('', @standard) ne join('', sort {$a cmp $b} keys %ltr_2) )
+ {
+ return false;
+ }
+ if ( join('-', @ltr_1{@standard}) ne join('-', @ltr_2{@standard}) )
+ {
+ return false;
+ }
+ if ( $str_1 eq $str_2)
+ {
+ if ( defined first { $_ > 1 } values %ltr_1 )
+ {
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+ }
+ return true;
+}