RabbitFarm

Part 1

You are given an array of positive integers @N. Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

Solution

/*
    You are given an array of positive integers @N.
    Write a script to return an array @M where $M[i] is 
    the product of all elements of @N except the index $N[i].
*/
product_a_b(A, B, P):- 
    P is A*B.
list_product([], 1).
list_product([H|T], P) :-
        foldl(product_a_b, T, H, P).

list_products(List, Products):-
    length(List, L0),
    L is L0 - 1,
    list_products(List, L, [], Products). 
list_products(_, -1, Products, Products).       
list_products(List, Index, ProductsAccum, Products):-
    nth0(Index, List, _, Remainder),
    list_product(Remainder, Product),
    NewIndex is Index - 1,
    list_products(List, NewIndex, [Product|ProductsAccum], Products).
    
main:-
    list_products([5, 2, 1, 4, 3], Products),
    write(Products),
    halt.  

Sample Run

$ swipl -s prolog/ch-1.p -g main
[24,60,120,30,40]

Notes

A problem like this really underscores the nature of lists in Prolog. That is, if you are programming in most other languages you might think of lists and arrays as interchangeable concepts for the most part. In Prolog that is very clearly not the case: lists are lists and obtaining an element at a certain position in the list is not as straightforward as simply accessing it with the usual square bracket notation. Not to say it is all that hard to do in Prolog, it’s just … different. Or, at least, requires a different mindset. People with experience in pure functional languages have this mindset of thinking of lists in terms of recursions and maps but fluency in these techniques is, sadly, less common these days.

Part 2

You are given m x n matrix of positive integers. Write a script to print spiral matrix as a list.

Solution

/*
    You are given m x n matrix of positive integers.
    Write a script to print spiral matrix as a list.
*/
write_remove_top(Matrix, UpdatedMatrix):-
    nth0(0, Matrix, Top),
    atomic_list_concat(Top, ",", TopString),
    write(TopString),
    nth0(0, Matrix, _, UpdatedMatrix).

write_remove_last([], UpdatedMatrix, UpdatedMatrix).
write_remove_last([H|T], RemainderAccum, UpdatedMatrix):-
    length(H, L),
    Last is L - 1,
    nth0(Last, H, Right),
    write(Right),
    write(","),
    nth0(Last, H, _, UpdatedRow),
    write_remove_last(T, [UpdatedRow|RemainderAccum], UpdatedMatrix).

write_remove_right(Matrix, UpdatedMatrix):-
    write_remove_last(Matrix, [], UpdatedMatrix).

write_remove_first([], UpdatedMatrix, UpdatedMatrix).
write_remove_first([H|T], RemainderAccum, UpdatedMatrix):-
    nth0(0, H, Left),
    write(Left),
    write(","),
    nth0(0, H, _, UpdatedRow),
    write_remove_first(T, [UpdatedRow|RemainderAccum], UpdatedMatrix).

write_remove_left(Matrix, UpdatedMatrix):-
    write_remove_first(Matrix, [], UpdatedMatrix).

write_remove_bottom(Matrix, UpdatedMatrix):-
    length(Matrix, L),
    Last is L - 1,
    nth0(Last, Matrix, Bottom),
    reverse(Bottom, ReverseBottom),
    atomic_list_concat(ReverseBottom, ",", BottomString),
    write(BottomString),
    nth0(Last, Matrix, _, UpdatedMatrix).
    
    
spiral(Matrix):-
    spiral(Matrix, _).
spiral(Matrix, UpdatedMatrix):-
    write_remove_top(Matrix, UpdatedMatrix),
    write(","),
    write_remove_right(UpdatedMatrix, RightRemainder),
    reverse(RightRemainder, RemainderRight),
    write_remove_bottom(RemainderRight, BottomRemainder), 
    write(","),
    reverse(BottomRemainder, RemainderBottom),
    write_remove_left(RemainderBottom, LeftRemainder), 
    spiral(LeftRemainder, _).
spiral(_, []):-
    write("\b").
    
main:-
    spiral([
        [ 1, 2, 3 ],
        [ 4, 5, 6 ],
        [ 7, 8, 9 ]
    ]), halt.  

Sample Run

$ swipl -s prolog/ch-2.p -g main
1,2,3,6,9,8,7,4,5

Notes

The spiral print works in a repeated pattern from the outside in: top row, right column, bottom row, left column. My solution puts each write/remove step of this pattern in their own predicates. A few things worth pointing out

• The matrix is a 2d list: a list with inner lists.
• For the spiral effect we need to print bottom up and right to left. In those cases I just use reverse/2 on the list being printed.
• I use a simple trick to remove a trailing comma in the final output; I print a backspace to the terminal which deletes it!
• Like Part 1 above I use nth0/4 as well as nth0/3 to directly access specific elements.

