Wait the light to fall

使用 Raku 进行峰值修剪

焉知非鱼

peaked trim with raku

这是我对 Perl 每周挑战 #071 的回应。

Challenge #071.1: 峰值元素

给出正整数 `$N (>1)`。

写一个脚本来创建一个大小为 `$N` 的数组,其随机元素在1到50之间。

如果找到的话,最后应该打印出数组中的峰值元素。

如果一个数组中的元素比它的邻元素大,则称为峰值。

例子 1
Array: [ 18, 45, 38, 25, 10, 7, 21, 6, 28, 48 ]
Peak: [ 48, 45, 21 ]

例子 2
Array: [ 47, 11, 32, 8, 1, 9, 39, 14, 36, 23 ]
Peak: [ 47, 32, 39, 36 ]

第一部分是处理输入($N),并生成一个随机数组。其实挑战赛并没有说数组中的值应该是整数,但我们可以从例子中推断出这一点。

文件: peak-element-if (部分)

#! /usr/bin/env raku

subset VeryPosInt of Int where * >= 1;               # [1]

unit sub MAIN (VeryPosInt $N, :$v, :$verbose = $v);  # [2]

my @array = (1..50).roll($N);                        # [3]

say ": Values: @array[]" if $verbose;                # [4]

[1] 我们使用自定义类型(用 subset 设置)来保证 $N 是一个整数,值为2或更高。

[2] 注意 «–verbose» 和 «–v» 的快捷方式。

[3] 从数组 (1..50) 中随机选一个值(用 roll),$N 次。

[4] Verbose 模式在这里很方便,以显示我们做对了。

这里不要使用 pick,因为它明确地避免了重复。我们确实希望在数组中出现重复的情况。

关于 subset 的更多信息,见 https://docs.raku.org/language/typesystem#index-entry-subset-subset

参见 https://docs.raku.org/routine/roll 了解更多关于 roll` 的信息。

参见 https://docs.raku.org/routine/pick 了解更多关于 pick` 的信息。

选择要保留的值很简单,将每个值与左边的值和右边的值进行比较。但是第一个和最后一个值怎么办呢?

开始和结束的值需要特别注意,因为它们没有两个邻居。我们可以解决这个问题,从第二个元素开始,一直到最后一个元素为止,然后再进行比较。

文件: peak-element-if (剩余部分)

my @peak;                     # [5]

for ^$N-> $index              # [6]
{
  if $index == 0              # [7]
  {
    say ": Checking at index $index: (value: @array[$index], \
      right:@array[$index+1])" if $verbose;
    @peak.push: @array[$index] if @array[$index] > @array[$index+1];
  }
  elsif $index <= $N -2       # [8]
  {
    say ": Checking at index $index: (left:@array[$index-1], \
      value: @array[$index], right:@array[$index+1])" if $verbose;
    @peak.push: @array[$index] if @array[$index] > @array[$index-1]
      && @array[$index] > @array[$index+1];
  }
  else # if $index == $N -2   # [9]
  {
    say ": Checking at index $index: (left:@array[$index-1], \
      value: @array[$index])" if $verbose;
    @peak.push: @array[$index] if @array[$index] > @array[$index-1];
  }
}

say "[ ", @peak.join(", "), " ]";

[5] 我们将在这里收集峰值元素。

[6] 对于随机数组中的每一个元素。

[7] 特例第一。

[8] 中间(有两个邻居的地方)。

[9] 最后一个。

列表中第一个元素的索引(偏移量)为 0,所以左手边第一个有邻居的元素索引为 1。

列表中的元素数为 $N。最后一个元素的索引为 $N -1。最后一个在右手边有邻居的元素的索引为 $N -2

运行它:

$ ./peak-element-if 4
[  ]

$ ./peak-element-if 10
[ 36, 29 ]

$ ./peak-element-if 10
[ 44, 47, 47 ]

用 verbose 模式运行它,可以看到发生了什么。

$ ./peak-element-if -v 2
: Values: 49 29
: Checking at position 1: (left:-1, value: 49, right:29)
: Checking at position 2: (left:49, value: 29, right:-1)
[ 49 ]

