From a7f35b2af2f11866e19421eb8220116d45ce33af Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sun, 29 Sep 2019 11:40:12 -0600 Subject: Minor comment typo --- challenge-027/joelle-maslak/perl6/ch-1.p6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-027/joelle-maslak/perl6/ch-1.p6 b/challenge-027/joelle-maslak/perl6/ch-1.p6 index 4a711c64b1..e2545f3058 100755 --- a/challenge-027/joelle-maslak/perl6/ch-1.p6 +++ b/challenge-027/joelle-maslak/perl6/ch-1.p6 @@ -90,7 +90,7 @@ class Line does StrictClass { die "Cannot solve for $x" if $.point.x ≠ $x; } - # Lines between horizontal and ertical + # Lines between horizontal and vertical return $.slope × $x + self.y-offset; } -- cgit From a5f1133e945c4b36b4760e11225aa586aadba6b8 Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sun, 29 Sep 2019 12:12:32 -0600 Subject: Joelle's solution to 27.1 in Perl 5 --- challenge-027/joelle-maslak/perl5/ch-1.pl | 210 ++++++++++++++++++++++++++++++ 1 file changed, 210 insertions(+) create mode 100755 challenge-027/joelle-maslak/perl5/ch-1.pl diff --git a/challenge-027/joelle-maslak/perl5/ch-1.pl b/challenge-027/joelle-maslak/perl5/ch-1.pl new file mode 100755 index 0000000000..258a2eb79f --- /dev/null +++ b/challenge-027/joelle-maslak/perl5/ch-1.pl @@ -0,0 +1,210 @@ +#!/usr/bin/env perl +use v5.26; +use strict; +use warnings; +use utf8; # For unicode comments + +# Turn on method signatures +use feature 'signatures'; +no warnings 'experimental::signatures'; + +# This program finds the intersection of two lines. While the word +# "ends" is used, I'm instead assuming that these are true mathematical +# lines, not line segments, so the intersection point may not be between +# the two points that define the line. +# +# The first thing we need to do is to find the slope of each line. +# +# Edge case 1: If either line is not fully defined, we return an error. +# This happens if both points are the same. +# +# Edge case 2: A vertical line can't be defined by the standard y = A × x₁ + C +# equation. In this case we handle it differently, see below. We use ∞ +# (undef) for the slope in this case. +# +# To find the slope (of non-vertical lines), it's just rise / run, which is +# easy to calculate. For the constant, we need to solve this: +# y = Ax + C +# A given point will define x and y, while the slope defines A, so we just +# solve for C. THus: +# C = y - Ax; +# +# If we have two equations: y₁ = A₁ × x₁ + C₁ +# y₂ = A₂ × x₂ + C₂ +# +# We can find the intersection: +# 1) If slope is identical, and constants differ, NO INTERSECTION +# 2) If slope is identical, and constants are the same, this is the +# same line. +# 3) If the slope is infinite of either line, just solve the other +# equation to determine y for that value of x. +# 4) Otherwise, we're looking for the point where x₁=x₂ and y₁=y₂ +# Thus, we can rewrite the equations as: +# y = A₁ × x + C₁ +# y = A₂ × x + C₂ +# We can solve this system for x: +# A₁ × x + C₁ = A₂ × x + C₂ +# Rewritten: +# A₁ × x - A₂ × x = C₂ - C₁ +# Rewritten: +# (A₁ - A₂) × x = C₂ - C₁ +# x = (C₂ - C₁) ÷ (A₁ - A₂) +# Once we have x, we can solve for y by plugging into either of the +# original equations. +# + +package Point { + use Moose; + use feature 'signatures'; + no warnings 'experimental::signatures'; + + use Regexp::Common; + + has x => ( + is => 'rw', + isa => 'Num', + required => 1, + ); + + has y => ( + is => 'rw', + isa => 'Num', + required => 1, + ); + + sub from_string ( $self, $point_str ) { + $point_str =~ s/^ \( [.*] \) $/$1/sx; # Remove parens + + my (@parts) = split ',', $point_str; + if ( scalar( grep { /^ $RE{num}{real} $/sx } @parts ) != scalar(@parts) ) { + die("Invalid point specification"); + } + die("Invalid point specification") unless scalar(@parts) == 2; + + return $self->new( x => $parts[0], y => $parts[1] ); + } + + sub eqv ( $self, $point ) { + return ( ( $self->x == $point->x ) && ( $self->y == $point->y ) ); + } +} + +package Line { + use Moose; + use feature 'signatures'; + no warnings 'experimental::signatures'; + + has slope => ( + is => 'rw', + isa => 'Maybe[Num]', + required => 1, + ); + + has point => ( + is => 'rw', + isa => 'Point', + required => 1, + ); + + sub solve_for_x ( $self, $y ) { + # Vertical line exception + return $self->x if !defined $self->slope; + + # Horizontal line exception + if ( $self->slope == 0 ) { + die "Cannot solve for $y" if $self->point->y != $y; + } + + return ( $y - $self->y_offset ) / $self->slope; + } + + sub solve_for_y ( $self, $x ) { + # Horizontal line exception + return $self->point->y if $self->slope == 0; + + # Vertical line exception + if ( !defined $self->slope ) { + die "Cannot solve for $x" if $self->point->x != $x; + } + + # Lines between horizontal and vertical + return $self->slope * $x + $self->y_offset; + } + + sub y_offset($self) { + # Vertical line exception + return if !defined $self->slope; + + # Non-vertical lines + return $self->point->y - $self->slope * $self->point->x; + } + + sub intersection ( $self, $line ) { + die "Lines are the same" if $self->eqv($line); + if ( defined $self->slope and defined $line->slope ) { + die "Lines do not intersect" if $self->slope == $line->slope; + } + + # If either line is vertical + if ( !defined $self->slope ) { + return Point->new( x => $self->point->x, y => $line->solve_for_y( $self->point->x ) ); + } elsif ( !defined $line->slope ) { + return Point->new( x => $line->point->x, y => $self->solve_for_y( $line->point->x ) ); + } + + # We're finding a normal intersection + my $x = ( $line->y_offset - $self->y_offset ) / ( $self->slope - $line->slope ); + my $y = $self->solve_for_y($x); + + return Point->new( x => $x, y => $y ); + } + + sub eqv ( $self, $line ) { + # Are both vertical? + if ( ( !defined $self->slope ) and ( !defined $line->slope ) ) { + return $self->point->x == $line->point->x; + } + + # Only one is vertical + return if ( !defined $self->slope ) or ( !defined $line->slope ); + + # All other lines + return if $self->slope != $line->slope; + return ( $self->point->y == $line->solve_for_y( $self->point->x ) ); + } + + sub from_points ( $self, $point1, $point2 ) { + # Handle same point + die "Lines must be defined with two different points" if $point1->eqv($point2); + + # Handle vertical line exception + return $self->new( point => $point1, slope => undef ) if $point1->x == $point2->x; + + # Handle other lines. + my $slope = ( $point1->y - $point2->y ) / ( $point1->x - $point2->x ); + return $self->new( point => $point1, slope => $slope ); + } +} + +# point1 and point2 define a line. You can determine which line by the +# letter +sub MAIN ( $point1a, $point2a, $point1b, $point2b ) { + my $line1 = Line->from_points( Point->from_string($point1a), Point->from_string($point2a), ); + my $line2 = Line->from_points( Point->from_string($point1b), Point->from_string($point2b), ); + + if ( $line1->eqv($line2) ) { + say "The two lines are the same"; + } elsif ( ( !defined $line1->slope ) and ( !defined $line2->slope ) ) { + say "The two lines don't intersect"; + } elsif ( defined $line1->slope and defined $line2->slope and $line1->slope == $line2->slope ) { + say "The two lines don't intersect"; + } else { + my $intersection = $line1->intersection($line2); + say "The lines intersect at (" . $intersection->x . "," . $intersection->y . ")"; + } + + return; +} + +MAIN(@ARGV); + -- cgit From 1721add9a24389338246cf4870927f07cdd9b629 Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sun, 29 Sep 2019 12:12:44 -0600 Subject: Type fixes --- challenge-027/joelle-maslak/perl6/ch-1.p6 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/challenge-027/joelle-maslak/perl6/ch-1.p6 b/challenge-027/joelle-maslak/perl6/ch-1.p6 index e2545f3058..da88c98315 100755 --- a/challenge-027/joelle-maslak/perl6/ch-1.p6 +++ b/challenge-027/joelle-maslak/perl6/ch-1.p6 @@ -150,7 +150,7 @@ class Line does StrictClass { # point1 and point2 define a line. You can determine which line by the # letter -sub MAIN(Str:D $point1a, Str:D $point2a, Str:D $point1b, $point2b) { +sub MAIN(Str:D $point1a, Str:D $point2a, Str:D $point1b, Str:D $point2b) { my $line1 = Line.from-points( Point.from-string($point1a), Point.from-string($point2a), -- cgit From e37ccf211816267d70de883935ab0d42c501c8bd Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sun, 29 Sep 2019 12:23:37 -0600 Subject: Bugfix for Perl 6 solution --- challenge-027/joelle-maslak/perl6/ch-2.p6 | 1 - 1 file changed, 1 deletion(-) diff --git a/challenge-027/joelle-maslak/perl6/ch-2.p6 b/challenge-027/joelle-maslak/perl6/ch-2.p6 index 8183d58d79..192b26f816 100755 --- a/challenge-027/joelle-maslak/perl6/ch-2.p6 +++ b/challenge-027/joelle-maslak/perl6/ch-2.p6 @@ -20,7 +20,6 @@ class History { method history() { my @h = @!hist; - @h.push: $!data; return @h; } } -- cgit From 43a7dbf7b937ef2a5f596f5e881d37752c2035c7 Mon Sep 17 00:00:00 2001 From: Joelle Maslak Date: Sun, 29 Sep 2019 12:43:49 -0600 Subject: Solution to 27.2 in Perl 5 --- challenge-027/joelle-maslak/perl5/ch-2.pl | 66 +++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100755 challenge-027/joelle-maslak/perl5/ch-2.pl diff --git a/challenge-027/joelle-maslak/perl5/ch-2.pl b/challenge-027/joelle-maslak/perl5/ch-2.pl new file mode 100755 index 0000000000..e45a5cdd15 --- /dev/null +++ b/challenge-027/joelle-maslak/perl5/ch-2.pl @@ -0,0 +1,66 @@ +#!/usr/bin/env perl +use v5.22; +use strict; +use warnings; + +# Turn on method signatures +use feature 'signatures'; +no warnings 'experimental::signatures'; + +# Limitation - this only tracks the scalar container, not changes to +# nested objects. + +package History { + use Moose; + use feature 'signatures'; + no warnings 'experimental::signatures'; + + has hist => ( + is => 'rw', + isa => 'ArrayRef', + default => sub { [] }, + ); + has data => ( is => 'rw', ); + + sub FETCH($self) { + return $self->data; + } + + sub STORE ( $self, $value ) { + $self->data($value); + push $self->hist->@*, $value; + + return $value; + } + + sub TIESCALAR($self) { + return $self->new(); + } + + sub history($self) { + return $self->hist->@*; + } +} + +MAIN: { + my $x; + my $hist = tie $x, 'History'; + + $x = 10; + $x = 20; + $x -= 5; + + $x = 'Foo!'; + + # A new instance of history should be independnet. + my $z; + my $hist2 = tie $z, 'History'; + $z = 3; # Won't show up in history for $x. + + # And we just set the original history, the one we log, to a new + # value + $x = 'Baz.'; + + say join( "\n", $hist->history ); +} + -- cgit