RabbitFarm
2022-02-06
Fibonacci Words That Yearn to Be Squarefree
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
posted at: 17:00 by: Adam Russell | path: /perl | permanent link to this entry