diff options
| author | James Smith <baggy@baggy.me.uk> | 2021-09-12 09:56:05 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-09-12 09:56:05 +0100 |
| commit | 1ea3a2ade8e13d8d83707d4886a3d9bd6d26c261 (patch) | |
| tree | 7cec2a85f47b7659f56f10595e5f96da2857c620 /challenge-129 | |
| parent | 71275e2e8a13cc47913a729b8cc07a602f204348 (diff) | |
| download | perlweeklychallenge-club-1ea3a2ade8e13d8d83707d4886a3d9bd6d26c261.tar.gz perlweeklychallenge-club-1ea3a2ade8e13d8d83707d4886a3d9bd6d26c261.tar.bz2 perlweeklychallenge-club-1ea3a2ade8e13d8d83707d4886a3d9bd6d26c261.zip | |
Update README.md
Diffstat (limited to 'challenge-129')
| -rw-r--r-- | challenge-129/james-smith/README.md | 168 |
1 files changed, 54 insertions, 114 deletions
diff --git a/challenge-129/james-smith/README.md b/challenge-129/james-smith/README.md index be4fb1ed86..42789ab46e 100644 --- a/challenge-129/james-smith/README.md +++ b/challenge-129/james-smith/README.md @@ -1,4 +1,4 @@ -# Perl Weekly Challenge #128 +# Perl Weekly Challenge #129 You can find more information about this weeks, and previous weeks challenges at: @@ -10,145 +10,85 @@ 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-128/james-smith/perl +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-129/james-smith/perl -# Task 1 - Maximum Sub-Matrix +# Task 1 - Root Distance -***You are given m x n binary matrix having 0 or 1 in each cell. Write a script to find out maximum sub-matrix having only 0*** - -## Ambiguity - -There may be multiple solutions (e.g. in Example 1 depending on how you write the algorithm) so rather than returning the matrix - my tests will be on the area of the matrix +***You are given a tree and a node of the given tree. Write a script to find out the distance of the given node from the root.*** ## The solution -Initialy this looks like an `O(n^4)` problem - you would need to scan the area to the right and below `O(n^2)` for a given cell `O(n^2)`. But with a bit of preprocessing - we can remove at least one of these loops - so the challenge becomes `O(n^3)`. - -### Preprocessing the matrix. - -To remove the inner loop - we can pre-compute this - the number of 0s in a continuouse line starting at the point and going right. For the first matrix we get - -``` - [ 1 0 0 0 1 0 ] [ 0 3 2 1 0 1 ] - [ 1 1 0 0 0 1 ] -> [ 0 0 3 2 1 0 ] - [ 1 0 0 0 0 0 ] [ 0 5 4 3 2 1 ] -``` - -The code that does that is this.... +By modifying our BinaryTree object from previous exercise by adding the ancestor to the object to the object as well as the child (yes I know there is garbage collection issue here with reference counting) but I haven't built a remove node function yet! In true object way this is the best option (there are other ways you can achieve this if you have a way to enumerate all nodes - e.g. Celko's nested sets) ```perl - ## Last column 1s become 0s, 0s become 1s - my @runs = map { [1 - $_->[-1]] } @rows; - - ## Remaining columns we are working backwards along the rows - ## Column is 0 if the matrix contains a 1 - o/w it is 1 more - ## than the cell to the right (which is the first cell in the row) - ## we use unshift to extend each row left... - foreach my $i (reverse 0..$w-1) { - unshift @{$runs[$_]}, $rows[$_][$i] ? 0 : $runs[$_][0]+1 foreach 0..$h; - } -``` -We then have the `O(n^3)` to find the maximum area. +## Object is an arrayref [ value, left child, right child, parent ] +sub add_child_left { + my( $self,$child ) = @_; + $self->[1] = $child; + $child->[3] = $self; + return $self; +} + +sub add_child_right { + my( $self,$child ) = @_; + $self->[2] = $child; + $child->[3] = $self; + return $self; +} -For each cell we work out the maximum area of any rectangle. +sub parent { + my $self = shift; + return $self->[3]; +} -For the first row it is just `$run[$y][$x]`. For subsequent rows it is the minimum of all `$run[$y][$x]` we have seen times height +sub has_parent { + my $self = shift; + return defined $self->[3]; +} -```perl - my $max_w = 1e9; - foreach my $j ( $y .. $h ) { - last unless $runs[$j][$x]; ## We have a 1 in the rectangle quit - $max_w = $runs[$j][$x] if $runs[$j][$x] < $max_w; - my $area = $max_w * ( $j - $y + 1 ); - $max_area = [ $area, $max_w, $j - $y + 1 ] if $area > $max_area->[0]; - } ``` -The variable `$max_area` contains three values `$max_area`, `$max_w`, `$max_h` - the latter two if you wish to draw the empty matrix..... +This then becomes a case of working up the tree to pick out the ancestors and return the length. This function returns the ancestors - calling scalar on the result gives the distance. -Put it all together we have... ```perl -sub find_empty { - my @runs = map { [ 1 - $_->[-1] ] } my @rows = @{$_[0]}; - my ( $h, $w ) = ( @rows - 1, @{$rows[0]} - 1 ); - - foreach my $i ( reverse 0 .. $w - 1 ) { - unshift @{$runs[$_]}, $rows[$_][$i] ? 0 : $runs[$_][0] + 1 foreach 0 .. $h; - } - - my $max_area = [ 0, 0 , 0 ]; - foreach my $x ( 0 .. $w ) { - foreach my $y ( 0 .. $h ) { - next unless $runs[$y][$x]; - my $max_w = 1e9; - foreach my $j ( $y .. $h ) { - last unless $runs[$j][$x]; - $max_w = $runs[$j][$x] if $runs[$j][$x] < $max_w; - my $area = $max_w * ( $j - $y + 1 ); - $max_area = [ $area, $max_w, $j - $y + 1 ] if $area > $max_area->[0]; - } - } +sub ancestors { + my $self = shift; + my $x = $self; + my @ancestors; + while($x->has_parent) { + push @ancestors, $x; + $x = $x->parent; } - - return $max_area; + return @ancestors; } ``` +# Task 2 - Add Linked Lists -# Task 2 - Minimum Platforms - -***You are given two arrays of arrival and departure times of trains at a railway station. Write a script to find out the minimum number of platforms needed so that no train needs to wait.*** - -## Background - -As mentioned this is effectively my day job again. To display information about genomic features and whether or not they overlapped a particular region (to know whether to display them or not) or to bump them for display (to make sure features didn't merge/overlap) which is exactly this problem. This one is in someways easier as we have the trains already sorted into date order. If we didn't sorting them would make life a lot easier! - not so easy on a genome browser where there may be 10s of thousands of features in a region. - -This is actually more my brother's line of work - he works for what was BR computing - and one of his jobs is just this. For a while BR had 66 minutes in an hour to allow them to get trains in and out of one of the large busy stations. +***You are given two linked list having single digit positive numbers. Write a script to add the two linked list and create a new linked representing the sum of the two linked list numbers. The two linked lists may or may not have the same number of elements.*** ## Solution -As we are assuming that starts are in time order we don't have to do a 2-sided test for overlaps. +We again use our LL module from previous challenges. -So foreach train we loop through all platforms - seeing if there is a platform with a slot in it (i.e. the last train has already left the platform). If there isn't we make a new platform and add the train to it, and repeat. All we do is store the last departure time for each platform, and because 24-hr date strings alphabetic/time order are the same - we only need to use the string comparison operator (in this case `gt`) to compare times. - -Here we use a little used concept in perl the label "`OUTER`" - this allows our inner loop to break out of it's own `foreach` loop and also jump to the next interation of it's parent loop. +We create our two input lists - and then start building our output list. The module doesn't allow empty lists - so we start by creating the first node. +We then work our way along each list using next which moves from 1 node to the next - add adding a new node to the list ```perl -sub bump_platform { - my @arr = @{shift @_}; - my @dep = @{shift @_}; - my @platforms = (); - OUTER: foreach my $st (@arr) { - foreach(0..$#platforms) { - ($platforms[$_] = shift @dep) && (next OUTER) - if $st gt $platforms[$_]; - } - push @platforms,shift @dep; - } - return scalar @platforms; +my $ch1 = LL->new( 1 )->add( 3 )->add( 2 ); +my $ch2 = LL->new( 3 )->add( 1 )->add( 2 ); + +my $ch3 = LL->new( $ch1->val + $ch2->val ); ## Create the first node of the new tree. +my ( $p1, $p2 ) = ( $ch1, $ch2 ); ## Make "pointers" to the trees we will later + ## move these forward an entry at a time + +while( 1 ) { + $p1 = $p1->next; + last unless $p1; + $p2 = $p2->next; + $ch3->add( $p1->val + $p2->val ); ## add to end of LL } -``` - -**Notes: -We can also keep information about which trains are on by re-writing what is stored in `@plat` rather than storing the last departure time - we can store the arrival/departure time of trains on each platform... - -```perl -sub bump_platform_keep_trains { - my @arr = @{shift @_}; - my @dep = @{shift @_}; - my($train_no, @platforms) = (0); - - OUTER: foreach my $st (@arr) { - foreach(@platforms) { - (push @{$_}, [ $st, (shift @dep), ++$train_no ]) && - (next OUTER) if $st gt $_->[-1][1]; - } - push @platforms, [ [ $st, (shift @dep), ++$train_no ] ]; - } - say ' ', join ' ', map { "Train $_->[2]: $_->[0]-$_->[1]" } @{$_} - foreach @platforms; - return scalar @platforms; -} +say join " ", $ch3->flatten; ``` |
