RabbitFarm

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given text file with rows numbered 1-15 in random order but there is a catch one row in missing in the file.

Solution

use strict;
use warnings;
sub find_missing{
    my(@numbers) = sort {$a <=> $b} @_;
    for(my $i=0; $i< @numbers - 1; $i++){
        return $numbers[$i] + 1 if $numbers[$i] != $numbers[$i + 1] - 1;   
    }  
}

MAIN:{
    my @line_numbers; 
    while(){
        chomp;
        m/([0-9]+),.*/;
        push @line_numbers, $1;
    }
    my $missing = find_missing(@line_numbers);
    print "$missing\n"; 
}

__DATA__
11, Line Eleven
1, Line one
9, Line Nine
13, Line Thirteen
2, Line two
6, Line Six
8, Line Eight
10, Line Ten
7, Line Seven
4, Line Four
14, Line Fourteen
3, Line three
15, Line Fifteen
5, Line Five

Sample Run

$ perl perl/ch-1.pl
12

Notes

My approach here is likely the most common one for this problem I would think. We get a list of all the numbers and then iterate through the list to determine which one is missing. This code assumes the conditions of the problem hold, that there is always one missing number.

Part 2

You are given size of a triangle. Write a script to find all possible paths from top to the bottom right corner. In each step, we can either move horizontally to the right (H), or move downwards to the left (L) or right (R).

Solution

use strict;
use warnings;
use constant FINAL => "end"; 
use constant DEADEND => "-1"; 
use constant TRIANGLE_TOP => q|/\\| ;
use constant TRIANGLE_BOTTOM => q|/__\\|;

sub find_paths{
    my($n) = @_;
    my %paths;
    my @complete_paths;
    my @vertices; 
    for my $i (0 .. $n){
        for my $j (0 .. $i){
            push @vertices, "$i-$j";
        }
    }
    $paths{""}=["0-0",["0-0"]];    
    my %updated_paths;
    while((keys %paths) > 0){
        %updated_paths = ();
        for my $path (keys %paths){
            my @exists;
            my @visited; 
            my $current = $paths{$path}->[0];  
            my $visited = $paths{$path}->[1];
            my @ij = split(/\-/, $current);  
            my($left, $horizontal, $right) = (($ij[0] + 1) . "-" . $ij[1], $ij[0] . "-" . ($ij[1] + 1), ($ij[0] + 1) . "-" . ($ij[1] + 1));
            @exists = grep {$_ eq $left} @vertices;
            @visited = grep {$_ eq $left} @{$visited};
            if(@exists && !@visited){
               my $visited_left = [@{$visited}, $left];
               if($left eq "$n-$n"){
                   push @complete_paths, $path . "L"; 
               }
               else{
                   $updated_paths{$path . "L"} = [$left, $visited_left];     
               }
            }          
            @exists = grep {$_ eq $horizontal} @vertices;
            @visited = grep {$_ eq $horizontal} @{$visited};
            if(@exists && !@visited){
               my $visited_horizontal = [@{$visited}, $horizontal];
               if($horizontal eq "$n-$n"){
                   push @complete_paths, $path . "H"; 
               }
               else{
                   $updated_paths{$path . "H"} = [$horizontal, $visited_horizontal];     
               }
            }           
            @exists = grep {$_ eq $right} @vertices;
            @visited = grep {$_ eq $right} @{$visited};
            if(@exists && !@visited){
               my $visited_right = [@{$visited}, $right];
               if($right eq "$n-$n"){
                   push @complete_paths, $path . "R"; 
               }
               else{
                   $updated_paths{$path . "R"} = [$right, $visited_right];     
               }
            }           
        }  
        %paths = %updated_paths;  
    }   
    return @complete_paths; 
}

sub print_triangle{
    my($n) = @_;
    my $top = TRIANGLE_TOP . "  ";
    for my $i (1 .. $n ){
        print " ";
        print "  " x ($n - $i);
        print $top x $i  ;
        print "\n";
        print "  " x ($n - $i );
        print TRIANGLE_BOTTOM x ($i );
        print "\n";
    }
}

MAIN:{
    my($N);
    $N = 1;
    print_triangle($N);
    for my $path (find_paths($N)){
        print "$path ";
    } 
    print "\n"; 
    $N = 2;
    print_triangle($N);
    for my $path (find_paths($N)){
        print "$path ";
    } 
    print "\n"; 
    $N = 3;
    print_triangle($N);
    for my $path (find_paths($N)){
        print "$path ";
    } 
    print "\n"; 
    $N = 4;
    print_triangle($N);
    for my $path (find_paths($N)){
        print "$path ";
    } 
    print "\n"; 
}

Sample Run

$ perl perl/ch-2.pl
 /\  
/__\
R LH 
   /\  
  /__\
 /\  /\  
/__\/__\
RR LRH RLH LHR LLHH LHLH 
     /\  
    /__\
   /\  /\  
  /__\/__\
 /\  /\  /\  
/__\/__\/__\
RRR LHRR RLHR LRRH RRLH RLRH LRHR LLHRH LLRHH RLHLH LHRLH RLLHH LHLRH LLHHR LHLHR LRLHH LRHLH LHLHLH LHLLHH LLHLHH LLLHHH LLHHLH 
       /\  
      /__\
     /\  /\  
    /__\/__\
   /\  /\  /\  
  /__\/__\/__\
 /\  /\  /\  /\  
