RabbitFarm
2021-05-16
The Weekly Challenge 112 (Prolog Solutions)
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 2
You are given $n steps to climb. Write a script to find out the distinct ways to climb to the top. You are allowed to climb either 1 or 2 steps at a time.
Solution
:-initialization(main).
steps --> [].
steps --> step, steps.
step --> [0]; [1]; [2].
sum_steps(Steps, Goal):-
length(Steps, Goal),
phrase(steps, Steps),
sum_list(Steps, Goal).
zero_remove([], []).
zero_remove([H|T], [ZR_H|ZR_T]):-
delete(H, 0, ZR_H),
zero_remove(T, ZR_T).
main:-
findall(Steps, sum_steps(Steps, 4), S),
zero_remove(S, SZR),
sort(SZR, SZR_Unique),
write(SZR_Unique), nl,
halt.
Sample Run
$ gprolog --consult-file prolog/ch-2.p
GNU Prolog 1.4.5 (32 bits)
Compiled Dec 3 2020, 00:37:14 with gcc
By Daniel Diaz
Copyright (C) 1999-2020 Daniel Diaz
compiling /home/adamcrussell/Projects/perlweeklychallenge-club/challenge-112/adam-russell/prolog/ch-2.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-112/adam-russell/prolog/ch-2.p compiled, 22 lines read - 2790 bytes written, 43 ms
[[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[2,2]]
Notes
I've been trying to do more with DCGs. This is not the most algorithmically pure use of DCG's but the point here was just to try something new.
Overview of this brute force approach with DCGs:
- Generate all lists of numbers of length
Goal
using digits 0, 1, and 2. - Keep all those lists that sum to
Goal
- Remove zeroes from these matching lists
- Remove duplicate lists (using
sort/2
)
References
posted at: 18:20 by: Adam Russell | path: /prolog | permanent link to this entry
The Weekly Challenge 112
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
Part 1
Write a script to convert the given absolute path to the simplified canonical path.
Solution
use strict;
use warnings;
##
# Write a script to convert the given absolute path to the simplified canonical path.
# The canonical path format:
# - The path starts with a single slash '/'.
# - Any two directories are separated by a single slash '/'.
# - The path does not end with a trailing '/'.
# - The path only contains the directories on the path from the root directory to the target file or directory
##
sub leading_slash{
my($path) = @_;
$path = "/" . $path if substr($path, 0, 1) ne "/";
return $path;
}
sub single_seperator{
my($path) = @_;
$path =~ s#\/\/#\/#;
return $path;
}
sub trailing_slash{
my($path) = @_;
chop($path) if substr($path, length($path) - 1, 1) eq "/";
return $path;
}
sub up_stay{
my($path) = @_;
my @directories = split(/\//, substr($path, 1));
my @temp_path;
for my $d (@directories){
push @temp_path, $d if $d ne "." && $d ne "..";
pop @temp_path if $d eq "..";
next if $d eq ".";
}
return "/" . join("/", @temp_path);
}
sub canonical_path{
my($path) = @_;
return up_stay(trailing_slash(single_seperator(leading_slash($path))));
}
MAIN:{
while(){
chomp;
print canonical_path($_) . "\n";
}
}
__DATA__
/a/
/a/b//c/
/a/b/c/../..
Sample Run
$ perl perl/ch-1.pl
/a
/a/b/c
/a
Notes
The challenge I set for myself here was to completely avoid any use of regular expressions! I think I pulled it off, more or less. I am not quite sure I covered every possible corner case, but it works for the examples given.
Part 2
You are given $n steps to climb. Write a script to find out the distinct ways to climb to the top. You are allowed to climb either 1 or 2 steps at a time.
Solution
use strict;
use warnings;
##
# You are given $n steps to climb
# Write a script to find out the distinct ways to climb to the top.
# You are allowed to climb either 1 or 2 steps at a time.
##
use Array::Compare;
use Algorithm::Combinatorics q/variations_with_repetition/;
sub steps{
my($k) = @_;
my @data = (0, 1, 2);
my @steps;
my $comparison = new Array::Compare();
my $iterator = variations_with_repetition(\@data, $k);
while(my $combination = $iterator->next()){
if(unpack("%32C*", pack("C*", @{$combination})) == $k){
my $step = [grep {$_ != 0} @{$combination}];
push @steps, $step if(!grep {$comparison->compare($_, $step)} @steps);
}
}
return @steps;
}
MAIN:{
my @steps;
@steps = steps(3);
print "k = 3\n";
for my $steps (@steps){
my $option;
for my $step (@{$steps}){
$option .= "$step step + " if $step == 1;
$option .= "$step steps + " if $step == 2;
}
chop($option);
chop($option);
print "$option\n";
}
@steps = steps(4);
print "\nk = 4\n";
for my $steps (@steps){
my $option;
for my $step (@{$steps}){
$option .= "$step step + " if $step == 1;
$option .= "$step steps + " if $step == 2;
}
chop($option);
chop($option);
print "$option\n";
}
@steps = steps(5);
print "\nk = 5\n";
for my $steps (@steps){
my $option;
for my $step (@{$steps}){
$option .= "$step step + " if $step == 1;
$option .= "$step steps + " if $step == 2;
}
chop($option);
chop($option);
print "$option\n";
}
}
Sample Run
$ perl perl/ch-2.pl
k = 3
1 step + 2 steps
2 steps + 1 step
1 step + 1 step + 1 step
k = 4
2 steps + 2 steps
1 step + 1 step + 2 steps
1 step + 2 steps + 1 step
2 steps + 1 step + 1 step
1 step + 1 step + 1 step + 1 step
k = 5
1 step + 2 steps + 2 steps
2 steps + 1 step + 2 steps
2 steps + 2 steps + 1 step
1 step + 1 step + 1 step + 2 steps
1 step + 1 step + 2 steps + 1 step
1 step + 2 steps + 1 step + 1 step
2 steps + 1 step + 1 step + 1 step
1 step + 1 step + 1 step + 1 step + 1 step
Notes
Rather than pursue some sort of algorithmic elegance and optimization I decided to
try what is effectively a brute force approach. For small values of $k
this works quite
nicely with the above example output generated in about a second on very modest hardware
(an approximately 20 year old 450Mhz G4 Power Macintosh). Naturally we face a
combinatorial explosion for larger values of $k
. For larger input values consider
a graph search with memoization!
Overview of this brute force approach:
- Generate all arrays of numbers of length
$k
using digits 0, 1, and 2. - Keep all those arrays that sum to
$k
- Remove zeroes from these matching arrays
- Remove duplicate arrays
Combinations are generated using Algorithm::Combinatorics.
Duplicate array removal is facilitated by Array::Compare.
References
posted at: 18:10 by: Adam Russell | path: /perl | permanent link to this entry