diff options
| author | Luis Mochan <mochan@fis.unam.mx> | 2022-05-21 12:42:59 -0500 |
|---|---|---|
| committer | Luis Mochan <mochan@fis.unam.mx> | 2022-05-21 12:42:59 -0500 |
| commit | 5e5c3947ab7e23384a1b8ea54eafbfa3959c9669 (patch) | |
| tree | 7691f7f4dcbca44bbed9ac5902fcfb3b076fbaf5 | |
| parent | 914fc5dec5a114e33e1acc3504f38e85654daf9e (diff) | |
| download | perlweeklychallenge-club-5e5c3947ab7e23384a1b8ea54eafbfa3959c9669.tar.gz perlweeklychallenge-club-5e5c3947ab7e23384a1b8ea54eafbfa3959c9669.tar.bz2 perlweeklychallenge-club-5e5c3947ab7e23384a1b8ea54eafbfa3959c9669.zip | |
Solve PWC165
| -rw-r--r-- | challenge-165/wlmb/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-165/wlmb/perl/ch-1.pl | 61 | ||||
| -rwxr-xr-x | challenge-165/wlmb/perl/ch-2.pl | 25 |
3 files changed, 87 insertions, 0 deletions
diff --git a/challenge-165/wlmb/blog.txt b/challenge-165/wlmb/blog.txt new file mode 100644 index 0000000000..a83fdc950d --- /dev/null +++ b/challenge-165/wlmb/blog.txt @@ -0,0 +1 @@ +https://wlmb.github.io/2022/05/20/PWC165/ diff --git a/challenge-165/wlmb/perl/ch-1.pl b/challenge-165/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..d0c42c212b --- /dev/null +++ b/challenge-165/wlmb/perl/ch-1.pl @@ -0,0 +1,61 @@ +#!/usr/bin/env perl +# Perl weekly challenge 165 +# Task 1: Scalable vector graphics (svg) +# +# See https://wlmb.github.io/2022/05/20/PWC165/#task-1-scalable-vector-graphics-svg +use v5.12; +use warnings; +use SVG; + +# Parameter definitions +my $relative_radius=0.01; # size of point vs. canvas size +my $relative_width=0.005; # width of stroke vs. canvas size +my $absolute_size=400; # absolute size of canvas +my $fill="red"; # fill color +my $stroke="blue"; # stroke color + +# Initialize svg object +my $svg=SVG->new(width=>$absolute_size, height=>$absolute_size); + +# make group for transforming coordinates +my $g=$svg->group(); + +my @bbox; # required bounding box +while(<>){ # read input + chomp; + my @coords=split /\s*,\s*/; # interpret as comma separated coordinates + # two coordinates for point, four for line + die "Expected x,y or x1,y1,x2,y2 coordinates" unless @coords==2 || @coords==4; + $g->circle(cx=>$coords[0], cy=>$coords[1], fill=>$fill) if @coords==2; + $g->line(x1=>$coords[0],y1=>$coords[1],x2=>$coords[2],y2=>$coords[3], stroke=>$stroke) + if @coords==4; + adjust_bbox(@coords[(0,1)]); # acomodate bounding box to new coordinates + adjust_bbox(@coords[(2,3)]); +} +my ($Lx, $Ly)=($bbox[2]-$bbox[0], $bbox[3]-$bbox[1]); # Get size of canvas in user coords. +$Lx||=1; # default size +$Ly||=1; +my $L=$Lx>$Ly?$Lx:$Ly; # make square canvas +my $radius=$relative_radius*$L; # radius of point +my $width=$relative_width*$L; # and stroke width in user coords +my $scale=$absolute_size/($L+2*$radius); # scale user to canvas coords +for(0,1){ # enlarge bounding box to accommodate radius of points at extremes + $bbox[$_]-=$radius; + $bbox[$_+2]=$bbox[$_]+$L+2*$radius; +} +# set radius of all circles +$_->setAttribute("r", $radius) for $g->getElements("circle"); +# set stroke widths of all lines +$_->setAttribute("stroke-width", $width) for $g->getElements("line"); +# set a coordinate transformation from user to canvas coordinates. +$g->setAttribute("transform", "scale($scale, -$scale) translate(".-$bbox[0].",".-$bbox[3].")"); +say $svg->xmlify; # output the svg code + +sub adjust_bbox { # enlarge the bounding box to accommodate a point + my ($x, $y)=@_; + return unless defined $x and defined $y; + for ([0, $x, 1], [1, $y, 1], [2, $x, -1], [3, $y, -1]){ + my ($i,$z, $s)=@$_; + $bbox[$i]=$z if !defined $bbox[$i] or $s*$z<$s*$bbox[$i]; + } +} diff --git a/challenge-165/wlmb/perl/ch-2.pl b/challenge-165/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..0028e7e720 --- /dev/null +++ b/challenge-165/wlmb/perl/ch-2.pl @@ -0,0 +1,25 @@ +#!/usr/bin/env perl +# Perl weekly challenge 165 +# Task 2: Line of best fit +# +# See https://wlmb.github.io/2022/05/20/PWC165/#task-2-line-of-best-fit +use v5.12; +use warnings; +use PDL; +die 'Usage: ./ch-2.pl "[[x1,y1], [x2,y2]...]" to fit a set of points' unless @ARGV==1; +my $input=pdl($ARGV[0]); +my $N=$input->dim(1); # number of points +die 'Require more than one point' unless $N>1; +my $sum=$input->transpose->sumover; +my ($sum_x, $sum_y)=$sum->list; +my $sum_2=($input**2)->transpose->sumover; # sum of squares +my ($sum_x_2, $sum_y_2)=$sum_2->list; +my $sum_xy=$input->prodover->sumover; # sum of xy +my $det=$N*$sum_x_2-$sum_x**2; +die "Singular system" if $det==0; +my $slope=($N*$sum_xy-$sum_x*$sum_y)/$det; +my $intercept=($sum_x_2*$sum_y-$sum_x*$sum_xy)/$det; +say join ",", @$_ for @{$input->unpdl}; # output points +my $x=$input->slice("(0)"); # x coords +my ($y0, $y1)=map {$slope*$_+$intercept} (my ($x0,$x1)=($x->minimum,$x->maximum)); +say "$x0, $y0, $x1, $y1"; |