$ ./peak-element-if -v 4
: Values: 17 23 21 4
: Checking at position 1: (left:-1, value: 17, right:23)
: Checking at position 2: (left:17, value: 23, right:21)
: Checking at position 3: (left:23, value: 21, right:4)
: Checking at position 4: (left:21, value: 4, right:-1)
[ 23 ]

$ ./peak-element-if -v 4
: Values: 49 20 17 30
: Checking at position 1: (left:-1, value: 49, right:20)
: Checking at position 2: (left:49, value: 20, right:17)
: Checking at position 3: (left:20, value: 17, right:30)
: Checking at position 4: (left:17, value: 30, right:-1)
[ 49, 30 ]

看起来不错。

我们可以去掉那些 if,稍加注意。

文件: peak-element

#! /usr/bin/env raku

subset VeryPosInt of Int where * > 1;

unit sub MAIN (VeryPosInt $N, :$v, :$verbose = $v);

my @array = (1..50).roll($N);

say ": Values: @array[]" if $verbose;

@array.push:    -1;     # [1]
@array.unshift: -1;     # [1]

my @peak;

for 1 .. $N  -> $index  # [2]
{
  say ": Checking at position $index: (left:@array[$index-1], \
    value: @array[$index], right:@array[$index+1])" if $verbose;
  @peak.push: @array[$index] if @array[$index] > @array[$index-1]
    && @array[$index] > @array[$index+1];
}

say "[ ", @peak.join(", "), " ]";

[1] 在数组两端增加一个新的值(push 在末尾增加,unshift 在开头增加-在原值的前面)。

[2] 注意修改后的索引限制。

请注意,我稍微改变了 verbose 输出。现在不显示索引(从0开始),而是显示位置(从1开始)。这简化了代码。

运行它显示它和以前的版本一样好用。

$ ./peak-element -v 2
: Values: 46 17
: Checking at position 1: (left:-1, value: 46, right:17)
: Checking at position 2: (left:46, value: 17, right:-1)
[ 46 ]

./peak-element -v 4
: Values: 38 26 31 22
: Checking at position 1: (left:-1, value: 38, right:26)
: Checking at position 2: (left:38, value: 26, right:31)
: Checking at position 3: (left:26, value: 31, right:22)
: Checking at position 4: (left:31, value: 22, right:-1)
[ 38, 31 ]

请注意,verbose 模式现在显示的是 -1 值。如果你觉得麻烦的话,可以很容易地删除这些值。(我不觉得烦。)

挑战 #071.2:修剪链表

给出一个单链接列表和一个正整数$N(>0)。

编写一个脚本,从链接列表的末尾删除第N个节点,并打印链接列表。

如果$N大于链接列表的大小,则删除列表的第一个节点。

注意:请使用纯链接列表实现。

例子:

Given Linked List: 1 -> 2 -> 3 -> 4 -> 5
when $N = 1
Output: 1 -> 2 -> 3 -> 4
when $N = 2
Output: 1 -> 2 -> 3 -> 5
when $N = 3
Output: 1 -> 2 -> 4 -> 5
when $N = 4
Output: 1 -> 3 -> 4 -> 5
when $N = 5
Output: 2 -> 3 -> 4 -> 5
when $N = 6
Output: 2 -> 3 -> 4 -> 5

First a non-working version using a class and methods only:

File: tll-class-wrong

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;

unit sub MAIN (PosInt $N, :$v, :$verbose = :$v);

class LinkedElement          # [1]
{
  has $.value;               # [2]
  has $.next is rw;          # [3]

  method print-list          # [4]
  {
    print self.value;        # [4a]
    if self.next             # [4b]
    {
      print " -> ";          # [4c]
      self.next.print-list;  # [4d]
    }
    else                     # [4e]
    {
      print "\n";            # [4f]
    }
  }

  method list-length         # [5]
  {
    my $length = 1;

    my $current = self.next;

    while ($current)
    {
      $current = $current.next;
      $length++;
    }
    return $length;
  }

