diff options
| -rw-r--r-- | challenge-165/jo-37/perl/ch-1.in | 3 | ||||
| -rwxr-xr-x | challenge-165/jo-37/perl/ch-1.pl | 138 | ||||
| -rw-r--r-- | challenge-165/jo-37/perl/ch-2.in | 6 | ||||
| -rwxr-xr-x | challenge-165/jo-37/perl/ch-2.pl | 78 |
4 files changed, 225 insertions, 0 deletions
diff --git a/challenge-165/jo-37/perl/ch-1.in b/challenge-165/jo-37/perl/ch-1.in new file mode 100644 index 0000000000..42acc2b70b --- /dev/null +++ b/challenge-165/jo-37/perl/ch-1.in @@ -0,0 +1,3 @@ +53,10 +53,10,23,30 +23,30 diff --git a/challenge-165/jo-37/perl/ch-1.pl b/challenge-165/jo-37/perl/ch-1.pl new file mode 100755 index 0000000000..01e1eb6dec --- /dev/null +++ b/challenge-165/jo-37/perl/ch-1.pl @@ -0,0 +1,138 @@ +#!/usr/bin/perl + +use v5.16; +use warnings; +use SVG; +use PDL; +use experimental qw(signatures postderef); +# mirror: +use constant MI => pdl(1, -1); +# origin: +use constant ORIG => pdl(10, 10); +# point radius: +use constant R => 3; + +# Do nothing but define subs to be imported into another program if +# $norun is set. See task 2. +our $norun; +goto end if $norun; + +die <<EOS if @ARGV && $ARGV[0] eq -h; +usage: $0 [FILE] + +FILE + Name of a file holding point and line coordinates. Prints the + generated SVG to STDOUT. + + Call $0 ch-1.in to produce the example SVG or + perl -pe 's/\\s+/\\n/gm ch-2.in | $0 + to visualize the second task's input data. + +EOS + + +### Input and Output + +say gen_svg(read_data(\*ARGV)); + + +### Implementation + +# Reading data from file handle and build piddles holding point and line +# endpoint coordinates respectively. +sub read_data($fh) { + # Collect points in a 2xN piddle. Can glue to a null piddle. + my $points = null; + # Collect lines in a 2x2xM piddle. An initial structure with + # dimensions 2x2x0 is needed to be able to flatten to 2x0 + # afterwards if there a no lines. + my $lines = pdl(null, null)->xchg(0, 1)->dummy(0, 2); + + # Read input lines of two or four coordinates representing a point + # or a line respectively and add these to the proper piddle. + while (<$fh>) { + my ($x1, $y1, $x2, $y2) = split /, */; + if (defined $y2) { + # Build a 2x2x1 piddle from the line's endpoints and augment the + # existing line list + $lines = $lines->glue(2, pdl([$x1, $y1], [$x2, $y2])->dummy(2)); + } else { + # Build a 2x1 piddle from the point and augment the existing + # point list. + $points = $points->glue(1, pdl($x1, $y1)->dummy(1)); + } + } + + ($points, $lines); +} + +# Generate an SVG from given points and lines. SVGs have a special +# coordinate system: The origin is located at the upper left corner, the +# x axis goes rightwards and the y axis goes downwards - in contrast to +# the usually expected behaviour. Mirroring y values to regain the +# expected outcome with a transformation (x, y) -> (x - minX, maxY - y). +sub gen_svg ($points, $lines) { + # Build a piddle from all points and line endpoints. For that + # purpose the lines piddle is flattened from 2x2xM to 2x2M, + # compatible with the 2xN points piddle. The result (after + # transpose) is a (N+2M)x2 piddle. + my $allpoints = $points->glue(1, $lines->clump(1, 2))->xchg(0, 1); + # Build $minmax as a 2x2 piddle holding the negative minimum and the + # maximum x and y coordinates from all points. This special piddle + # comes handy, as the sum over the x and y values respectively + # produces the size of a surrounding rectangle and the diagonal + # gives the shift in the aforementioned transformation. + my $minmax = -(MI->dummy(0)) * pdl(($allpoints->minmaximum)[0, 1]); + my $shift = $minmax->diagonal(0, 1); + + # Build an SVG object in the required size plus borders. + (\my %attr)->@{qw(width height)} = + ($minmax->xchg(0, 1)->sumover + 2 * ORIG)->list; + my $svg = SVG->new(%attr); + + # Create a group providing common circle attributes. + my $cg = $svg->group(id => 'cg', fill => '#f73'); + # Transform the points' coordinates into SVG coordinates with origin + # ORIG and create (small) circles around these. + (ORIG + $points * MI + $shift)->svg_circle($cg, R) + unless $points->isempty; + + # Create a group providing common line attributes. + my $lg = $svg->group(id => 'lg', 'stroke-width' => 4, stroke => '#369'); + # Transform the lines' endpoint coordinates into SVG coordinates with + # origin ORIG and create lines connecting these. The lines' + # endpoint pairs need to be flattened from 2x2 to 4x1. + (ORIG + $lines * MI + $shift)->clump(0, 1)->svg_line($lg) + unless $lines->isempty; + + # Return the SVG object as XML. + $svg->xmlify; +} + +# Let the fun begin: +# Defining two PDL methods 'svg_circle' and 'svg_line' that are +# threading over a piddle's first dimension to create SVG circles and +# lines respectively. + +BEGIN { + # Threaded creation of SVG circles: + # Create a circle of radius $r around the given point. + # Method args: svg, radius + thread_define 'PDL::svg_circle(a(2)), NOtherPars => 2', over { + my ($point, $svg, $r) = @_; + (\my %attr)->@{qw(cx cy r)} = ($point->list, $r); + $svg->circle(%attr); + }; + + # Threaded creation of SVG lines: + # Create a line connecting its endpoint coordinates. + # Method arg: svg + thread_define 'PDL::svg_line(a(4)), NOtherPars => 1', over { + my ($line, $svg) = @_; + (\my %attr)->@{qw(x1 y1 x2 y2)} = $line->list; + $svg->line(%attr); + }; +} + +end: +1; diff --git a/challenge-165/jo-37/perl/ch-2.in b/challenge-165/jo-37/perl/ch-2.in new file mode 100644 index 0000000000..9e5ecc346a --- /dev/null +++ b/challenge-165/jo-37/perl/ch-2.in @@ -0,0 +1,6 @@ +333,129 39,189 140,156 292,134 393,52 160,166 362,122 13,193 +341,104 320,113 109,177 203,152 343,100 225,110 23,186 282,102 +284,98 205,133 297,114 292,126 339,112 327,79 253,136 61,169 +128,176 346,72 316,103 124,162 65,181 159,137 212,116 337,86 +215,136 153,137 390,104 100,180 76,188 77,181 69,195 92,186 +275,96 250,147 34,174 213,134 186,129 189,154 361,82 363,89 diff --git a/challenge-165/jo-37/perl/ch-2.pl b/challenge-165/jo-37/perl/ch-2.pl new file mode 100755 index 0000000000..23282b39c7 --- /dev/null +++ b/challenge-165/jo-37/perl/ch-2.pl @@ -0,0 +1,78 @@ +#!/usr/bin/perl -s + +use v5.16; +use warnings; +use PDL; +use PDL::Slatec; +use experimental 'signatures'; + +our ($norun, $svg, $help); + +die <<EOS if $help; +usage: $0 [-help] [-svg] [FILE] + +-help + Print this help. + +-svg + Print an SVG containing the points and the regression line on STDOUT. + +FILE + Name of a file holding (x, y) pairs. The values of a single pair + shall be separated by comma and pairs by whitespace. + + Call "./ch-2.pl ch-2.in" to solve task 2. (Output: regression line + endpoints.) + + Call "./ch-2.sh -svg ch-2.in" to solve task 2 and generate an SVG + for visualization using the solution to task 1. + +EOS + + +### Input and Output + +if ($svg) { + # Import the SVG generator from task 1. + local $norun = 1; + do "./ch-1.pl" or die $@; + say scalar least_square_linear_regression(\*ARGV); +} else { + say join ", ", least_square_linear_regression(\*ARGV); +} + + +### Implementation + +sub least_square_linear_regression ($fh) { + # Slurp the file content, remove trailing whitespace, convert + # whitespace to semicolons and use the resulting string as a piddle + # constructor argument. This results in a 2xN piddle of coordinate + # pairs. + my $points = do { + local $/; + pdl <$fh> =~ s/\s+\z//r =~ s/\s+/;/gr + }; + # Split the points' coordinates in separate piddles along the first + # dimension resulting in piddles for x and y values as required by + # "polyfit". Then find the best fit with a polynomial of degree one + # (i.e. a line). Here only the solution's internal representation + # is needed as the result. + my $fit = (polyfit $points->xchg(0, 1)->dog, ones($points->dim(1)), 1)[3]; + # Get the x range. + my $x = pdl minmax $points->slice(0); + # Get the corresponding y values. + my $y = (polyvalue(1, 0, $x, $fit))[0]; + # Create a line piddle having x and y as endpoint coordinates. + my $line = pdl($x, $y)->xchg(0, 1); + + if (wantarray) { + # Flatten the line piddle. + return $line->list; + } else { + # Convert the line endpoints (2x2) into the shape expected by + # gen_svg (2x2x1) from task 1 and generate an SVG from the given + # points and the regression line. + return gen_svg($points, $line->dummy(2)); + } +} |