From 5957f3d0dd509e68787beaa1b16b5d1b95deea90 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 18 May 2022 10:29:16 +0100 Subject: oo version --- challenge-165/james-smith/perl/SVG.pm | 150 +++++++++++++++++++++ challenge-165/james-smith/perl/ch-1.pl | 119 +--------------- challenge-165/james-smith/perl/ch-2.pl | 2 +- .../perl/examples/01-example-point-and_line.txt | 3 + .../perl/examples/02-example-from-site.txt | 6 + .../perl/examples/03-horizontal-cluster.txt | 10 ++ .../perl/examples/04-vertical-cluster.txt | 10 ++ .../james-smith/perl/examples/05-only-one-x.txt | 2 + challenge-165/james-smith/perl/examples/data1.txt | 3 - challenge-165/james-smith/perl/examples/data2.txt | 6 - challenge-165/james-smith/perl/examples/data3.txt | 10 -- challenge-165/james-smith/perl/examples/data4.txt | 10 -- challenge-165/james-smith/perl/examples/data5.txt | 2 - challenge-165/james-smith/perl/fit.pl | 1 + challenge-165/james-smith/perl/functional.pl | 147 ++++++++++++++++++++ .../james-smith/perl/object-orientated.pl | 28 ++++ challenge-165/james-smith/perl/plot.pl | 1 + 17 files changed, 360 insertions(+), 150 deletions(-) create mode 100644 challenge-165/james-smith/perl/SVG.pm mode change 100644 => 120000 challenge-165/james-smith/perl/ch-1.pl create mode 100644 challenge-165/james-smith/perl/examples/01-example-point-and_line.txt create mode 100644 challenge-165/james-smith/perl/examples/02-example-from-site.txt create mode 100644 challenge-165/james-smith/perl/examples/03-horizontal-cluster.txt create mode 100644 challenge-165/james-smith/perl/examples/04-vertical-cluster.txt create mode 100644 challenge-165/james-smith/perl/examples/05-only-one-x.txt delete mode 100644 challenge-165/james-smith/perl/examples/data1.txt delete mode 100644 challenge-165/james-smith/perl/examples/data2.txt delete mode 100644 challenge-165/james-smith/perl/examples/data3.txt delete mode 100644 challenge-165/james-smith/perl/examples/data4.txt delete mode 100644 challenge-165/james-smith/perl/examples/data5.txt create mode 120000 challenge-165/james-smith/perl/fit.pl create mode 100644 challenge-165/james-smith/perl/functional.pl create mode 100644 challenge-165/james-smith/perl/object-orientated.pl create mode 120000 challenge-165/james-smith/perl/plot.pl diff --git a/challenge-165/james-smith/perl/SVG.pm b/challenge-165/james-smith/perl/SVG.pm new file mode 100644 index 0000000000..d2d8323c17 --- /dev/null +++ b/challenge-165/james-smith/perl/SVG.pm @@ -0,0 +1,150 @@ +package SVG; +use warnings; +use feature qw(say); +use Data::Dumper qw(Dumper); +use Const::Fast qw(const); + +const my $DEFAULT_CONFIG => { 'margin' => 40, 'max_w' => 960, 'max_h' => 540, + 'color' => '#000', 'stroke' => 3, + 'fill' => '#ccc', 'radius' => 10, + 'border' => '#000', 'bg' => '#eee' }; +const my $LINE_TEMPLATE => ''; +const my $POINT_TEMPLATE => ''; +const my $SVG_TEMPLATE => ' + + + + + %s + + + %s + +'; + + +sub new { + my ( $class, $config ) = @_; + my $self = { + 'config' => { %{$DEFAULT_CONFIG}, %{$config} }, + 'points' => [], + 'lines' => [], + 'min_x' => undef, + 'max_x' => undef, + 'min_y' => undef, + 'max_y' => undef, + 'width' => undef, + 'height' => undef, + 'scale' => undef, + }; + bless $self, $class; + $self; +} + +sub load_data { + my( $self, $fn, @t ) = @_; + local $/ = undef; + open my $ifh, '<', $fn; + 4 == (@t = split /,/) ? ( push @{$self->{'lines'}}, [@t] ) ## Length 4 - line + : 2 == @t ? ( push @{$self->{'points'}}, [@t] ) ## Length 2 - point + : ( warn "input error: $_" ) ## o/w error + for grep { /\S/ } split /\s+/, <$ifh>; + close $ifh; + $self; +} + +sub add_points { + my( $self, @points ) = @_; + push @{$self->{'points'}}, @points; + $self; +} + +sub add_lines { + my( $self, @lines ) = @_; + push @{$self->{'lines'}}, @lines; + $self; +} + +sub get_range { + my $self = shift; + + ## rather than having a special cast as the first part of the loop, we start with the + ## values for the first point (or start of line if no points) + my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{$self->{'points'}} ? @{$self->{'points'}[1]} : @{$self->{'lines'}[0]}; + + ## Compute the range of all points. We comma separate conditions so we only need one postfix for + ## We use ($c)&&($a=?) to mimic if($c) { $a=? } so we can use the postfix loop... + ## Note we unravel the two ends of the line by mapping the each line ($_) to $_ + the last two values $_. + ($_->[0]<$min_x)&&($min_x=$_->[0]), ($_->[0]>$max_x)&&($max_x=$_->[0]), + ($_->[1]<$min_y)&&($min_y=$_->[1]), ($_->[1]>$max_y)&&($max_y=$_->[1]) + for @{$self->{'points'}}, map {($_,[$_->[2],$_->[3]])} @{$self->{'lines'}||[]}; + ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'} ) = ( $min_x, $max_x, $min_y, $max_y ); + $self; +} + +sub best_fit { + my $self = shift; + my $sx = my $sy = my $sxy = my $sxx = 0, my $n = @{$self->{'points'}}; + $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] for @{$self->{'points'}}; + return $sx/$n unless $n*$sxx - $sx*$sx; + my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); + ( ($sy-$b*$sx)/$n, $b ); +} + +sub add_line_of_best_fit { + my $self = shift; + my ($a,$b) = $self->best_fit; + my ($min_x, $max_x, $min_y, $max_y, $extn) = ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'}, $self->{'config'}{'margin'} ); + ## special case of a vertical line + $self->add_lines( [ $a, $min_y - $extn, $a, $max_y + $extn] ), return $self unless defined $b; + + ## Normal case - get y coprdinates of end points, adjust if outside the box... + my $l_y = $a + $b * ($min_x - $extn); + my $r_y = $a + $b * ($max_x + $extn); + my $l_x = $l_y < $min_y - $extn ? ( ( $l_y = $min_y - $extn ) - $a)/$b + : $l_y > $max_y + $extn ? ( ( $l_y = $max_y + $extn ) - $a)/$b : $min_x - $extn; + my $r_x = $r_y < $min_y - $extn ? ( ( $r_y = $min_y - $extn ) - $a)/$b + : $r_y > $max_y + $extn ? ( ( $r_y = $max_y + $extn ) - $a)/$b : $max_x + $extn; + $self->add_lines( [ $l_x, $l_y, $r_x, $r_y ] ); +} + +sub calculate_image_size { + my $self = shift; + my $margin = $self->{'config'}{'margin'}; + + ## Adjust height and width so it fits the size from the self->{'config'}ig. + my($W,$H,$width,$height) = ($self->{'config'}{'max_w'},$self->{'config'}{'max_h'},$self->{'max_x'}-$self->{'min_x'}+2*$margin,$self->{'max_y'}-$self->{'min_y'}+2*$margin); + ( $width/$height > $W/$H ) ? ( $H = $height/$width*$W ) : ( $W = $width/$height*$H ); + ## Calculate the scale factor so that we keep spots/lines the same size irrespective of the ranges. + ( $self->{'width'}, $self->{'height'}, $self->{'scale'} ) = ( $W, $H, $width/$W ); + $self; +} + +sub render_with_best_fit { + my $self = shift; + return $self->get_range()->add_line_of_best_fit()->_render(); +} + +sub render { + my $self = shift; + return $self->get_range()->_render(); +} + +sub _render { + my $self = shift; + $self->calculate_image_size(); + my $margin = $self->{'config'}{'margin'}; + sprintf $SVG_TEMPLATE, + $self->{'height'}, $self->{'width'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, + $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, + $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, + $self->{'config'}{'border'}, $self->{'scale'}, $self->{'config'}{'bg'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, + $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, + $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, + $self->{'config'}{'color'}, $self->{'config'}{'stroke'} * $self->{'scale'}, join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } @{$self->{'lines'}} ), ## lines + $self->{'config'}{'fill'}, join( qq(\n ), map { sprintf $POINT_TEMPLATE, @{$_}, $self->{'config'}{'radius'}*$self->{'scale'} } @{$self->{'points'}} ) ## points + +} + +1; diff --git a/challenge-165/james-smith/perl/ch-1.pl b/challenge-165/james-smith/perl/ch-1.pl deleted file mode 100644 index 89c27e4f6f..0000000000 --- a/challenge-165/james-smith/perl/ch-1.pl +++ /dev/null @@ -1,118 +0,0 @@ -#!/usr/local/bin/perl -use strict; - -use warnings; -use feature qw(say); - -my $CONFIG = { - 'margin' => 40, 'max_w' => 960, 'max_h' => 540, # Size of image & margins - 'stroke' => 5, 'color' => '#900', # Style for lines - 'radius' => 10, 'fill' => '#090', # Style for dots - 'border' => '#009', 'bg' => '#ffd', # Style for "page".... -}; - -my ($pts,$lines) = get_points_and_lines( ); ## Parses file and updates lines/points -add_best_fit_line( $pts, $lines, $CONFIG->{'margin'} ) if $0 eq 'ch-2.pl'; ## Only if fitting line! -say render_svg( $pts, $lines, $CONFIG ); ## Pass in config to render correctly - -##---------------------------------------------------------------------- -## Now the code does the real work.... -##---------------------------------------------------------------------- - -## Parse stdin / files given on command line, to return a list of points and lines.. -sub get_points_and_lines { - my($ps,$ls,@t)=([],[]); - local $/ = undef; - - 4 == (@t = split /,/) ? ( push @{$ls}, [@t] ) ## Length 4 - line - : 2 == @t ? ( push @{$ps}, [@t] ) ## Length 2 - point - : ( warn "input error: $_" ) ## o/w error - for grep { $_ } split /\s+/, <>; - return ($ps,$ls); -} - -## Compute the best fit line for the points array (using linear regression... -## Assumes a dependency of y on x.... - -sub best_fit { - my $sx = my $sy = my $sxy = my $sxx = 0, my $n = @{$_[0]}; - $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] foreach @{$_[0]}; - return $sx/$n unless $n*$sxx - $sx*$sx; - my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); - ( ($sy-$b*$sx)/$n, $b ); -} - -## Get the range of x,y values for the given list of lines/points -## Returns a tuple of min & max x and min & max y. - -sub get_ranges { - my( $ps, $ls ) = @_; - my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{$ps} ? @{$pts->[0]} : @{$ls->[0]}; - ($_->[0]<$min_x)&&($min_x=$_->[0]), ($_->[0]>$max_x)&&($max_x=$_->[0]), - ($_->[1]<$min_y)&&($min_y=$_->[1]), ($_->[1]>$max_y)&&($max_y=$_->[1]) for @{$ps}, map {($_,[$_->[2],$_->[3]])} @{$ls||[]}; - ( $min_x, $max_x, $min_y, $max_y ); -} - -## Get the best fit line, and then add extend it to edge of the box - by default we assume that the line will start/end on -## the side of the box, but just to be sure - we check to see if the pts lie above or below the top/bottom of the box and -## move them appropriately. - -sub add_best_fit_line { - my ($ps,$ls,$extn) = @_; - $extn //= 40; - my( $a, $b ) = best_fit( $ps ); - my( $min_x, $max_x, $min_y, $max_y ) = get_ranges( $ps ); - unless( defined $b ) { - push @{$ls}, [ $a, $min_y - $extn, $a, $max_y + $extn]; - return; - } - my $l_y = $a + $b * ($min_x - $extn); - my $r_y = $a + $b * ($max_x + $extn); - my $l_x = $l_y < $min_y - $extn ? ( ($l_y = $min_y - $extn ) - $a)/$b - : $l_y > $max_y + $extn ? ( ($l_y = $max_y + $extn ) - $a)/$b : $min_x - $extn; - my $r_x = $r_y < $min_y - $extn ? ( ($r_y = $min_y - $extn ) - $a)/$b - : $r_y > $max_y + $extn ? ( ($r_y = $max_y + $extn ) - $a)/$b : $max_x + $extn; - push @{$ls}, [ $l_x,$l_y,$r_x,$r_y ]; -} - -## Finally the rendering of the points/lines, this uses most of the config entries to deal with colour, size etc. -## We get the range and again add the margin { we don't include the lines in the equation if we are doing challenge 2 -## the line fitting as otherwise we would extend the region twice... } -## -## Once we have the size of the image - we work out it's aspect ratio and work out whether we have to make the image -## narrower or shorter so that the image is no-bigger than the suggested size and that the image is as big as possible -## -## As we have a scaling between the x+y values and the size of the image - we need to adjust the size of dots/width of lines -## by multiplying these all by a scale factor - -sub render_svg { - my( $ps, $ls, $config ) = @_; - my( $min_x, $max_x, $min_y, $max_y ) = get_ranges( $pts, $0 eq 'ch-2.pl' ? [] : $lines ); - my $margin = $config->{'margin'}//20; - - ## Adjust height and width so it fits the size from the config. - my($W,$H,$width,$height) = ($config->{'max_w'}//800,$config->{'max_h'}//600,$max_x-$min_x+2*$margin,$max_y-$min_y+2*$margin); - ( $width/$height > $W/$H ) ? ( $H = $height/$width*$W ) : ( $W = $width/$height*$H ); - ## Calculate the scale factor so that we keep spots/lines the same size irrespective of the ranges. - my $sf = $width/$W; - - sprintf ' - - - - - %s - - - %s - -', - $H, $W, $min_x - $margin, $min_y - $margin, $width, $height, ## svg element - $config->{'border'}//'#000', $sf, $config->{'bg'}//'#eee', ## background rectangle - $min_x - $margin, $min_y - $margin, $width, $height, - $config->{'fill'}//'#000', ($config->{'stroke'}//5) * $sf, ## lines - join( qq(\n ), map { sprintf '', @{$_} } @{$ls} ), - $config->{'color'}//'#ccc', ## dots - join( qq(\n ), map { sprintf '', @{$_}, ($config->{'radius'}//10)*$sf } @{$ps} ) -} diff --git a/challenge-165/james-smith/perl/ch-1.pl b/challenge-165/james-smith/perl/ch-1.pl new file mode 120000 index 0000000000..4e6fe42bc5 --- /dev/null +++ b/challenge-165/james-smith/perl/ch-1.pl @@ -0,0 +1 @@ +functional.pl \ No newline at end of file diff --git a/challenge-165/james-smith/perl/ch-2.pl b/challenge-165/james-smith/perl/ch-2.pl index 8b09e2d217..4e6fe42bc5 120000 --- a/challenge-165/james-smith/perl/ch-2.pl +++ b/challenge-165/james-smith/perl/ch-2.pl @@ -1 +1 @@ -ch-1.pl \ No newline at end of file +functional.pl \ No newline at end of file diff --git a/challenge-165/james-smith/perl/examples/01-example-point-and_line.txt b/challenge-165/james-smith/perl/examples/01-example-point-and_line.txt new file mode 100644 index 0000000000..42acc2b70b --- /dev/null +++ b/challenge-165/james-smith/perl/examples/01-example-point-and_line.txt @@ -0,0 +1,3 @@ +53,10 +53,10,23,30 +23,30 diff --git a/challenge-165/james-smith/perl/examples/02-example-from-site.txt b/challenge-165/james-smith/perl/examples/02-example-from-site.txt new file mode 100644 index 0000000000..9e5ecc346a --- /dev/null +++ b/challenge-165/james-smith/perl/examples/02-example-from-site.txt @@ -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/james-smith/perl/examples/03-horizontal-cluster.txt b/challenge-165/james-smith/perl/examples/03-horizontal-cluster.txt new file mode 100644 index 0000000000..dd2b0780d5 --- /dev/null +++ b/challenge-165/james-smith/perl/examples/03-horizontal-cluster.txt @@ -0,0 +1,10 @@ +1,1 +2,1 +3,1 +4,1 +5,1 +6,1 +7,1 +8,1 +9,1 +100,100 diff --git a/challenge-165/james-smith/perl/examples/04-vertical-cluster.txt b/challenge-165/james-smith/perl/examples/04-vertical-cluster.txt new file mode 100644 index 0000000000..d22449e7df --- /dev/null +++ b/challenge-165/james-smith/perl/examples/04-vertical-cluster.txt @@ -0,0 +1,10 @@ +1,1 +1,2 +1,3 +1,4 +1,5 +1,6 +1,7 +1,8 +1,9 +199,100 diff --git a/challenge-165/james-smith/perl/examples/05-only-one-x.txt b/challenge-165/james-smith/perl/examples/05-only-one-x.txt new file mode 100644 index 0000000000..76802ba689 --- /dev/null +++ b/challenge-165/james-smith/perl/examples/05-only-one-x.txt @@ -0,0 +1,2 @@ +10,200 +10,10 diff --git a/challenge-165/james-smith/perl/examples/data1.txt b/challenge-165/james-smith/perl/examples/data1.txt deleted file mode 100644 index 42acc2b70b..0000000000 --- a/challenge-165/james-smith/perl/examples/data1.txt +++ /dev/null @@ -1,3 +0,0 @@ -53,10 -53,10,23,30 -23,30 diff --git a/challenge-165/james-smith/perl/examples/data2.txt b/challenge-165/james-smith/perl/examples/data2.txt deleted file mode 100644 index 9e5ecc346a..0000000000 --- a/challenge-165/james-smith/perl/examples/data2.txt +++ /dev/null @@ -1,6 +0,0 @@ -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/james-smith/perl/examples/data3.txt b/challenge-165/james-smith/perl/examples/data3.txt deleted file mode 100644 index dd2b0780d5..0000000000 --- a/challenge-165/james-smith/perl/examples/data3.txt +++ /dev/null @@ -1,10 +0,0 @@ -1,1 -2,1 -3,1 -4,1 -5,1 -6,1 -7,1 -8,1 -9,1 -100,100 diff --git a/challenge-165/james-smith/perl/examples/data4.txt b/challenge-165/james-smith/perl/examples/data4.txt deleted file mode 100644 index d22449e7df..0000000000 --- a/challenge-165/james-smith/perl/examples/data4.txt +++ /dev/null @@ -1,10 +0,0 @@ -1,1 -1,2 -1,3 -1,4 -1,5 -1,6 -1,7 -1,8 -1,9 -199,100 diff --git a/challenge-165/james-smith/perl/examples/data5.txt b/challenge-165/james-smith/perl/examples/data5.txt deleted file mode 100644 index 76802ba689..0000000000 --- a/challenge-165/james-smith/perl/examples/data5.txt +++ /dev/null @@ -1,2 +0,0 @@ -10,200 -10,10 diff --git a/challenge-165/james-smith/perl/fit.pl b/challenge-165/james-smith/perl/fit.pl new file mode 120000 index 0000000000..47aed1db5e --- /dev/null +++ b/challenge-165/james-smith/perl/fit.pl @@ -0,0 +1 @@ +object-orientated.pl \ No newline at end of file diff --git a/challenge-165/james-smith/perl/functional.pl b/challenge-165/james-smith/perl/functional.pl new file mode 100644 index 0000000000..6064e5dff7 --- /dev/null +++ b/challenge-165/james-smith/perl/functional.pl @@ -0,0 +1,147 @@ +#!/usr/local/bin/perl +use strict; + +use warnings; +use feature qw(say); + +my $DEF = { 'margin' => 40, 'max_w' => 960, 'max_h' => 540, + 'color' => '#000', 'stroke' => 3, + 'fill' => '#ccc', 'radius' => 10, + 'border' => '#000', 'bg' => '#eee' }; +my $LINE_TEMPLATE = ''; +my $POINT_TEMPLATE = ''; +my $SVG_TEMPLATE = ' + + + + + %s + + + %s + +'; + +my $config = { + 'margin' => 40, 'max_w' => 960, 'max_h' => 540, # Size of image & margins + 'stroke' => 5, 'color' => '#900', # Style for lines + 'radius' => 10, 'fill' => 'rgba(0,153,0,0.5)', # Style for dots + 'border' => '#009', 'bg' => '#ffd', # Style for "page".... +}; + +my $html = 'Examples

SVG examples

'; +for ( @ARGV ) { + my ($pts,$lines) = get_points_and_lines( $_ ); ## Parses file and updates lines/points + add_best_fit_line( $pts, $lines, $config->{'margin'} ) if $0 eq 'ch-2.pl'; ## Only if fitting line! + $html .= "

$_

". render_svg( $pts, $lines, $config ); ## add to HTML +} +say $html.''; + +##---------------------------------------------------------------------- +## Now the code does the real work.... +##---------------------------------------------------------------------- + +## Parse stdin / files given on command line, to return a list of points and lines.. +sub get_points_and_lines { + my($ps,$ls,@t)=([],[]); + local $/ = undef; + open my $ifh, '<', $_[0]; + + 4 == (@t = split /,/) ? ( push @{$ls}, [@t] ) ## Length 4 - line + : 2 == @t ? ( push @{$ps}, [@t] ) ## Length 2 - point + : ( warn "input error: $_" ) ## o/w error + for grep { $_ } split /\s+/, <$ifh>; + close $ifh; + ($ps,$ls); +} + +## Compute the best fit line for the points array (using linear regression... +## Assumes a dependency of y on x.... + +sub best_fit { + my $sx = my $sy = my $sxy = my $sxx = 0, my $n = @{$_[0]}; + $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] foreach @{$_[0]}; + return $sx/$n unless $n*$sxx - $sx*$sx; + my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); + ( ($sy-$b*$sx)/$n, $b ); +} + +## Get the range of x,y values for the given list of lines/points +## Returns a 4-tuple of min & max x and min & max y. + +sub get_ranges { + my( $ps, $ls ) = @_; + + ## rather than having a special cast as the first part of the loop, we start with the + ## values for the first point (or start of line if no points) + my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{$ps} ? @{$ps->[0]} : @{$ls->[0]}; + + ## Compute the range of all points. We comma separate conditions so we only need one postfix for + ## We use ($c)&&($a=?) to mimic if($c) { $a=? } so we can use the postfix loop... + ## Note we unravel the two ends of the line by mapping the each line ($_) to $_ + the last two values $_. + ($_->[0]<$min_x)&&($min_x=$_->[0]), ($_->[0]>$max_x)&&($max_x=$_->[0]), + ($_->[1]<$min_y)&&($min_y=$_->[1]), ($_->[1]>$max_y)&&($max_y=$_->[1]) for @{$ps}, map {($_,[$_->[2],$_->[3]])} @{$ls||[]}; + + ( $min_x, $max_x, $min_y, $max_y ); +} + +## Get the best fit line, and then extend it to edge of the box - by default we start with the line going from the left +## hand edge of the box to the right hand end. If either of these points lies outside the box we adjust the y-coord to +## the top/bottom of the box, and then alter the x coordinate. +## We treat the special case where the line is vertical ($b then contains the x-coordinate of all the points... by drawing +## a vertical line... +## +## Note we use the trick of assigning values (the new y-position) with in the ternary operators computing the x-position +## of the ends... + +sub add_best_fit_line { + my ($ps,$ls,$extn) = @_; + $extn //= $DEF->{'margin'}; + + my( $a, $b ) = best_fit( $ps ); + my( $min_x, $max_x, $min_y, $max_y ) = get_ranges( $ps ); + + ## special case of a vertical line + push( @{$ls}, [ $a, $min_y - $extn, $a, $max_y + $extn]), return unless defined $b; + + ## Normal case - get y coprdinates of end points, adjust if outside the box... + my $l_y = $a + $b * ($min_x - $extn); + my $r_y = $a + $b * ($max_x + $extn); + my $l_x = $l_y < $min_y - $extn ? ( ( $l_y = $min_y - $extn ) - $a)/$b + : $l_y > $max_y + $extn ? ( ( $l_y = $max_y + $extn ) - $a)/$b : $min_x - $extn; + my $r_x = $r_y < $min_y - $extn ? ( ( $r_y = $min_y - $extn ) - $a)/$b + : $r_y > $max_y + $extn ? ( ( $r_y = $max_y + $extn ) - $a)/$b : $max_x + $extn; + + push @{$ls}, [ $l_x,$l_y,$r_x,$r_y ]; +} + +## Finally the rendering of the points/lines, this uses most of the config entries to deal with colour, size etc. +## We get the range and again add the margin { we don't include the lines in the equation if we are doing challenge 2 +## the line fitting as otherwise we would extend the region twice... } +## +## Once we have the size of the image - we work out it's aspect ratio and work out whether we have to make the image +## narrower or shorter so that the image is no-bigger than the suggested size and that the image is as big as possible +## +## As we have a scaling between the x+y values and the size of the image - we need to adjust the size of dots/width of lines +## by multiplying these all by a scale factor + +sub render_svg { + my( $ps, $ls, $config ) = @_; + my %conf = (%{$DEF}, %{$config}); + my( $min_x, $max_x, $min_y, $max_y ) = get_ranges( $ps, $0 eq 'ch-2.pl' ? [] : $ls ); + my $margin = $conf{'margin'}; + + ## Adjust height and width so it fits the size from the config. + my($W,$H,$width,$height) = ($conf{'max_w'},$conf{'max_h'},$max_x-$min_x+2*$margin,$max_y-$min_y+2*$margin); + ( $width/$height > $W/$H ) ? ( $H = $height/$width*$W ) : ( $W = $width/$height*$H ); + ## Calculate the scale factor so that we keep spots/lines the same size irrespective of the ranges. + my $sf = $width/$W; + + sprintf $SVG_TEMPLATE, + $H, $W, $min_x - $margin, $min_y - $margin, $width, $height, ## svg element + $conf{'border'}, $sf, $conf{'bg'}, $min_x - $margin, $min_y - $margin, $width, $height, ## bg rect + $conf{'color'}, $conf{'stroke'} * $sf, join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } @{$ls} ), ## lines + $conf{'fill'}, join( qq(\n ), map { sprintf $POINT_TEMPLATE, @{$_}, $conf{'radius'}*$sf } @{$ps} ) ## points +} + diff --git a/challenge-165/james-smith/perl/object-orientated.pl b/challenge-165/james-smith/perl/object-orientated.pl new file mode 100644 index 0000000000..790507747b --- /dev/null +++ b/challenge-165/james-smith/perl/object-orientated.pl @@ -0,0 +1,28 @@ +#!/usr/local/bin/perl +use strict; + +use warnings; +use feature qw(say); +use Cwd qw(getcwd); + +BEGIN { push @INC, getcwd; }; +use SVG; + +my $config = { + 'margin' => 40, 'max_w' => 960, 'max_h' => 540, # Size of image & margins + 'stroke' => 5, 'color' => '#900', # Style for lines + 'radius' => 10, 'fill' => 'rgba(0,153,0,0.5)', # Style for dots + 'border' => '#009', 'bg' => '#ffd', # Style for "page".... +}; + +my $method = $0 eq 'fit.pl' ? 'render_with_best_fit' : 'render'; +say sprintf ' + + Examples: $0 + + +

SVG examples: %s

+ %s + +', $0, join "\n ", map { "

$_

". SVG->new( $config )->load_data( $_ )->$method } @ARGV ; + diff --git a/challenge-165/james-smith/perl/plot.pl b/challenge-165/james-smith/perl/plot.pl new file mode 120000 index 0000000000..47aed1db5e --- /dev/null +++ b/challenge-165/james-smith/perl/plot.pl @@ -0,0 +1 @@ +object-orientated.pl \ No newline at end of file -- cgit From 7c83f334c6abda21d945945ba8f0da5ff388b833 Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 18 May 2022 10:50:10 +0100 Subject: tidied up --- challenge-165/james-smith/perl/SVG.pm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/challenge-165/james-smith/perl/SVG.pm b/challenge-165/james-smith/perl/SVG.pm index d2d8323c17..9a9ca6b77b 100644 --- a/challenge-165/james-smith/perl/SVG.pm +++ b/challenge-165/james-smith/perl/SVG.pm @@ -95,7 +95,8 @@ sub best_fit { sub add_line_of_best_fit { my $self = shift; my ($a,$b) = $self->best_fit; - my ($min_x, $max_x, $min_y, $max_y, $extn) = ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'}, $self->{'config'}{'margin'} ); + my ( $min_x, $max_x, $min_y, $max_y, $extn ) = + ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'}, $self->{'config'}{'margin'} ); ## special case of a vertical line $self->add_lines( [ $a, $min_y - $extn, $a, $max_y + $extn] ), return $self unless defined $b; @@ -114,7 +115,8 @@ sub calculate_image_size { my $margin = $self->{'config'}{'margin'}; ## Adjust height and width so it fits the size from the self->{'config'}ig. - my($W,$H,$width,$height) = ($self->{'config'}{'max_w'},$self->{'config'}{'max_h'},$self->{'max_x'}-$self->{'min_x'}+2*$margin,$self->{'max_y'}-$self->{'min_y'}+2*$margin); + my($W,$H,$width,$height) = ($self->{'config'}{'max_w'},$self->{'config'}{'max_h'}, + $self->{'max_x'}-$self->{'min_x'}+2*$margin,$self->{'max_y'}-$self->{'min_y'}+2*$margin); ( $width/$height > $W/$H ) ? ( $H = $height/$width*$W ) : ( $W = $width/$height*$H ); ## Calculate the scale factor so that we keep spots/lines the same size irrespective of the ranges. ( $self->{'width'}, $self->{'height'}, $self->{'scale'} ) = ( $W, $H, $width/$W ); @@ -133,8 +135,8 @@ sub render { sub _render { my $self = shift; - $self->calculate_image_size(); - my $margin = $self->{'config'}{'margin'}; + $self->calculate_image_size(); ## Given max height/width work out the dimensions of image and the scale factor. + my $margin = $self->{'config'}{'margin'}; ## Get margin... sprintf $SVG_TEMPLATE, $self->{'height'}, $self->{'width'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, @@ -142,8 +144,10 @@ sub _render { $self->{'config'}{'border'}, $self->{'scale'}, $self->{'config'}{'bg'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, - $self->{'config'}{'color'}, $self->{'config'}{'stroke'} * $self->{'scale'}, join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } @{$self->{'lines'}} ), ## lines - $self->{'config'}{'fill'}, join( qq(\n ), map { sprintf $POINT_TEMPLATE, @{$_}, $self->{'config'}{'radius'}*$self->{'scale'} } @{$self->{'points'}} ) ## points + $self->{'config'}{'color'}, $self->{'config'}{'stroke'} * $self->{'scale'}, + join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } @{$self->{'lines'}} ), ## lines + $self->{'config'}{'fill'}, join( qq(\n ), + map { sprintf $POINT_TEMPLATE, @{$_}, $self->{'config'}{'radius'}*$self->{'scale'} } @{$self->{'points'}} ) ## points } -- cgit From acb344474346813aab5e3db342939de9c23ab60e Mon Sep 17 00:00:00 2001 From: drbaggy Date: Wed, 18 May 2022 11:07:53 +0100 Subject: tidied up --- challenge-165/james-smith/perl/object-orientated.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/challenge-165/james-smith/perl/object-orientated.pl b/challenge-165/james-smith/perl/object-orientated.pl index 790507747b..431d67377c 100644 --- a/challenge-165/james-smith/perl/object-orientated.pl +++ b/challenge-165/james-smith/perl/object-orientated.pl @@ -16,6 +16,7 @@ my $config = { }; my $method = $0 eq 'fit.pl' ? 'render_with_best_fit' : 'render'; + say sprintf ' Examples: $0 -- cgit From 754e62b50d43251183c8514047b3a79f75bdbe65 Mon Sep 17 00:00:00 2001 From: James Smith Date: Wed, 18 May 2022 11:49:31 +0100 Subject: Update README.md --- challenge-165/james-smith/README.md | 208 ++++++++++++++++++++++++++++++++++++ 1 file changed, 208 insertions(+) diff --git a/challenge-165/james-smith/README.md b/challenge-165/james-smith/README.md index 065063da5b..bfcc50acb4 100644 --- a/challenge-165/james-smith/README.md +++ b/challenge-165/james-smith/README.md @@ -344,3 +344,211 @@ sub render_svg { join( qq(\n ), map { sprintf '', @{$_}, ($config->{'radius'}//10)*$sf } @{$ps} ) } ``` + +# Object oriented version + +Although recently object-oriented coding has been discussed on the perl mailing lists - this is an example where OO code can make some things easier. + +Rather than using global variables - and some "hacky" passing around we can store a lot more of these on the object itself. + +We will create an object of class "SVG", this class has methods which will initialise, load data, and render with or without the best fit line. +The code is this. + +```perl +#!/usr/local/bin/perl +use strict; + +use warnings; +use feature qw(say); +use Cwd qw(getcwd); + +BEGIN { push @INC, getcwd; }; +use SVG; + +my $config = { + 'margin' => 40, 'max_w' => 960, 'max_h' => 540, # Size of image & margins + 'stroke' => 5, 'color' => '#900', # Style for lines + 'radius' => 10, 'fill' => 'rgba(0,153,0,0.5)', # Style for dots + 'border' => '#009', 'bg' => '#ffd', # Style for "page".... +}; + +my $method = $0 eq 'fit.pl' ? 'render_with_best_fit' : 'render'; + +say sprintf ' + + Examples: $0 + + +

SVG examples: %s

+ %s + +', $0, join "\n ", map { "

$_

". SVG->new( $config )->load_data( $_ )->$method } @ARGV ; +``` + +Tthe important lines are: + +```perl +my $method = $0 eq 'fit.pl' ? 'render_with_best_fit' : 'render'; +say SVG->new( $config )->load_data( $fn )->$method; +``` + +which choose which method we are going to use to render (fit.pl - fit line). Once we have decided this we create and configure the SVG object, load the data in and render... + +The definition of the class is, which has many of the same methods as the functional version, but the arrays of points and lines, the configuration and additional information about the size of the image are stored in the object so don't have to be passed around as function parameters or left as global variables which makes things + +```perl +package SVG; +use warnings; +use feature qw(say); +use Data::Dumper qw(Dumper); +use Const::Fast qw(const); + +const my $DEFAULT_CONFIG => { 'margin' => 40, 'max_w' => 960, 'max_h' => 540, + 'color' => '#000', 'stroke' => 3, + 'fill' => '#ccc', 'radius' => 10, + 'border' => '#000', 'bg' => '#eee' }; +const my $LINE_TEMPLATE => ''; +const my $POINT_TEMPLATE => ''; +const my $SVG_TEMPLATE => ' + + + + + %s + + + %s + +'; + + +sub new { + my ( $class, $config ) = @_; + my $self = { + 'config' => { %{$DEFAULT_CONFIG}, %{$config} }, + 'points' => [], + 'lines' => [], + 'min_x' => undef, + 'max_x' => undef, + 'min_y' => undef, + 'max_y' => undef, + 'width' => undef, + 'height' => undef, + 'scale' => undef, + }; + bless $self, $class; + $self; +} + +sub load_data { + my( $self, $fn, @t ) = @_; + local $/ = undef; + open my $ifh, '<', $fn; + 4 == (@t = split /,/) ? ( push @{$self->{'lines'}}, [@t] ) ## Length 4 - line + : 2 == @t ? ( push @{$self->{'points'}}, [@t] ) ## Length 2 - point + : ( warn "input error: $_" ) ## o/w error + for grep { /\S/ } split /\s+/, <$ifh>; + close $ifh; + $self; +} + +sub add_points { + my( $self, @points ) = @_; + push @{$self->{'points'}}, @points; + $self; +} + +sub add_lines { + my( $self, @lines ) = @_; + push @{$self->{'lines'}}, @lines; + $self; +} + +sub get_range { + my $self = shift; + + ## rather than having a special cast as the first part of the loop, we start with the + ## values for the first point (or start of line if no points) + my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{$self->{'points'}} ? @{$self->{'points'}[1]} : @{$self->{'lines'}[0]}; + + ## Compute the range of all points. We comma separate conditions so we only need one postfix for + ## We use ($c)&&($a=?) to mimic if($c) { $a=? } so we can use the postfix loop... + ## Note we unravel the two ends of the line by mapping the each line ($_) to $_ + the last two values $_. + ($_->[0]<$min_x)&&($min_x=$_->[0]), ($_->[0]>$max_x)&&($max_x=$_->[0]), + ($_->[1]<$min_y)&&($min_y=$_->[1]), ($_->[1]>$max_y)&&($max_y=$_->[1]) + for @{$self->{'points'}}, map {($_,[$_->[2],$_->[3]])} @{$self->{'lines'}||[]}; + ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'} ) = ( $min_x, $max_x, $min_y, $max_y ); + $self; +} + +sub best_fit { + my $self = shift; + my $sx = my $sy = my $sxy = my $sxx = 0, my $n = @{$self->{'points'}}; + $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] for @{$self->{'points'}}; + return $sx/$n unless $n*$sxx - $sx*$sx; + my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); + ( ($sy-$b*$sx)/$n, $b ); +} + +sub add_line_of_best_fit { + my $self = shift; + my ($a,$b) = $self->best_fit; + my ( $min_x, $max_x, $min_y, $max_y, $extn ) = + ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'}, $self->{'config'}{'margin'} ); + ## special case of a vertical line + $self->add_lines( [ $a, $min_y - $extn, $a, $max_y + $extn] ), return $self unless defined $b; + + ## Normal case - get y coprdinates of end points, adjust if outside the box... + my $l_y = $a + $b * ($min_x - $extn); + my $r_y = $a + $b * ($max_x + $extn); + my $l_x = $l_y < $min_y - $extn ? ( ( $l_y = $min_y - $extn ) - $a)/$b + : $l_y > $max_y + $extn ? ( ( $l_y = $max_y + $extn ) - $a)/$b : $min_x - $extn; + my $r_x = $r_y < $min_y - $extn ? ( ( $r_y = $min_y - $extn ) - $a)/$b + : $r_y > $max_y + $extn ? ( ( $r_y = $max_y + $extn ) - $a)/$b : $max_x + $extn; + $self->add_lines( [ $l_x, $l_y, $r_x, $r_y ] ); +} + +sub calculate_image_size { + my $self = shift; + my $margin = $self->{'config'}{'margin'}; + + ## Adjust height and width so it fits the size from the self->{'config'}ig. + my($W,$H,$width,$height) = ($self->{'config'}{'max_w'},$self->{'config'}{'max_h'}, + $self->{'max_x'}-$self->{'min_x'}+2*$margin,$self->{'max_y'}-$self->{'min_y'}+2*$margin); + ( $width/$height > $W/$H ) ? ( $H = $height/$width*$W ) : ( $W = $width/$height*$H ); + ## Calculate the scale factor so that we keep spots/lines the same size irrespective of the ranges. + ( $self->{'width'}, $self->{'height'}, $self->{'scale'} ) = ( $W, $H, $width/$W ); + $self; +} + +sub render_with_best_fit { + my $self = shift; + return $self->get_range()->add_line_of_best_fit()->__render(); +} + +sub render { + my $self = shift; + return $self->get_range()->__render(); +} + +sub __render { + my $self = shift; + $self->calculate_image_size(); ## Given max height/width work out the dimensions of image and the scale factor. + my $margin = $self->{'config'}{'margin'}; ## Get margin... + sprintf $SVG_TEMPLATE, + $self->{'height'}, $self->{'width'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, + $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, + $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, + $self->{'config'}{'border'}, $self->{'scale'}, $self->{'config'}{'bg'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, + $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, + $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, + $self->{'config'}{'color'}, $self->{'config'}{'stroke'} * $self->{'scale'}, + join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } @{$self->{'lines'}} ), ## lines + $self->{'config'}{'fill'}, join( qq(\n ), + map { sprintf $POINT_TEMPLATE, @{$_}, $self->{'config'}{'radius'}*$self->{'scale'} } @{$self->{'points'}} ) ## points + +} + +1; +``` -- cgit From c2aab9b27da177963f91bd93079b673e34b2134b Mon Sep 17 00:00:00 2001 From: James Smith Date: Wed, 18 May 2022 12:09:23 +0100 Subject: Create simple.svg --- challenge-165/james-smith/simple.svg | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 challenge-165/james-smith/simple.svg diff --git a/challenge-165/james-smith/simple.svg b/challenge-165/james-smith/simple.svg new file mode 100644 index 0000000000..8e97d0084f --- /dev/null +++ b/challenge-165/james-smith/simple.svg @@ -0,0 +1,11 @@ + + + + + + + + + + -- cgit From e5fa1ba2fd3414349ab8d3c04e2c7cfc5c82216d Mon Sep 17 00:00:00 2001 From: drbaggy Date: Fri, 20 May 2022 05:05:03 +0100 Subject: tidied up OO --- challenge-165/james-smith/perl/SVG.pm | 183 +++++++++++++++++----------------- 1 file changed, 91 insertions(+), 92 deletions(-) diff --git a/challenge-165/james-smith/perl/SVG.pm b/challenge-165/james-smith/perl/SVG.pm index 9a9ca6b77b..7e8c413244 100644 --- a/challenge-165/james-smith/perl/SVG.pm +++ b/challenge-165/james-smith/perl/SVG.pm @@ -4,13 +4,16 @@ use feature qw(say); use Data::Dumper qw(Dumper); use Const::Fast qw(const); -const my $DEFAULT_CONFIG => { 'margin' => 40, 'max_w' => 960, 'max_h' => 540, - 'color' => '#000', 'stroke' => 3, - 'fill' => '#ccc', 'radius' => 10, - 'border' => '#000', 'bg' => '#eee' }; +## ----------------------------------- +## Constants - configuration & SVG templates... +## ----------------------------------- + +const my %DEFAULT_CONFIG => ( 'margin' => 40, 'max_w' => 960, 'max_h' => 540, 'color' => '#000', 'stroke' => 3, + 'fill' => '#ccc', 'radius' => 10, 'border' => '#000', 'bg' => '#eee' ); const my $LINE_TEMPLATE => ''; const my $POINT_TEMPLATE => ''; -const my $SVG_TEMPLATE => ' +const my $SVG_TEMPLATE => +' @@ -24,131 +27,127 @@ const my $SVG_TEMPLATE => ''; +## ----------------------------------- +## Constructor +## ----------------------------------- + sub new { my ( $class, $config ) = @_; my $self = { - 'config' => { %{$DEFAULT_CONFIG}, %{$config} }, - 'points' => [], - 'lines' => [], - 'min_x' => undef, - 'max_x' => undef, - 'min_y' => undef, - 'max_y' => undef, - 'width' => undef, - 'height' => undef, - 'scale' => undef, + 'config' => { %DEFAULT_CONFIG }, + 'points' => [], 'lines' => [], 'range' => [], 'size' => [], + 'scale' => 1, }; bless $self, $class; - $self; + $self->update_config( %{$config} ) + ->set_range( 0, 0, $self->max_w, $self->max_h ) + ->set_size( $self->max_w, $self->max_h ) } +## ----------------------------------- +## Getters.... +## ----------------------------------- + +sub min_x { $_[0]{'range'}[0] } sub min_y { $_[0]{'range'}[1] } +sub max_x { $_[0]{'range'}[2] } sub max_y { $_[0]{'range'}[3] } +sub width { $_[0]{'size'}[0] } sub height { $_[0]{'size'}[1] } +sub points { @{$_[0]{'points'}} } sub lines { @{$_[0]{'lines'}} } +sub scale { $_[0]{'scale'} } sub config { $_[0]{'config'}{$_[1]} } +sub margin { $_[0]->config('margin') } +sub max_w { $_[0]->config('max_w') } sub max_h { $_[0]->config('max_h') } +sub color { $_[0]->config('color') } sub stroke { $_[0]->config('stroke') } +sub fill { $_[0]->config('fill') } sub radius { $_[0]->config('radius') } +sub border { $_[0]->config('border') } sub bg { $_[0]->config('bg') } + +## ----------------------------------- +## Setters.. +## ----------------------------------- + +sub add_point { my( $self, @coord ) = @_; push @{$self->{'points'}}, [@coord]; $self } +sub add_points { my( $self, @points ) = @_; push @{$self->{'points'}}, @points; $self } +sub add_line { my( $self, @coord ) = @_; push @{$self->{'lines'}}, [@coord]; $self } +sub add_lines { my( $self, @lines ) = @_; push @{$self->{'lines'}}, @lines; $self } +sub set_size { my( $self, $w, $h ) = @_; $self->{'size'} = [ $w, $h ]; $self } +sub set_range { my( $self, $l, $b, $r, $t ) = @_; $self->{'range'} = [ $l, $b, $r, $t ]; $self } +sub set_scale { my( $self, $scale ) = @_; $self->{'scale'} = $scale; $self } + +sub update_config { my( $self, %pars ) = @_; + ( exists $self->{'config'}{$_} ) && ( $self->{'config'}{$_} = $pars{$_} ) for keys %pars; $self } + +## -------------------------------------------------------- +## The real code - no direct references to the $self hash! +## -------------------------------------------------------- + sub load_data { my( $self, $fn, @t ) = @_; local $/ = undef; open my $ifh, '<', $fn; - 4 == (@t = split /,/) ? ( push @{$self->{'lines'}}, [@t] ) ## Length 4 - line - : 2 == @t ? ( push @{$self->{'points'}}, [@t] ) ## Length 2 - point - : ( warn "input error: $_" ) ## o/w error + 4 == (@t = split /,/) ? ( $self->add_line( @t ) ) ## Length 4 - line + : 2 == @t ? ( $self->add_point( @t ) ) ## Length 2 - point + : ( warn "input error: $_" ) ## o/w error for grep { /\S/ } split /\s+/, <$ifh>; close $ifh; $self; } -sub add_points { - my( $self, @points ) = @_; - push @{$self->{'points'}}, @points; - $self; -} - -sub add_lines { - my( $self, @lines ) = @_; - push @{$self->{'lines'}}, @lines; - $self; -} - -sub get_range { +sub compute_range { my $self = shift; + my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{ $self->points ? ($self->points)[0] : ($self->lines)[0] }; - ## rather than having a special cast as the first part of the loop, we start with the - ## values for the first point (or start of line if no points) - my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{$self->{'points'}} ? @{$self->{'points'}[1]} : @{$self->{'lines'}[0]}; - - ## Compute the range of all points. We comma separate conditions so we only need one postfix for - ## We use ($c)&&($a=?) to mimic if($c) { $a=? } so we can use the postfix loop... - ## Note we unravel the two ends of the line by mapping the each line ($_) to $_ + the last two values $_. ($_->[0]<$min_x)&&($min_x=$_->[0]), ($_->[0]>$max_x)&&($max_x=$_->[0]), ($_->[1]<$min_y)&&($min_y=$_->[1]), ($_->[1]>$max_y)&&($max_y=$_->[1]) - for @{$self->{'points'}}, map {($_,[$_->[2],$_->[3]])} @{$self->{'lines'}||[]}; - ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'} ) = ( $min_x, $max_x, $min_y, $max_y ); - $self; -} + for $self->points, map { ($_, [$_->[2],$_->[3]]) } $self->lines; -sub best_fit { - my $self = shift; - my $sx = my $sy = my $sxy = my $sxx = 0, my $n = @{$self->{'points'}}; - $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] for @{$self->{'points'}}; - return $sx/$n unless $n*$sxx - $sx*$sx; - my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); - ( ($sy-$b*$sx)/$n, $b ); + $self->set_range( $min_x, $min_y, $max_x, $max_y ); } sub add_line_of_best_fit { my $self = shift; - my ($a,$b) = $self->best_fit; - my ( $min_x, $max_x, $min_y, $max_y, $extn ) = - ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'}, $self->{'config'}{'margin'} ); - ## special case of a vertical line - $self->add_lines( [ $a, $min_y - $extn, $a, $max_y + $extn] ), return $self unless defined $b; - - ## Normal case - get y coprdinates of end points, adjust if outside the box... - my $l_y = $a + $b * ($min_x - $extn); - my $r_y = $a + $b * ($max_x + $extn); - my $l_x = $l_y < $min_y - $extn ? ( ( $l_y = $min_y - $extn ) - $a)/$b - : $l_y > $max_y + $extn ? ( ( $l_y = $max_y + $extn ) - $a)/$b : $min_x - $extn; - my $r_x = $r_y < $min_y - $extn ? ( ( $r_y = $min_y - $extn ) - $a)/$b - : $r_y > $max_y + $extn ? ( ( $r_y = $max_y + $extn ) - $a)/$b : $max_x + $extn; - $self->add_lines( [ $l_x, $l_y, $r_x, $r_y ] ); + my $sx = my $sy = my $sxy = my $sxx = 0, my $n = $self->points; + + $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] for $self->points; + + return $self->add_line( $sx/$n, $self->min_y - $self->margin, $sx/$n, $self->max_y + $self->margin ) + unless $n*$sxx - $sx*$sx; ## special case of a vertical line + + my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); my $a = ($sy-$b*$sx)/$n; + my ( $l, $r, $d, $t ) = ( $self->min_x - $self->margin, $self->max_x + $self->margin, + $self->min_y - $self->margin, $self->max_y + $self->margin ); + + my $l_y = $a + $b * $l; + my $r_y = $a + $b * $r; + my $l_x = $l_y < $d ? ( ( $l_y = $d ) - $a)/$b : $l_y > $t ? ( ( $l_y = $t ) - $a)/$b : $l; + my $r_x = $r_y < $d ? ( ( $r_y = $d ) - $a)/$b : $r_y > $t ? ( ( $r_y = $t ) - $a)/$b : $r; + + $self->add_line( $l_x, $l_y, $r_x, $r_y ); } sub calculate_image_size { my $self = shift; - my $margin = $self->{'config'}{'margin'}; - ## Adjust height and width so it fits the size from the self->{'config'}ig. - my($W,$H,$width,$height) = ($self->{'config'}{'max_w'},$self->{'config'}{'max_h'}, - $self->{'max_x'}-$self->{'min_x'}+2*$margin,$self->{'max_y'}-$self->{'min_y'}+2*$margin); + my($W,$H,$width,$height) = ( $self->max_w, $self->max_h, + $self->max_x-$self->min_x+2*$self->margin,$self->max_y-$self->min_y+2*$self->margin); ( $width/$height > $W/$H ) ? ( $H = $height/$width*$W ) : ( $W = $width/$height*$H ); - ## Calculate the scale factor so that we keep spots/lines the same size irrespective of the ranges. - ( $self->{'width'}, $self->{'height'}, $self->{'scale'} ) = ( $W, $H, $width/$W ); - $self; -} -sub render_with_best_fit { - my $self = shift; - return $self->get_range()->add_line_of_best_fit()->_render(); + $self->set_size( $W, $H )->set_scale( $width / $W ); } -sub render { - my $self = shift; - return $self->get_range()->_render(); -} +sub render_with_best_fit { shift->compute_range->add_line_of_best_fit->_render } +sub render { shift->compute_range->_render } sub _render { my $self = shift; - $self->calculate_image_size(); ## Given max height/width work out the dimensions of image and the scale factor. - my $margin = $self->{'config'}{'margin'}; ## Get margin... - sprintf $SVG_TEMPLATE, - $self->{'height'}, $self->{'width'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, - $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, - $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, - $self->{'config'}{'border'}, $self->{'scale'}, $self->{'config'}{'bg'}, $self->{'min_x'} - $margin, $self->{'min_y'} - $margin, - $self->{'max_x'} - $self->{'min_x'} + 2 * $margin, - $self->{'max_y'} - $self->{'min_y'} + 2 * $margin, - $self->{'config'}{'color'}, $self->{'config'}{'stroke'} * $self->{'scale'}, - join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } @{$self->{'lines'}} ), ## lines - $self->{'config'}{'fill'}, join( qq(\n ), - map { sprintf $POINT_TEMPLATE, @{$_}, $self->{'config'}{'radius'}*$self->{'scale'} } @{$self->{'points'}} ) ## points + $self->calculate_image_size; ## Given max height/width work out the dimensions of image and the scale factor. + my $margin = $self->margin; ## Get margin... + + sprintf $SVG_TEMPLATE, + $self->height, $self->width, $self->min_x - $margin, $self->min_y - $margin, + $self->max_x - $self->min_x + 2 * $margin, $self->max_y - $self->min_y + 2 * $margin, + $self->border, $self->scale, $self->bg, $self->min_x - $margin, $self->min_y - $margin, + $self->max_x - $self->min_x + 2 * $margin, $self->max_y - $self->min_y + 2 * $margin, + $self->color, $self->stroke * $self->scale, join( qq(\n ), map { sprintf $LINE_TEMPLATE, @{$_} } $self->lines ), ## lines + $self->fill, join( qq(\n ), map { sprintf $POINT_TEMPLATE, @{$_}, $self->radius*$self->scale } $self->points ) ## points } 1; -- cgit From d12ce487c56ed972348cc05ebd0370311b7e75a2 Mon Sep 17 00:00:00 2001 From: James Smith Date: Fri, 20 May 2022 08:10:18 +0100 Subject: Update README.md --- challenge-165/james-smith/README.md | 203 +++++++++++++++++------------------- 1 file changed, 95 insertions(+), 108 deletions(-) diff --git a/challenge-165/james-smith/README.md b/challenge-165/james-smith/README.md index bfcc50acb4..6942c5cd2c 100644 --- a/challenge-165/james-smith/README.md +++ b/challenge-165/james-smith/README.md @@ -403,16 +403,19 @@ use feature qw(say); use Data::Dumper qw(Dumper); use Const::Fast qw(const); -const my $DEFAULT_CONFIG => { 'margin' => 40, 'max_w' => 960, 'max_h' => 540, - 'color' => '#000', 'stroke' => 3, - 'fill' => '#ccc', 'radius' => 10, - 'border' => '#000', 'bg' => '#eee' }; -const my $LINE_TEMPLATE => ''; -const my $POINT_TEMPLATE => ''; -const my $SVG_TEMPLATE => ' +## ----------------------------------- +## Constants - cnfuration & SVG templates... +## ----------------------------------- + +const my %DEF_CNF => ( 'margin' => 40, 'max_w' => 960, 'max_h' => 540, 'color' => '#000', 'stroke' => 3, + 'fill' => '#ccc', 'radius' => 10, 'border' => '#000', 'bg' => '#eee' ); +const my $JOIN => "\n "; +const my $LN_TMPL => ''; +const my $PT_TMPL => ''; +const my $SVG_TMPL => ' - + %s @@ -423,132 +426,116 @@ const my $SVG_TEMPLATE => ''; +## ----------------------------------- +## Constructor +## ----------------------------------- + sub new { - my ( $class, $config ) = @_; - my $self = { - 'config' => { %{$DEFAULT_CONFIG}, %{$config} }, - 'points' => [], - 'lines' => [], - 'min_x' => undef, - 'max_x' => undef, - 'min_y' => undef, - 'max_y' => undef, - 'width' => undef, - 'height' => undef, - 'scale' => undef, - }; - bless $self, $class; - $self; + my ( $class, $cnf ) = @_; + my $s = { 'cnf' => { %DEF_CNF }, 'scale' => 1, + 'points' => [], 'lines' => [], 'range' => [], 'size' => [] }; + bless $s, $class; + $s->update_cnf( %{$cnf} )->set_size( $s->max_w, $s->max_h ) + ->set_range( 0, 0, $s->max_w, $s->max_h ) } +## ----------------------------------- +## Getters.... +## ----------------------------------- + +sub min_x { $_[0]{'range'}[0] } sub min_y { $_[0]{'range'}[1] } +sub max_x { $_[0]{'range'}[2] } sub max_y { $_[0]{'range'}[3] } +sub width { $_[0]{'size'}[0] } sub height { $_[0]{'size'}[1] } +sub points { @{$_[0]{'points'}} } sub lines { @{$_[0]{'lines'}} } +sub scale { $_[0]{'scale'} } sub cnf { $_[0]{'cnf'}{$_[1]} } +sub max_w { $_[0]->cnf('max_w') } sub max_h { $_[0]->cnf('max_h') } +sub color { $_[0]->cnf('color') } sub stroke { $_[0]->cnf('stroke') } +sub fill { $_[0]->cnf('fill') } sub radius { $_[0]->cnf('radius') } +sub border { $_[0]->cnf('border') } sub bg { $_[0]->cnf('bg') } +sub margin { $_[0]->cnf('margin') } +sub bb_l { $_[0]->min_x-$_[0]->margin } sub bb_r { $_[0]->max_x+$_[0]->margin } +sub bb_b { $_[0]->min_y-$_[0]->margin } sub bb_t { $_[0]->max_y+$_[0]->margin } +sub bb_w { $_[0]->max_x-$_[0]->min_x+2*$_[0]->margin } +sub bb_h { $_[0]->max_y-$_[0]->min_y+2*$_[0]->margin } +## ----------------------------------- +## Setters.. +## ----------------------------------- + +sub add_point { my $s = shift; push @{$s->{'points'}}, [@_]; $s } +sub add_points { my $s = shift; push @{$s->{'points'}}, @_; $s } +sub add_line { my $s = shift; push @{$s->{'lines'}}, [@_]; $s } +sub add_lines { my $s = shift; push @{$s->{'lines'}}, @_; $s } +sub set_size { my $s = shift; $s->{'size'} = [@_]; $s } +sub set_range { my $s = shift; $s->{'range'} = [@_]; $s } +sub set_scale { my $s = shift; $s->{'scale'} = $_[0]; $s } + + +sub update_cnf {my($s,%p)=@_; exists$s->{'cnf'}{$_}&&($s->{'cnf'}{$_}=$p{$_}) for keys %p; $s} + +## -------------------------------------------------------- +## The real code - no direct references to the $s hash! +## -------------------------------------------------------- + sub load_data { - my( $self, $fn, @t ) = @_; + my( $s, $fn, @t ) = @_; local $/ = undef; open my $ifh, '<', $fn; - 4 == (@t = split /,/) ? ( push @{$self->{'lines'}}, [@t] ) ## Length 4 - line - : 2 == @t ? ( push @{$self->{'points'}}, [@t] ) ## Length 2 - point - : ( warn "input error: $_" ) ## o/w error + 4==(@t = split /,/) ? ($s->add_line(@t)) : 2==@t ? ($s->add_point(@t)) : (warn "Error: $_") for grep { /\S/ } split /\s+/, <$ifh>; close $ifh; - $self; -} - -sub add_points { - my( $self, @points ) = @_; - push @{$self->{'points'}}, @points; - $self; + $s; } -sub add_lines { - my( $self, @lines ) = @_; - push @{$self->{'lines'}}, @lines; - $self; -} - -sub get_range { - my $self = shift; - - ## rather than having a special cast as the first part of the loop, we start with the - ## values for the first point (or start of line if no points) - my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{$self->{'points'}} ? @{$self->{'points'}[1]} : @{$self->{'lines'}[0]}; +sub compute_range { + my $s = shift; + my( $min_x,$min_y ) = my( $max_x,$max_y ) = @{ $s->points ? ($s->points)[0] : ($s->lines)[0] }; - ## Compute the range of all points. We comma separate conditions so we only need one postfix for - ## We use ($c)&&($a=?) to mimic if($c) { $a=? } so we can use the postfix loop... - ## Note we unravel the two ends of the line by mapping the each line ($_) to $_ + the last two values $_. ($_->[0]<$min_x)&&($min_x=$_->[0]), ($_->[0]>$max_x)&&($max_x=$_->[0]), ($_->[1]<$min_y)&&($min_y=$_->[1]), ($_->[1]>$max_y)&&($max_y=$_->[1]) - for @{$self->{'points'}}, map {($_,[$_->[2],$_->[3]])} @{$self->{'lines'}||[]}; - ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'} ) = ( $min_x, $max_x, $min_y, $max_y ); - $self; -} + for $s->points, map { ($_, [$_->[2],$_->[3]]) } $s->lines; -sub best_fit { - my $self = shift; - my $sx = my $sy = my $sxy = my $sxx = 0, my $n = @{$self->{'points'}}; - $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] for @{$self->{'points'}}; - return $sx/$n unless $n*$sxx - $sx*$sx; - my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); - ( ($sy-$b*$sx)/$n, $b ); + $s->set_range( $min_x, $min_y, $max_x, $max_y ); } sub add_line_of_best_fit { - my $self = shift; - my ($a,$b) = $self->best_fit; - my ( $min_x, $max_x, $min_y, $max_y, $extn ) = - ( $self->{'min_x'}, $self->{'max_x'}, $self->{'min_y'}, $self->{'max_y'}, $self->{'config'}{'margin'} ); - ## special case of a vertical line - $self->add_lines( [ $a, $min_y - $extn, $a, $max_y + $extn] ), return $self unless defined $b; - - ## Normal case - get y coprdinates of end points, adjust if outside the box... - my $l_y = $a + $b * ($min_x - $extn); - my $r_y = $a + $b * ($max_x + $extn); - my $l_x = $l_y < $min_y - $extn ? ( ( $l_y = $min_y - $extn ) - $a)/$b - : $l_y > $max_y + $extn ? ( ( $l_y = $max_y + $extn ) - $a)/$b : $min_x - $extn; - my $r_x = $r_y < $min_y - $extn ? ( ( $r_y = $min_y - $extn ) - $a)/$b - : $r_y > $max_y + $extn ? ( ( $r_y = $max_y + $extn ) - $a)/$b : $max_x + $extn; - $self->add_lines( [ $l_x, $l_y, $r_x, $r_y ] ); + my $s = shift; + my $sx = my $sy = my $sxy = my $sxx = 0, my $n = $s->points; + + $sx += $_->[0], $sxy += $_->[0]*$_->[1], $sy += $_->[1], $sxx += $_->[0]*$_->[0] for $s->points; + + return $s->add_line( $sx/$n, $s->bb_b, $sx/$n, $s->bb_t ) + unless $n*$sxx - $sx*$sx; ## special case of a vertical line + + my $b = ( $n*$sxy-$sx*$sy ) / ( $n*$sxx - $sx*$sx ); my $a = ($sy-$b*$sx)/$n; + my ( $l, $r, $d, $t ) = ( $s->bb_l, $s->bb_r, $s->bb_b, $s->bb_t ); + my ( $l_y,$r_y ) = ( $a+$b*$l, $a+$b*$r ); + my ( $l_x,$r_x ) = ( $l_y<$d ? (($l_y=$d)-$a)/$b : $l_y>$t ? (($l_y=$t)-$a)/$b : $l, + $r_y<$d ? (($r_y=$d)-$a)/$b : $r_y>$t ? (($r_y=$t)-$a)/$b : $r ); + + $s->add_line( $l_x, $l_y, $r_x, $r_y ); } sub calculate_image_size { - my $self = shift; - my $margin = $self->{'config'}{'margin'}; + my $s = shift; - ## Adjust height and width so it fits the size from the self->{'config'}ig. - my($W,$H,$width,$height) = ($self->{'config'}{'max