  method remove-from-end($from-the-end) # [6]
  {
    my $length = self.list-length;

    if $length == 1
    {
       die "[]";
    }
    elsif $from-the-end > $length
    {
      self = self.next;
    }
    else
    {
      my $current = self;

      for 1 .. ($length - $from-the-end -1)
      {
        $current = $current.next;
      }
    
      $current.next = $current.next.next;
    }
  }
}

my $length = (1..50).pick;     # [7]

my $head;                      # [8]
my $current;                   # [9]

for 1..$length -> $value       # [10]
{
  my $new = LinkedElement.new(value => $value); # [10a]

  if $current                  # [12]
  {
    $current.next = $new;      # [12a]
    $current = $current.next;  # [12b]
  }
  else # Initially             # [11]
  {
    $head = $new;              # [11a]
    $current = $head;          # [11b]
  }
}

$head.print-list;

say "Length: ", $head.list-length if $verbose;

$head.remove-from-end($N);

$head.print-list;

[1] A class for an element in the list,

[2] with a value (shown as consecutive integers in the challenge), so that we can see what is going on after deleting something.

[3] A pointer to the next value. We have only links in one direction, as specified in the challenge. Note the is rw so that we can change the value after we have created the object. This makes it possible to generate objects from the first one, and then add new ones on to the end until we have the full length.

[4] We need a way of printing the list. This recursive method does just that. It starts by printing the value of the current element [4a], then if it has a neighbour [4b], print the required arrow [4c] and invoke itself on that neighbour [4d]. If not, end the output with a newline and we are done.

[5] We are asked to remove an element counted from the end. This is easier to do if we know the length, so this method does just that. It follows the list, counting the elements as it goes along, and returns that length. We need this method, as the length is not known to the list itself.

[6] Remove the element. First get the length. If the requested element is before the first one (or the first one), remove that. (Except that it fails, as we’ll see below.) If it somewhere inside the list, we count along to the right position, and deletes the node.

[7] The length of the array is a random value, between 1 and 50, just to make it more exciting. And unpredictable.

[8] Pointer to the first node in the linked list.

[9] The current pointer, used when we generate the list.

[10] Loop through the values to add to the linked list, and generate the objects [10a].

[11] If this is the first element we generate, set the head and current variables.

[12] If not, add it as the next element of the current pointer, and set the current pointer to this new element, ready for the next iteration.

Let us try:

./tll-class-wrong 16
1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> 8 -> 9 -> 10 -> 11 -> 12 -> 13 -> 14 \
  -> 15 -> 16 -> 17 -> 18 -> 19 -> 20 -> 21 -> 22
Length: 22
1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 8 -> 9 -> 10 -> 11 -> 12 -> 13 -> 14 -> 15 \
  -> 16 -> 17 -> 18 -> 19 -> 20 -> 21 -> 22

$ ./tll-class-wrong 99
1 -> 2 -> 3 -> 4
Length: 4

