diff options
| -rw-r--r-- | challenge-007/duncan-c-white/README | 49 | ||||
| -rw-r--r-- | challenge-011/duncan-c-white/README | 4 | ||||
| -rwxr-xr-x | challenge-025/duncan-c-white/perl5/ch-1.pl | 2 | ||||
| -rwxr-xr-x | challenge-025/duncan-c-white/perl5/v16.pl | 95 | ||||
| -rw-r--r-- | challenge-151/duncan-c-white/README | 92 | ||||
| -rwxr-xr-x | challenge-151/duncan-c-white/perl/ch-1.pl | 94 | ||||
| -rwxr-xr-x | challenge-151/duncan-c-white/perl/ch-2.pl | 89 |
7 files changed, 328 insertions, 97 deletions
diff --git a/challenge-007/duncan-c-white/README b/challenge-007/duncan-c-white/README index fb3a863c80..5fe2b0356b 100644 --- a/challenge-007/duncan-c-white/README +++ b/challenge-007/duncan-c-white/README @@ -1,14 +1,41 @@ -Challenge 1: "Create a script which takes a list of numbers from -command line and print the same in the compact form. For example, if -you pass 1,2,3,4,9,10,14,15,16 then it should print the compact form -like 1-4,9,10,14-16.." +Challenge 1: "Print all the niven numbers from 0 to 50 inclusive, each on +their own line. A niven number is a non-negative number that is divisible +by the sum of its digits. The first few Niven numbers are 1, 2, 3, 4, +5, 6, 7, 8, 9, 10, 12, 18, 20, 21, 24.." -Quite simple and dull problem. But ok, let's have a go. +My notes: Cute little problem, let's have a go. -Challenge 2: "Create a script to calculate Ramanujan's constant with at -least 32 digits of precision." -Never heard of this constant, seems to be e^(pi*sqrt(163)), which is -"very nearly an integer", I don't particularly care about abtruse mathematical -formulae. But ok, Perl's built in module biggrat will let you do this anyway, -specifying accuracy 32; see ch-2.sh for the oneliner. +Challenge 2: "A word ladder is a sequence of words [w0, w1, #, wn] such +that each word wi in the sequence is obtained by changing a single +character in the word wi-1. All words in the ladder must be valid +English words. + +Given two input words and a file that contains an ordered word list, +implement a routine (e.g., find_shortest_ladder(word1, word2, wordlist)) +that finds the shortest ladder between the two input words. For example, +for the words cold and warm, a possible ladder might be: + +("cold", "cord", "core", "care", "card", "ward", "warm") + +However, there's a several shorter ladders between cold and warm, eg: + +("cold", "cord", "card", "ward", "warm"). + +and we want the shortest which is: + + +All words in the list have the same length. +All words contain only lowercase alphabetical characters. +There are no duplicates in the word list. +The input words aren't empty and aren't equal but they have +the same length as any word in the word list. + +The routine must return a list of the words in the ladder if it +exists. Otherwise, it returns an empty list. + +If any of the input words is the wrong length (i.e., its length is +different to a random from the word list) or isn't in the word list, +return an empty list." + +My notes: Finally, a well-specified problem:-) diff --git a/challenge-011/duncan-c-white/README b/challenge-011/duncan-c-white/README index 3ff28fa716..c8e257df40 100644 --- a/challenge-011/duncan-c-white/README +++ b/challenge-011/duncan-c-white/README @@ -1,4 +1,6 @@ -Challenge 1: "Write a script that computes the equal point in the Fahrenheit and Celsius scales, knowing that the freezing point of water is 32 °F and 0 °C, and that the boiling point of water is 212 °F and 100 Â," +Challenge 1: "Write a script that computes the equal point in the +Fahrenheit and Celsius scales, knowing that the freezing point of water +is 32 F and 0 C, and that the boiling point of water is 212 F and 100 C" My notes: Isn't that just Maths? solve F = 9/5C + 32 for F==C? diff --git a/challenge-025/duncan-c-white/perl5/ch-1.pl b/challenge-025/duncan-c-white/perl5/ch-1.pl index a8dc4aa651..072eef9794 100755 --- a/challenge-025/duncan-c-white/perl5/ch-1.pl +++ b/challenge-025/duncan-c-white/perl5/ch-1.pl @@ -151,7 +151,7 @@ fun findall() # extend path s by each unused word no in the inwords push @$newpaths, map { - # word no $_ no longer available. + # mark $wno no longer available. my $newavail = $avail; substr( $newavail, $_, 1 ) = 0; diff --git a/challenge-025/duncan-c-white/perl5/v16.pl b/challenge-025/duncan-c-white/perl5/v16.pl index 24bc7e03b5..bfea5a873e 100755 --- a/challenge-025/duncan-c-white/perl5/v16.pl +++ b/challenge-025/duncan-c-white/perl5/v16.pl @@ -37,15 +37,11 @@ my @words = qw(audino bagon baltoy banette bidoof braviary bronzor carracosta wartortle whismur wingull yamask); #@words = qw(hello ollie excellent thanks shelter runaround set to); -#die scalar(@words); - my %sw; # hash from letter L to list of word nos of words STARTING with L -my @outword; # array from word no N to array of wordnos of words going "out" - # from word N, i.e. starting with the last letter of word N - # if there are no such words, then [] - -my @stopword;# list of stop word nos (word nos of words with no outwords) +my @stopword;# list of stop word nos (word nos of words with no words going + # "out" from them onto another word, ie. word numbers N where + # no other word starts with the last letter of word N) my %ew; # hash from letter L to list of word nos of words ENDING with L @@ -75,17 +71,15 @@ foreach my $wn (0..$#words) } #die Dumper \%ew; -# build @outword and @stopword, using %sw +# build @stopword, using %sw foreach my $wn (0..$#words) { my $word = $words[$wn]; $word =~ /(.)$/; my $lastletter = $1; my $aref = $sw{$lastletter} // []; - $outword[$wn]= $aref; push @stopword, $wn if @$aref==0; } -#die Dumper \@outword; #die Dumper [ map { $words[$_] } @stopword ]; # build @inword, using %ew @@ -109,6 +103,46 @@ exit 0; # +# my @suset = suset( $wno ); +# Form a SUset in which all word nos are unused, except $wno. +# +fun suset( $wno ) +{ + my @suset = (0) x scalar(@words); + $suset[$wno] = 1; + return @suset; +} + + +# +# show_seqs( @seqs ); +# Show the sequences (as words, not word nos) +# +fun show_seqs( @seqs ) +{ + foreach my $s (@seqs) + { + my $str = join( ',', map { $words[$_] } split(/,/,$s) ); + print "$str\n"; + } +} + + +# +# show_sus( @sus ); +# Show the sequences (as words, not word nos) contained in SUlist @sus +# +fun show_sus( @sus ) +{ + foreach my $s (@sus) + { + my $str = $s->[1]; + print "$str\n"; + } +} + + +# # my @seqs = findall(); # Find all sequences, starting with sequences of length 1 (stop words), # then working back, i.e. prepending words onto the front of existing @@ -184,44 +218,3 @@ fun findall( ) my $currsus = $sus[$curr]; return map { $_->[1] } @$currsus; } - - - -# -# my @suset = suset( $wno ); -# Form a SUset in which all word nos are unused, except $wno. -# -fun suset( $wno ) -{ - my @suset = (0) x scalar(@words); - $suset[$wno] = 1; - return @suset; -} - - -# -# show_sus( @sus ); -# Show the sequences (as words, not word nos) contained in SUlist @sus -# -fun show_sus( @sus ) -{ - foreach my $s (@sus) - { - my $str = $s->[1]; - print "$str\n"; - } -} - - -# -# show_seqs( @seqs ); -# Show the sequences (as words, not word nos) -# -fun show_seqs( @seqs ) -{ - foreach my $s (@seqs) - { - my $str = join( ',', map { $words[$_] } split(/,/,$s) ); - print "$str\n"; - } -} diff --git a/challenge-151/duncan-c-white/README b/challenge-151/duncan-c-white/README index 4c7c2d807d..b4889e4611 100644 --- a/challenge-151/duncan-c-white/README +++ b/challenge-151/duncan-c-white/README @@ -1,48 +1,74 @@ -TASK #1 - Fibonacci Words +TASK #1 - Binary Tree Depth -You are given two strings having same number of digits, $a and $b. +You are given binary tree. -Write a script to generate Fibonacci Words by concatenation of the -previous two strings. Finally print 51st digit of the first term having -at least 51 digits. +Write a script to find the minimum depth. -Example: +The minimum depth is the number of nodes from the root to the nearest +leaf node (node without any children). - Input: $a = '1234' $b = '5678' - Output: 7 +Example 1: - Fibonacci Words: + Input: '1 | 2 3 | 4 5' - '1234' - '5678' - '12345678' - '567812345678' - '12345678567812345678' - '56781234567812345678567812345678' - '1234567856781234567856781234567812345678567812345678' + 1 + / \ + 2 3 + / \ + 4 5 - The 51st digit in the first term having at least 51 digits - '1234567856781234567856781234567812345678567812345678' is 7. + Output: 2 -MY NOTES: Pretty easy. Fibonacci words == append two previous strings. -Use -d (debug mode) to see all the above explanatory info. +Example 2: + Input: '1 | 2 3 | 4 * * 5 | * 6' -TASK #2 - Square-free Integer + 1 + / \ + 2 3 + / \ + 4 5 + \ + 6 + Output: 3 -Write a script to generate all square-free integers <= 500. +MY NOTES: well, if I built a binary tree from the input, it would be quite +simple to find the minimum depth. But there must be a way to solve the +problem using only the input syntax. Something like: split into rows on '|'. +Each row has 2 * (rowno-1) elements (starting at row 1). If a row hasn't +got that many elements, pad it with '*'s. Now, find the first non-full row, +ie. with one or more '*'s. Take the row a pair of elements at a time. If +any pair are both '*'s, then the min depth is rowno-1. Otherwise proceed +to the next row, and keep going down the rows. -In mathematics, a square-free integer (or squarefree integer) is an -integer which is divisible by no perfect square other than 1. That is, -its prime factorization has exactly one factor for each prime that -appears in it. For example, 10 = 2 * 5 is square-free, but 18 = 2 * -3 * 3 is not, because 18 is divisible by 9 = 3**2. -Example +TASK #2 - Rob The House -The smallest positive square-free integers are - 1, 2, 3, 5, 6, 7, 10, 11, 13, 14, 15, 17, 19, 21, 22, 23, 26, 29, 30, ... +You are planning to rob a row of houses, always starting with the first +and moving in the same direction. However, you can't rob two adjacent +houses. -MY NOTES: also pretty easy. The second definition above suggests using prime -numbers, which is easy enough, especially as I have a prime generating module, -but actually it's simpler to do it without primes as the first definition hints. +Write a script to find the highest possible gain that can be achieved. + +Example 1: + + Input: @valuables = (2, 4, 5); + Output: 7 + +If we rob house 0 we get 2 and then the only house we can rob is house +2 where we have 5. So the total valuables in this case is (2 + 5) = 7. + + +Example 2: + + Input: @valuables = (4, 2, 3, 6, 5, 3); + Output: 13 + +The best choice would be to first rob house 0 then rob house 3 then finally +house 5. This would give us 4 + 6 + 3 =13. + + +MY NOTES: Hmm.. some sort of recursive "find all paths" method. +It always helps to pick the right function purpose and name. +I think the recursive function we need is: +my $maxvaluables = maxrobbery( startpos ), invoked as my $max=maxrobbery(0)? diff --git a/challenge-151/duncan-c-white/perl/ch-1.pl b/challenge-151/duncan-c-white/perl/ch-1.pl new file mode 100755 index 0000000000..e0ad0e559a --- /dev/null +++ b/challenge-151/duncan-c-white/perl/ch-1.pl @@ -0,0 +1,94 @@ +#!/usr/bin/perl +# +# TASK #1 - Binary Tree Depth +# +# You are given binary tree. +# +# Write a script to find the minimum depth. +# +# The minimum depth is the number of nodes from the root to the nearest +# leaf node (node without any children). +# +# Example 1: +# +# Input: '1 | 2 3 | 4 5' +# +# 1 +# / \ +# 2 3 +# / \ +# 4 5 +# +# Output: 2 +# +# Example 2: +# +# Input: '1 | 2 3 | 4 * * 5 | * 6' +# +# 1 +# / \ +# 2 3 +# / \ +# 4 5 +# \ +# 6 +# Output: 3 +# +# MY NOTES: well, if I built a binary tree from the input, it would be quite +# simple to find the minimum depth. But there must be a way to solve the +# problem using only the input syntax. Something like: split into rows on '|'. +# Each row should have 2 * (rowno-1) elements (starting at row 1). If a row hasn't +# got that many elements, pad it with '*'s. Now, find the first non-full row, +# ie. with one or more '*'s. Take the row a pair of elements at a time. If +# any pair are both '*'s, then the min depth is rowno-1. Otherwise proceed +# to the next row, and keep going down the rows. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +#use Data::Dumper; + +my $debug=0; +die "Usage: min-tree-depth [--debug] 'binary tree in rows with *s for missing entries]\n" + unless GetOptions( "debug"=>\$debug ) && @ARGV==1; +my $input = shift; + +# +# my $mindepth = mindepth( $treeinput ); +# Given an encoded binary tree, with '|' separating rows, spaces +# separating elements, and '*' representing missing elements not +# at the end of a row, find and return the minimum depth of the tree. +# +sub mindepth ($) +{ + my( $treeinput ) = @_; + + my @row = split( /\s*\|\s*/, $treeinput ); + + my $expectednel = 1; # how many elements the row is expected + # to have: it doubles each time + + foreach my $rowno (1..@row) + { + my $row = $row[$rowno-1]; + my @el = split( /\s+/, $row ); + + # pad the elements out with '*'s if too few.. + push @el, ( '*' ) x ($expectednel - @el); + + #say "row $rowno has *s: ", Dumper \@el; + # Consider each pair of elements (a,b): + while( (my $a, my $b, @el) = @el ) + { + # If they're BOTH '*' the mindepth is rowno-1 + return $rowno-1 if $a eq '*' && $b eq '*'; + } + $expectednel *= 2; + } + return scalar(@row); +} + +my $mindepth = mindepth( $input ); +say $mindepth; diff --git a/challenge-151/duncan-c-white/perl/ch-2.pl b/challenge-151/duncan-c-white/perl/ch-2.pl new file mode 100755 index 0000000000..87720291ec --- /dev/null +++ b/challenge-151/duncan-c-white/perl/ch-2.pl @@ -0,0 +1,89 @@ +#!/usr/bin/perl +# +# TASK #2 - Rob The House +# +# You are planning to rob a row of houses, always starting with the first +# and moving in the same direction. However, you can't rob two adjacent +# houses. +# +# Write a script to find the highest possible gain that can be achieved. +# +# Example 1: +# +# Input: @valuables = (2, 4, 5); +# Output: 7 +# +# If we rob house 0 we get 2 and then the only house we can rob is house +# 2 where we have 5. So the total valuables in this case is (2 + 5) = 7. +# +# Example 2: +# +# Input: @valuables = (4, 2, 3, 6, 5, 3); +# Output: 13 +# +# The best choice would be to first rob house 0 then rob house 3 +# then finally house 5. This would give us 4 + 6 + 3 =13. +# +# MY NOTES: Hmm.. some sort of recursive "find all paths" method. +# It always helps to pick the right function purpose and name. +# I think the recursive function we need is: +# my $maxvaluables = maxrobbery( startpos ), invoked as +# my $max=maxrobbery(0)? +# +# Extra note: if you want to which the house numbers and corresponding +# valuables that make up the maximum robbery, run this with the -d flag. +# + +use strict; +use warnings; +use feature 'say'; +use Getopt::Long; +use Function::Parameters; +#use Data::Dumper; + +my $debug=0; + +die "Usage: rob-houses [--debug] house_values\n" unless + GetOptions( "debug"=>\$debug ) && @ARGV>0; + +my @valuables = @ARGV; + + +# +# my( $maxvaluables, @robhouses ) = maxrobbery( $starthouseno, @valuables ); +# Given a list of valuables @valuables, and a starting house number +# $starthouseno, try all combinations of houses to rob, always robbing +# house $starthouseno, not robbing house $starthouseno+1 and considering +# whether or not to rob each subsequent house, and return the +# ( maximum sum of valuables, and list of robbed house numbers that +# gave the maximum sum of valuables). +# +fun maxrobbery( $starthouseno, @valuables ) +{ + my @besth; + my $besttotal = 0; + foreach my $hno ($starthouseno+2..$#valuables) + { + # find the best partial solution starting by robbing house $hno + my( $mv2, @rh2 ) = maxrobbery( $hno, @valuables ); + + # then find the best of all those partial solutions + if( $mv2 > $besttotal ) + { + $besttotal = $mv2; + @besth = @rh2; + } + } + # then the overall best solution involves adding starthouseno + # to the best partial solution.. + return ( $valuables[$starthouseno]+$besttotal, $starthouseno, @besth ); +} + + +my( $maxvaluables, @robhouses ) = maxrobbery( 0, @valuables ); +say "max valuables is $maxvaluables"; +say "got by robbing house numbers ", + join(', ', + map { "$robhouses[$_] (value $valuables[$robhouses[$_]])" } + 0..$#robhouses + ) if $debug; |