PERL WEEKLY CHALLENGE – 035

This is my fifth week participating into the weekly challenge.


Easy Challenge

“Write a program to encode text into binary encoded morse code.”

Pay attention to any changes which might need to be made to the text to make it valid morse code.

Morse code consists of dots, dashes and gaps. It can be encoded in binary in the following fashion:

dot: 1
dash: 111
intra-character gap: 0
character gap: 000
word gap: 0000000


An intra-character gap is inserted between the dots and dashes in a character.

Looking for an ASCII to morse code converter was a bit difficult so I pieced together what I could find online and hopefully it’s correct. I didn’t bother to include international characters but I did add punctuations and numbers.

For both Perl5 and Raku I did a simple lookup table. Another way I could have done this is modeling it with a binary tree, but who has the time for that. 🙂

I generated the raku lookup table from the modified perl 5 solution.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl 'string to test'
use strict;
use warnings;
use feature qw /say/;

say encode(join ' ', @ARGV);

sub encode {
	my $test_string = shift;
	my $converted_string = '';

	# Some definitions
	my $dot      = '1';
	my $dash     = '1' x 3;
	my $gap      = '0';
	my $char_gap = '0' x 3;
	my $word_gap = '0' x 7;

	# For my sanity I just copied and paste real morse code
	# This could be cleaner
	my %morse = qw(
		A .-     B -...   C -.-.  D -..   E .    F ..-.
		G --.    H ....   I ..    J .---  K -.-   L .-..
		M --     N -.     O ---   P .--.  Q --.-  R .-.
		S ...    T -      U ..-   V ...-  W .--
		X -..-   Y -.--   Z --..
		0 -----  1 .----  2 ..--- 3 ...-- 4 ....-
		5 .....  6 -....  7 --... 8 ---.. 9 ----.
		. .-.-.- / -...-  : ---... ' .----.
		- -....- ? ..--.. ! ..--. @ ...-.- + .-.-.
	);

	# Stop perl from spitting out a warning
	# about a comma in qw
	$morse{','} = '--..--';

	# Convert the dot and dashes to the required 0 and 1's
	for my $key (sort keys %morse) {
		my $code = $morse{$key};
		$code =~ s/\.$/$dot/;      # trailing $dot
		$code =~ s/\-$/$dash/;     # trailing $dash
		$code =~ s/\./$dot$gap/g;  # all other dots
		$code =~ s/\-/$dash$gap/g; # all other dashes
		$morse{$key} = $code;
	}

	# Split words
	my @words = split('\s+', $test_string);
	for my $i (0 .. $#words) {

		# Split characters
		my @chars = split('', $words[$i]);
		for my $j (0 .. $#chars) {
			# Translate the character
			$converted_string .= $morse{uc($chars[$j])};

			# Add the character gap
			$converted_string .= $char_gap
				unless ($j == $#chars);
		}

		# Add the word gap
		$converted_string .= $word_gap
			unless ($i == $#words);
	}

	return $converted_string;
}

Test: 0123456789 The quick brown fox jumps over the lazy dog ,-?!@./+

Output

111011101110111011100010111011101110111000101011101110111000101010111011100010101010111000101010101000111010101010001110111010101000111011101110101000111011101110111010000000111000101010100010000000111011101011100010101110001010001110101110100011101011100000001110101010001011101000111011101110001011101110001110100000001010111010001110111011100011101010111000000010111011101110001010111000111011100010111011101000101010000000111011101110001010101110001000101110100000001110001010101000100000001011101010001011100011101110101000111010111011100000001110101000111011101110001110111010000000111011101010111011100011101010101011100010101110111010100010101110111010001010101110101110001011101011101011100011101010101110001011101011101

Raku solution

# Test: perl6 ch2.p6 'string to test'
use v6.d;

sub MAIN (Str $message) {
	say encode($message);
}

sub encode (Str $message) {
	my $encoded_message = '';

	# Some definitions
	my $char_gap = '0' x 3;
	my $word_gap = '0' x 7;

	# I generated this lookup table using a modified perl5 script
	my %morse = (
	'!' => '1010111011101',     "'" => '1011101110111011101',
	'+' => '1011101011101',     ',' => '1110111010101110111',
	'-' => '111010101010111',   '.' => '10111010111010111',
	'/' => '1110101010111',     '0' => '1110111011101110111',
	'1' => '10111011101110111', '2' => '101011101110111',
	'3' => '1010101110111',     '4' => '10101010111',
	'5' => '101010101',         '6' => '11101010101',
	'7' => '1110111010101',     '8' => '111011101110101',
	'9' => '11101110111011101', ':' => '11101110111010101',
	'?' => '101011101110101',   '@' => '101010111010111',
	'A' => '10111',             'B' => '111010101',
	'C' => '11101011101',       'D' => '1110101',
	'E' => '1',                 'F' => '101011101',
	'G' => '111011101',         'H' => '1010101',
	'I' => '101',               'J' => '1011101110111',
	'K' => '111010111',         'L' => '101110101',
	'M' => '1110111',           'N' => '11101',
	'O' => '11101110111',       'P' => '10111011101',
	'Q' => '1110111010111',     'R' => '1011101',
	'S' => '10101',             'T' => '111',
	'U' => '1010111',           'V' => '101010111',
	'W' => '101110111',         'X' => '11101010111',
	'Y' => '1110101110111',     'Z' => '11101110101',
	);

	# Split words
	 my @words = $message.split(rx{\s+});
	for (0 .. @words.end) -> $i {
		# Split characters
		my @chars = @words[$i].comb;

		for (0 .. @chars.end) -> $j {
			# Translate the character
			$encoded_message ~= %morse{@chars[$j].uc};

			# Add the character gap
			$encoded_message ~= $char_gap
				unless ($j == @chars.end);
		}

		# Add the word gap
		$encoded_message ~= $word_gap
			unless ($i == (@words.end));
	}

	return $encoded_message;
}

Test: 0123456789 The quick brown fox jumps over the lazy dog ,-?!@./+

Output

111011101110111011100010111011101110111000101011101110111000101010111011100010101010111000101010101000111010101010001110111010101000111011101110101000111011101110111010000000111000101010100010000000111011101011100010101110001010001110101110100011101011100000001110101010001011101000111011101110001011101110001110100000001010111010001110111011100011101010111000000010111011101110001010111000111011100010111011101000101010000000111011101110001010101110001000101110100000001110001010101000100000001011101010001011100011101110101000111010111011100000001110101000111011101110001110111010000000111011101010111011100011101010101011100010101110111010100010101110111010001010101110101110001011101011101011100011101010101110001011101011101

Hard Challenge

“Write a program to decode binary morse code.”

Consider how it might be possible to recover from badly formed morse code.

a) by splitting the morse code on gaps
b) without looking further than one digit ahead

