我可以在 perl 中调用带有子类比较的超类排序吗?

Can I call a superclass sort with a subclass compare in perl?

我想使用使用子类比较函数的超类排序。我试图在以下代码中提炼出问题的本质。这不是 "production" 代码,但在此处显示是为了说明。已测试。

#!/usr/bin/perl
# $Id: foo,v 1.10 2019/02/23 14:14:33 bennett Exp bennett $

use strict;
use warnings;

package Fruit;
use Scalar::Util 'blessed';

sub new {
    my $class = shift;
    my $self = bless({}, $class);
    $self->{itemList} = [];
    warn "Called with class ", blessed $self, "\n";
    return $self;
}

package Apples;

use parent qw(-norequire Fruit);

sub mySort {
    my $self = shift;
    @{$self->{itemList}} = sort compare @{$self->{itemList}};
    return $self;
}

sub compare {
    $a->{mass} <=> $b->{mass};
}

package main;

my $apfel = Apples->new();
push(@{$apfel->{itemList}}, { "name" => "grannysmith", "mass" => 12 });
push(@{$apfel->{itemList}}, { "name" => "macintosh", "mass" => 6 });
push(@{$apfel->{itemList}}, { "name" => "Alkmene", "mass" => 8 });

$apfel->mySort();

for my $f (@{$apfel->{itemList}}) {
    printf("%s is %d\n", $f->{name}, $f->{mass});
}

exit 0;

我想做的是将mySort()移动到抽象超类Fruit。我已经尝试了多种解决 $self->compare() 子例程的方法,但我的运气并不好。

有什么想法吗?

我已经让它调用了正确的子例程,但从来没有使用正确的 $a$b。我已经将我所有失败的尝试都排除在这个问题之外,希望有人会立即知道如何将 mySort() 移动到 Fruit 包,以便我可以使用相同的子程序对我的橙子进行排序.

变量 $a$bsort 用作调用排序的同一包中的包变量,因此为了 child class看到他们,你可以试试这个。

在parent class:

sub mySort {
    my $self = shift;
    @{$self->{itemList}} = sort { $self->compare($a, $b) } @{$self->{itemList}};
    return $self;
}

在childclass:

sub compare {
    my ( $self, $a, $b ) = @_;
    $a->{mass} <=> $b->{mass};
}

$_[1]等标点符号变量被称为"super-globals",因为它们引用了main::命名空间中的变量。 [2] 也就是说,不管现在的包是什么,$_都是$main::_.

的缩写

$a$b 不是超级全局变量。它们是普通的包变量。 sort 填充发现 sort 的包的 $a$b,如果 sort 和比较功能在不同的地方找到,则会导致问题包。这意味着将 mySort 移动到 Fruit:: 将导致 sort 填充 $Fruit::a$Fruit::b,但您的 compare 函数读取 $Apple::a$Apple::b.

当涉及多个包时,您可以使用一些解决方案,但最简单的是在比较函数上使用 ($$) 原型。这导致 sort 将要比较的值作为参数传递,而不是使用 $a$b.

package Foo;
my $compare = \&Bar::compare;
my @sorted = sort $compare @unsorted;

package Bar;
sub compare($$) { $_[0] cmp $_[1] }

sort 将 sub 作为函数而不是方法来调用。如果你想把它作为方法调用,你需要一个包装器。

package Foo;
my @sorted = sort { Bar->compare($a, $b) } @unsorted;

package Bar;
sub compare { $_[1] cmp $_[2] }

也就是说,将 sort 放在一个 class 中,将分类器放在子 class 中的想法从根本上是有缺陷的。您可能有一个包含苹果和橘子的列表,那么您如何确定要调用哪个 compare 方法?

package Foo;
my @sorted = sort { ???->compare($a, $b) } @unsorted;

package Bar;
sub compare { $_[1] cmp $_[2] }

  1. 还有一些命名的,例如 STDIN

  2. 通过使用完全限定名称(例如$package::_),您可以访问其他包的标点符号变量。这些没有特殊意义;它们不被 Perl 本身使用。

你有两个问题。首先,需要superclass中的mySort函数调用正确subclass的compare函数。其次,您需要 subclass 中的 compare 函数,以便能够从不同包中的调用中接收它想要比较的两个元素。

