PERL WEEKLY CHALLENGE – 038

This is my eight week participating into the weekly challenge.


Easy Challenge

Date Finder
Create a script to accept a 7 digits number, where the first number can only be 1 or 2. The second and third digits can be anything 0-9. The fourth and fifth digits corresponds to the month i.e. 01,02,03…,11,12. And the last 2 digits respresents the days in the month i.e. 01,02,03….29,30,31. Your script should validate if the given number is valid as per the rule and then convert into human readable format date.


RULES
1) If 1st digit is 1, then prepend 20 otherwise 19 to the 2nd and 3rd digits to make it 4-digits year.

2) The 4th and 5th digits together should be a valid month.

3) The 6th and 7th digits together should be a valid day for the above month.


In perl 5, I used checked the formatting of the date using regex and I checked the validity of the date using use Date::Manip to make sure dates like 2230231 don’t sneak by (Feb 31, 1923).

In Raku, I used the same Regex to check the date format and used the Date object to check if the date is valid, catching the exception if the date is invalid but correctly passes the format regex like (2230231)

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl 2230120
use strict;
use warnings;
use feature qw /say/;
use Date::Manip;

say parse_date($ARGV[0]);

sub parse_date {
	my $date = shift;

	# Regex to test date format
	return "Invalid date format"
		unless $date && $date =~ /
			^                     # start string
			([12])                # 1 or 2
			(\d\d)                # year 00-99
			(0[1-9]|1[0-2])       # month 1-12
			(0[1-9]|[12]\d|3[01]) # day 1-31
			$                     # end string
		/x;

	# The date string
	my $date_string =
		( ($1 == 1) ? '20' . $2  : '19' . $2 )
		. '-' . $3 . '-' . $4;

	# Make sure the date is valid
	# even if it passed the format check
	# using Date::Manip
	return "Invalid date"
		unless (ParseDate($date_string));

	return $date_string;
}

Output

1923-01-20

Raku solution

# Test: perl6 ch1.p6 2230120
use v6.d;

sub MAIN(Int $date) {
	say parse-date($date);
}

sub parse-date(Int $date) {
	# Regex to test date format
	return "Invalid date format"
		unless ($date ~~ /
			^^            # Start of string
			(<[12]>)      # 1 or 2
			(\d\d)        # year 00-99
			(0<[1..9]> || # month 1-12
			 1<[0..2]>)
			(0<[1..9]> || # day 1-31
			 <[1..2]>\d||
			 3<[01]>)
			$$            # End of string
		/);

	# The date string
	my $date_string =
		( ($0 == 1) ?? '20' ~ $1  !! '19' ~ $1 )
		~ '-' ~ $2 ~ '-' ~ $3;

	# Make sure the date is valid
	# even if it passed the format check
	try {
		my $date_check = Date.new($date_string);

		CATCH {
			return "Invalid date";
		}
	}

	return $date_string;
}

Output

1923-01-20

Hard Challenge

Word Game
Lets assume we have tiles as listed below, with an alphabet (A..Z) printed on them. Each tile has a value, e.g. A (1 point), B (4 points) etc. You are allowed to draw 7 tiles from the lot randomly. Then try to form a word using the 7 tiles with maximum points altogether. You don’t have to use all the 7 tiles to make a word. You should try to use as many tiles as possible to get the maximum points.


For example, A (x8) means there are 8 tiles with letter A.

1 point
A (x8), G (x3), I (x5), S (x7), U (x5), X (x2), Z (x5)

2 points
E (x9), J (x3), L (x3), R (x3), V (x3), Y (x5)

3 points
F (x3), D (x3), P (x5), W (x5)

4 points
B (x5), N (x4)

5 points
T (x5), O (x3), H (x3), M (x4), C (x4)

10 points
K (x2), Q (x2)


This was quite an interesting and fun challenge.

First I needed to generate a list of valid words. Most flavours of unix have a dictionary file and mine was located at /usr/share/dict/words. I loaded this file and stored it into a global hash called %valid_words.

To generate the tilesets, I create a shuffled list of indexes in perl 5 and retrieved the first x tiles from them. Raku had a convenient method called pick which allows you to pick x items from the array.

To generate the combinations, In the perl5 solution I used Algorithm::Combinatorics to generate the different permutations of the 7 tiles using the variations method. For Raku I used used the combination and permutation methods of the Array Class to generate all the possible permutations from 1 to 7 tiles.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch2.pl
use strict;
use warnings;
use feature qw /say/;
use Algorithm::Combinatorics qw(variations);
use List::Util qw(shuffle);

# Store valid words
our %valid_words;

# Tiles metadata
our %tiles_metadata =  (
	A => { points => 1,  amount => 8 },
	B => { points => 4,  amount => 5 },
	C => { points => 5,  amount => 4 },
	D => { points => 3,  amount => 3 },
	E => { points => 2,  amount => 9 },
	F => { points => 3,  amount => 3 },
	G => { points => 1,  amount => 3 },
	H => { points => 5,  amount => 3 },
	I => { points => 1,  amount => 5 },
	J => { points => 2,  amount => 3 },
	K => { points => 10, amount => 2 },
	L => { points => 2,  amount => 3 },
	M => { points => 5,  amount => 4 },
	N => { points => 4,  amount => 4 },
	O => { points => 5,  amount => 3 },
	P => { points => 3,  amount => 5 },
	Q => { points => 10, amount => 2 },
	R => { points => 2,  amount => 3 },
	S => { points => 1,  amount => 7 },
	T => { points => 5,  amount => 5 },
	U => { points => 1, amount  => 5 },
	V => { points => 2,  amount => 3 },
	W => { points => 3,  amount => 5 },
	X => { points => 1,  amount => 2 },
	Y => { points => 2,  amount => 5 },
	Z => { points => 1,  amount => 5 },
);

