diff options
| -rw-r--r-- | challenge-115/duncan-c-white/README | 55 | ||||
| -rwxr-xr-x | challenge-115/duncan-c-white/perl/ch-1.pl | 118 | ||||
| -rwxr-xr-x | challenge-115/duncan-c-white/perl/ch-2.pl | 89 |
3 files changed, 238 insertions, 24 deletions
diff --git a/challenge-115/duncan-c-white/README b/challenge-115/duncan-c-white/README index de73e12315..d6cdf5924e 100644 --- a/challenge-115/duncan-c-white/README +++ b/challenge-115/duncan-c-white/README @@ -1,42 +1,49 @@ -Task 1: "Next Palindrome Number +Task 1: "String Chain -You are given a positive integer $N. +You are given an array of strings. -Write a script to find out the next Palindrome Number higher than the given integer $N. +Write a script to find out if the given strings can be chained to form +a circle. Print 1 if found otherwise 0. -Example +A string $S can be put before another string $T in circle if the last +character of $S is same as first character of $T. - Input: $N = 1234 - Output: 1331 +Examples: - Input: $N = 999 - Output: 1001 + Input: @S = ("abc", "dea", "cd") + Output: 1 as we can form circle e.g. "abc", "cd", "dea". + + Input: @S = ("ade", "cbd", "fgh") + Output: 0 as we can't form circle. " -My notes: sounds very simple. Generate and test for palindromic-ness. +My notes: word chains are often quite hard. HOWEVER, this time it's a circular word chain +using ALL the words, so that's much easier: +1. we don't have to try "what if we start with this word (for each word)", just pick one. +2. we must use every word. +(2) also implies an obvious shortcut to speed up failure (0) case: +fail if numwords(starting_with_a_letter) != numwords(ending_with_that_letter). +But I don't think I need implement that. -Task 2: "Higher Integer Set Bits -You are given a positive integer $N. +Task 2: "Largest Multiple (Even) -Write a script to find the next higher integer having the same number -of 1 bits in binary representation as $N. +You are given a list of positive integers (0-9), single digit. -Example +Write a script to find the largest multiple of 2 that can be formed from the list. -Input: $N = 3 -Output: 5 +Examples -Binary representation of 3 is 011. There are two 1 bits. So the next -higher integer is 5 having the same the number of 1 bits i.e. 101. + Input: @N = (1, 0, 2, 6) + Output: 6210 -Input: $N = 12 -Output: 17 + Input: @N = (1, 4, 2, 8) + Output: 8412 -Binary representation of 12 is 1100. There are two 1 bits. So the next -higher integer is 17 having the same number of 1 bits i.e. 10001. + Input: @N = (4, 1, 7, 6) + Output: 7614 " -My notes: also sounds pretty simple. Generate and test for "having B -bits set in the binary representation". +My notes: should be easy (multiple of 2 == even number). Obvious heuristic is: put biggest digit +first, but I suppose it's possible that no even numbers would result. Hell, just try all perms.. diff --git a/challenge-115/duncan-c-white/perl/ch-1.pl b/challenge-115/duncan-c-white/perl/ch-1.pl new file mode 100755 index 0000000000..3a594ca578 --- /dev/null +++ b/challenge-115/duncan-c-white/perl/ch-1.pl @@ -0,0 +1,118 @@ +#!/usr/bin/perl +# +# Task 1: "String Chain +# +# You are given an array of strings. +# +# Write a script to find out if the given strings can be chained to form +# a circle. Print 1 if found otherwise 0. +# +# A string $S can be put before another string $T in circle if the last +# character of $S is same as first character of $T. +# +# Examples: +# +# Input: @S = ("abc", "dea", "cd") +# Output: 1 as we can form circle e.g. "abc", "cd", "dea". +# +# Input: @S = ("ade", "cbd", "fgh") +# Output: 0 as we can't form circle. +# " +# +# My notes: word chains are often quite hard. HOWEVER, this time it's a circular word chain +# using ALL the words, so that's much easier: +# 1. we don't have to try "what if we start with this word (for each word)", just pick one. +# 2. we must use every word. +# There's also (if needed) an obvious shortcut to speed up failure (0) case: +# fail if numwords(starting_with_a_letter) != numwords(ending_with_that_letter). +# +# (2) also implies an obvious shortcut to speed up failure (0) case: +# fail if numwords(starting_with_a_letter) != numwords(ending_with_that_letter). +# But I don't think I need implement that. +# + +use strict; +use warnings; +use feature 'say'; +use Function::Parameters; +use Getopt::Long; +use Data::Dumper; + +my $debug = 0; +die "Usage: word-circle [--debug] Wd Wd...\n" if + GetOptions( "debug" => \$debug ) && @ARGV==0; +my @wd = @ARGV; + + +# @{$start{letter}} = list of words starting with that letter +my %start; + + +# +# make_start( @wd ); +# Make %start from the words in @wd. +# +fun make_start( @wd ) +{ + foreach my $w (@wd) + { + $w =~ /^(.)/; + my $first = $1; + $start{$first} //= []; + push @{$start{$first}}, $w; + } + #die Dumper( \%start ); +} + + +# +# my $iscircle = wordcircle( @wd ); +# Determine whether all the words in @wd form a chained word +# circle as the problem describes. +# Return 1 iff they do, 0 otherwise. +# +fun wordcircle( @wd ) +{ + make_start( @wd ); + my $w = $wd[0]; + my $found = rec_wordcircle( $w, $w, { map { $_ => 1 } @wd } ); + return $found; +} + +# +# my $iscircle = rec_wordcircle( $targetwd, $fromwd, $unused ); +# Recursive word circle finder: can you find a circle of words from +# word $fromwd leading to word $targetwd in 1-or-more-steps, using +# all words, with %$unused the words unused so far, using %start and %end maps. +# Return 1 iff we can, 0 otherwise. +# +fun rec_wordcircle( $targetwd, $w, $unused ) +{ + $w =~ /(.)$/; + my $last = $1; + + my $u = join(',',sort keys %$unused ); + #say "rwc: w=$w, target=$targetwd, unused=$u, first=$first, last=$last"; + + my @next = grep { $unused->{$_} } @{$start{$last}}; + if( $debug ) + { + my $uuw = join(',', sort keys %$unused); + say "rwc: w=$w, unused words $uuw, unused next words: ", join(',',@next); + } + foreach my $nextw (@next) + { + my %un = %$unused; # mark $nextw as used now + delete $un{$nextw}; + return 1 if $nextw eq $targetwd && keys %un == 0; + next if $nextw eq $targetwd; + + my $found = rec_wordcircle( $targetwd, $nextw, \%un ); + return 1 if $found; + } + return 0; +} + + +my $iscircle = wordcircle( @wd ); +say $iscircle; diff --git a/challenge-115/duncan-c-white/perl/ch-2.pl b/challenge-115/duncan-c-white/perl/ch-2.pl new file mode 100755 index 0000000000..382b38a808 --- /dev/null +++ b/challenge-115/duncan-c-white/perl/ch-2.pl @@ -0,0 +1,89 @@ +#!/usr/bin/perl +# +# Task 2: "Largest Multiple (Even) +# +# You are given a list of positive integers (0-9), single digit. +# +# Write a script to find the largest multiple of 2 that can be formed from the list. +# +# Examples +# +# Input: @N = (1, 0, 2, 6) +# Output: 6210 +# +# Input: @N = (1, 4, 2, 8) +# Output: 8412 +# +# Input: @N = (4, 1, 7, 6) +# Output: 7614 +# " +# +# My notes: should be easy (multiple of 2 == even number). Obvious heuristic is: put biggest digit +# first, but I suppose it's possible that no even numbers would result. Hell, just try all perms.. +# + +use strict; +use warnings; +use feature 'say'; +use Function::Parameters; +#use Data::Dumper; + +die "Usage: largest-even D D...\n" if @ARGV==0; +my @digits = @ARGV; + +die "All values should be decimal digits\n" unless (grep { /^[0-9]$/ } @digits) == @digits; +die "At least one digit must be even\n" if (grep { /^[02468]$/ } @digits) == 0; + + +# +# try_all_perms( $callback, @digits ); +# Permutation generator: Invoke $callback->( permutation ) +# once for every permutation of @digits. +# +fun try_all_perms( $callback, @digits ) +{ + rec_allperm( $callback, [], @digits ); +} + + +# +# rec_allperm( $callback, $prefix, @rest ); +# Recursive all permutations generator. Given a "permutation prefix" of @$prefix, +# and a collection of unused digits @rest, for all permutations of @$prefix + @rest, +# calling $callback->( permutation ) for each complete permutation found. +# +fun rec_allperm( $callback, $prefix, @rest ) +{ + foreach my $pos (0..$#rest) + { + my $x = $rest[$pos]; + # try with $x first (after @$prefix) + my @pre = @$prefix; + push @pre, $x; + + # delete pos $pos from copy of @rest + my @r = @rest; + splice( @r, $pos, 1 ); + + if( @r == 0 ) + { + $callback->( @pre ); + } else + { + rec_allperm( $callback, \@pre, @r ); + } + } +} + + +my $max = 0; + +fun eachperm(@perm) +{ + my $p = join('', @perm); + #say "perm: $p"; + $max = $p if $p > $max && $p % 2 == 0; +} + +try_all_perms( \&eachperm, @digits ); +say "$max"; |