diff options
| -rw-r--r-- | challenge-124/james-smith/README.md | 292 | ||||
| -rw-r--r-- | challenge-124/james-smith/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-124/james-smith/logo/ch-1.logo | 33 | ||||
| -rw-r--r-- | challenge-124/james-smith/perl/ch-1.pl | 55 | ||||
| -rw-r--r-- | challenge-124/james-smith/perl/ch-2.pl | 82 |
5 files changed, 366 insertions, 97 deletions
diff --git a/challenge-124/james-smith/README.md b/challenge-124/james-smith/README.md index 870c8f9a0a..96211096d5 100644 --- a/challenge-124/james-smith/README.md +++ b/challenge-124/james-smith/README.md @@ -1,4 +1,4 @@ -# Perl Weekly Challenge #123 +# Perl Weekly Challenge #124 You can find more information about this weeks, and previous weeks challenges at: @@ -10,136 +10,234 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-123/james-smith/perl +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-124/james-smith/perl -# Task 1 - Ugly Numbers +# Task 1 - Happy Women's Day -***You are given an integer `$n >= 1`. Write a script to find the $nth element of Ugly Numbers.*** - -**Defn:** Ugly numbers are those number whose prime factors are 2, 3 or 5. For example, the first 10 Ugly Numbers are 1, 2, 3, 4, 5, 6, 8, 9, 10, 12. +***Write a script to print the Venus Symbol, international gender symbol for women. Please feel free to use any character.*** ## The solution -There are two ways of working out the *nth* ugly number - we either have to search all numbers starting at 1 counting ugly numbers -OR- do something more "intellegent". +We will first look at the symbol defined in the question... + +``` + ^^^^^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^^^^^ + ^ + ^ + ^ + ^^^^^ + ^ + ^ +``` -The former works well for small `n`, but doesn't scale well as the ugly numbers become more sparse. +We note there are 3 types of rows: -### Method + * Type I: a line of 5 symbols (centered) + * Type II: a single symbol in the middle of the row + * Type III: two symbols either side of the middle at a given distance. -Any Ugly number is either a multiple of 2, 3 or 5 of another Ugly number. So to find the next ugly number we multiple all ugly numbers by 2, 3 or 5 and find the lowest value greater than the last ugly seen. +We encode these in an array -1 -> line of 5 symbols; 0 -> a single symbol at the centre; values > 0 - two points at the given distance away from the centre. The code becomes this: ```perl -sub nth_ugly { - my $n = shift; - state @uglies = (1); - while(1) { - return $uglies[$n-1] if $n <= @uglies; - my $next = 0; - foreach my $l (5,3,2) { - foreach(@uglies) { - next if $_ * $l <= $uglies[-1]; - $next = $_*$l if !$next || $next > $_*$l; - last; - } - } - push @uglies, $next; - } -} +my @pts = qw(-1 3 4 5 5 5 5 5 4 3 -1 0 0 0 -1 0 0); +say $_ < 0 ? ' ^^^^^' + : !$_ ? ' ^' + : ' ' x (6-$_) . '^' . ' 'x($_*2-1) .'^' + foreach @pts; ``` -We cache the values internally in the function - in the `state` variable `@uglies` +### Now for a more generic solution! -### Optimization +This symbol is just a circle and cross below. We can use trig to work out the points of the circle. To ensure we don't leave gaps we sweep the arcs away from the cardinal points (N,S,E,W) up to the ordinal points (NE,NW,SE,SW) - 8 different 45deg arcs. This way we just need to compute one point for each line and then compute the other co-ordinate using pythagorus' theorem. -We can speed this up by short-cutting the inner loop. - * All uglies are either a multiple of 2, 3 or 5 times another ugly (with the exception of 1). - * We keep track of the next ugly that is a multiple of 2, 3, 5 etc - we call these `$v2`, `$v3` and `$v5` respectively. These are `2*$uglies[$i2]`, `3*$uglies[$i3]`, `5*$uglies[$i5]`. - * Initially the values of `$l2`, `$l3`, `$l5`, `$v2`, `$v3`, `$v5` are `0`, `0`, `0`, `2`, `3`, `5`, and the list `@uglies` is initialized with the value `(1)`. - * Every time we need a new ugly, we find it as the lowest value of `$v2`, `$v3`, `$v5`. We then `push` it onto `@uglies`. - * Now we need to update `$v2`, `$v3` and `$v5` if they are equal to this value. We do this by incrementing the index `$i2`, `$i3` and/or `$i5` and then setting - `$v? = ?*$uglies[$i?]`... This will often update 2 or even all 3 of the values... +Why do we do this? If we just did 4 arcs of 90 degrees we would find that once we passed 45 degrees we would miss out points... -Additionally we speed up the code by keeping a cache of ugly values we have found, and if we are asked for one we return that value from the cache, if not as we have -kept the state of the loop we just continue from where we left off with the values of `$l2`, `$l3`, `$l5`, `$v2`, `$v3`, `$v5` which are also held in the state -variable. +Our process has 4 steps. -This gives us the following optimized perl code. + 1. Create a blank canvas + 2. Draw the circle (note when we compute the y value we take half off the radius - this gives a better circle as we are tracing a line through the centre of the "squares"... + 3. Draw the cross + 4. Display the canvas... ```perl -sub nth_ugly_opt { - my $n = shift; - state $l2 = 0; state $l3 = 0; state $l5 = 0; - state $v2 = 2; state $v3 = 3; state $v5 = 5; - state @uglies = (1); - return $uglies[$n-1] if $n <= @uglies; - while( @uglies < $n ) { - push @uglies, my $next = $v2<$v3 && $v2<$v5 ? $v2 : $v3<$v5 ? $v3 : $v5; - $v2 = $uglies[++$l2]*2 if $v2 == $next; - $v3 = $uglies[++$l3]*3 if $v3 == $next; - $v5 = $uglies[++$l5]*5 if $v5 == $next; - } - return $uglies[-1]; +## Create the canvas.. +my @a = map { ' ' x ($radius*2+1) } 0..$radius*2+$cross; + +## Now we draw the circle... +foreach my $x (0 .. ceil($radius*0.71)) { + my $y = int sqrt( ($radius-.5)**2 - $x**2 ); + substr $a[ $radius - $x ],$radius-$y,1,'^'; + substr $a[ $radius + $x ],$radius-$y,1,'^'; + substr $a[ $radius - $x ],$radius+$y,1,'^'; + substr $a[ $radius + $x ],$radius+$y,1,'^'; + substr $a[ $radius - $y ],$radius-$x,1,'^'; + substr $a[ $radius + $y ],$radius-$x,1,'^'; + substr $a[ $radius - $y ],$radius+$x,1,'^'; + substr $a[ $radius + $y ],$radius+$x,1,'^'; } + +## And the two parts of the cross... +substr $a[2*$radius+$_],$radius,1,'^' foreach 0..$cross; +substr $a[2*$radius+$cross/2],$radius-$cross/2,$cross+1,'^'x($cross+1); + +### Finally we render the canvas... +say $_ foreach @a; ``` -Below is the performance of the methods. Note these were tested without using `state` variables, as the caching nature of -state variables prevents benchmarking (values are obtained directly from the cache) - although if you were using this in a -real world situation that would be an advantage! Scanning where `n` is greater than 500 takes too long to get accurate -benchmarks. +Example output... +``` + ^^^^^^^^^ + ^^^ ^^^ + ^^ ^^ + ^^ ^^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^ ^ + ^^ ^^ + ^^ ^^ + ^^^ ^^^ + ^^^^^^^^^ + ^ + ^ + ^ + ^ + ^ + ^ + ^^^^^^^^^^^^^ + ^ + ^ + ^ + ^ + ^ + ^ +``` -| n | Ugly_n | scan /s | simple /s | opt /s | opt vs sim % | sim vs scn % | opt vs scn % | -| -----: | -------------------------: | --------: | ------------: | ------------: | -----------: | -----------: | -----------: | -| 1 | 1 | *938,492* | **3,005,191** | 1,799,451 | -40 | 220 | 92 | -| 2 | 2 | *536,552* | 816,345 | **1,089,848** | 34 | 52 | 103 | -| 5 | 5 | *234,116* | 238,716 | **455,051** | 91 | 2 | 94 | -| 10 | 12 | 98,061 | *77,865* | **250,411** | 222 | -21 | 155 | -| 20 | 36 | 32,105 | *21,225* | **130,707** | 516 | -34 | 307 | -| 50 | 243 | *4,289* | 5,504 | **43,065** | 682 | 28 | 904 | -| 100 | 1,536 | *724* | 1,203 | **24,768** | 1,959 | 66 | 3,321 | -| 200 | 16,200 | *63.50* | 272 | **12,470** | 4,485 | 328 | 19,538 | -| 500 | 937,500 | *0.57* | 48 | **4,639** | 9,565 | 8,306 | 812,334 | -| 1,000 | 51,200,000 | *-* | 10.60 | **2,503** | 23,513 | - | - | -| 2,000 | 8,062,156,800 | *-* | 2.75 | **1,187** | 43,064 | - | - | -| 5,000 | 50,837,316,566,580 | *-* | 0.41 | **375** | 91,812 | - | - | -| 10,000 | 288,325,195,312,500,000 | *-* | 0.08 | **230** | 273,710 | - | - | -| 13,282 | 18,432,000,000,000,000,000 | *-* | 0.05 | **148** | 302,757 | - | - | +## Alternative languages +As this was a script to generate an image - why not go back to learning languages after we had looked at CESIL, and visit the learning language of the 70s & 80s - LOGO. A graphic language where you drive a "turtle" around the screen. -# Task 2 - Square Points +```logo +setpensize 4 +pendown -***You are given coordinates of four points i.e. (x1, y1), (x2, y2), (x3, y3) and (x4, y4). Write a script to find out if the given four points form a square.*** +;cross +back 300 +forward 150 +left 90 +forward 150 +back 300 +forward 150 +right 90 +forward 150 -## Assumption +;circle +right 89 +repeat 180 [ + forward 10 + left 2 +] -We will assume that the points are not in any particular order (The sequare may be p1->p2->p3->p4 OR p1->p3->p2->p4) -## Solution +penup +``` +# Task 2 - Tug of War -First we need to think how we define a square - it has 4 sides of equal length and sides at right angles. If we want to define it terms of distances between points we have 4 pairs of points that are the same distance apart and two pairs of points which are at `sqrt(2)` times this distance. +***You are given a set of `$n` integers `(n1, n2, n3, ...)`. Write a script to divide the set in two subsets of `n/2` sizes each so that the difference of the sum of two subsets is the least. If `$n` is even then each subset must be of size `$n/2` each. In case `$n` is odd then one subset must be `($n-1)/2` and other must be `($n+1)/2`.*** + +## Solution -**Note:** There are two other combinations of points for which 4 of the distances are the same and 2 of the distances and the same. These are: - * an isosceles triangle with an inscribed equilateral triangle - the ratio of the two squares is `2+sqrt(3)` - * a kite - for which one half is an equilateral triangle and the other has height `1-sqrt(3)/2` - the ratio of the two squares is `2-sqrt(3)`. +We will use an iterative solution. We start by allocating person 1 to team 1, we then iterate down allocating each person to either team 1 or team 2. If either team gets too big we bomb out (this makes this solution more efficient than the non-iterative solution). As we go we keep a tally of the difference between the two teams weights. -There are three other combinations of points for which there are only two distances. - * With 5 of one length and 1 of another - we have an rhomobus consisting of two equilateral triangles (ratio of squares is 3) - * With 3 of one length and 3 of another - we have a equilateral triangle with the fourth point at it's centre (ratio of squares is also 3) and trapezium which is a regular pentagon with one point knocked off (with ratio of squares `2:3+sqrt(5)` -` - +As we do a pre-allocation stage - we need to split the routine into two functions, the first function preps the data for interation and then handles the data at the end. The second does the interative step. -We therefore measure the squares of the distances between the points, and collect them together. If the list of distances is 2, and the ratio of the squares of the distances is 2 then we have a square. +At each step we need to know: + 1) What is the max-size of the group; + 2) Who is in team 1; + 3) Who is in team 2; + 4) What the difference in weight is; + 5) What is the smallest difference we have found; + 6) The weights of people left to be allocated. - * The `while/foreach` loops calculate the square of the distances between points, and stores these in the hash `%dist` where the distance is the key. - * We flip the hash so that the keys become values and values become keys. This allows us to check to see if we have one length 4 times and one length 2 times, and check the ratio of the length of the diagonal vs the length of the edges of the sides to see that it is 2. +So to start - we allocate person 1 to group 1, and set the difference to his weight. `$best` is an object to collect the information about the best allocation (the members of the two teams and the smallest difference)... ```perl -sub is_square { - my @pts = @_; - my %dist; - while(@pts>1) { - my $p = shift @pts; - $dist{ ($p->[0]-$_->[0]) ** 2 + ($p->[1]-$_->[1]) ** 2 }++ foreach @pts; +sub match_teams { + my( $diff, @n ) = @_; + separate( 1 + int(@n/2), [$diff], [], $diff, my $best = [], @n ); + return "Team 1: [@{$best->[0]}]; Team 2: [@{$best->[1]}]; difference $best->[2]"; +} + +sub separate { + my($maxsize,$team1,$team2,$diff,$be,@nums) = @_; + unless(@nums) { + if( !defined $be->[0] || $be->[2]>abs $diff ) { + $be->[0] = $team1; + $be->[1] = $team2; + $be->[2] = abs $diff; + } + return; } - my %flip = reverse %dist; - return exists $flip{2} && exists $flip{4} && $flip{2} == 2*$flip{4} || 0; + my $next = shift @nums; + separate( $maxsize, [@{$team1},$next], $team2, $diff+$next, $be, @nums ) if @{$team1} < $maxsize; + separate( $maxsize, $team1, [@{$team2},$next], $diff-$next, $be, @nums ) if @{$team2} < $maxsize; } ``` +### Notes: + * Notice the yoda inequality `$be->[2]>abs $diff` - it makes it clearer that you are only computing the absolute value of `$diff` not that of `$diff < $be->[2]`. + * `$team1` / `$team2` are refs - so when we update them we make copies `[@{$team2},$next]` rather than pushing to them. + * We keep the running total as it avoids the need to do the sum each time. + +### Timings + +| players | rate/time | +| ------- | --------: | +| 10 | 2,273/s | +| 12 | 598/s | +| 14 | 157/s | +| 16 | 41/s | +| 18 | 10/s | +| 20 | 2.68/s | +| 22 | 0.57/s | +| 24 | ~ 6s | +| 26 | ~ 23s | +| 28 | ~ 94s | +| 30 | ~ 365s | + +``` diff --git a/challenge-124/james-smith/blog.txt b/challenge-124/james-smith/blog.txt new file mode 100644 index 0000000000..3631591878 --- /dev/null +++ b/challenge-124/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/blob/master/challenge-124/james-smith/ diff --git a/challenge-124/james-smith/logo/ch-1.logo b/challenge-124/james-smith/logo/ch-1.logo new file mode 100644 index 0000000000..aa46fcb972 --- /dev/null +++ b/challenge-124/james-smith/logo/ch-1.logo @@ -0,0 +1,33 @@ +; pendown to start drawing... + +setpensize 4 +pendown + +; first draw the cross - we are assuming +; our initial direction is facing north + +back 300 +forward 150 +left 90 +forward 150 +back 300 +forward 150 +right 90 +forward 150 + +; Now we are back at the cross - we are going to turn +; 89 degrees to the left to start our circle.. We will +; use a 180 sided polygon in place of the circle. We +; then need to twist each side by 2 degrees. We start at +; 89 rather than 90 so that the circle is symmetric around +; the N/S line (if we didn't it would be off to the right) +; alternatively we could have started with a line of length +; 5 and ended with another line of length 5 but this is +; easier!!! + +right 89 +repeat 180 [ + forward 10 + left 2 +] +penup diff --git a/challenge-124/james-smith/perl/ch-1.pl b/challenge-124/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..4340825447 --- /dev/null +++ b/challenge-124/james-smith/perl/ch-1.pl @@ -0,0 +1,55 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); +use POSIX qw(ceil); +my $tau = 6.283185307179586476925286766559; + + +my $radius = @ARGV ? shift @ARGV : 10; +my $cross = @ARGV ? shift @ARGV : $radius; + $cross++ if $cross&1; + +### A simple one to render the cross as drawin the question... +### This is what we show if the radius (first parameter is 0) + +unless($radius) { + my @pts = qw(-1 3 4 5 5 5 5 5 4 3 -1 0 0 0 -1 0 0); + say $_ < 0 ? ' ^^^^^' + : !$_ ? ' ^' + : ' ' x (6-$_) . '^' . ' 'x($_*2-1) .'^' + foreach @pts; + exit; +} + +## We will render the relevant sized venus symbol... + +## Create the canvas.. +my @a = map { ' ' x ($radius*2+1) } 0..$radius*2+$cross; + +## Now we draw the circle... +foreach my $x ( 0 .. ceil($radius*0.71) ) { ## Only need to do 45 deg {X = r/sqrt(2)} + my $y = int sqrt( ($radius-.5)**2 - $x**2 ); ## Do a circle of radius r-.5 as we want + ## to draw the mid point of the squares + substr $a[ $radius - $x ], $radius-$y, 1, '^'; # W -> NW + substr $a[ $radius + $x ], $radius-$y, 1, '^'; # W -> SW + substr $a[ $radius - $x ], $radius+$y, 1, '^'; # E -> NE + substr $a[ $radius + $x ], $radius+$y, 1, '^'; # E -> SE + substr $a[ $radius - $y ], $radius-$x, 1, '^'; # N -> NW + substr $a[ $radius + $y ], $radius-$x, 1, '^'; # S -> SW + substr $a[ $radius - $y ], $radius+$x, 1, '^'; # N -> NE + substr $a[ $radius + $y ], $radius+$x, 1, '^'; # S -> SE +} + +## And the two parts of the cross... +substr $a[2*$radius+$_], $radius, 1, '^' foreach 0..$cross; +substr $a[2*$radius+$cross/2], $radius-$cross/2, $cross+1, '^' x ($cross+1); + +### Finally we render the canvas... +say $_ foreach @a; + diff --git a/challenge-124/james-smith/perl/ch-2.pl b/challenge-124/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..6b360cd40d --- /dev/null +++ b/challenge-124/james-smith/perl/ch-2.pl @@ -0,0 +1,82 @@ +#!/usr/local/bin/perl + +use strict; + +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); +use Data::Dumper qw(Dumper); + +done_testing(); +say match_teams( map { $_*10 } 1..15 ); +say match_teams( map { $_*10 } 1..10 ); +say match_teams( qw(10 -15 20 30 -25 0 5 40 -5) ); +say match_teams( qw(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97) ); +timethis(1000, sub { match_teams( map { $_*10 } 1..10 ); } ); +timethis(1000, sub { match_teams( map { $_*10 } 1..12 ); } ); +timethis(1000, sub { match_teams( map { $_*10 } 1..14 ); } ); +exit; +timethis(100, sub { match_teams( map { $_*10 } 1..16 ); } ); +timethis(100, sub { match_teams( map { $_*10 } 1..18 ); } ); +timethis(100, sub { match_teams( map { $_*10 } 1..20 ); } ); +timethis(10, sub { match_teams( map { $_*10 } 1..22 ); } ); +timethis(10, sub { match_teams( map { $_*10 } 1..24 ); } ); +timethis(5, sub { match_teams( map { $_*10 } 1..26 ); } ); +timethis(5, sub { match_teams( map { $_*10 } 1..28 ); } ); +timethis(5, sub { match_teams( map { $_*10 } 1..30 ); } ); + +sub match_teams { + ## Pre-process input + ## * Remove first person from list - he will always go in team 1 + ## * The rest are to be allocated. + ## * Pre-compute the maximum size team! + ## + ## $best - stores the result!! + ## + ## $best->[0] = array of team 1 members + ## $best->[1] = array of team 2 members + ## $best->[2] = difference between scores + + my( $diff, @names ) = @_; + separate( 1 + int( @names/2 ), [$diff], [], $diff, my $best = [], @names ); + return "Team 1: [@{$best->[0]}]; Team 2: [@{$best->[1]}]; difference $best->[2]"; +} + +sub separate { + my( $maxsize, $team1, $team2, $diff, $be, @nums ) = @_; + unless(@nums) { + if( !defined $be->[0] || $be->[2]>abs $diff ) { + $be->[0] = $team1; ## If this is the first time we have got to the end of the list + $be->[1] = $team2; ## OR we have got to the end of the list and have a better solution + $be->[2] = abs $diff; ## store this in $be - can't just do $be = [ , , ] as this would + } ## change the pointer and wouldn't be preserved.... + return; + } + my $next = shift @nums; ## Get the next person and allocate to team 1 and/or team 2 depending + ## on whether the teams have space... + separate( $maxsize, [@{$team1},$next], $team2, $diff+$next, $be, @nums ) if @{$team1} < $maxsize; + separate( $maxsize, $team1, [@{$team2},$next], $diff-$next, $be, @nums ) if @{$team2} < $maxsize; + + ## We update the difference as we go along to avoid the need to sum the two teams and compute + ## differences at the end! When we add a member to a team we don't just push but create a new arrayref + ## by adding the new member to the team array. If we pushed the reference would be the same and + ## the recursion code would fall over! +} + +## +## Timings +## +## #players rate +## +## 10 2,273/s +## 12 598/s +## 14 157/s +## 16 41/s +## 18 10/s +## 20 2.68/s +## 22 0.57/s +## 24 ~ 6s +## 26 ~ 23s +## 28 ~ 94s +## 30 ~ 365s |