diff options
| -rwxr-xr-x | challenge-027/e-choroba/perl5/ch-1.pl | 79 | ||||
| -rwxr-xr-x | challenge-027/e-choroba/perl5/ch-2.pl | 31 |
2 files changed, 110 insertions, 0 deletions
diff --git a/challenge-027/e-choroba/perl5/ch-1.pl b/challenge-027/e-choroba/perl5/ch-1.pl new file mode 100755 index 0000000000..916098c0c0 --- /dev/null +++ b/challenge-027/e-choroba/perl5/ch-1.pl @@ -0,0 +1,79 @@ +#!/usr/bin/perl +use warnings; +use strict; + +sub line { + my ($x1, $y1, $x2, $y2) = @_; + my ($A, $B, $C); + die 'Not enough points' if $x1 == $x2 && $y1 == $y2; + if ($x1 == $x2) { + if ($x1) { + ($A, $B, $C) = (-1 / $x1, 0, 1); + } else { + ($A, $B, $C) = (1, 0, 0); + } + } else { + ($A, $B, $C) = (($y2 - $y1) / ($x1 - $x2), 1, + -($x1 * ($y2 - $y1) / ($x1 - $x2) + $y1)); + } + return $A, $B, $C +} + +sub intersection { + my ($a1, $b1, $c1, $a2, $b2, $c2) = @_; + if ($a1 * $b2 == $a2 * $b1) { + die 'No intersection' if $c1 != $c2; + die 'Identical lines' if $c1 == $c2; + } + my $y = ($a2 * $c1 / $a1 - $c2) * $a1 / ($b2 * $a1 - $a2 * $b1); + my $x = (-$b1 * $y - $c1) / $a1; + return $x, $y +} + + +use Test::More; +use Test::Exception; + +sub point_on_line { + my ($x1, $y1, $x2, $y2) = @_; + my ($A, $B, $C) = line($x1, $y1, $x2, $y2); + is $A * $x1 + $B * $y1 + $C, 0; + is $A * $x2 + $B * $y2 + $C, 0; +} + +point_on_line(3, 3, 5, 3); +point_on_line(3, 3, 3, 7); +point_on_line(1, 5, 3, 11); +throws_ok { line(1, 1, 1, 1) } qr/Not enough points/; + +is_deeply [ intersection( + line(1, 5, 3, 11), + line(0, -1, 3, 5) +) ], [-3, -7]; + +is_deeply [ intersection( + line(1, 2, 5, 14), + line(0, 2, -1, 7) +) ], [3/8, 1/8]; + +is_deeply [ intersection( + line(0, 0, 0, 1), + line(0, 0, 1, 0) +) ], [0, 0]; + +is_deeply [ intersection( + line(4.2, 19, 4.8, 22), + line(4, 19, 3.5, 17.5) +) ], [4.5, 20.5]; + +throws_ok { intersection( + line(0, 0, 1, 1), + line(2, 2, 3, 3) +) } qr/Identical lines/; + +throws_ok { intersection( + line(2, 2, 1, 1), + line(0, 2, 1, 3) +) } qr/No intersection/; + +done_testing(13); diff --git a/challenge-027/e-choroba/perl5/ch-2.pl b/challenge-027/e-choroba/perl5/ch-2.pl new file mode 100755 index 0000000000..8d5479b0db --- /dev/null +++ b/challenge-027/e-choroba/perl5/ch-2.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl +use warnings; +use strict; + +{ package Historical; + use Tie::Scalar; + use parent -norequire => 'Tie::StdScalar'; + + sub TIESCALAR { bless [], shift } + sub FETCH { $_[0][-1] } + sub STORE { push @{ $_[0] }, $_[1] } + + sub history { $_[0] } +} + +tie my $x, 'Historical'; +$x = 'initial value'; +$x = 'second value'; +$x = 'last value'; + +use Test::More tests => 2; +is_deeply tied($x)->history, + [ 'initial value', 'second value', 'last value' ]; + +tie my $y, 'Historical'; +$y = 10; +$y = 20; +$y -= 5; + +is_deeply tied($y)->history, + [ 10, 20, 15 ]; |
