### Perl Weekly Challenge: Week 191

#### Challenge 1:

**Twice Largest**

You are given list of integers,

`@list`

.Write a script to find out whether the largest item in the list is at least twice as large as each of the other items.

##### Example 1

```
Input: @list = (1,2,3,4)
Output: -1
The largest in the given list is 4. However 4 is not greater than twice of every remaining elements.
1 x 2 <= 4
2 x 2 <= 4
2 x 3 > 4
```

##### Example 2

```
Input: @list = (1,2,0,5)
Output: 1
The largest in the given list is 5. Also 5 is greater than twice of every remaining elements.
1 x 2 <= 5
2 x 2 <= 5
0 x 2 <= 5
```

##### Example 3

```
Input: @list = (2,6,3,1)
Output: 1
The largest in the given list is 6. Also 6 is greater than twice of every remaining elements.
2 x 2 <= 6
3 x 2 <= 6
1 x 2 <= 6
```

##### Example 4

```
Input: @list = (4,5,2,3)
Output: -1
The largest in the given list is 5. Also 5 is not greater than twice of every remaining elements.
4 x 2 > 5
2 x 2 <= 5
3 x 2 > 5
```

My first attempt in Raku looked like this:

Because we receive `@list`

from the command line it is immutable. So the first thing I did was copy it to a new, mutable, sorted list.

```
my @sorted = @list.sort;
```

Then everything happens in one line. Because `@sorted`

ia, well, sorted, we know the largest value will be the last element (`@sorted[*-1]`

). The rest of the elements (`@sorted[0 ..^ *-1]`

) are all doubled at once using the hyper operator (`>>*>> 2`

)
Then using the `.all()`

method of the list, the elements are compared with the largest value. If they are all less or equal, we print 1 otherwise we print -1.

```
say (@sorted[0 ..^ *-1] >>*>> 2).all <= @sorted[*-1] ?? 1 !! -1;
```

This worked but I had an epiphany. Because the list is sorted, I only actually need to compare the largest value to the second-largest value. If that is less than or equal to the largest, it automatically means all the other elements are less than or equal. So the code I actually submitted looks like this:

```
say @sorted[*-2] * 2 <= @sorted[*-1] ?? 1 !! -1;
```

It was a very straightforward port to Perl.

```
say $sorted[-2] * 2 <= $sorted[-1] ? 1 : -1;
```

#### Challenge 2:

**Cute List**

You are given an integer,

`0 < $n <= 15`

.Write a script to find the number of orderings of numbers that form a cute list.

```
With an input @list = (1, 2, 3, .. $n) for positive integer $n, an ordering of @list is cute if for every entry, indexed with a base of 1, either
1) $list[$i] is evenly divisible by $i
or
2) $i is evenly divisible by $list[$i]
```

##### Example

```
Input: $n = 2
Ouput: 2
Since $n = 2, the list can be made up of two integers only i.e. 1 and 2.
Therefore we can have two list i.e. (1,2) and (2,1).
@list = (1,2) is cute since $list[1] = 1 is divisible by 1 and $list[2] = 2 is divisible by 2.
```

I should mention at the outset that the code I am about to show you is suboptimal. It should and does work for all the input
specified but as `$n`

grow bigger, it gets slower. On my laptop, I only got to 10 in any decent amount of time. Unfortunately,
I ran out of time to optimize it.

The core of the script is this line:

```
(1 .. $n).permutations.grep({ isCute(@$_); }).elems.say;
```

It makes a list of consecutive integers from 1 to `$n`

, generates a list of permutations of those integers with the `.permutations`

method and searches the permutations for cute lists using `isCute()`

. The number of cute lists found is printed.

This is `isCute()`

.

```
sub isCute(@list) {
```

One requirement of this challenge is that the lists we examine should be indexed from 1 instead of the usual 0.Another variable holds the total number of cute elements we shall find.

```
my $i = 1;
my $cute = 0;
```

For each element in the list...

```
for @list -> $elem {
```

If it meets the requirements set forth in the spec, the total is incremented.

```
if ($i %% $elem || $elem %% $i) {
$cute++;
}
```

In any case, `$i`

is incremented.

```
$i++;
}
```

If the total number of elements in the list is equal to the number of cute elements, the list is cute so we can return true or if not, false.

```
return @list.elems == $cute;
}
```

There is an easy optimization we can make.

```
sub isCute(@list) {
my $i = 1;
for @list -> $elem {
```

Instead of integer modulus (`%%`

), we can use the regular modulus operator (`%`

) which will be true if the condition is **not**
evenly divisible. If both conditions are true, it means the element was **not** cute which means the list itself is not cute and
there is no point in checking the rest of the elements; we can immediately return false.

```
if ($i % $elem && $elem % $i) {
return False;
}
$i++;
}
return True;
}
```

Despite this, the script is, as I mentioned, rather slow. Both Raku and (with a little help) Perl have facilities for parallel processing which would probably speed things up quite a bit on modern hardware. But if I had to hazard a guess, the place to focus on would be the permutations generating code. The number of permutations grows exponentially as `$n`

grows larger and I'm guessing
it is not neccessary to check every single one. Perhaps some time when I am less busy, I will look into it.

For completeness's sake, here is the Perl version. It uses the `permute()`

method I've used in previous challenges. Alas, it suffers from the same defects as the Raku version.

```
sub isCute {
my ($list) = @_;
my $i = 1;
for my $elem (@{$list}) {
if ($i % $elem && $elem % $i) {
return undef;
}
$i++;
}
return 1;
}
my @perms;
permute { push @perms, \@_; } (1 .. $n);
say scalar grep { isCute($_) } @perms;
```