The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Benchmark qw{:all};

#my @arr = map { [map { rand(100) } (1 .. 23)] } (1 .. 23);
#my @arr = map { [map { rand(100) } (1 .. 347)] } (1 .. 23);
my @arr = map { [map { rand(100) } (1 .. 1009)] } (1 .. 23);

sub subtract(@) {
  my %set;
	my $lhs = shift;
  undef @set{@$lhs} if @$lhs;
	do { delete @set{@$_} if @$_ } for @_;
  return keys %set;
}

my $id = sub { $_[0] };

my $counter = 0;
sub get_next(){ $arr[ $counter++ % @arr ] }
sub get_rand(){ $arr[ int(@arr * rand) ] }

############################################

sub intersection_counter {
	my $size = @_;
	my %hash;
	do { ++$hash{$_} for @$_ } for (@_);
	return grep { $hash{$_} == $size } keys %hash;
}

sub intersection_delete(@) {
	my $first = shift;

	do { return unless @$_ } for @_;

	my (%set, %other_set);

	undef @set{@$first};

	for (@_) {
		undef @other_set{@$_};
		delete @set{grep { ! exists $other_set{$_} } keys %set};
		#return unless keys %set;
		%other_set = ();
	}

	return keys %set;
}

sub intersection_delete_fn(&@) {
	my $func = shift;
	my $first = shift;

	do { return unless @$_ } for @_;

	my (%set, %other_set);

	@set{ map { $func->($_) } @$first } = @$first;

	for (@_) {
		undef @other_set{map { $func->($_) } @$_};
		delete @set{grep { ! exists $other_set{$_} } keys %set};
		#return unless keys %set;
		%other_set = ();
	}

	return values %set;
}

sub intersection_grep {
	my %set;
	undef @set{@{$_[0]}};
	return grep { exists $set{$_} } @{$_[1]};
}

sub intersection_grep_defined_fn(&@) {
	my $func = shift;
	my $lhs = shift;

	return unless $lhs && @$lhs;

	my @int;
	my %set;
	@set{ map { $func->($_) } @$lhs } = @$lhs;

	for (@_) {
		@int = grep { defined } @set{ map { $func->($_) } @$_ };
		return unless @int;
		undef %set;
		@set{ map { $func->($_) } @int } = @int;
	}
	return keys %set;
}

sub intersection_grep_exists_fn(&@) {
	my $func = shift;
	my $lhs = shift;

	return unless $lhs && @$lhs;

	my @int;
	my %set;
	@set{ map { $func->($_) } @$lhs } = @$lhs;

	for (@_) {
		@int = grep { exists $set{$func->($_)} } @$_;
		return unless @int;
		undef %set;
		@set{ map { $func->($_) } @int } = @int;
	}
	return keys %set;
}

sub intersection_grep_exists_fn_2(&@) {
	my $func = shift;
	my $lhs = shift;

	return unless $lhs && @$lhs;

	my @int;
	my %set;
	@set{ map { $func->($_) } @$lhs } = @$lhs;

	for (@_) {
		@int = grep { exists $set{$func->($_)} } @$_;
		return unless @int;
		%set = ();
		@set{ map { $func->($_) } @int } = @int;
	}
	return keys %set;
}

sub intersection_grep_multi {
	my %set;
	undef @set{shift @_};
	for (@_) {
		my @int = grep { exists $set{$_} } @$_;
		return unless @int;
		undef %set;
		undef @set{@int};
	}
	return keys %set;
}

sub intersection_grep_multi_2 {
	my %set;
	undef @set{shift @_};
	for (@_) {
		my @int = grep { exists $set{$_} } @$_;
		return unless @int;
		%set = ();
		undef @set{@int};
	}
	return keys %set;
}

sub intersection_slice {
	my %set = map { ($_ => \$_) } @{$_[0]};
	return map { $$_ } grep { defined } @set{@{$_[1]}};
}

sub intersection_subtract {
	my @only_a = subtract(@_);
	return subtract($_[0], \@only_a);
}

sub intersection_subtract_multi {
	my $lhs = shift;
	do {
		my @lhs_only = subtract($lhs, $_);
		my @int = subtract($lhs, \@lhs_only);
		$lhs = \@int;
	} for (@_);
	return @$lhs;
}

cmpthese(10000, {
	intersection_counter  => sub { intersection_counter(get_next, get_rand) },
	intersection_delete   => sub { intersection_delete(get_next, get_rand) },
	intersection_grep     => sub { intersection_grep(get_next, get_rand) },
	intersection_slice    => sub { intersection_slice(get_next, get_rand) },
	intersection_subtract => sub { intersection_subtract(get_next, get_rand) },
});

cmpthese(10000, {
	intersection_counter        => sub { intersection_counter(get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_delete         => sub { intersection_delete(get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_grep_multi     => sub { intersection_grep_multi(get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_grep_multi_2   => sub { intersection_grep_multi_2(get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_subtract_multi => sub { intersection_subtract_multi(get_next, get_rand, get_rand, get_rand, get_rand) },
});


cmpthese(10000, {
	intersection_delete_fn        => sub { &intersection_delete_fn($id, get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_grep_defined_fn  => sub { &intersection_grep_defined_fn($id, get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_grep_exists_fn   => sub { &intersection_grep_exists_fn($id, get_next, get_rand, get_rand, get_rand, get_rand) },
	intersection_grep_exists_fn_2 => sub { &intersection_grep_exists_fn_2($id, get_next, get_rand, get_rand, get_rand, get_rand) },
});