Sum enchanted evening… you’ll see a special number
You’ll see a special number, and you’ll sum its squares.
And somehow you know, you know even then,
That somehow you’re working on Perl Weekly Challenge 252!

Task 1: Special Numbers

You are given an array of integers, @ints.

Write a script to find the sum of the squares of all special elements of the given array.

An element $int[i] of @ints is called special if i divides n, i.e. n % i == 0.
Where n is the length of the given array. Also the array is 1-indexed for the task.

Example 1

Input: @ints = (1, 2, 3, 4)
Output: 21

There are exactly 3 special elements in the given array:
$ints[1] since 1 divides 4,
$ints[2] since 2 divides 4, and
$ints[4] since 4 divides 4.

Hence, the sum of the squares of all special elements of given array:
1 * 1 + 2 * 2 + 4 * 4 = 21.

Example 2

Input: @ints = (2, 7, 1, 19, 18, 3)
Output: 63

There are exactly 4 special elements in the given array:
$ints[1] since 1 divides 6,
$ints[2] since 2 divides 6,
$ints[3] since 3 divides 6, and
$ints[6] since 6 divides 6.

Hence, the sum of the squares of all special elements of given array:
2 * 2 + 7 * 7 + 1 * 1 + 3 * 3 = 63

Approach

Well, if you’ve been following me, you know I’m going to break this up into smaller functions. I’m also borrowing code I wrote for Perl Weekly Challenge 229.

Raku

sub specialElementIndices($n) {
  return (1 .. $n).grep({ $n % $_ == 0 });
}

# code borrowed from my code for PWC 229
sub english_list ( *@list ) {
  # given a list, join it in a way that makes sense
  # to english speakers
  my $last = @list.pop(); # last element in array
  if (@list == 0) {
    # using an array in a scalar context returns
    # the number of elements in the array

    # there was only one element in the list
    return $last;
  }
  my $joined = @list.join(qq{,\n});
  if (@list > 1) {
    # if there's more than element, add an Oxford comma
    $joined ~= q{,};
  }
  return "$joined and\n$last";
}

sub specialNumberSquareSum(@ints) {
  my $n = @ints.elems;

  # find the list of indices for "special" numbers
  my @specialIndices = specialElementIndices($n);
  my $count = @specialIndices.elems;
  my @explain_list = @specialIndices.map({
    "\$ints[$_] since $_ divides $n"
  });
  my $explain = "There are exactly $count special elements "
    ~ "in the given array:\n" ~ english_list(@explain_list);

  # find the special numbers themselves
  my @special = @specialIndices.map({ @ints[$_ - 1] });

  # find the sum of the squares
  my $sum = @special.map({ $_ ** 2 }).sum;

  $explain ~= "\nHence, the sum of the squares of all special "
    ~ "elements of given array:\n"
    ~ @special.map({ "$_ * $_" }).join(' + ')
    ~ " = " ~ $sum;

  return (
    $sum,
    $explain
  );
}

View the entire Raku script for this task on GitHub.

Perl

Nothing really changes in the Perl implementation except the normal syntax changes from Raku to Perl…

use List::Util qw( sum );

sub specialElementIndices($n) {
  return grep { $n % $_ == 0 } 1 .. $n;
}

sub english_list ( @list ) {
  # given a list, join it in a way that makes sense
  # to english speakers
  my $last = pop @list; # last element in array
  if (@list == 0) {
    # using an array in a scalar context returns
    # the number of elements in the array

    # there was only one element in the list
    return $last;
  }
  my $joined = join qq{,\n}, @list;
  if (@list > 1) {
    # if there's more than element, add an Oxford comma
    $joined .= q{,};
  }
  return "$joined and\n$last";
}

sub specialNumberSquareSum(@ints) {
  # in scalar context, an array evaluates to the number
  # of elements in the array
  my $n = @ints;

  # find the list of indices for "special" numbers
  my @specialIndices = specialElementIndices($n);
  my $count = @specialIndices;
  my @explain_list = map {
    "\$ints[$_] since $_ divides $n"
  } @specialIndices;
  my $explain = "There are exactly $count special elements "
    . "in the given array:\n" . english_list(@explain_list);

  # find the special numbers themselves
  my @special = map { $ints[$_ - 1] } @specialIndices;

  # find the sum of the squares
  my $sum = sum( map { $_ ** 2 } @special);

  $explain .= "\nHence, the sum of the squares of all special "
    . "elements of given array:\n"
    . join(' + ', map { "$_ * $_" } @special)
    . " = " . $sum;

  return (
    $sum,
    $explain
  );
}

View the entire Perl script for this task on GitHub.

Python

Mostly what tripped me up going from Raku to Python was the lack of sigils meaning I couldn’t give variables the same names as built-in functions.

def specialElementIndices(n):
    return list( filter(lambda x: n % x == 0, range(1, n+1)) )