/__\/__\/__\/__\
RRRR LRRHR LRHRR RRLHR LRRRH RRLRH RLRRH RLHRR RLRHR LHRRR RRRLH LHRRLH RLRHLH RLHLRH RLHLHR LLRHRH RLLRHH RLLHRH LHLRRH LLRRHH LRRLHH LRHRLH RLLHHR LHLRHR LHLHRR LLRHHR RRLLHH LRLHHR RLHRLH RLRLHH LHRLRH LRLRHH LHRLHR LRLHRH LRHLHR LLHRRH LRRHLH LLHHRR RRLHLH LLHRHR LRHLRH LLHRHLH LLLHHHR LLHHRLH LRLLHHH LLLRHHH LRHLHLH LLLHRHH RLHLLHH LLHLHHR LHRLHLH LHLHLHR LLRHLHH LHLLHRH LRLHHLH LLHLRHH RLLHLHH LLHHLRH LHLRLHH LHLHRLH LLRHHLH LRLHLHH LHLRHLH RLLHHLH LLLHHRH LHRLLHH LLHHLHR LRHLLHH LHLLHHR RLHLHLH LHLHLRH LLHRLHH LHLLRHH LLRLHHH RLLLHHH LLHLHRH LLHHLHLH LLLHHLHH LHLLHHLH LHLLLHHH LHLHLLHH LLHLHLHH LLLLHHHH LLHLHHLH LHLHLHLH LLHLLHHH LLLHHHLH LHLLHLHH LLHHLLHH LLLHLHHH 

Notes

Here we see a great example of combinatorial explosion! As the triangle size grows the number of possible pathways increases extremely quickly. The number of possible paths when $N = 10 is 1,037,718. My code finds all of those in about 40 seconds when run on a 2019 MacBook Pro. Performance on more modest hardware is still reasonable.

When $N = 20 the complete number of paths is so large that maintaining a list of paths in memory will cause the Perl interpreter to run out of memory and crash. It is simply not possible to list them all!

Interestingly it turns out that the original author of the challenge thought simply counting the paths would be sufficient, but the problem was edited to instead list the paths. I have to say that listing them all, along with my own optional variation of drawing the triangles was fun. The only downside was a bit of initial surprise, and then realization, about just how large the number of paths grows.

It turns out that this task is a slightly disguised description of what is known as a Quantum Pascal's Triangle. The possible number of paths, the count that is, can be obtained directly from a closed form approach. No need to actually traverse the paths!

What I did here was to effectively do a breadth first traversal.

• A hash is kept of all paths. Keys are the paths themselves and values are an array reference containing the current position and all previously visited nodes on that path.
• Each path is examined and updated to move to the next position proved that next position exists and has not yet been visited. (See more on visited positions next).
• The hash of paths is refreshed by moving paths that are completed to an array. Also, this code allows for catching paths which deadend (i.e. end up in a corner which is impossible to get out of without backtracking over a visited node). Without horizontal leftward movements this is not really possible however. Some CPU cycles can be saved by eliminating these checks, but I decided to leave them in anyway. Please do note the unnecessary extra work, however!
• The traversal ends when all paths have been exhausted, the loop ends, and the paths are returned.

References

Challenge 117

Quantum Pascal's Triangle

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

You are given text file with rows numbered 1-15 in random order but there is a catch one row in missing in the file.

Solution

:-initialization(main).

check_and_read(10, [] ,_):-
    !.
check_and_read(13, [], _):-
    !.
check_and_read(44, [], _):-
    !.
check_and_read(end_of_file, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

line_numbers([], []).  
line_numbers([N0,_|T], [N1|N]):-
    number_atom(N1, N0),
    line_numbers(T, N). 

missing(Contents, Missing):-
    line_numbers(Contents, Numbers),
    max_list(Numbers, Max),
    min_list(Numbers, Min),
    between(Min, Max, X),
    \+ member(X, Numbers),
    Missing = X. 

main:-
    open('data', read, Stream),
    read_data(Stream, Contents),
    close(Stream),
    missing(Contents, Missing),
    format('Missing: ~d ~N', [Missing]), 
    halt.   

Sample Run

$ gprolog --consult-file prolog/ch-1.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-117/adam-russell/prolog/ch-1.p for byte code...
/home/adamcrussell/Projects/perlweeklychallenge-club/challenge-117/adam-russell/prolog/ch-1.p compiled, 18 lines read - 1808 bytes written, 38 ms
Missing: 12

Notes

What interested me the most on this is the majority of the code here is to read in the data file. It's all boilerplate stuff, ordinarily it'd be in some other file of utilities. The work is all done in the seven lines of missing/2. Once we have all the line numbers we use member/2 to determine which one is missing.

As usual there was a second task in this week's challenge but I did not get around to coding up a solution in Prolog. I did get do it in Perl however. Given the nature of that problem my Prolog would have been a fairly close re-implementation of the same algorithm.

Happy Father's Day!

References

Challenge 117