Perl Weekly Challenge: Weeks 27-28
I've missed the deadline for the Perl Weekly Challenge a couple of times before but never as much as this. You see I went to India to scatter my late fathers' ashes in the river Ganga as per Hindu custom. I didn't take my laptop with me but I had an IPad with which I hoped to SSH into my server to do work (including the challenge.) Unfortunately the wifi at the place I was staying was completely unusable. While being off devices for a while was no doubt good for me spiritually, it meant I had a ton of work to deal with when I got back. Happily, I am all caught up now so here is a double-sized post covering weeks 27 and 28.
Week 27 Challenge 1:
Write a script to find the intersection of two straight lines. The co-ordinates of the two lines should be provided as command line parameter. For example:
The two ends of Line 1 are represented as co-ordinates (a,b) and (c,d).
The two ends of Line 2 are represented as co-ordinates (p,q) and (r,s).
The script should print the co-ordinates of point of intersection of the above two lines.
This required just a translation of an intricate but otherwise straightforward math formula so not much needs to be said. This is Perl5:
sub intersection {
my ($a, $b, $c, $d, $p, $q, $r, $s) = @_;
my $denominator = ((($c - $a) * ($s - $q)) - (($r - $p) * ($d - $b)));
if ($denominator == 0) {
say 'Lines do not intersect or intersect at multiple points.';
return;
}
my $x = ((($c * $b) - ($a * $d)) * ($r - $p)) -
((($r * $q) - ($p * $s)) * ($c - $a)) /
$denominator;
my $y = ((($c * $b) - ($a * $d)) * ($s - $q)) -
((($r * $q) - ($p * $s)) * ($d - $b)) /
$denominator;
say "($x,$y)";
}
if (scalar @ARGV != 8) {
say 'specify four points as integers: x1 y1 x2 y2 x3 y3 x4 y4';
} else {
intersection(@ARGV);
}
...and this is Perl6:
sub MAIN($x1, $y1, $x2, $y2, $x3, $y3, $x4, $y4) {
my $denominator = ((($x2 - $x1) * ($y4 - $y3)) - (($x4 - $x3) * ($y2 - $y1);
if ($denominator == 0) {
say 'Lines do not intersect or intersect at multiple points.';
return;
}
my $x = ((($x2 * $y1) - ($x1 * $y2)) * ($x4 - $x3)) -
((($x4 * $y3) - ($x3 * $y4)) * ($x2 - $x1)) /
$denominator;
my $y = ((($x2 * $y1) - ($x1 * $y2)) * ($y4 - $y3)) -
((($x4 * $y3) - ($x3 * $y4)) * ($y2 - $y1)) /
$denominator;
say "($x,$y)";
}
When doing this one, I decided to use x and y rather than a..d and p..s. It makes it a litter easier to understand in Perl6's autogenerated help text.
Week 27 Challenge 2:
Write a script that allows you to capture/display historical data. It could be an object or a scalar. For example
my $x = 10; $x = 20; $x -= 5;
After the above operations, it should list $x historical value in order.
This specification is a little bit vague. I interpreted it to mean the script should log the changes to the value of $x. I hope I understood properly.
Way back in the recesses of my mind I recalled that in Perl5 you can "tie" a variable enabling actions to be performed at different points in its' lifecyle. I don't think I've ever had to do this in real life but it seems like it could fit the bill for this problem. Here's what I came up with chiefly following the example in the perltie perldoc.
package Historical {
use Tie::Scalar;
use parent -norequire => 'Tie::StdScalar';
our @history;
sub TIESCALAR {
my ($class, $value) = @_;
push @history, "Storing <$value> (was [])";
return bless \$value, $class;
}
sub STORE {
my ($self, $value) = @_;
push @history, "Storing <$value> (was [$$self])";
$$self = $value;
}
}
package main {
tie my $x, 'Historical', 10;
$x = 20;
$x -= 5;
say join "\n", @Historical::history;
}
Ties do not exist in Perl6; instead you have to implement a Proxy object. For once, this seems less flexible than the Perl5 solution. At least I would have expected Proxy to be a role. That way I could have composed it into a historical class and properly encapsulated @history.
my @history;
sub historical($value) is rw {
my $storage = $value;
@history.push("Storing <$value> (was [])");
Proxy.new(
FETCH => method () {
return $storage;
},
STORE => method ($new) {
@history.push("Storing <$new> (was [$storage])");
$storage = $new;
},
)
}
my $x := historical(10);
$x = 20;
$x -= 5;
@history.join("\n").say;
Week 28 Challenge 1:
Write a script to check the file content without explicitly reading the content. It should accept file name with path as command line argument and print "The file content is binary." or else "The file content is ascii." accordingly.
In Perl5 we can do this as a one-liner as it has -B and -T file test operators to do this very task.
perl -E 'say "The file content is ", (-B shift) ? "binary." : "text."'
Well, -T won't exactly tell you if a file is ASCII. It tests for valid UTF-8 the most common Unicode encoding as it should because it is a big world out there with a huge variety of languages and simple ASCII doesn't cut it anymore. It should be a point of pride that Perl has the best Unicode support of any major programming language.
For the second time in this post, Perl5 is more featureful than Perl6. The latter doesn't have -B and -T. So I had to make make my own equivalent of -T. What I did was to read the file (upto a 64k block.) and attempt to convert it to UTF-8. If that failed it would be likely that the file is binary. This is not 100% foolproof, the file could be text in some weird pre-Unicode Windows character encoding for instance. Still this ought to be good enough for most text files one is likely to encounter nowadays.
sub isText(IO::Path $file) {
my Buf $firstBlock;
given $file.open {
$firstBlock = .read;
.close;
}
try {
$firstBlock.decode('utf-8');
CATCH {
return False;
}
}
return True;
}
sub MAIN( Str $arg) {
say 'The file content is ', isText($arg.IO) ?? 'text.' !! 'binary.';
}
Week 28 Challenge 2:
Write a script to display Digital Clock. Feel free to be as creative as you can when displaying digits. We expect bare minimum something like "14:10:11".
This is a challenge I could have had a lot of fun with but due to my time pressure I only made the "bare minimum."
My first attempt in Perl5 looked like this.
sub tick {
print "\b" x 8, sprintf("%02d:%02d:%02d", (localtime)[2,1,0]);
alarm 1;
}
$SIG{ALRM} = tick;
tick;
\b does a backspace so I can clear the previous output without having to use a terminal-dependent clear command or function. The POSIX alarm system call sets off a signal, SIGALRM in the specified number of seconds. I made my tick() function the signal handler where I print the current time and then set the alarm again for one more second.
The problem is that it doesn't work because Perl, unlike C, disables the previous signal handler when alarm is called so tick will only get called once. (By the way, the standalone call to tick() is to deal with the 0 seconds case.)
So after looking through the docs I found out a better way to do this is with the select system call which is also callable from Perl. It blocks execution for one second and then I print the current time in the next iteration of an infinite loop. My submitted entry looked like this:
$OUTPUT_AUTOFLUSH = 1;
while(1) {
print "\b" x 8, sprintf("%02d:%02d:%02d", (localtime)[2,1,0]);
select undef, undef, undef, 1;
}
Even if alarm had been usable, the script would not have worked properly without the first line ($| - 1 if you don't use English.) prints output is buffered by default so no output would have shown up until the buffer was full without this.
The Perl6 version uses what are called "futures" or "promises" in other programming languages. Here they are called "supplies." A supply is much more efficient than the system call based approach of Perl5 because it can make better use of the multithreading capabilities of modern CPUs.
sub tick() {
my $now = DateTime.now;
print "\b" x 8,
sprintf("%02d:%02d:%02d", $now.hour, $now.minute , $now.second);
}
my $supply = Supply.interval(1);
$supply.tap( -> $v { tick; } );
tick();
sleep;
A supply is created and set up so that it fires every one second interval. At that point it is "tapped" by calling the tick() subroutine which prints the correct time. (No need for autoflushing this time.) Once again there is an initial call to tick() to handle 0 seconds. sleep waits indefinately but unlike an infinite loop, gives control back to the CPU so it can do other things.