Perl Weekly Challenge 150.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 150.

Task 1: Fibonacci Words

Submitted by: Mohammad S Anwar
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.

The sequence is obtained by concatenating the previous two sequences. We stop when the length is large enough and then look at a specific position in the resulting string. This is easily onelined:

perl -E '($x,$y)=@ARGV;($x,$y)=($y,$x.$y) until length($x)>=51;
say substr $x,50,1' 1234 5678

Results:

7

The full code is

 1  # Perl weekly challenge 150
 2  # Task 1: fibonacci words
 3  #
 4  # See https://wlmb.github.io/2022/01/31/PWC150/#task-1-fibonacci-words
 5  use v5.12;
 6  use warnings;
 7  die "Usage: ./ch-1.pl word word [N]" .
 8      "to get the N-th (default=51) character of a fibonacci word"
 9      unless @ARGV>=2;
10  my ($x, $y, $N)=@ARGV;
11  $N//=51;
12  die "N should be >=1" unless $N>=1;
13  die "Words should not be empty"
14      unless length $x > 0 && length $y > 0;
15  say "Fibonacci sequence:";
16  say($x), ($x, $y)=($y, $x . $y) until length($x)>=$N;
17  say $x;
18  say "\n$N-th letter: ", substr $x,$N-1,1;

Example:

./ch-1.pl 1234 5678

Results:

Fibonacci sequence:
1234
5678
12345678
567812345678
12345678567812345678
56781234567812345678567812345678
1234567856781234567856781234567812345678567812345678

51-th letter: 7

Another example:

./ch-1.pl ab cde 5

Results:

Fibonacci sequence:
ab
cde
abcde

5-th letter: e

Actually, I don’t have to build the Fibonacci string to get the letter, I just have to calculate the sequence of string lengths l(n)=l(n-2)+l(n-1). Thus, the N-th letter of the n-th string is the M=N-l(n-2)-th letter of the n-1-th string. If M<=0 it means it is in the n-2-th string instead. I don’t even have to store the lengths of the strings as they can be reconstructed from the last two.

perl -E '($x, $y, $N)=@ARGV; $N//=51; ($l,$m)=map {length $_} ($x, $y);
say(substr $x, $N-1, 1), exit if $N<=$l; say(substr $y, $N-1, 1), exit if $N<=$m;
do {($l,$m)=($m,$m+$l)} until $N<=$m; ($l,$m,$N)=($m-$l, $l, $N>0?$N+$l-$m:$N+$l)
while($m>length($y)); say $N<=0?substr $x,$N+length($x)-1,1:substr $y,$N-1,1;
' 1234 5678

Results:

7

The full version:

 1  # Perl weekly challenge 150
 2  # Task 1: fibonacci words
 3  #
 4  # See https://wlmb.github.io/2022/01/31/PWC150/#task-1-fibonacci-words
 5  use v5.12;
 6  use warnings;
 7  die "Usage: ./ch-1.pl word word [N]" .
 8      "to get the N-th (default=51) character of a fibonacci word"
 9      unless @ARGV>=2;
10  my ($x, $y, $N)=@ARGV;
11  $N//=51; # default
12  my ($l,$m)=map {length $_} ($x, $y); # last two lengths
13  die "Words should not be empty" unless $l > 0 && $m > 0;
14  die "N should be >=1" unless $N>=1;
15  say "Input: x=$x, y=$y, N=$N";
16  say("Output: ", substr $x, $N-1, 1), exit if $N<=$l; # character in first word
17  say("Output: ", substr $y, $N-1, 1), exit if $N<=$m; # character in second word
18  do {($l,$m)=($m,$m+$l)} until $N<=$m; # get lengths of concatenated strings
19  # get back to the initial two strings
20  # while updating $N
21  # Negative $N corresponds to a char not in the current string, but in the following,
22  # so we make it positive in the following step
23  ($l,$m,$N)=($m-$l, $l, $N>0?$N+$l-$m:$N+$l)  while($m>length($y));
24  # A final negative $N corresponds to the first word
25  # a final positive $N corresponds to the second word
26  say "Output: ", $N<=0? substr($x,$N+length($x)-1,1):substr($y,$N-1,1);

Example:

./ch-1a.pl 1234 5678

Results:

Input: x=1234, y=5678, N=51
Output: 7

Another example:

./ch-1a.pl ab cde 5

Results:

Input: x=ab, y=cde, N=5
Output: e

This method is best for very large $N, as in

./ch-1a.pl ab cde 1000000

Results:

Input: x=ab, y=cde, N=1000000
Output: e

which hopefully is the correct answer (I tested the program with many small examples though).

(I realize I had not read the problem carefully: the strings were supposed to be digits and were supposed to be of the same size; I solved the problem for arbitrary input strings.)

Task 2: Square-free Integer

Submitted by: Mohammad S Anwar
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, ...

This can be solved with a variation of Eratosthenes algorithm, by removing all multiples of all squares from an array and looking at the remaining number. This may be done with a PDL oneliner:

perl -MPDL -MPDL::NiceSlice -E '$n=ones(501); $n(0).=0;
$n($_*$_:-1:$_*$_).=0 for(2..sqrt(500)); say sequence(501)->where($n)'

Results:

[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]

I explain the code after the full version:

 1  # Perl weekly challenge 150
 2  # Task 2: square-free integer
 3  #
 4  # See https://wlmb.github.io/2022/01/31/PWC150/#task-2-square-free-integer
 5  use v5.12;
 6  use warnings;
 7  use PDL;
 8  use PDL::NiceSlice;
 9  my $N=$ARGV[0]//500;
10  my $square_free=ones($N+1);
11  $square_free(0).=0; # ignore zero
12  $square_free($_*$_:-1:$_*$_).=0
13      for(2..sqrt($N));
14  say sequence($N+1)->where($square_free);

In line 10 I make a vector with $N+1 entries, corresponding to the numbers 0..$N initialized to ones. I set to zero those numbers that are not square free (lines 11 and 12) and the remaining 1’s correspond to square-free numbers. First I remove 0 (line 11). I leave 1 and starting from 2 (line 13), I remove each square and all its multiples. The line $square_free($_*$_:-1:$_*$_) makes a vector from elements of $square_free starting at $_*$_ up to the end (-1) and with a stride $_*$_, i.e., chooses all multiples of the square of $_ which are therefore not square-free, and flags them with a 0. Finally, line 14 makes a vector with all numbers 0,1,…$N and chooses only those that correspond to a true value in the array $square_free.

Example

./ch-2.pl

Results (formatted):

[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]

Smaller example:

./ch-2.pl 10

Results:

[1 2 3 5 6 7 10]

Larger example:

./ch-2.pl 1000

Results (edited):

[1 2 3 5 6 7 10 ... 985 986 987 989 991 993 994 995 997 998]
Written on January 31, 2022