Part 1

You are given an array of positive integers @N. Write a script to return an array @M where $M[i] is the product of all elements of @N except the index $N[i].

Solution

use strict;
use warnings;
##
# You are given an array of positive integers @N.
# Write a script to return an array @M where $M[i] 
# is the product of all elements of @N except the index $N[i].
##
sub list_product{
    my @numbers = @_;
    my $product = 1;
    map {$product *= $_ } @numbers;
    return $product;
}

MAIN:{
    my(@N, @M);
    @N = (5, 2, 1, 4, 3);
    for my $i (0 .. (@N - 1)){
        my @numbers = @N[0 .. $i - 1, $i+1 .. (@N - 1)];
        push @M, list_product(@numbers);
    }
    print "(" . join(", ", @M) . ")\n";
    @M = ();
    @N = (2, 1, 4, 3);
    for my $i (0 .. (@N - 1)){
        my @numbers = @N[0 .. $i - 1, $i+1 .. (@N - 1)];
        push @M, list_product(@numbers);
    }
    print "(" . join(", ", @M) . ")\n";
}

Sample Run

$ perl perl/ch-1.pl
(24, 60, 120, 30, 40)
(12, 24, 6, 8)

Notes

Taking the product of a list of numbers is a well known perl idiom using map. To keep the code somewhat cleaner I placed the list_product computation in it’s own subroutine. The trickiest part, then, is to make sure the list has the right element removed. This is done using array slices. as we loop over the array of numbers we construct a list of indices which do not include the current element.

Another possible approach would be to use a map inside the loop to identify the elements we want to retain. I decided against that approach since it would be a second complete full iteration over the list. To be fair, I don’t necessarily try to always make these challenge solutions all that efficient, but this just happened to strike me as particularly egregious at the time!

Part 2

You are given m x n matrix of positive integers. Write a script to print spiral matrix as a list.

Solution

use strict;
use warnings;
##
# You are given m x n matrix of positive integers.
# Write a script to print spiral matrix as a list.
##
sub print_remove_top{
    my(@matrix) = @_;
    print join(", ", @{$matrix[0]}) . ", ";
    splice(@matrix, 0, 1);
    return @matrix;
}

sub print_remove_right{
    my(@matrix) = @_;
    my @right;
    for my $row (@matrix){
        push @right, $row->[-1];
        my @a = @{$row}[0 .. (@{$row} - 2)];
        $row = \@a;
    }
    print join(", ", @right) . ", ";
    return @matrix;
}

sub print_remove_bottom{
    my(@matrix) = @_;
    print join(", ", reverse(@{$matrix[-1]})) . ", ";
    splice(@matrix, -1);
    return @matrix;
}

sub print_remove_left{
    my(@matrix) = @_;
    my @left;
    for my $row (@matrix){
        push @left, $row->[0];
        my @a = @{$row}[1 .. (@{$row} - 1)];
        $row = \@a;
    }
    print join(", ", reverse(@left)) . ", ";
    return @matrix;
}

sub spiral_print{
    my(@matrix) = @_;
    print "[";
    {
        @matrix = print_remove_top(@matrix) if @matrix;
        @matrix = print_remove_right(@matrix) if @matrix;
        @matrix = print_remove_bottom(@matrix) if @matrix;
        @matrix = print_remove_left(@matrix) if @matrix;
        redo if @matrix;
    }
    print "\b\b]\n";
}

MAIN:{
    spiral_print(
        [1, 2, 3],
        [4, 5, 6],
        [7, 8, 9]
    );
    spiral_print(
        [ 1,  2,  3,  4],
        [ 5,  6,  7,  8],
        [ 9, 10, 11, 12],
        [13, 14, 15, 16]
    );
}

Sample Run

$ perl perl/ch-2.pl
[1, 2, 3, 6, 9, 8, 7, 4, 5] 
[1, 2, 3, 4, 8, 12, 16, 15, 14, 13, 9, 5, 6, 7, 11, 10] 

Notes

The spiral print works in a repeated pattern from the outside in: top row, right column, bottom row, left column. My solution put each print/remove step of this pattern in their own subroutines. A few things worth pointing out

• The matrix is a 2d array: a perl array with inner array references.
• In some cases I use splice to remove from the matrix. splice doesn’t work on array references (since perl v5.24) so when needing to remove from the matrice’s inner array references I just use the slicing syntax.
• redo looked better to me than the equivalent while loop although obviously either one would work fine.
• for the spiral effect we need to print bottom up and right to left. In those cases I first use reverse on the elements being printed.