404 Blog Not Found:perl - 配列の∪と∩に想定内の返事が。

asin:4873113148
PERL HACKS(日本語版)
[英語版]
2010-05-01 - methaneの日記
一方、Pythonはsetの演算子を定義した。

もちろんPerlでも定義できます。

以下、実例。

#!/usr/bin/perl
use strict;
use warnings;

package Set;
sub main::set { __PACKAGE__->new(@_) } # exportの代わり

use overload (
    '@{}' => \&array_ref,
    '""'  => \&string,
    '|'   => \&union,
    '&'   => \&intersection,
    '-'   => \&difference,
    '^'   => \&symmetric_difference,
    '<='  => \&issubset,
    '>='  => \&issuperset,
);

sub new {
    my $class = shift;
    my %self = map { $_ => 1 } @_;
    bless \%self, $class;
}

sub copy { bless { %{ $_[0] } }, __PACKAGE__ }
sub array     { keys %{ $_[0] } }
sub array_ref { [ shift->array ] }
sub string    { 'set(' . join( ", ", sort shift->array ) . ')' }
sub len       { 0 + @{ $_[0] } }

sub union {
    bless { %{ $_[0] }, %{ $_[1] } }, __PACKAGE__;
}

sub intersection {
    my %result;
    $_[0]->{$_} && $result{$_}++ for $_[1]->array;
    bless \%result, __PACKAGE__;
}

sub difference {
    my %result = %{ $_[0] };
    delete @result{ $_[1]->array };
    bless \%result, __PACKAGE__;
}

sub symmetric_difference {
    ( $_[0] | $_[1] ) - ( $_[0] & $_[1] );
}

sub issubset {
    $_[1]->{$_} or return for $_[0]->array;
    return 1;
}

sub issuperset { $_[1]->issubset( $_[0] ) }

package main;

local ( $,, $\ ) = ( ", ", "\n" ); # to prettyprint
my $a = set( 1, 2, 3, 4 );
my $b = set( 3, 4, 5, 6 );
print $a;
print $b;
print $a->len;
print $a | $b;
print $a & $b;
print $a - $b;
print $a ^ $b;
print( ( $a <= $b )      ? "true" : "false" );
print( ( $a & $b ) <= $a ? "true" : "false" );
print( ( $a | $b ) >= $a ? "true" : "false" );

とりあえず

にある演算子は、inを除き全て実装してあります。Hashで実装しているので、x in set相当は$set->{$x}で出来ます。

ArrayでなくHashで実装したおかげでunionやdifferenceの実装が面白いことになってます。overloadの実習として適度な車輪の再発明でしょう。

ちょっと残念なのが、( $a & $b ) <= $aとしないと演算子の優先順位の関係で()が必要なこと。上の例ではpythonにあわせたのですが、&|ではなく*+をつかった方が良かったかも

再発明がいやな人には、Set::Arrayというモジュールが既に存在します。

Dan the (Perl Monger|Occasional Pythonista)