diff options
| author | Mohammad Sajid Anwar <Mohammad.Anwar@yahoo.com> | 2025-07-25 18:59:22 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2025-07-25 18:59:22 +0100 |
| commit | cd61656667a09b5e3d881b1733d430a016382f5e (patch) | |
| tree | d5b4708f1fe8797f00a33fa30a0b063677687482 | |
| parent | 16b3084d799d0ae45315f2db5bb637d09bc4b9b5 (diff) | |
| parent | 037ec9945b0221e18f45cc80e527994388c6ce4a (diff) | |
| download | perlweeklychallenge-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.pl | 39 | ||||
| -rw-r--r-- | challenge-331/wanderdoc/perl/ch-2.pl | 83 |
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; +} |