Cannot modify an immutable LinkedElement (LinkedElement.new(va...)
  in method remove-from-end at ./tll-class-wrong line 50
  in sub MAIN at ./tll-class-wrong line 93
  in block <unit> at ./tll-class-wrong line 3

The problem is that self is a pointer to the current element. And it is read only, so we cannot change it. As we just tried to do..

We can fix this by trickery:

File: tll-class

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;

unit sub MAIN (PosInt $N, :$v, :$verbose = :$v);

class LinkedElement
{
  has $.value is rw; # [2]
  has $.next  is rw;

  method print-list
  {
    print self.value;
    if self.next
    {
      print " -> ";
      self.next.print-list;
    }
    else
    {
      print "\n";
    }
  }

  method list-length
  {
    my $length = 1;

    my $current = self.next;

    while ($current)
    {
      $current = $current.next;
      $length++;
    }
    return $length;
  }

  method remove-from-end($from-the-end)
  {
    my $length = self.list-length;

    if $length == 1
    {
       die "[]";
    }
    elsif $from-the-end > $length
    {
      self.value = self.next.value;  # [1]
      self.next  = self.next.next;   # [1]
    }
    else
    {
      my $current = self;

      for 1 .. ($length - $from-the-end -1)
      {
        $current = $current.next;
      }
    
      $current.next = $current.next.next;
    }
  }
}

my $length = (1..50).pick;

my $head;
my $current;

for 1..$length -> $value
{
  my $new = LinkedElement.new(value => $value);

  if $current
  {
    $current.next = $new;
    $current = $current.next;
  }
  else # Initially
  {
    $head = $new;
    $current = $head;
  }
}

$head.print-list;

say "Length: ", $head.list-length if $verbose;

$head.remove-from-end($N);

$head.print-list;

[1] We cannot change self itself (pun intended), but we can change the object attributes. Which we do; let the head take over the second elements value, and remove that from the list.

[2] We have to make the value changeable (with is rw) for this to work.

We are messing around with the value of the first object in the linked list, and that is cheating. It works, but that does not change the fact that it is cheating.

Replacing the offending method with a procedure solves the problem. But it does not look very nice, and the object encapsulation has gone.

File: tll-hybrid

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;

unit sub MAIN (PosInt $N, :$v, :$verbose = :$v, :$limit = 50);

class LinkedElement
{
  has $.value is rw;
  has $.next  is rw;

  method print-list
  {
    print self.value;
    if self.next
    {
      print " -> ";
      self.next.print-list;
    }
    else
    {
      print "\n";
    }
  }

  method list-length
  {
    my $length = 1;

    my $current = self.next;

    while ($current)
    {
      $current = $current.next;
      $length++;
    }
    return $length;
  }
}

my $length = (1..$limit).pick;

my $head;
my $current;

for 1..$length -> $value
{
  my $new = LinkedElement.new(value => $value);

  if $current
  {
    $current.next = $new;
    $current = $current.next;
  }
  else # Initially
  {
    $head = $new;
    $current = $head;
  }
}

say $head.raku;

$head.print-list;

say "Length: ", $head.list-length if $verbose;

remove-element($head, $N);

$head                       # [1]
  ?? $head.print-list
  !! say "[]";

sub remove-element ($list is rw, $from-the-end)
{
  my $length = $list.list-length;

  if $from-the-end > $length
  {
    $list = $list.next;
  }
  else
  {
    my $current = $list;

    for 1 .. ($length - $from-the-end -1)
    {
      $current = $current.next;
    }
    
    $current.next = $current.next.next;
  }
}

[1] An alternate way of handling an empty list.

It is possible to call the procedure with an alternate «method look-alike syntax», with a dot and and ampersand (.&), if that makes you happier:

# remove-element($head, $N);
$head.&remove-element($N);

See docs.raku.org/language/operators#methodop_.& for more information about the special procedure invocation syntax .&.

Here is a version where all the methods have been replaced by procedures:

File: tll-proc

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;

unit sub MAIN (PosInt $N, :$v, :$verbose = :$v);

class LinkedElement
{
  has $.value;
  has $.next is rw;
}

my $length = (1..50).pick;

my $head;
my $current;

for 1..$length -> $value
{
  my $new = LinkedElement.new(value => $value);

  if $current
  {
    $current.next = $new;
    $current = $current.next;
  }
  else # Initially
  {
    $head = $new;
    $current = $head;
  }
}

say $head.raku;

print-list($head);

sub print-list ($list)
{
  print $list.value;
  if $list.next
  {
    print " -> ";
    print-list($list.next);
  }
  else
  {
    print "\n";
  }
}

sub get-list-length ($list)
{
  return 0 unless $list;
  my $length = 1;

  $current = $list.next;

  while ($current)
  {
    $current = $current.next;
    $length++;
  }
  return $length;
}

say "Length: ", get-list-length($head) if $verbose;

remove-element($head, $N);

print-list($head);

sub remove-element ($list is rw, $from-the-end)
{
  my $length = get-list-length($list);

  if $from-the-end > $length
  {
    $list = $list.next;
  }
  else
  {
    my $current = $list;

    for 1 .. ($length - $from-the-end -1)
    {
      $current = $current.next;
    }
    
    $current.next = $current.next.next;
  }
}

Say goodbye to object encapsulation. We could make the code more robust by adding type constraints on the procedure arguments. E.g.

# sub print-list ($list)
sub print-list (LinkedElement $list)

But using methods in(side) the class is much better.