# Load the dictionary
load_words('/usr/share/dict/words');

# Grab 7 times
my @tiles = get_tiles(7);
say 'Picked tiles: ' . join ', ', @tiles;

# Find the word with the most points
my ($word, $score) = find_best_word(\@tiles);
say 'Best word: ' . $word .
    ' with score: ' . $score;

# Load the dictionary into memory
sub load_words {
	my $filename = shift;

	open(my $fh, '<:encoding(UTF-8)', $filename) || die "$@";
	while (my $row = <$fh>) {
		chomp $row;
		$valid_words{uc($row)} = 1;
	}
}

# Get tiles
sub get_tiles {
	my $no_tiles = shift;

	# Generate the set of tiles
	my @tileset;
	for my $key (keys %tiles_metadata) {
		for my $i (1 .. $tiles_metadata{$key}->{amount}) {
			push @tileset, $key;
		}
	}

	# Get Seven tiles
	my @shuffled_indexes = shuffle(0..$#tileset);
	my @my_tiles =
		@tileset[
			@shuffled_indexes[ 0 .. $no_tiles -1 ]
		];
	return @my_tiles;
}

# Find the best word
sub find_best_word {
	my $tiles_ref = shift;
	my $top_score = 0;
	my $top_word;

	# Generate the possible combinations
	for my $i (1..7) {
		my $iter = variations($tiles_ref,$i);

		# Loop through each variation
		while (my $v = $iter->next) {
			my $word = join '', @{$v};
			if ($valid_words{$word}) {
				my $score = calculate_score($v);

				# If this is the best word store it
				if ($score > $top_score) {
					$top_score = $score;
					$top_word  = $word;
				}
			}
		}
	}

	return $top_word, $top_score;
}

# Calculate score
sub calculate_score {
	my $word_ref = shift;
	my $score = 0;

	for my $letter (@${word_ref}) {
		$score += $tiles_metadata{$letter}->{points};
	}

	return $score;
}

Output

Picked tiles: S, V, A, O, Q, S, F
Best word: FOSSA with score: 11

Raku solution

# Test: perl6 ch2.p6
use v6.d;

# Store valid words
our %valid_words;

# Tiles metadata
our %tiles_metadata =  (
	A => { points => 1,  amount => 8 },
	B => { points => 4,  amount => 5 },
	C => { points => 5,  amount => 4 },
	D => { points => 3,  amount => 3 },
	E => { points => 2,  amount => 9 },
	F => { points => 3,  amount => 3 },
	G => { points => 1,  amount => 3 },
	H => { points => 5,  amount => 3 },
	I => { points => 1,  amount => 5 },
	J => { points => 2,  amount => 3 },
	K => { points => 10, amount => 2 },
	L => { points => 2,  amount => 3 },
	M => { points => 5,  amount => 4 },
	N => { points => 4,  amount => 4 },
	O => { points => 5,  amount => 3 },
	P => { points => 3,  amount => 5 },
	Q => { points => 10, amount => 2 },
	R => { points => 2,  amount => 3 },
	S => { points => 1,  amount => 7 },
	T => { points => 5,  amount => 5 },
	U => { points => 1, amount  => 5 },
	V => { points => 2,  amount => 3 },
	W => { points => 3,  amount => 5 },
	X => { points => 1,  amount => 2 },
	Y => { points => 2,  amount => 5 },
	Z => { points => 1,  amount => 5 },
);

# Box configurations
sub MAIN () {
	# Load the dictionary
	load-words('/usr/share/dict/words');

	# Grab 7 tiles
	my @tiles = get-tiles(7);
	say 'Picked tiles: ' ~ @tiles;

	# Find the word with the most points
	my ($word, $score) = find-best-word(@tiles);
	say 'Best word: ' ~ $word ~
	    ' with score: ' ~ $score;
}

# Find the best word
sub find-best-word(@tiles) {
	my $top_score = 0;
	my $top_word;

	my @combos = @tiles.combinations: 1..7;
	for @combos -> $combo {
		for $combo.permutations -> $perms {
			my $word = $perms.join;

			if %valid_words.{$word} {
				my $score = calculate-score($word);

				# If this is the best word store it
				if ($score > $top_score) {
					$top_score = $score;
					$top_word  = $word;
				}
			}
		};
	}

	return $top_word, $top_score;
}

# Calculate score
sub calculate-score(Str $word) {
	my $score = 0;

	for $word.comb -> $letter {
		$score += %tiles_metadata.{$letter}.{'points'};
	}

	return $score;
}

# Get tiles
sub get-tiles(Int $number_of_tiles) {
	my @tileset;

	# Generate the set of tiles
	for %tiles_metadata.keys() -> $key {
		for 1 .. %tiles_metadata.{$key}.{"amount"} -> $i {
			@tileset.push($key);
		}
	}

	return @tileset.pick($number_of_tiles)
}

# Load the dictionary into memory
sub load-words(Str $filename) {
	for $filename.IO.lines -> $line {
		%valid_words{$line.uc} = 1;
	}
}

Output

Picked tiles: M W A H C R Q
Best word: MARCH with score: 18

One thought on “PERL WEEKLY CHALLENGE – 038

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