def english_list (strlist):
    # given a list, join it in a way that makes sense
    # to english speakers
    last = strlist.pop(-1) # last element in array
    if (len(strlist) == 0):
        # using an array in a scalar context returns
        # the number of elements in the array

        # there was only one element in the list
        return last

    joined = ',\n'.join(strlist)
    if (len(strlist) > 1):
        # if there's more than element, add an Oxford comma
        joined += ','

    return f'{joined} and\n{last}'

def specialNumberSquareSum(ints):
    n = len(ints)

    # find the list of indices for "special" numbers
    specialIndices = specialElementIndices(n)
    count = len(specialIndices)
    explain_list = [
        f"$ints[{x}] since {x} divides {n}"
        for x in specialIndices
    ] 
    explain = (
        "There are exactly $count special elements " +
        "in the given array:\n" + english_list(explain_list)
    )

    # find the special numbers themselves
    special = [ ints[x - 1] for x in specialIndices ]

    # find the sum of the squares
    sumval = sum([ x ** 2 for x in special ])

    explain += '\nHence, the sum of the squares of all special '
    explain += 'elements of given array:\n'
    explain += ' + '.join(map(lambda x: f'{x} * {x}', special))
    explain += f' = {sumval}'

    return (
        sumval,
        explain
    )

View the entire Python script for this task on GitHub.

Task 2: Unique Sum Zero

You are given an integer, $n.

Write a script to find an array containing $n unique integers such that they add up to zero.

Example 1

Input: $n = 5
Output: (-7, -1, 1, 3, 4)

Two other possible solutions could be as below:
(-5, -1, 1, 2, 3) and (-3, -1, 2, -2, 4).

Example 2

Input: $n = 3
Output: (-1, 0, 1)

Example 3

Input: $n = 1
Output: (0)

Approach

This one is a little more challenging. Looking at the examples, I can see that when $n is 1, the array has to be ( 0 ). When $n is 3, the array needs to be ( -x, 0, x ) where x is some positive integer. We can extrapolate that when $n is 2, array needs to be ( -x, x ) where x is some positive integer. As $n gets larger, the number of possible arrays gets larger: the example output arrays have the form ( -(x+y), -z, z, x, y ) and ( -x, -y, z, -z, x+y ).

Rather than generate permutations of $n unique integers and check them to see if they sum to 0, I think I’m going to take the approach of generating a list I know will sum to 0 ahead of time:

If $n is odd, push 0 onto the list and decrement $n by one
set $x to 1
if $n is still greater than 0, push -$x and $x onto the list, then decrement $n by two and increment $x by one
repeat the last step until $n is equal to 0

With this algorithm, my output winds up being:

Example 1:
Input: $n = 5
Output: (-2, -1, 0, 1, 2)

Example 2:
Input: $n = 3
Output: (-1, 0, 1)

Example 3:
Input: $n = 1
Output: (0)

But for $n = 2, the output would be (-1, 1), and for $n = 4, the output would be
(-2, -1, 1, 2).

Raku

Because subroutine parameters are read-only (and you can mark them read-write with is rw only if what’s being passed into them is a writable object, not a numeric constant, I’m copying the value from the parameter to a working variable.

sub uniqueSumZero($input) {
  my $n = $input;
  my @list;
  my $x = 1;
  while ($n > 0) {
    if ($n % 2 == 1) { # $n is odd
      @list.push(0);
      $n -= 1;
    }
    else { # $n is even
      @list.append($x * -1, $x);
      $x += 1;
      $n -= 2;
    }
  }
  return @list.sort;
}

View the entire Raku script for this task on GitHub.

Perl

Perl, however, doesn’t have the problem with the subroutine parameter being read-only, so I can modify $n to my heart’s content.

sub uniqueSumZero($n) {
  my @list;
  my $x = 1;
  while ($n > 0) {
    if ($n % 2 == 1) { # $n is odd
      push @list, 0;
      $n--;
    }
    else { # $n is even
      push @list, $x * -1, $x;
      $x++;
      $n -= 2;
    }
  }
  return sort { $a <=> $b } @list;
}

View the entire Perl script for this task on GitHub.

Python

def uniqueSumZero(n):
    zero_sum_list = []
    x = 1
    while n > 0:
        if (n % 2 == 1): # n is odd
            zero_sum_list.append(0)
            n -= 1
        else: # n is even
            zero_sum_list.append(x * -1)
            zero_sum_list.append(x)
            x += 1
            n -= 2
    zero_sum_list.sort()
    return zero_sum_list

View the entire Python script for this task on GitHub.

Here’s all my solutions in GItHub: https://github.com/packy/perlweeklychallenge-club/tree/master/challenge-252/packy-anderson

Packy’s Place

Packy's just 'zis guy, you know?

Perl Weekly Challenge: Sum Enchanted Evening

Task 1: Special Numbers

Approach

Raku

Perl

Python

Task 2: Unique Sum Zero

Approach

Raku

Perl

Python

Related