RabbitFarm

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

You are given two strings having the same number of digits, $a and $b. Write a script to generate Fibonacci Words by concatenation of the previous two strings. Print the 51st
of the first term having at least 51 digits.

Solution

use strict;
use warnings;

sub _fibonacci_words_51{
    my($accumulated) = @_;
    my $i = @{$accumulated} - 1;
    my $next = $accumulated->[$i - 1] . $accumulated->[$i];
    return substr($next, 51 - 1, 1) if length($next) >= 51;
    push @{$accumulated}, $next;
    _fibonacci_words_51($accumulated);
}

sub fibonacci_words{
    my($u, $v) = @_;
    return _fibonacci_words_51([$u, $v]);
}

MAIN:{
    print fibonacci_words(q[1234], q[5678]) . "\n";    
}

Sample Run

$ perl perl/ch-1.pl
7

Notes

Fibonacci sequences are often an introductory example of recursion. This solution keeps with that recursive tradition. sub _fibonacci_words_51 takes a single argument, an array reference which stores the sequence terms. At each recursive step the next term is computed and checked for the terminating condition.

Part 2

Write a script to generate all square-free integers <= 500.

Solution

use strict;
use warnings;

use constant LIMIT => 500;

sub prime_factor{
    my $x = shift(@_); 
    my @factors;    
    for (my $y = 2; $y <= $x; $y++){
        next if $x % $y;
        $x /= $y;
        push @factors, $y;
        redo;
    }
    return @factors;  
}

sub square_free{
    my @square_free;
    for my $x (1 .. LIMIT){
        my @factors = prime_factor($x);
        my @a;
        map {$a[$_]++} @factors;
        @a = grep {$_ && $_ > 1} @a;
        push @square_free, $x if !@a;
    }
    return @square_free;
}

main:{
    print join(", ", square_free()) . "\n";
}

Sample Run

$ perl perl/ch-2.pl
1, 2, 3, 5, 6, 7, 10, 11, 13, 14, 15, 17, 19, 21, 22, 23, 26, 29, 30, 31, 33, 34, 35, 37, 38, 39, 41, 42, 43, 46, 47, 51, 53, 55, 57, 58, 59, 61, 62, 65, 66, 67, 69, 70, 71, 73, 74, 77, 78, 79, 82, 83, 85, 86, 87, 89, 91, 93, 94, 95, 97, 101, 102, 103, 105, 106, 107, 109, 110, 111, 113, 114, 115, 118, 119, 122, 123, 127, 129, 130, 131, 133, 134, 137, 138, 139, 141, 142, 143, 145, 146, 149, 151, 154, 155, 157, 158, 159, 161, 163, 165, 166, 167, 170, 173, 174, 177, 178, 179, 181, 182, 183, 185, 186, 187, 190, 191, 193, 194, 195, 197, 199, 201, 202, 203, 205, 206, 209, 210, 211, 213, 214, 215, 217, 218, 219, 221, 222, 223, 226, 227, 229, 230, 231, 233, 235, 237, 238, 239, 241, 246, 247, 249, 251, 253, 254, 255, 257, 258, 259, 262, 263, 265, 266, 267, 269, 271, 273, 274, 277, 278, 281, 282, 283, 285, 286, 287, 290, 291, 293, 295, 298, 299, 301, 302, 303, 305, 307, 309, 310, 311, 313, 314, 317, 318, 319, 321, 322, 323, 326, 327, 329, 330, 331, 334, 335, 337, 339, 341, 345, 346, 347, 349, 353, 354, 355, 357, 358, 359, 362, 365, 366, 367, 370, 371, 373, 374, 377, 379, 381, 382, 383, 385, 386, 389, 390, 391, 393, 394, 395, 397, 398, 399, 401, 402, 403, 406, 407, 409, 410, 411, 413, 415, 417, 418, 419, 421, 422, 426, 427, 429, 430, 431, 433, 434, 435, 437, 438, 439, 442, 443, 445, 446, 447, 449, 451, 453, 454, 455, 457, 458, 461, 462, 463, 465, 466, 467, 469, 470, 471, 473, 474, 478, 479, 481, 482, 483, 485, 487, 489, 491, 493, 494, 497, 498, 499

Notes

This solution makes use of sub prime_factor which frequently comes in handy in these challenges. Beyond getting the prime factors the only other requirement is to determine that none are repeated. This is done by a counting array, created with a map and then checked with grep for any entries greater than 1. If such an entry exists then we know that there was a duplicate prime factor and that number is not square free.

References

Challenge 150

Squarefree Numbers

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

Part 1

You are given two strings having the same number of digits, $a and $b. Write a script to generate Fibonacci Words by concatenation of the previous two strings. Print the 51st
of the first term having at least 51 digits.

Solution

fibonacci_words(Size, A, B) --> {atom_concat(A, B, C), atom_chars(C, Chars), length(Chars, N), N < Size}, [A], fibonacci_words(Size, B, C).
fibonacci_words(Size, A, B) --> {atom_concat(A, B, C), atom_chars(C, Chars), length(Chars, N), N >= Size}, [C].

