Discs and Spheres

The solution to the first challenge in TWC-312 is pretty simple and straight forward. Even for a perl one liner it's very small. The solution is just length($str). Yup that's it. If there are 3 characters then it takes 3 seconds, 4 characters takes 4 seconds. That's all. You see, Anwar mentioned that it takes 1 sec to print a character but didn't mention in the problem statement how many seconds it takes to move from one character to another character. It must be instantaneous, otherwise it would have been mentioned.

Hey what are you doing here?

Nothing.

You need to leave now!

Let me show the perl one liner to....

OUT!!!

Sorry guys, ignore him, that was my sarcastic pedantic version talking till now. Let's get into the first challenge. Looking at the problem, I can see why Anwar is really intelligent. He could have used a straight edge etched with the alphabets for the typewriter, but he chose to use a disc. That's more efficient. Suppose I made a typewriter with a straight edge and I had to type the word "zap". After typing 'z', I'd have to wait 25 seconds to move to letter 'a'. But on this disc, I just have to blink for 1 second before typing 'a'. Very clever!

With great power comes great responsibility. Now it is not straight forward to calculate the shortest amount of time it takes to type something. If it was a straight edge, the time taken to move from one letter to another letter is just the difference between them obtained by calculating the absolute difference between their positions on the alphabet. There is no decision to be made. But now, on this disc, there are two possible answers. From 'a' to 'z', I can take the longer route following the natural alphabetical order which takes 25 seconds, or I can take 1 second to move in the reverse direction. But how to calculate the time taken to travel in the reverse direction?

Look at this picture, the distance from e to j is 5 in the normal direction or 21 in the reverse direction. You see any common pattern between previous example and this? The sum of distances in normal and reverse direction is always 26. That's because it is nothing but one full rotation around the disc.

Making use of this fact, you can calculate the reverse distance and always pick the smaller distance to solve this challenge. Just don't make the mistakes I made like forgetting to chomp after reading input from the terminal or forgetting that the starting point is always from letter 'a'. But they're very easy to debug because perl is an interpreted language, you don't have to wait for long compile times between making your changes and testing the script.

#!/usr/bin/perl

use strict;

use warnings;

sub least_distance {

my ($char1, $char2) = @_;

my $distance = abs(ord($char1) - ord($char2));

if ($distance > 13) {

$distance = 26 - $distance;

}

return $distance;

}

print('Enter any string: ');

my $str = <STDIN>;

chomp($str);

$str = lc $str;

my @str_chars = split //, $str;

my $total_distance = length($str);

if (substr($str,0,1) ne 'a') {

unshift(@str_chars, 'a');

}

foreach my $i (0 .. $#str_chars - 1) {

my $step_distance = least_distance($str_chars[$i], $str_chars[$i+1]);

$total_distance += $step_distance;

}

print("Minimum distance: " . $total_distance . "\n");

One personal observation is that the second string "bza" that Anwar randomly used in this example is the railway station code for the place Vijayawada where I grew up in India. It used to be called Bezawada in the past, so the code stuck as bza.

In the second challenge, I'm using our good old friend "the perl hash" which does the deduplication work for us here.

I'm iterating through all the ball and box positions to create a hash which has the box as the first level key and ball colour as the second level key. Emphasis on the 'key' part for ball colur. I could have used an array as the second level datastructure and store the ball colours as elements of that array, but I would have to process the array by iterating through it again to check if all the colours are present in it or not. By using a hash, the duplicates are removed and I can check the count of unique keys (balls) per box directly. 

I trust Anwar that he did not mischievously add a random coloured ball just to mess around with people. If he did, I would have to check for the presence of all colours in each box instead of depending on the count of unique ball colours in each box. i.e instead of "scalar keys %{$count{$box}} == 3" I have to use "exists $count{$box}{R} and exists $count{$box}{G} and exists $count{$box}{B}" which is very cumbersome. Alternatively, I could use "all" from List::Util to shorten it to "all {exists $count{$box}{$_}} qw(R G B)". But I'll stick to the first option here.

#!/usr/bin/perl

use strict;

use warnings;

use List::Util qw(all);

print('Enter the balls and boxes string: ');

my $str = <STDIN>;

chomp($str);

my $i=0;

