PERL WEEKLY CHALLENGE – 065

This is my 35th week participating into the weekly challenge.


TASK #1 › Digits Sum

Submitted by: Mohammad S Anwar
Reviewed by: Ryan Thompson

You are given two positive numbers $N and $S.

Write a script to list all positive numbers having exactly $N digits where sum of all digits equals to $S.

Example

Input:
    $N = 2
    $S = 4

Output:
    13, 22, 31, 40

For this challenge, i just brute forced by iterating through all N digit numbers.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-1.pl
use Modern::Perl;
use List::Util qw/sum/;

# Store the answers
my @answers;

# Default $N and $S
my $N = shift // 2;
my $S = shift // 4;

# Calculate start and end
my $start = 10 ** ($N - 1);
my $end   = (10 ** $N) - 1;

# Process each number
for my $i ($start .. $end) {
	my @numbers = split(//, $i);
	push @answers, $i
		if (sum(@numbers) == $S);
}

# Display answers
say join ', ', @answers;

Output: perl ./ch-1.pl

13, 22, 31, 40

Raku solution

# Test: perl6 ch-1.p6
multi MAIN() { MAIN(2, 4); }

multi MAIN(Int $N, Int $S) {
	# Store the answers
	my @answers;

	# Calculate start and end
	my $start = 10 ** ($N - 1);
	my $end   = (10 ** $N) - 1;

	# Process each number
	for ($start .. $end) -> $i {
		my @numbers = $i.comb;
		@answers.push($i)
			if (@numbers.sum == $S);
	}

	# Display answers
	say @answers.join(", ");
}

Output perl6 ch-1.p6

13, 22, 31, 40

TASK #2 › Palindrome Partition

Submitted by: Mohammad S Anwar
Reviewed by: Ryan Thompson

You are given a string $S. Write a script print all possible partitions that gives Palindrome. Return -1 if none found.

Please make sure, partition should not overlap. For example, for given string “abaab”, the partition “aba” and “baab” would not be valid, since they overlap.

Example 1

Input: $S = 'aabaab'
Ouput: 'aa', 'baab'

Example 2

Input: $S = 'abbaba'
Output:
 There are 2 possible solutions.
 a) 'abba'
 b) 'bb', 'aba'

For this challenge I broke the work down into separate letters and just iterated through the letters. Then I used a little recursion to break the palindrome down into chunks to print all possible answers.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl
use Modern::Perl;

say 'Solutions for: aabaab:';
for my $answer (palindrome('aabaab')) {
	say join ', ', @$answer;
};

say "\n\nSolutions for: abbaba:";
for my $answer (palindrome('abbaba')) {
	say join ', ', @$answer;
};

sub palindrome {
	my $string = shift;
	my @letters = split (//, $string);

	# All possible answers
	my @answers;

	# Divide the answers into chunks #scalar(@letters)
	for (my $i = 0; $i < scalar(@letters); $i++) {
			my $possible_word = '';

			# Process each chunk
			for (my $j = $i; $j < scalar(@letters); $j++) {
				$possible_word .= $letters[$j];

				# Make sure the word is longer than 1 char
				if (length($possible_word) > 1) {
					# Check this word
					if ($possible_word eq reverse($possible_word)) {
						# Recusive check
						my $sub_string = substr($string, $j + 1);
						my @palins = palindrome($sub_string);

						if (scalar (@palins)) {
							for my $palin (@palins) {
								push @answers, [ $possible_word, @$palin ] ;
							}
						} else {
							push @answers,  [ $possible_word ];
						}
					}
				}
			}
	}

	return @answers;
}

Output ./ch-2.pl

Solutions for: aabaab:
aa, baab
aa, aa
aabaa
aba
baab
aa


Solutions for: abbaba:
abba
bb, aba
bab
aba

Raku solution

# Test: perl6 ch-2.p6
sub MAIN() {
	say 'Solutions for: aabaab:';
	for (palindrome('aabaab')) -> $answer {
		say $answer.join(", ")
	};

	say "\n\nSolutions for: abbaba:";
	for (palindrome('abbaba')) -> $answer {
		say $answer.join(", ");
	};
}

sub palindrome (Str $string){
	my @letters = $string.comb;

	# All possible answers
	my @answers;

	# Divide the answers into chunks #scalar(@letters)
	loop (my $i = 0; $i < @letters.elems; $i++) {
			my $possible_word = '';

			# Process each chunk
			loop (my $j = $i; $j < @letters.elems; $j++) {
				$possible_word ~= @letters[$j];

				# Make sure the word is longer than 1 char
				if ($possible_word.chars > 1) {

					# Check this word
					if ($possible_word eq $possible_word.flip) {
						# Recusive check
						my $sub_string = substr($string, $j + 1);
						my @palins = palindrome($sub_string);

						if (@palins) {
							for (@palins) -> $palin {
								push @answers, [ $possible_word, @$palin ] ;
							}
						} else {
							@answers.push([ $possible_word ]);
						}
					}
				}
			}
	}
	return @answers;
}

Output perl6 ch-2.p6

Solutions for: aabaab:
aa, baab
aa, aa
aabaa
aba
baab
aa


Solutions for: abbaba:
abba
bb, aba
bab
aba

One thought on “PERL WEEKLY CHALLENGE – 065

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s