fibonacci_words_nth_character(A, B, N, NthChar) :-
    phrase(fibonacci_words(N, A, B), FibonacciWords),
    last(FibonacciWords, LongestTerm),
    atom_chars(LongestTerm, LongestTermChars),
    nth(N, LongestTermChars, NthChar).

Sample Run

$ gprolog --consult-file prolog/ch-1.p
| ?- fibonacci_words_nth_character('1234', '5678', 51, N).

N = '7' ? 

(2 ms) yes
| ?- 

Notes

This little bit of code might be the thing I am proudest of in a while! You see, modern Prolog style generally promotes the use of DCGs for almost any list processing you might want to do. The reasons for this are that DCG code is usually easily bimodal and also testing of code is much easier. Furthermore, DCG code can be said to rely more on the Prolog engine itself backtracking versus more manual recursive style code. Of course these are general statements which are not always necessarily true. In any event I default to not using DCGs so generally, but have been making a conscious attempt to do so. This Fibonacci Words task is well suited for DCGs.

Size, A, and B are passed as extra arguments to the DCG. Some parts of the DCG might appear a little mysterious so here is what the DCG code looks like when expanded

fibonacci_words(A, B, C, D, E) :-
        atom_concat(B, C, F),
        atom_chars(F, G),
        length(G, H),
        H < A,
        D = [B|I],
        fibonacci_words(A, C, F, I, E).
fibonacci_words(A, B, C, D, E) :-
        atom_concat(B, C, F),
        atom_chars(F, G),
        length(G, H),
        H >= A,
        D = [F|E].

while the variable names are changed during the term expansion you can see the behavior which may at first seem odd. The first three variables for each predicate are the "extra" ones which carry the size information, and the most recent two terms of the sequence which are used to compute the next term. In the DCG when we have [A] you can see what happens, that it is expanded to unify with the first implicit argument. In the expanded version we see D = [B|I], and in this way we create the recursive relationship to build the sequence list. Well, of course the recursive call which follows is important too, but see how we've now passed as the first implicit argument I which represents the uninstantiated tail of a list and on the next call will recursively be added to.

Part 2

Write a script to generate all square-free integers <= 500.

Solution

prime_factors(N, L):- 
    N > 0,  
    prime_factors(N, L, 2).
prime_factors(1, [], _):- 
    !.
prime_factors(N, [F|L], F):-                     
    R is N // F, 
    N =:= R * F, 
    !, 
    prime_factors(R, L, F).
prime_factors(N, L, F):-
    next_factor(N, F, NF), 
    prime_factors(N, L, NF).
next_factor(_, 2, 3):- 
    !.
next_factor(N, F, NF):- 
    F * F < N, 
    !, 
    NF is F + 2.
next_factor(N, _, N).

square_free(N, SquareFree):-
    findall(X,
        (between(1, N, X),
         prime_factors(X, PrimeFactors),
         sort(PrimeFactors, PrimeFactorsSorted),
         msort(PrimeFactors, PrimeFactorsMSorted),
         length(PrimeFactorsSorted, SortedLength),
         length(PrimeFactorsMSorted, MSortedLength),
         SortedLength == MSortedLength), SquareFree).

Sample Run

$ gprolog --consult-file prolog/ch-2.p 
| ?- square_free(500, SquareFree).

SquareFree = [1,2,3,5,6,7,10,11,13,14,15,17,19,21,22,23,26,29,30,31,33,34,35,37,38,39,41,42,43,46,47,51,53,55,57,58,59,61,62,65,66,67,69,70,71,73,74,77,78,79,82,83,85,86,87,89,91,93,94,95,97,101,102,103,105,106,107,109,110,111,113,114,115,118,119,122,123,127,129,130,131,133,134,137,138,139,141,142,143,145,146,149,151,154,155,157,158,159,161,163,165,166,167,170,173,174,177,178,179,181,182,183,185,186,187,190,191,193,194,195,197,199,201,202,203,205,206,209,210,211,213,214,215,217,218,219,221,222,223,226,227,229,230,231,233,235,237,238,239,241,246,247,249,251,253,254,255,257,258,259,262,263,265,266,267,269,271,273,274,277,278,281,282,283,285,286,287,290,291,293,295,298,299,301,302,303,305,307,309,310,311,313,314,317,318,319,321,322,323,326,327,329,330,331,334,335,337,339,341,345,346,347,349,353,354,355,357,358,359,362,365,366,367,370,371,373,374,377,379,381,382,383,385,386,389,390,391,393,394,395,397,398,399,401,402,403,406,407,409,410,411,413,415,417,418,419,421,422,426,427,429,430,431,433,434,435,437,438,439,442,443,445,446,447,449,451,453,454,455,457,458,461,462,463,465,466,467,469,470,471,473,474,478,479,481,482,483,485,487,489,491,493,494,497,498,499]

(26 ms) yes
| ?-

Notes

I am re-using the prime factorization code I have use din the past, most recently in Challenge 123. Getting the factors is really the hardest part. Once that is doine we need to only check to see if a number has duplicate prime factors indicating a square. To do that we sort using msort/2 and sort/2 and see if the resulting lists are the same length. Recall that sort/2 will remove duplicates whereas msort/2 does not. If the results of both are the same length then we can conclude there were no square factors.

References

Challenge 150

Squarefree Numbers