my @balls_boxes = split(//, $str);

my %count;

while($i <= $#balls_boxes) {

my $ball = $balls_boxes[$i];

my $box = $balls_boxes[$i+1];

$count{$box}{$ball} = 1;

$i += 2;

}

my $count = 0;

foreach my $box (keys %count) {

if (scalar keys %{$count{$box}} == 3) {

$count++;

}

}

print("Number of boxes containing all three colours: $count\n");

PS: I'm planning to use github pages going forward for these blogs. You can use markdown there.

Switch Case?

TWC-311

Life Bytes

Before going into the code let me just reflect on the last time I submitted my solution to PWC. That was in 2021. Around 3 years back. That was also the first time I did a submission. I was an avid perl developer at that time. Although I learnt C, python and java programming languages before learning perl, I have a special liking towards perl because of it's versatility, TIMTOWTDI, The three virtues by Larry Wall among other things. Now I have transitioned to a python developer because of reasons not relevant to this discussion but I am still passionate about perl which pulled me back to TWC. I just realised while writing this that PWC has now become TWC!

One interesting observation I had about the EZPWC tool which simplifies submitting these challenges to github is that it can be pronounced as "easy pveesy". Very similar to "easy peasy" i.e how it makes the submission process. I wonder if the creator(s) call it that way. I found that to be really cool. On the same wavelength of coolness is that the REPL(Read Evaluate Print Loop) for perl can be started by just running the "re.pl" command. How cool is that! Anyway, enough of my ramblings, let's get right into code.

Task 1: Upper Lower

Submitted by: Mohammad Sajid Anwar

---

You are given a string consists of english letters only.

Write a script to convert lower case to upper and upper case to lower in the given string.

Example 1

Input: $str = "pERl"
Output: "PerL"

Example 2

Input: $str = "rakU"
Output: "RAKu"

Example 3

Input: $str = "PyThOn"
Output: "pYtHoN"

Analysis

I first checked if perl has some subroutine to do this. Surprisingly there wasn't a ready to use helper function to do this in perl. So, I finally got the chance to use the tr operator in perl which I only used while learning perl but never after. Since the question explicitly states that the string consists of english letters only, such a simple solution is acceptable.

Code

print("Enter a nice string: "); my $s = <STDIN>; $s =~ tr/a-zA-Z/A-Za-z/; print("Switched Case version of the above string: " . $s);

Sample Output

$ ch-1.pl
Enter a nice string: Happy New Year
Switched Case version of the above string: hAPPY nEW yEAR
$ ch-1.pl
Enter a nice string: REALLY
Switched Case version of the above string: really
$ ch-1.pl
Enter a nice string: omg
Switched Case version of the above string: OMG

Bonus

• Since the code was small, I also wrote it as a perl one liner

• perl -e '$ARGV[0] =~ tr/a-zA-Z/A-Za-z/; print($ARGV[0]."\n")' $1

• Another sidenote is that python happens to have a function called swapcase to do exactly this.
• The title of this blog is based on this problem. What should be the name of a function which does this kind of functionality? Switch Case immediately came to my mind but the field of programming already has overloaded terms all around us. Another commonly used term being overloaded with a new meaning is the last thing we need right now. So, this can be called swapcase following the pythonic way.

Task 2: Group Digit Sum

Submitted by: Mohammad Sajid Anwar

---

You are given a string, $str, made up of digits, and an integer, $int, which is less than the length of the given string.

Write a script to divide the given string into consecutive groups of size $int (plus one for leftovers if any). Then sum the digits of each group, and concatenate all group sums to create a new string. If the length of the new string is less than or equal to the given integer then return the new string, otherwise continue the process.

Example 1

Input: $str = "111122333", $int = 3
Output: "359"

Step 1: "111", "122", "333" => "359"

Example 2

Input: $str = "1222312", $int = 2
Output: "76"

Step 1: "12", "22", "31", "2" => "3442"
Step 2: "34", "42" => "76"

Example 3

Input: $str = "100012121001", $int = 4
Output: "162"

Step 1: "1000", "1212", "1001" => "162"

Analysis

I initially misread the question and thought that the sum of the groups of substrings should be done. After a second reading of the challenge, I got to know exactly what is to be done.
There are many interesting parts to this challenge like breaking down a string into equal substrings of a constant length, splitting a string into characters etc. For breaking down a string into chunks, I made use of one other concept that I rarely got to use, the unpack function.
I never ignore the opportunity to use recursion if it makes sense. So here is the final solution combining all the above points.

Code

use strict;

use warnings; use List::Util qw(sum); sub reduce_string { my ($string, $number) = @_; my @strings; print "groups: "; foreach my $chunk (unpack("(A$number)*", $string)) { print "$chunk "; my $local_sum = sum split("", $chunk); push @strings, $local_sum; } print "\ngroups with their sums: @strings\n"; my $new_string = join("", @strings); if (length($new_string) > $number) { print "new string: ".$new_string."\n"; $new_string = reduce_string($new_string, $number); } return $new_string; } print "Enter a random number of random length: "; my $string = <STDIN>; print "Enter any number smaller than the number of digits in previous number: "; my $number = <STDIN>; print("Final reduced string: " . reduce_string($string, $number) . "\n");

Sample Output

$ ch-2.pl
Enter a random number of random length: 1234567
Enter any number smaller than the number of digits in previous number: 3
groups: 123 456 7 
groups with their sums: 6 15 7
new string: 6157
groups: 615 7 
groups with their sums: 12 7
Final reduced string: 127

Call for help

Please suggest me some platform for my next blog where markdown can be used for formatting. This will probably be my last blog on this platform which still uses only html. Extremely cumbersome and inconvenient. Happy coding to coders all around the world!

Divisibility, Sieves and Masks - PWC 141

Here is my first attempt at solving the tasks in Perl Weekly Challenge (Week 141)

TASK #1 › Number Divisors

Submitted by: Mohammad S Anwar

Write a script to find lowest 10 positive integers having exactly 8 divisors.

Analysis:

At the heart of this task lies the subtask of finding number of divisors to a given number. Based on the input, there is no pressing need to optimise the performance. So, here is the brute force approach:

The Code:

number_divisors_task(10, 8);

sub number_divisors_task {
	my ($number_count, $divisor_count) = @_;
	
	my @desired_numbers;
	my $i = $divisor_count;
	while (@desired_numbers < $number_count) {
		if (number_of_divisors($i) == $divisor_count) {
			push @desired_numbers, $i;
		}
		$i++;
	}
	print "Lowest 10 positive integers having exactly 8 divisors\n";
	print join("\n", @desired_numbers);
}

sub number_of_divisors {
	my ($num) = @_;
	my $count = 0;
	foreach my $divisor (1 .. $num) {
		if ($num % $divisor == 0) {
			$count++;
		}
	}
	return $count;
}

Output:

$ perl pwc_141_1.pl
Lowest 10 positive integers having exactly 8 divisors
24	30	40	42	54	56	66	70	78	88

Optimisation:

The brute force method works in this scenario because we only need to find the first 10 numbers, but the time taken increases very rapidly when the first 100 numbers or first 1000 such numbers need to be found. That's because the above method has O(n^2) complexity.

Optimisation can be done by improving the number_of_divisors function. It can be modified to find the prime factors and number of divisors can be derived from that using the simple mathematical formula:

Suppose a number can be written as N = p1^c1 * p2^c2 * ... * pn^cn 

where p1, p2 etc are prime numbers then the total number of divisors = (c1 + 1) * (c2 + 1) * ... * (cn + 1)

But how to find the list of prime numbers less than a given number? Based on the definition, a number is prime if the total number of its divisors is equal to 2. So, here we are faced with a classic chicken egg problem. To find out divisors you need to know primes and to find out the primes, you need to know its divisors. Fortunately, there exists a more efficient way to find out all prime numbers less than a given number. Drumroll!!! "The Sieve of Eratosthenes".

This is how it works: Starting from the smallest prime, for each prime number, all it's multiples are filtered out except that number itself. The next smallest number remaining is prime and all its multiples are filtered out. This process is continued and all composite numbers are filtered out from the set one by one.

sub number_of_divisors {
	my ($num) = @_;
	
	# Find all primes below $num using Sieve of Eratosthenes
	# $primes is an arrayref with 1 at prime indices and 0 at composite indices
	my $primes = find_primes($num);
	my $count = 1;
	foreach my $prime (2 .. $num) {
		if ($primes->[$prime]) {
			if ($num % $prime == 0){
				$power = 0;		
				while ($num % $prime == 0) {
					$num = $num / $prime;
					$power++;
				}
				
				$count *= ($power+1);
			}			
		}
	}
	return $count;
}

sub find_primes {
	my ($num) = @_;
	
	my @primes = (1) x ($num+1);

	my $p = 2;
	while ($p * $p < $num) {
		if ($primes[$p]) {
			$i=2;
			while ($p * $i < $num) {
				$primes[$p * $i] = 0;
				$i++;
			}
		}
		$p++;
	}
	return \@primes;
}

TASK #2 › Like Numbers

Submitted by: Mohammad S Anwar

You are given positive integers, $m and $n.

Write a script to find total count of integers created using the digits of $m which is also divisible by $n.

Repeating of digits are not allowed. Order/Sequence of digits can’t be altered. You are only allowed to use (n-1) digits at the most. For example, 432 is not acceptable integer created using the digits of 1234. Also for 1234, you can only have integers having no more than three digits.

Analysis:

Breaking down the problem into two parts, we have:

• find the possible ministrings of $m satisfying the given conditions
• find how many of those are divisible by $n

The second part is trivial but the first part involves a bit of logic as discussed below.

The sequence of the digits should not be changed and repititions are not allowed, so the desired set of ministrings consists of 

• ministrings of length 1 (1, 2, 3, 4 in given example)
• ministrings of length 2 (12, 23, 34, 13, 14, 24 ) and so on....

The total number of such combinations can be proved to be 2^n where n is the number of digits. It also consists of ministring of length 0 (empty string '') and length n (the full string '1234') which we would like to ignore in our task.

Each one of these ministrings has a one to one correspondence with a binary code. Example the ministrings of length 1 (1, 2, 3, 4) correspond to binary codes 1000, 0100, 0010, 0001. So, the task boils down to finding the list of binary codes and using them as masks to derive the ministrings from the original number.

Solution:

$m = 1234;
$n = 2;
likenumbers_divisible($m, $n);

sub likenumbers_divisible {
	my ($m, $n) = @_;

	my $length = length($m);
	my @likenumbers;
	my $divisible_count = 0;
	# Get all binary masks of length $length excluding all zeroes and all ones.
	foreach my $i (1 .. (2 ** $length)-2) {
		my $mask = sprintf("%.${length}b", $i);
		my $ministring = '';
		#perform the masking operation to generate 23 from 1234 if mask is 0110.
		foreach my $i (0 .. $length-1) {
			$ministring .= substr($m, $i, 1) if substr($mask, $i, 1);
		}
		if ($ministring % $n == 0) {
			$divisible_count++;
		}
	}
	print "divisible_count: [$divisible_count]\n";
}

Output:

$ perl pwc_141_2.pl
divisible_count: [9]

Happy Coding everyone!

Being Random

We humans are interested in many things. We like to make generalisations of what we observe. Later we frame hypotheses and come up with theories. We go on to conclude that things happen the way they happen because of a reason and that's how they always happen.

At the other extreme, we are also fascinated by things that we can't systematically generalise. Those are the things that happen at random. Simply put, something is random if it can't be predicted. It is funny that many things that we really care about in our lives are random: occurrence of rain, the gender of a baby to be born, prices of shares in the share market, choosing the winner of a lottery  prize(if it is done honestly of course) etc.

Sometimes these random events bring sorrow to us. That grief increases because of the fact that we can't control them. But when they bring us good news, then our joy knows no bounds. A good thing happening is one thing whereas the same thing happening when it is least expected is totally another.

But one thing is true. Life will be very bland without this randomness. Just imagining that everything is systematic and can be predicted before it happens is very boring. In fact, life is all about uncertainty. We wake up everyday without knowledge of what life has in store for us for that day. We experience a thrill in exploring the unknown. We enjoy listening songs in shuffle mode. We watch anxiously to see which team wins the toss before a cricket match. All this is the beauty of randomness.

So when life gets boring, try something out of the ordinary, be unpredictable everyday. Surprise everyone. Join the madness, join me in... being random.