From 5650f5f8ecfbd388441323510fafae9f8f4726f6 Mon Sep 17 00:00:00 2001 From: wanderdoc Date: Mon, 22 Sep 2025 19:02:43 +0200 Subject: Create ch-1.pl --- challenge-340/wanderdoc/perl/ch-1.pl | 79 ++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 challenge-340/wanderdoc/perl/ch-1.pl diff --git a/challenge-340/wanderdoc/perl/ch-1.pl b/challenge-340/wanderdoc/perl/ch-1.pl new file mode 100644 index 0000000000..faf4abc5a9 --- /dev/null +++ b/challenge-340/wanderdoc/perl/ch-1.pl @@ -0,0 +1,79 @@ +#!perl +use strict; +use warnings FATAL => qw(all); + +=prompt +You are given a string, $str, consisting of lowercase English letters. + +Write a script to return the final string after all duplicate removals have been made. Repeat duplicate removals on the given string until we no longer can. + + A duplicate removal consists of choosing two adjacent and equal letters and removing them. + + +Example 1 + +Input: $str = 'abbaca' +Output: 'ca' + +Step 1: Remove 'bb' => 'aaca' +Step 2: Remove 'aa' => 'ca' + + +Example 2 + +Input: $str = 'azxxzy' +Output: 'ay' + +Step 1: Remove 'xx' => 'azzy' +Step 2: Remove 'zz' => 'ay' + + +Example 3 + +Input: $str = 'aaaaaaaa' +Output: '' + +Step 1: Remove 'aa' => 'aaaaaa' +Step 2: Remove 'aa' => 'aaaa' +Step 3: Remove 'aa' => 'aa' +Step 4: Remove 'aa' => '' + + +Example 4 + +Input: $str = 'aabccba' +Output: 'a' + +Step 1: Remove 'aa' => 'bccba' +Step 2: Remove 'cc' => 'bba' +Step 3: Remove 'bb' => 'a' + + +Example 5 + +Input: $str = 'abcddcba' +Output: '' + +Step 1: Remove 'dd' => 'abccba' +Step 2: Remove 'cc' => 'abba' +Step 3: Remove 'bb' => 'aa' +Step 4: Remove 'aa' => '' +=cut + +use Test2::V0 -no_srand => 1; +is(duplicate_removal('abbaca'), 'ca', 'Example 1'); +is(duplicate_removal('azxxzy'), 'ay', 'Example 2'); +is(duplicate_removal('aaaaaaaa'), '', 'Example 3'); +is(duplicate_removal('aabccba'), 'a', 'Example 4'); +is(duplicate_removal('abcddcba'), '', 'Example 5'); +done_testing(); + +sub duplicate_removal +{ + my $str = $_[0]; + while ( $str =~ /(.)\g{1}/ ) + { + $str =~ s/(.)\g{1}//; + } + return $str; +} -- cgit From c2e553db5f27dde812d197f3a1c02f26ebdc6b6b Mon Sep 17 00:00:00 2001 From: wanderdoc Date: Mon, 22 Sep 2025 19:03:17 +0200 Subject: Create ch-2.pl --- challenge-340/wanderdoc/perl/ch-2.pl | 70 ++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 challenge-340/wanderdoc/perl/ch-2.pl diff --git a/challenge-340/wanderdoc/perl/ch-2.pl b/challenge-340/wanderdoc/perl/ch-2.pl new file mode 100644 index 0000000000..ac329069db --- /dev/null +++ b/challenge-340/wanderdoc/perl/ch-2.pl @@ -0,0 +1,70 @@ +#!perl +use strict; +use warnings FATAL => qw(all); + +=prompt +You are given a string, $str, is list of tokens separated by a single space. Every token is either a positive number consisting of digits 0-9 with no leading zeros, or a word consisting of lowercase English letters. +Write a script to check if all the numbers in the given string are strictly increasing from left to right. + +Example 1 + +Input: $str = "The cat has 3 kittens 7 toys 10 beds" +Output: true + +Numbers 3, 7, 10 - strictly increasing. + + +Example 2 + +Input: $str = 'Alice bought 5 apples 2 oranges 9 bananas' +Output: false + + +Example 3 + +Input: $str = 'I ran 1 mile 2 days 3 weeks 4 months' +Output: true + + +Example 4 + +Input: $str = 'Bob has 10 cars 10 bikes' +Output: false + + +Example 5 + +Input: $str = 'Zero is 0 one is 1 two is 2' +Output: true +=cut + + +use constant { true => 1, false => 0 }; +use Test2::V0 -no_srand => 1; + +is(ascending_numbers('The cat has 3 kittens 7 toys 10 beds'), true, 'Example 1'); +is(ascending_numbers('Alice bought 5 apples 2 oranges 9 bananas'), false, 'Example 2'); +is(ascending_numbers('I ran 1 mile 2 days 3 weeks 4 months'), true, 'Example 3'); +is(ascending_numbers('Bob has 10 cars 10 bikes'), false, 'Example 4'); +is(ascending_numbers('Zero is 0 one is 1 two is 2'), true, 'Example 5'); +done_testing(); + + +sub ascending_numbers +{ + my $str = $_[0]; + my @arr = grep { $_ =~ /^\d+$/ } split(/\s/, $str); + my $prev; + for my $num ( @arr ) + { + if ( defined($prev) and $prev >= $num ) + { + return false; + } + else + { + $prev = $num; + } + } + return true; +} -- cgit