Perl Weekly Challenge: Week 150

Challenge 1:

Fibonacci Words

You are given two strings having same number of digits, $a and $b.

Write a script to generate Fibonacci Words by concatenation of the previous two strings. Finally print 51st digit of the first term having at least 51 digits.

Example

Input: $a = '1234' $b = '5678'
Output: 7

Fibonacci Words:

'1234'
'5678'
'12345678'
'567812345678'
'12345678567812345678'
'56781234567812345678567812345678'
'1234567856781234567856781234567812345678567812345678'

The 51st digit in the first term having at least 51 digits '1234567856781234567856781234567812345678567812345678' is 7.

Creating and using the Fibonacci sequence is pretty easy in Perl and Raku; it has come up several times in previous challenges. The novelty this time is we are not dealing with numbers of the sequence themselves but "words" which are formed in a similar way.

First we combine the input into an array.

my @strings = ($a, $b);

The first two terms in the Fibonacci sequence are 0 and 1 so the first two Fibonacci words will be $strings[0] and $strings[1] i.e. $a and $b. We add them into an array called @words.

my @words = @strings;

The reason the two lines above are separate is due to my previous failed attempts to solve this challenge (I seriously overthought it.) In hindsight, we don't need @strings at all and we could have directly initialized @words with ($a, $b).

After the first two, terms in the Fibonacci sequence are formed by adding together the previous two terms. The string equivalent to adding is .join()ing words and that's what we shall do in an infinite loop. The generated words are appended to @words.

loop {
    @words.push( (@words[*-2], @words[*-1]).join(q{}) );

If the most recent word we have generated is 52 characters long, we have the information needed to solve the challenge so we can break out of the loop.

    if @words[*-1].chars > 51 {
        last;
    }
}

Now all that remains to do is to find the 51st digit in the last word generated and display it.

say @words[*-1].substr(50, 1);

(Full code on Github.)

The Perl version is equally simple.

my @strings = ($a, $b);
my @words = @strings;

while(true) {
    push @words, (join q{}, ($words[-2], $words[-1])); 
    if (length $words[-1] > 51) {
        last;
    }
}

say substr $words[-1], 50, 1;

(Full code on Github.)

Challenge 2:

Square-Free Integer

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

In mathematics, a square-free integer (or squarefree integer) is an integer which is divisible by no perfect square other than 1. That is, its prime factorization has exactly one factor for each prime that appears in it. For example, 10 = 2 ⋅ 5 is square-free, but 18 = 2 ⋅ 3 ⋅ 3 is not, because 18 is divisible by 9 = 3**2.

Example

The smallest positive square-free integers are
    1, 2, 3, 5, 6, 7, 10, 11, 13, 14, 15, 17, 19, 21, 22, 23, 26, 29, 30, ...

We make an array to store any squareless numbers we might find. 1 is squareless by definition so we can add it immediately without any additional calculations.

my @squareless = (1);

For the rest of the integers upto 500...

for 2 .. 500 -> $n {

...we will need each ones prime factors. I already had a function I could reuse for that from PWC 133.

    my @primeFactors = factorize($n);

If all the prime factors are unique, we add the number to @squareless.

    if @primeFactors == @primeFactors.unique {
        @squareless.push($n);
    }
}

And finally, we print @squareless joined by spaces and commas.

@squareless.join(q{, }).say;

(Full code on Github.)

The Perl version of factorize() uses another function called isPrime() and we also need a replacement for unique(). With these, the Perl version is the same as Raku.

my @squareless = (1);

for my $n (2 .. 500) {
    my @primeFactors = factorize($n);

    if (@primeFactors == unique(@primeFactors)) {
        push @squareless, $n;
    }
}

say join q{, }, @squareless;

(Full code on Github.)

In case you want to know, the complete list of square-free integers under 500 is:

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