不清楚您是否找到了第一个问题的解决方案,但一个解决方案是使用 UNIVERSAL::can 找出正确的比较方法。

package Fruit;
sub mySort {
    my $self = shift;
    my $compare_func = $self->can("compare");
    @{$self->{itemList}} = sort $compare_func @{$self->{itemList}};
}

这将找到正确的子class compare 函数并在排序调用中使用它。

现在 Apples::compare 函数中的问题是当 Fruit::mySort 准备好比较几个元素时,它会设置包变量 $Fruit::a$Fruit::b,而不是 $Apples::a$Apples::b。所以你的 Apples::compare 函数必须为此做好准备。这里有几个解决方案:

package Apples;
sub compare {
    package Fruit;
    $a->{mass} <=> $b->{mass};
}

sub compare {
    $Fruit::a->{mass} <=> $Fruit::b->{mass}
}

或更具防御性,

package Apples;
sub compare {
    my $pkg = caller;
    if ($pkg ne __PACKAGE__) {
        no strict 'refs';
        $a = ${"${pkg}::a"};
        $b = ${"${pkg}::b"};
    }
    $a->{mass} <=> $b->{mass}
}

Update:我考虑制作一个子例程属性,将 $a$b 值复制到正确的包中,但在对其进行基准测试和思考之后关于替代方案,我决定反对。这是我的后代结果:

考虑三个排序例程(可能在另一个包中并且很难从当前包中使用)

sub numsort { $a <=> $b }
sub lexsort { $a cmp $b }
sub objsort { $a->{value} <=> $b->{value} }

我们可以通过以下一些方式使这些包易于访问:

  1. 实现一个子程序属性来准备右包中的$a$b变量。实现太长,无法包含在此处,但子声明看起来像

    sub numsort : CrossPkg { $a <=> $b }
    
  2. 重写比较函数来比较$_[0]$_[1]而不是$a$b,并在[=39中使用包装器=] 呼叫

    sub lexcmp { $_[0] cmp $_[1] }
    ...
    @output = sort { lexcmp($a,$b) } @input
    
  3. 在正确的包中执行排序调用,因此设置正确的 $a$b 值。

    @output = do { package OtherPackage; sort numsort @input };
    

这是基准测试结果。 local 方法是普通的 sort 调用,没有跨包问题。

                 Rate attrib-numsort    wrap-numcmp  local-numsort repkg-numsort
attrib-numsort 1.17/s             --           -90%           -96%          -96%
wrap-numcmp    11.6/s           885%             --           -61%          -64%
local-numsort  29.5/s          2412%           155%             --           -8%
repkg-numsort  32.2/s          2639%           178%             9%            --

                 Rate attrib-lexsort  repkg-lexsort    wrap-lexcmp local-lexsort
attrib-lexsort 3.17/s             --           -12%           -14%          -17%
repkg-lexsort  3.60/s            13%             --            -2%           -5%
wrap-lexcmp    3.68/s            16%             2%             --           -3%
local-lexsort  3.80/s            20%             6%             3%            --

                 Rate attrib-objsort    wrap-objcmp  local-objsort repkg-objsort
attrib-objsort 1.22/s             --           -81%           -88%          -89%
wrap-objcmp    6.32/s           417%             --           -38%          -44%
local-objsort  10.1/s           730%            61%             --          -10%
repkg-objsort  11.3/s           824%            79%            11%            --

总结:开销与 lexsort 无关, 每次比较都需要更多时间。属性 方法在到达时就死了。设置包进入 sort 电话有 最好的结果——或多或少没有开销——但事实并非如此 适用于此应用程序(在对象层次结构中)。 重写比较函数并包装函数 在 sort 调用中,性能下降并不算太糟糕, 它在对象层次结构中工作,所以最后 推荐是:

package Fruit;
sub compare { ... }
sub mySort {
    my $self = shift;
    @{$self->{itemList}} =
        sort { $self->can("compare")->($a,$b) } @{$self->{itemList}};
}

package Apples;
our @ISA = qw(Fruit)
sub compare { $_[0]->{mass} <=> $_[1]->{mass} }