This was basically the same as encoding the morse code. I created a reverse lookup table. In the perl 5 solution I simulated some errors. I didn’t bother with this in Raku, but I did talk about error correction in a paragraph below.

Easiest way to test this is to create some morse code from ch1.pl and pipe it to ch2.pl

./ch1.pl ‘string to test’ | ./ch2.pl

and

perl6 ch1.p6 ‘string to test’ | perl6 ch2.p6

You might notice a simulate error subroutine which will be explained in the error correction.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl 'string to test' | ./ch2.pl
use strict;
use warnings;
use feature qw /say/;

say decode(<STDIN>);

sub decode {
	my $encoded_string = shift;
	my $converted_string = '';
	chomp $encoded_string;

	# Do some error correction
	if (scalar(@ARGV)) {
		$encoded_string =
			simulate_error($encoded_string, $ARGV[0]);
		$encoded_string =
			error_correction($encoded_string);
	}

	# Some definitions
	my $char_gap = '0' x 3;
	my $word_gap = '0' x 7;

	# I generated this lookup table using a modified perl5 script
	my %morse = (
	'1010111011101'     => '!', '1011101110111011101' => "'",
	'1011101011101'     => '+', '1110111010101110111' => ',',
	'111010101010111'   => '-', '10111010111010111'   => '.',
	'1110101010111'     => '/', '1110111011101110111' => '0',
	'10111011101110111' => '1', '101011101110111'     => '2',
	'1010101110111'     => '3', '10101010111'         => '4',
	'101010101'         => '5', '11101010101'         => '6',
	'1110111010101'     => '7', '111011101110101'     => '8',
	'11101110111011101' => '9', '11101110111010101'   => ':',
	'101011101110101'   => '?', '101010111010111'     => '@',
	'10111'             => 'A', '111010101'           => 'B',
	'11101011101'       => 'C', '1110101'             => 'D',
	'1'                 => 'E', '101011101'           => 'F',
	'111011101'         => 'G', '1010101'             => 'H',
	'101'               => 'I', '1011101110111'       => 'J',
	'111010111'         => 'K', '101110101'           => 'L',
	'1110111'           => 'M', '11101'               => 'N',
	'11101110111'       => 'O', '10111011101'         => 'P',
	'1110111010111'     => 'Q', '1011101'             => 'R',
	'10101'             => 'S', '111'                 => 'T',
	'1010111'           => 'U', '101010111'           => 'V',
	'101110111'         => 'W', '11101010111'         => 'X',
	'1110101110111'     => 'Y', '11101110101'         => 'Z',
	);

	# Split words
	my @words = split($word_gap, $encoded_string);
	for my $i (0 .. $#words) {

		# Split characters
		my @chars = split($char_gap, $words[$i]);
		for my $j (0 .. $#chars) {
			# Translate the character
			$converted_string .= $morse{$chars[$j]}
				if (defined($morse{$chars[$j]}));
		}

		# Add the word gap
		$converted_string .= ' '
			unless ($i == $#words);
	}

	return $converted_string;
}

sub simulate_error {
	my $mutated_string = shift;
	my $mutations = shift;

	for my $i (0..$mutations) {
		my @zero_locations = ();

		# locate all the 0's
		my @chars = split ('', $mutated_string);
		for my $i (0 .. $#chars) {
			push @zero_locations, $i
				if ($chars[$i] == 0);
		}

		# remove a random 0;
		my $random_position = int(rand($#zero_locations));
		substr $mutated_string,
		       $zero_locations[$random_position], 1, '';
	}

	return $mutated_string;
}


sub error_correction {
	my $corrected_string = shift;

	# missed char sep between two shorts
	$corrected_string =~ s/^110/^1010/g;

	 # missed char sep between two longs
	$corrected_string =~ s/111111/1110111/g;

	# missed char sep between two shorts
	$corrected_string =~ s/0110/01010/g;

	# missed word separator
	$corrected_string =~ s/10{4,6}1/100000001/g;

	# missed char separator
	$corrected_string =~ s/1001/10001/g;

	# missed on short and long
	$corrected_string =~ s/1111/10111/g;

	return $corrected_string;
}

Test: 0123456789 The quick brown fox jumps over the lazy dog ,-?!@./+

111011101110111011100010111011101110111000101011101110111000101010111011100010101010111000101010101000111010101010001110111010101000111011101110101000111011101110111010000000111000101010100010000000111011101011100010101110001010001110101110100011101011100000001110101010001011101000111011101110001011101110001110100000001010111010001110111011100011101010111000000010111011101110001010111000111011100010111011101000101010000000111011101110001010101110001000101110100000001110001010101000100000001011101010001011100011101110101000111010111011100000001110101000111011101110001110111010000000111011101010111011100011101010101011100010101110111010100010101110111010001010101110101110001011101011101011100011101010101110001011101011101

Output

0123456789 THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG ,-?!@./+

Raku solution

# Test: perl6 ch1.p6 'string to test' | perl6 ch2.p6
use v6.d;

sub MAIN () {
	for $*IN.lines() -> $line {
		say decode($line);
	}
}

sub decode (Str $message) {
	my $decoded_message = '';

	# Some definitions
	my $char_gap = '0' x 3;
	my $word_gap = '0' x 7;

	# I generated this lookup table using a modified perl5 script
	my %morse = (
	'1010111011101'     => '!', '1011101110111011101' => "'",
	'1011101011101'     => '+', '1110111010101110111' => ',',
	'111010101010111'   => '-', '10111010111010111'   => '.',
	'1110101010111'     => '/', '1110111011101110111' => '0',
	'10111011101110111' => '1', '101011101110111'     => '2',
	'1010101110111'     => '3', '10101010111'         => '4',
	'101010101'         => '5', '11101010101'         => '6',
	'1110111010101'     => '7', '111011101110101'     => '8',
	'11101110111011101' => '9', '11101110111010101'   => ':',
	'101011101110101'   => '?', '101010111010111'     => '@',
	'10111'             => 'A', '111010101'           => 'B',
	'11101011101'       => 'C', '1110101'             => 'D',
	'1'                 => 'E', '101011101'           => 'F',
	'111011101'         => 'G', '1010101'             => 'H',
	'101'               => 'I', '1011101110111'       => 'J',
	'111010111'         => 'K', '101110101'           => 'L',
	'1110111'           => 'M', '11101'               => 'N',
	'11101110111'       => 'O', '10111011101'         => 'P',
	'1110111010111'     => 'Q', '1011101'             => 'R',
	'10101'             => 'S', '111'                 => 'T',
	'1010111'           => 'U', '101010111'           => 'V',
	'101110111'         => 'W', '11101010111'         => 'X',
	'1110101110111'     => 'Y', '11101110101'         => 'Z',
	);

	# Split words
	 my @words = $message.split($word_gap);
	for (0 .. @words - 1) -> $i {
		# Split characters
		my @chars = @words[$i].split($char_gap);

		for (0 .. @chars - 1) -> $j {
			# Translate the character
			$decoded_message ~= %morse{@chars[$j]};
		}

		# Add the word gap
		$decoded_message ~= ' '
			unless ($i == (@words - 1));
	}

	return $decoded_message;
}

Test: 0123456789 The quick brown fox jumps over the lazy dog ,-?!@./+

111011101110111011100010111011101110111000101011101110111000101010111011100010101010111000101010101000111010101010001110111010101000111011101110101000111011101110111010000000111000101010100010000000111011101011100010101110001010001110101110100011101011100000001110101010001011101000111011101110001011101110001110100000001010111010001110111011100011101010111000000010111011101110001010111000111011100010111011101000101010000000111011101110001010101110001000101110100000001110001010101000100000001011101010001011100011101110101000111010111011100000001110101000111011101110001110111010000000111011101010111011100011101010101011100010101110111010100010101110111010001010101110101110001011101011101011100011101010101110001011101011101

Output

0123456789 THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG ,-?!@./+

Error Correction

The second part of the difficult task involved how to implement some error correction to the encoded morse code string.

I can think of a few ways to do this, but don’t really have the time or energy to implement it. I implemented some simple error correction in the perl 5 implementation and it could be simulated by passing a number argument to ./ch2.pl

for example run:
/ch1.pl ‘0123456789 The quick brown fox jumps over the lazy dog ,-?!@./+’ | ./ch2.pl 5

What this does is simulates a few skipped low inputs (basically remove a 5 zeroes in this case) and tries to fix it with the error_correction subroutine. This is error correction at its most basic. I don’t account mutations like turning 0’s to 1’s and vice versa or removing high signals.

Also another way is the model the morse code with a binary tree and do some kind of predictive algorithm with whatever language you’re sending the morse code in. The problem is there is quite a lot of entropy when you model morse code in a binary fashion.

I’m sure there are more ways to handle error correction and I look forward to reading the solution

Morse_code_tree3

One thought on “PERL WEEKLY CHALLENGE – 035

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