File Coverage

blib/lib/Set/Relation/V1.pm

Criterion	Covered	Total	%
statement	629	1922	32.7
branch	134	538	24.9
condition	48	225	21.3
subroutine	73	181	40.3
pod	0	84	0.0
total	884	2950	29.9

use 5.008000;
use utf8;
use strict;
use warnings;

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

{ package Set::Relation::V1; # class
    our $VERSION = '0.013004';
    $VERSION = eval $VERSION;

    use Carp 'confess';
    use Scalar::Util 'blessed', 'refaddr';
    use List::Util 'any', 'all', 'notall', 'uniqstr';

    # with Set::Relation::Mutable
    sub does {
        my ($self, $role_name) = @_;
        confess q{This does() may only be invoked on an object.}
            if not blessed $self;
        confess q{does(): Bad $role_name arg; it must be a defined string.}
            if !defined $role_name;
        return 0
            if !$self->isa( __PACKAGE__ );
        return 1
            if $role_name eq 'Set::Relation'
                or $role_name eq 'Set::Relation::Mutable';
        return 0;
    }

    # has _heading
        # isa HashRef
            # One elem per attribute:
                # hkey is Str attr name
                # hval is undef+unused
        # default {}
    sub _heading {
        my $self = shift;
        $self->{_heading} = $_[0] if scalar @_;
        return $self->{_heading};
    }
    # has _degree
        # isa Int
        # default 0
    sub _degree {
        my $self = shift;
        $self->{_degree} = $_[0] if scalar @_;
        return $self->{_degree};
    }
    sub degree {
        my $self = shift;
        return $self->{_degree};
    }

    # has _body
        # isa HashRef
            # One elem per tuple:
                # hkey is Str identity generated from all tuple attrs
                # hval is HashRef that is the coll of separate tuple attrs:
                    # hkey is Str attr name
                    # hval is 2-elem ArrayRef that is the tuple attr value
                        # [0] is actual attr value
                        # [1] is Str identity generated from attr value
        # default {}
    sub _body {
        my $self = shift;
        $self->{_body} = $_[0] if scalar @_;
        return $self->{_body};
    }
    # has _cardinality
        # isa Int
        # default 0
    sub _cardinality {
        my $self = shift;
        $self->{_cardinality} = $_[0] if scalar @_;
        return $self->{_cardinality};
    }
    sub cardinality {
        my $self = shift;
        return $self->{_cardinality};
    }

    # This may only be made defined when _has_frozen_identity is true.
    # has _which
        # isa Maybe[Str]
        # default undef
    sub _which {
        my $self = shift;
        $self->{_which} = $_[0] if scalar @_;
        return $self->{_which};
    }

    # has _indexes
        # isa HashRef
            # One elem per index:
                # hkey is index name;
                    # - is Str ident gen f head subset tha index ranges ovr
                # hval is 2-elem ArrayRef that is the index itself + meta
                    # [0] is HashRef of atnms that index ranges over
                        # - structure same as '_heading'
                    # [1] is index itself;
                        # - HashRef; one elem per tup of projection of body
                            # on attrs that index ranges over
                        # hkey is Str ident gen fr distinct projection tupl
                        # hval is set of body tup having projection tuples
                            # in comn; is HashRef; one elem per body tuple
                            # - structure same as '_body', is slice o _body
        # default {}
    sub _indexes {
        my $self = shift;
        $self->{_indexes} = $_[0] if scalar @_;
        return $self->{_indexes};
    }

    # has _keys
        # isa HashRef
            # One elem per key:
                # hkey is key name;
                    # - is Str ident gen f head subset tha index ranges ovr
                # hval is HashRef of atnms that index ranges over
                    # - structure same as '_heading'
        # default {}
    sub _keys {
        my $self = shift;
        $self->{_keys} = $_[0] if scalar @_;
        return $self->{_keys};
    }

    # If this is made true, no further mutation of S::R head/body allowed,
    # and then it can't be made false again.
    # has _has_frozen_identity
        # isa Bool
        # default 0
    sub _has_frozen_identity {
        my $self = shift;
        $self->{_has_frozen_identity} = $_[0] if scalar @_;
        return $self->{_has_frozen_identity};
    }
    sub has_frozen_identity {
        my $self = shift;
        return $self->{_has_frozen_identity};
    }

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

sub new {
    my ($class, @args) = @_;
    $class = (blessed $class) || $class;

    my $params = $class->BUILDARGS( @args );

    my $self = bless {}, $class;

    # Set attribute default values.
    $self->_heading( {} );
    $self->_degree( 0 );
    $self->_body( {} );
    $self->_cardinality( 0 );
    $self->_which( undef );
    $self->_indexes( {} );
    $self->_keys( {} );
    $self->_has_frozen_identity( 0 );

    if (exists $params->{has_frozen_identity}) {
        $self->_has_frozen_identity( $params->{has_frozen_identity} ? 1 : 0 );
    }

    $self->BUILD( $params );

    return $self;
}

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

sub BUILDARGS {
    my ($class, @args) = @_;
    if (@args == 1) {
        if (ref $args[0] ne 'HASH') {
            # Constructor was called with a single positional argument.
            return { members => $args[0] };
        }
        else {
            # Constructor was called with (possibly zero) named arguments.
            return { %{$args[0]} };
        }
    }
    elsif ((scalar @args % 2) == 0) {
        # Constructor was called with (possibly zero) named arguments.
        return { @args };
    }
    else {
        # Constructor was called with odd number positional arguments >= 3.
        confess q{new(): Bad arguments list; it must either have an even}
            . q{ number of elements or exactly 1 element.};
    }
}

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

sub BUILD {
    my ($self, $args) = @_;
    my ($members, $keys) = @{$args}{'members', 'keys'};

    # Note, $members may be in all of the same formats as a HDMD_Perl_STD
    # Relation value literal payload, but with a few extra trivial options.

    if (!defined $members) {
        # Extra option 1.
        $members = [];
    }
    elsif (!ref $members) {
        # Extra option 2.
        $members = [$members];
    }
    elsif (blessed $members and $members->can( 'does' )
            and $members->does( 'Set::Relation' )
            and !$members->isa( __PACKAGE__ )) {
        # We got a $members that is a Set::Relation-doing class where that
        # class isn't us; so clone it from a dump using public interface.
        $members = $self->_new( $members->export_for_new() );
    }
    confess q{new(): Bad :$members arg; it must be either undefined}
            . q{ or an array-ref or a non-ref or a Set::Relation object.}
        if ref $members ne 'ARRAY'
            and not (blessed $members and $members->isa( __PACKAGE__ ));

    # If we get here, $members is either a Set::Relation::V1 or an ary-ref.

    if (!defined $keys) {
        $keys = [];
    }
    elsif (ref $keys ne 'ARRAY') {
        $keys = [$keys];
    }
    if (any { ref $_ ne 'ARRAY' } @{$keys}) {
        $keys = [$keys];
    }
    for my $key (@{$keys}) {
        confess q{new(): Bad $keys arg; it is not correctly formatted.}
            if ref $key ne 'ARRAY'
                or notall { defined $_ and !ref $_ } @{$key};
    }

    # If we get here, $keys is an Array of Array of Str.

    if (blessed $members and $members->isa( __PACKAGE__ )) {
        # We'll just shallow clone h, copy b of anoth V1 obj's member-set.
        $self->_heading( $members->_heading() );
        $self->_degree( $members->degree() );
        $self->_body( {%{$members->_body()}} );
        $self->_cardinality( $members->cardinality() );
        $self->_keys( {%{$members->_keys()}} );
    }
    elsif (@{$members} == 0) {
        # Input specifies zero attrs + zero tuples.
        # No-op; attr defaults are fine.
    }
    else {
        # Input specifies at least one attr or at least one tuple.
        my $member0 = $members->[0];
        if (!defined $member0) {
            confess q{new(): Bad :$members arg; it is an array ref}
                . q{ but it directly has an undefined element.};
        }
        elsif (!ref $member0) {
            # Input spec at least 1 attr + zero tuples.
            # Each $members elem is expected to be an atnm.
            confess q{new(): Bad :$members arg; it has a non-ref elem,}
                    . q{ indicating it should just be a list of attr}
                    . q{ names, but at least one other elem is}
                    . q{ undefined or is a ref.}
                if notall { defined $_ and !ref $_ } @{$members};
            confess q{new(): Bad :$members arg; it specifies a list of}
                    . q{ attr names with at least one duplicated name.}
                if (uniqstr @{$members}) != @{$members};
            $self->_heading( {CORE::map { ($_ => undef) } @{$members}} );
            $self->_degree( scalar @{$members} );
        }
        elsif (ref $member0 eq 'HASH') {
            # Input spec at least 1 tuple, in named attr format.
            my $heading
                = {CORE::map { ($_ => undef) } CORE::keys %{$member0}};
            my $body = {};
            for my $tuple (@{$members}) {
                confess q{new(): Bad :$members arg; it has a hash-ref}
                        . q{ elem, indicating it should just be a list of}
                        . q{ tuples in named-attr format, but at least one}
                        . q{ other elem is not a hash-ref, or the 2 elems}
                        . q{ don't have exactly the same set of hkeys.}
                    if ref $tuple ne 'HASH'
                        or !$self->_is_identical_hkeys( $heading, $tuple );
                confess q{new(): Bad :$members arg;}
                        . q{ at least one of its hash-ref elems is such}
                        . q{ that there exists circular refs between}
                        . q{ itself or its tuple-valued components.}
                    if $self->_tuple_arg_has_circular_refs( $tuple );
                $tuple = $self->_import_nfmt_tuple( $tuple );
                $body->{$self->_ident_str( $tuple )} = $tuple;
            }
            $self->_heading( $heading );
            $self->_degree( scalar CORE::keys %{$heading} );
            $self->_body( $body );
            $self->_cardinality( scalar CORE::keys %{$body} );
        }
        elsif (ref $member0 eq 'ARRAY') {
            # Input is in ordered attr format.
            my $member1 = $members->[1];
            confess q{new(): Bad :$members arg; it has an array-ref first}
                    . q{ elem, indicating it should just be a list of}
                    . q{ tuples in ordered-attr format, but either}
                    . q{ :$members doesn't have exactly 2 elements or its}
                    . q{ second element isn't also an array-ref.}
                if @{$members} != 2 or ref $member1 ne 'ARRAY';
            # Each $member0 elem is expected to be an atnm.
            confess q{new(): Bad :$members array-ref arg array-ref}
                    . q{ first elem; it should be just be a list of}
                    . q{ attr names, but at least one name}
                    . q{ is undefined or is a ref.}
                if notall { defined $_ and !ref $_ } @{$member0};
            confess q{new(): Bad :$members arg; it specifies a list of}
                    . q{ attr names with at least one duplicated name.}
                if (uniqstr @{$member0}) != @{$member0};
            my $heading = {CORE::map { ($_ => undef) } @{$member0}};
            my $body = {};
            for my $tuple (@{$member1}) {
                confess q{new(): Bad :$members array-ref arg array-ref}
                        . q{ second elem; at least one elem isn't an}
                        . q{ array-ref, or that doesn't have the same}
                        . q{ count of elems as the :$members first elem.}
                    if ref $tuple ne 'ARRAY' or @{$tuple} != @{$member0};
                # Each $tuple elem is expected to be an atvl.
                confess q{new(): Bad :$members arg;}
                        . q{ at least one of its array-ref elems}
                        . q{ is such that there exists circular refs}
                        . q{ between its tuple-valued components.}
                    if any { ref $_ eq 'HASH'
                            and $self->_tuple_arg_has_circular_refs( $_ )
                        } (@{$tuple});
                $tuple = $self->_import_ofmt_tuple( $member0, $tuple );
                $body->{$self->_ident_str( $tuple )} = $tuple;
            }
            $self->_heading( $heading );
            $self->_degree( scalar CORE::keys %{$heading} );
            $self->_body( $body );
            $self->_cardinality( scalar CORE::keys %{$body} );
        }
        else {
            confess q{new(): Bad :$members arg; it is an array-ref but it}
                . q{ has an elem that is neither a defined scalar nor}
                . q{ an array-ref nor a hash-ref.};
        }
    }

    my $self_h = $self->_heading();

    for my $key (@{$keys}) {
        confess q{new(): At least one of the relation keys defined by the}
                . q{ $keys arg isn't a subset of the heading of the}
                . q{ relation defined by the $members arg.}
            if notall { exists $self_h->{$_} } @{$key};
        confess q{new(): The relation defined by the $members arg violates}
                . q{ at least one of the candidate unique key constraints}
                . qq{ defined by the $members arg: [@{$key}].}
            if !$self->_has_key( $key );
    }

    return;
}

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

sub _new {
    my ($self, @args) = @_;
    return (blessed $self)->new( @args );
}

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

sub export_for_new {
    my ($self, $want_ord_attrs, $allow_dup_tuples) = @_;
    return {
        'members' => $self->_members(
            'export_for_new', '$want_ord_attrs', $want_ord_attrs ),
        'keys' => $self->keys(),
        # Note, we make an exception by not exporting the
        # 'has_frozen_identity' object attribute even though the 'new'
        # constructor can take an argument to user-initialize it;
        # there doesn't seem to be a point, as if a user wanted an
        # immutable clone of an immutable object, just use the original;
        # or if they wanted a mutable clone of a mutable object, then
        # mutable is what they get by default anyway; more likely they want
        # a mutable clone of an immutable object.
    };
}

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

sub which {
    my ($self) = @_;
    my $ident_str = $self->_which();
    if (!defined $ident_str) {
        $self->_has_frozen_identity( 1 );
        my $hs = $self->_heading_ident_str( $self->_heading() );
        my $bs = CORE::join qq{,\n}, sort (CORE::keys %{$self->_body()});
        my $vstr = "H=$hs;\nB={$bs}";
        $ident_str = 'Relation:' . (length $vstr) . ':{' . $vstr . '}';
        $self->_which( $ident_str );
    }
    return $ident_str;
}

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

sub members {
    my ($self, $want_ord_attrs, $allow_dup_tuples) = @_;
    return $self->_members(
        'members', '$want_ord_attrs', $want_ord_attrs );
}

sub _members {
    my ($self, $rtn_nm, $arg_nm, $want_ord_attrs) = @_;
    if ($want_ord_attrs) {
        my $ord_attr_names = $self->_normalize_true_want_ord_attrs_arg(
            $rtn_nm, $arg_nm, $want_ord_attrs );
        return [$ord_attr_names, [CORE::map {
                $self->_export_ofmt_tuple( $ord_attr_names, $_ )
            } values %{$self->_body()}]];
    }
    elsif ((CORE::keys %{$self->_body()}) == 0) {
        # We have zero tuples, just export attr names.
        return [sort (CORE::keys %{$self->_heading()})];
    }
    else {
        # We have at least one tuple, export in named-attr format.
        return [CORE::map { $self->_export_nfmt_tuple( $_ ) }
            values %{$self->_body()}];
    }
}

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

sub heading {
    my ($self) = @_;
    return [sort (CORE::keys %{$self->_heading()})];
}

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

sub body {
    my ($self, $want_ord_attrs, $allow_dup_tuples) = @_;
    if ($want_ord_attrs) {
        my $ord_attr_names = $self->_normalize_true_want_ord_attrs_arg(
            'body', '$want_ord_attrs', $want_ord_attrs );
        return [CORE::map { $self->_export_ofmt_tuple(
            $ord_attr_names, $_ ) } values %{$self->_body()}];
    }
    else {
        return [CORE::map { $self->_export_nfmt_tuple( $_ ) }
            values %{$self->_body()}];
    }
}

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

sub _normalize_true_want_ord_attrs_arg {
    my ($self, $rtn_nm, $arg_nm, $want_ord_attrs) = @_;

    my $heading = $self->_heading();

    my $attr_names = [CORE::keys %{$heading}];
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it must be either undefined|false or the scalar value '1'}
            . q{ or an array-ref of attr names whose degree and}
            . q{ elements match the heading of the invocant.}
        if not (!ref $want_ord_attrs and $want_ord_attrs eq '1'
            or ref $want_ord_attrs eq 'ARRAY'
                and @{$want_ord_attrs} == @{$attr_names}
                and all { exists $heading->{$_} } @{$want_ord_attrs});

    return
        $want_ord_attrs eq '1' ? [sort @{$attr_names}] : $want_ord_attrs;
}

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

sub slice {
    my ($self, $attr_names, $want_ord_attrs, $allow_dup_tuples) = @_;

    (my $proj_h, $attr_names)
        = $self->_atnms_hr_from_assert_valid_atnms_arg(
        'slice', '$attr_names', $attr_names );
    my (undef, undef, $proj_only)
        = $self->_ptn_conj_and_disj( $self->_heading(), $proj_h );
    confess q{slice(): Bad $attr_names arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if @{$proj_only} > 0;

    if ($want_ord_attrs) {
        confess q{slice(): Bad $want_ord_attrs arg; it must be}
                . q{ either undefined|false or the scalar value '1'.}
            if $want_ord_attrs ne '1';
        return [CORE::map { $self->_export_ofmt_tuple(
            $attr_names, $_ ) } values %{$self->_body()}];
    }
    else {
        return [CORE::map {
            my $t = $_;
            $t = {CORE::map { ($_ => $t->{$_}) } @{$attr_names}};
            $self->_export_nfmt_tuple( $t );
        } values %{$self->_body()}];
    }
}

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

sub attr {
    my ($self, $name, $allow_dup_tuples) = @_;

    $self->_assert_valid_atnm_arg( 'attr', '$name', $name );
    confess q{attr(): Bad $name arg; that attr name}
            . q{ doesn't match an attr of the invocant's heading.}
        if !exists $self->_heading()->{$name};

    return [CORE::map {
            my $atvl = $_->{$name}->[0];
            if (ref $atvl eq 'HASH') {
                $atvl = $self->_export_nfmt_tuple( $atvl );
            }
            $atvl;
        } values %{$self->_body()}];
}

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

sub keys {
    my ($self) = @_;
    return [CORE::map { [sort @{$_}] } values %{$self->_keys()}];
}

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

sub _normalize_same_heading_tuples_arg {
    my ($r, $rtn_nm, $arg_nm, $t) = @_;

    my $r_h = $r->_heading();

    if (ref $t eq 'HASH') {
        $t = [$t];
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg; it must be}
            . q{ an array-ref or a hash-ref.}
        if ref $t ne 'ARRAY';
    for my $tuple (@{$t}) {
        confess qq{$rtn_nm(): Bad $arg_nm arg elem;}
                . q{ it isn't a hash-ref, or it doesn't have exactly the}
                . q{ same set of attr names as the invocant.}
            if ref $tuple ne 'HASH'
                or !$r->_is_identical_hkeys( $r_h, $tuple );
        confess qq{$rtn_nm(): Bad $arg_nm arg elem;}
                . q{ it is a hash-ref, and there exist circular refs}
                . q{ between itself or its tuple-valued components.}
            if $r->_tuple_arg_has_circular_refs( $tuple );
    }

    return $t;
}

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

sub _tuple_arg_has_circular_refs {
    # This routine just checks that no Hash which would be treated as
    # being of a value type contains itself as a component, where the
    # component and any intermediate components are treated as value types.
    # It *is* fine for a Hash to contain the same other Hash more than once
    # such that the other is a sibling/cousin/etc to itself.
    my ($self, $tuple, $ancs_of_tup_atvls) = @_;
    $ancs_of_tup_atvls = $ancs_of_tup_atvls ? {%{$ancs_of_tup_atvls}} : {};
    $ancs_of_tup_atvls->{refaddr $tuple} = undef;
    for my $atvl (values %{$tuple}) {
        if (ref $atvl eq 'HASH') {
            return 1
                if exists $ancs_of_tup_atvls->{refaddr $atvl};
            return 1
                if $self->_tuple_arg_has_circular_refs(
                    $atvl, $ancs_of_tup_atvls );
        }
    }
    return 0;
}

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

sub _self_is_component_of_tuple_arg {
    my ($self, $tuple) = @_;
    for my $atvl (values %{$tuple}) {
        if (blessed $atvl and $atvl->isa( __PACKAGE__ )) {
            return 1
                if refaddr $atvl == refaddr $self;
        }
        elsif (ref $atvl eq 'HASH') {
            return 1
                if $self->_self_is_component_of_tuple_arg( $atvl );
        }
    }
    return 0;
}

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

sub _is_identical_hkeys {
    my ($self, $h1, $h2) = @_;
    my $h1_hkeys = [CORE::keys %{$h1}];
    my $h2_hkeys = [CORE::keys %{$h2}];
    return (@{$h1_hkeys} == @{$h2_hkeys}
        and all { exists $h1->{$_} } @{$h2_hkeys});
}

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

sub _heading_ident_str {
    my ($self, $heading) = @_;
    my $vstr = CORE::join q{,}, CORE::map {
            'Atnm:' . (length $_) . ':<' . $_ . '>'
        } sort (CORE::keys %{$heading});
    return 'Heading:' . (length $vstr) . ':{' . $vstr . '}';
}

sub _ident_str {
    # Note, we assume that any hash-ref arg we get is specifically in
    # internal tuple format, meaning each hval is a 2-elem array etc,
    # and that this is recursive for hash-ref hvals of said.
    my ($self, $value) = @_;
    my $ident_str;
    if (!defined $value) {
        # The Perl undef is equal to itself, distinct from all def values.
        $ident_str = 'Undef';
    }
    elsif (!ref $value) {
        # Treat all defined non-ref values as their string representation.
        $ident_str = 'Scalar:' . (length $value) . ':<' . $value . '>';
    }
    elsif (!blessed $value) {
        # By default, every non-object reference is distinct, and its
        # identity is its memory address; the exception is if the reference
        # is a hash-ref, in which case it is treated as an internal tuple.
        if (ref $value eq 'HASH') {
            my $vstr = CORE::join q{,}, CORE::map {
                my $atnm = 'Atnm:' . (length $_) . ':<' . $_ . '>';
                my $atvl = $value->{$_}->[1];
                "N=$atnm;V=$atvl";
            } sort (CORE::keys %{$value});
            $ident_str = 'Tuple:' . (length $vstr) . ':{' . $vstr . '}';
        }
        else {
            my $vstr = "$value";
            $ident_str = 'Ref:' . (length $vstr) . ':<' . $vstr . '>';
        }
    }
    else {
        # By default, every object instance is distinct, and its identity
        # is its memory address; the exception is if the object is a
        # Set::Relation::V1 or if it overloads stringification.
        if ($value->isa( __PACKAGE__ )) {
            $ident_str = $value->which(); # 'Relation:...'
        }
        else {
            my $vstr = "$value";
            $ident_str = 'Object[' . (blessed $value) . ']:'
                . (length $vstr) . ':<' . $vstr . '>';
        }
    }
    return $ident_str;
}

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

sub _import_nfmt_tuple {
    my ($self, $tuple) = @_;
    return {CORE::map {
        my $atnm = $_;
        my $atvl = $tuple->{$_};
        if (ref $atvl eq 'HASH') {
            $atvl = $self->_import_nfmt_tuple( $atvl );
        }
        elsif (blessed $atvl and $atvl->can( 'does' )
                and $atvl->does( 'Set::Relation' )
                and !$atvl->isa( __PACKAGE__ )) {
            $atvl = $self->_new( $atvl );
        }
        ($atnm => [$atvl, $self->_ident_str( $atvl )]);
    } CORE::keys %{$tuple}};
}

sub _export_nfmt_tuple {
    my ($self, $tuple) = @_;
    return {CORE::map {
        my $atnm = $_;
        my $atvl = $tuple->{$_}->[0];
        if (ref $atvl eq 'HASH') {
            $atvl = $self->_export_nfmt_tuple( $atvl );
        }
        ($atnm => $atvl);
    } CORE::keys %{$tuple}};
}

sub _import_ofmt_tuple {
    my ($self, $atnms, $atvls) = @_;
    return {CORE::map {
        my $atnm = $atnms->[$_];
        my $atvl = $atvls->[$_];
        if (ref $atvl eq 'HASH') {
            $atvl = $self->_import_nfmt_tuple( $atvl );
        }
        elsif (blessed $atvl and $atvl->can( 'does' )
                and $atvl->does( 'Set::Relation' )
                and !$atvl->isa( __PACKAGE__ )) {
            $atvl = $self->_new( $atvl );
        }
        ($atnm => [$atvl, $self->_ident_str( $atvl )]);
    } 0..$#{$atnms}};
}

sub _export_ofmt_tuple {
    my ($self, $atnms, $tuple) = @_;
    return [CORE::map {
        my $atvl = $tuple->{$_}->[0];
        if (ref $atvl eq 'HASH') {
            $atvl = $self->_export_nfmt_tuple( $atvl );
        }
        $atvl;
    } @{$atnms}];
}

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

sub is_nullary {
    my ($topic) = @_;
    return $topic->degree() == 0;
}

sub has_attrs {
    my ($topic, $attr_names) = @_;
    (my $proj_h, $attr_names)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'has_attrs', '$attr_names', $attr_names );
    my (undef, undef, $proj_only)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $proj_h );
    return @{$proj_only} == 0;
}

sub attr_names {
    my ($topic) = @_;
    return [sort (CORE::keys %{$topic->_heading()})];
}

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

sub count {
    my ($self, @args) = @_;
    return $self->cardinality( @args );
}

sub is_empty {
    my ($topic) = @_;
    return $topic->cardinality() == 0;
}

sub has_member {
    my ($r, $t) = @_;
    $t = $r->_normalize_same_heading_tuples_arg( 'has_member', '$t', $t );
    my $r_b = $r->_body();
    return all {
            exists $r_b->{$r->_ident_str( $r->_import_nfmt_tuple( $_ ) )}
        } @{$t};
}

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

sub has_key {
    my ($topic, $attr_names) = @_;
    (undef, $attr_names) = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'has_key', '$attr_names', $attr_names );
    my $topic_h = $topic->_heading();
    confess q{has_key(): Bad $attr_names arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if notall { exists $topic_h->{$_} } @{$attr_names};
    return $topic->_has_key( $attr_names );
}

sub _has_key {
    my ($topic, $attr_names) = @_;

    my $subheading = {CORE::map { ($_ => undef) } @{$attr_names}};
    my $subheading_ident_str = $topic->_heading_ident_str( $subheading );
    my $keys = $topic->_keys();

    return 1
        if exists $keys->{$subheading_ident_str};

    my $index = $topic->_want_index( $attr_names );

    return 0
        if notall { (CORE::keys %{$_}) == 1 } values %{$index};

    $keys->{$subheading_ident_str} = $subheading;
    return 1;
}

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

sub empty {
    my ($topic) = @_;
    if ($topic->is_empty()) {
        return $topic;
    }
    my $result = $topic->_new();
    $result->_heading( $topic->_heading() );
    $result->_degree( $topic->_degree() );
    return $result;
}

sub insertion {
    my ($r, $t) = @_;
    $t = $r->_normalize_same_heading_tuples_arg( 'insertion', '$t', $t );
    if (@{$t} == 0) {
        return $r;
    }
    return $r->_new( $r )->_insert( $t );
}

sub deletion {
    my ($r, $t) = @_;
    $t = $r->_normalize_same_heading_tuples_arg( 'deletion', '$t', $t );
    if (@{$t} == 0) {
        return $r;
    }
    return $r->_new( $r )->_delete( $t );
}

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

sub rename {
    my ($topic, $map) = @_;

    confess q{rename(): Bad $map arg; it must be a hash-ref.}
        if ref $map ne 'HASH';
    confess q{rename(): Bad $map arg;}
            . q{ its hash elem values should be just be a list of attr}
            . q{ names, but at least one name is undefined or isa ref.}
        if notall { defined $_ and !ref $_ } values %{$map};
    confess q{rename(): Bad $map arg;}
            . q{ its hash elem values specify a list of}
            . q{ attr names with at least one duplicated name.}
        if (uniqstr values %{$map}) != (CORE::keys %{$map});

    my ($topic_attrs_to_ren, $topic_attrs_no_ren, $map_hvals_not_in_topic)
        = $topic->_ptn_conj_and_disj(
            $topic->_heading(), {reverse %{$map}} );
    confess q{rename(): Bad $map arg; that list of attrs to be renamed,}
            . q{ the hash values, isn't a subset of th invocant's heading.}
        if @{$map_hvals_not_in_topic} > 0;

    my ($map_hkeys_same_as_topic_no_ren, undef, undef)
        = $topic->_ptn_conj_and_disj(
            {CORE::map { ($_ => undef) } @{$topic_attrs_no_ren}}, $map );
    confess q{rename(): Bad $map arg; at least one key of that hash,}
            . q{ a new name for an attr of the invocant to rename,}
            . q{ duplicates an attr of the invocant not being renamed.}
        if @{$map_hkeys_same_as_topic_no_ren} > 0;

    return $topic->_rename( $map );
}

sub _rename {
    my ($topic, $map) = @_;

    # Remove any explicit no-ops of an attr being renamed to the same name.
    $map = {CORE::map { ($_ => $map->{$_}) }
        grep { $map->{$_} ne $_ } CORE::keys %{$map}};

    if ((scalar CORE::keys %{$map}) == 0) {
        # Rename of zero attrs of input yields the input.
        return $topic;
    }

    # Expand map to specify all topic attrs being renamed to something.
    my $inv_map = {reverse %{$map}};
    $map = {CORE::map { ((
            exists $inv_map->{$_} ? $inv_map->{$_} : $_
        ) => $_) } CORE::keys %{$topic->_heading()}};

    my $result = $topic->_new();

    $result->_heading( {CORE::map { ($_ => undef) } CORE::keys %{$map}} );
    $result->_degree( $topic->degree() );

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $result_t = {CORE::map {
                ($_ => $topic_t->{$map->{$_}})
            } CORE::keys %{$map}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result_b->{$result_t_ident_str} = $result_t;
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

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

sub projection {
    my ($topic, $attr_names) = @_;

    (my $proj_h, $attr_names)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'projection', '$attr_names', $attr_names );
    my (undef, undef, $proj_only)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $proj_h );
    confess q{projection(): Bad $attr_names arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if @{$proj_only} > 0;

    return $topic->_projection( $attr_names );
}

sub _projection {
    my ($topic, $attr_names) = @_;

    if (@{$attr_names} == 0) {
        # Projection of zero attrs yields identity relation zero or one.
        if ($topic->is_empty()) {
            return $topic->_new();
        }
        else {
            return $topic->_new( [ {} ] );
        }
    }
    if (@{$attr_names} == $topic->degree()) {
        # Projection of all attrs of input yields the input.
        return $topic;
    }

    my $result = $topic->_new();

    $result->_heading( {CORE::map { ($_ => undef) } @{$attr_names}} );
    $result->_degree( scalar @{$attr_names} );

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $result_t
            = {CORE::map { ($_ => $topic_t->{$_}) } @{$attr_names}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        if (!exists $result_b->{$result_t_ident_str}) {
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

sub cmpl_proj {
    my ($topic, $attr_names) = @_;

    my $topic_h = $topic->_heading();

    (my $cproj_h, $attr_names)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'cmpl_proj', '$attr_names', $attr_names );
    my (undef, undef, $cproj_only)
        = $topic->_ptn_conj_and_disj( $topic_h, $cproj_h );
    confess q{cmpl_proj(): Bad $attr_names arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if @{$cproj_only} > 0;

    return $topic->_projection(
        [grep { !$cproj_h->{$_} } CORE::keys %{$topic_h}] );
}

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

sub wrap {
    my ($topic, $outer, $inner) = @_;

    $topic->_assert_valid_atnm_arg( 'wrap', '$outer', $outer );
    (my $inner_h, $inner) = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'wrap', '$inner', $inner );

    my (undef, $topic_attrs_no_wr, $inner_attrs_not_in_topic)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $inner_h );
    confess q{wrap(): Bad $inner arg; that list of attrs to be wrapped}
            . q{ isn't a subset of the invocant's heading.}
        if @{$inner_attrs_not_in_topic} > 0;
    confess q{wrap(): Bad $outer arg; that name for a new attr to add}
            . q{ to the invocant, consisting of wrapped invocant attrs,}
            . q{ duplicates an attr of the invocant not being wrapped.}
        if any { $_ eq $outer } @{$topic_attrs_no_wr};

    return $topic->_wrap( $outer, $inner, $topic_attrs_no_wr );
}

sub _wrap {
    my ($topic, $outer, $inner, $topic_attrs_no_wr) = @_;

    my $result = $topic->_new();

    $result->_heading(
        {CORE::map { ($_ => undef) } @{$topic_attrs_no_wr}, $outer} );
    $result->_degree( @{$topic_attrs_no_wr} + 1 );

    my $topic_b = $topic->_body();
    my $result_b = $result->_body();

    if ($topic->is_empty()) {
        # An empty $topic means an empty result.
        # So $result_b is already correct.
    }
    elsif (@{$inner} == 0) {
        # Wrap zero $topic attrs as new attr.
        # So this is a simple static extension of $topic w static $outer.
        my $inner_t = {};
        my $outer_atvl = [$inner_t, $topic->_ident_str( $inner_t )];
        for my $topic_t (values %{$topic_b}) {
            my $result_t = {$outer => $outer_atvl, {%{$topic_t}}};
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    elsif (@{$topic_attrs_no_wr} == 0) {
        # Wrap all $topic attrs as new attr.
        for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
            my $result_t = {$outer => [$topic_b->{$topic_t_ident_str},
                $topic_t_ident_str]};
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    else {
        # Wrap at least one but not all $topic attrs as new attr.
        for my $topic_t (values %{$topic_b}) {
            my $inner_t = {CORE::map { ($_ => $topic_t->{$_}) } @{$inner}};
            my $outer_atvl = [$inner_t, $topic->_ident_str( $inner_t )];
            my $result_t = {
                $outer => $outer_atvl,
                CORE::map { ($_ => $topic_t->{$_}) } @{$topic_attrs_no_wr}
            };
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

sub cmpl_wrap {
    my ($topic, $outer, $cmpl_inner) = @_;

    $topic->_assert_valid_atnm_arg( 'cmpl_wrap', '$outer', $outer );
    (my $cmpl_inner_h, $cmpl_inner)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
            'cmpl_wrap', '$cmpl_inner', $cmpl_inner );

    my $topic_h = $topic->_heading();

    confess q{cmpl_wrap(): Bad $cmpl_inner arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if notall { exists $topic_h->{$_} } @{$cmpl_inner};

    my $inner = [grep { !$cmpl_inner_h->{$_} } CORE::keys %{$topic_h}];
    my $inner_h = {CORE::map { $_ => undef } @{$inner}};

    my (undef, $topic_attrs_no_wr, undef)
        = $topic->_ptn_conj_and_disj( $topic_h, $inner_h );
    confess q{cmpl_wrap(): Bad $outer arg; that name for a new attr to add}
            . q{ to the invocant, consisting of wrapped invocant attrs,}
            . q{ duplicates an attr of the invocant not being wrapped.}
        if any { $_ eq $outer } @{$topic_attrs_no_wr};

    return $topic->_wrap( $outer, $inner, $topic_attrs_no_wr );
}

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

sub unwrap {
    my ($topic, $inner, $outer) = @_;

    (my $inner_h, $inner) = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'unwrap', '$inner', $inner );
    $topic->_assert_valid_atnm_arg( 'unwrap', '$outer', $outer );

    my $topic_h = $topic->_heading();

    confess q{unwrap(): Bad $outer arg; that attr name}
            . q{ doesn't match an attr of the invocant's heading.}
        if !exists $topic_h->{$outer};

    my $topic_h_except_outer = {%{$topic_h}};
    CORE::delete $topic_h_except_outer->{$outer};

    my ($inner_attrs_dupl_topic, $topic_attrs_no_uwr, undef)
        = $topic->_ptn_conj_and_disj( $topic_h_except_outer, $inner_h );
    confess q{unwrap(): Bad $inner arg; at least one name in that attr}
            . q{ list, which the invocant would be extended with when}
            . q{ unwrapping $topic{$outer}, duplicates an attr of the}
            . q{ invocant not being unwrapped.}
        if @{$inner_attrs_dupl_topic} > 0;

    my $topic_b = $topic->_body();

    for my $topic_t (values %{$topic_b}) {
        my $inner_t = $topic_t->{$outer}->[0];
        confess q{unwrap(): Can't unwrap $topic{$outer} because there is}
                . q{ not a same-heading tuple value for the $outer attr of}
                . q{ every tuple of $topic whose heading matches $inner.}
            if ref $inner_t ne 'HASH'
                or !$topic->_is_identical_hkeys( $inner_h, $inner_t );
    }

    my $result = $topic->_new();

    $result->_heading( {%{$topic_h_except_outer}, %{$inner_h}} );
    $result->_degree( @{$topic_attrs_no_uwr} + @{$inner} );

    my $result_b = $result->_body();

    if ($topic->is_empty()) {
        # An empty $topic means an empty result.
        # So $result_b is already correct.
    }
    elsif (@{$topic_attrs_no_uwr} == 0) {
        # Only $topic attr is $outer, all result attrs from $outer unwrap.
        for my $topic_t (values %{$topic_b}) {
            my $outer_atvl = $topic_t->{$outer};
            $result_b->{$outer_atvl->[1]} = $outer_atvl->[0];
        }
    }
    elsif (@{$inner} == 0) {
        # Unwrap of $outer adds zero attrs to $topic.
        # So this is a simple projection of $topic excising $outer.
        for my $topic_t (values %{$topic_b}) {
            my $result_t = {
                CORE::map { ($_ => $topic_t->{$_}) } @{$topic_attrs_no_uwr}
            };
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    else {
        # Result has at least 1 attr from $outer, at least 1 not from it.
        for my $topic_t (values %{$topic_b}) {
            my $result_t = {
                %{$topic_t->{$outer}->[0]},
                CORE::map { ($_ => $topic_t->{$_}) } @{$topic_attrs_no_uwr}
            };
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

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

sub group {
    my ($topic, $outer, $inner) = @_;

    $topic->_assert_valid_atnm_arg( 'group', '$outer', $outer );
    (my $inner_h, $inner) = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'group', '$inner', $inner );

    my (undef, $topic_attrs_no_gr, $inner_attrs_not_in_topic)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $inner_h );
    confess q{group(): Bad $inner arg; that list of attrs to be grouped}
            . q{ isn't a subset of the invocant's heading.}
        if @{$inner_attrs_not_in_topic} > 0;
    confess q{group(): Bad $outer arg; that name for a new attr to add}
            . q{ to the invocant, consisting of grouped invocant attrs,}
            . q{ duplicates an attr of the invocant not being grouped.}
        if any { $_ eq $outer } @{$topic_attrs_no_gr};

    return $topic->_group( $outer, $inner, $topic_attrs_no_gr, $inner_h );
}

sub _group {
    my ($topic, $outer, $inner, $topic_attrs_no_gr, $inner_h) = @_;

    my $result = $topic->_new();

    $result->_heading(
        {CORE::map { ($_ => undef) } @{$topic_attrs_no_gr}, $outer} );
    $result->_degree( @{$topic_attrs_no_gr} + 1 );

    if ($topic->is_empty()) {
        # An empty $topic means an empty result.
        # So result body is already correct.
    }
    elsif (@{$inner} == 0) {
        # Group zero $topic attrs as new attr.
        # So this is a simple static extension of $topic w static $outer.
        my $result_b = $result->_body();
        my $inner_r = $topic->_new( [ {} ] );
        my $outer_atvl = [$inner_r, $inner_r->which()];
        for my $topic_t (values %{$topic->_body()}) {
            my $result_t = {$outer => $outer_atvl, {%{$topic_t}}};
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
        $result->_cardinality( $topic->cardinality() );
    }
    elsif (@{$topic_attrs_no_gr} == 0) {
        # Group all $topic attrs as new attr.
        # So $topic is just used as sole attr of sole tuple of result.
        my $result_t = {$outer => [$topic, $topic->which()]};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result->_body( {$result_t_ident_str => $result_t} );
        $result->_cardinality( 1 );
    }
    else {
        # Group at least one but not all $topic attrs as new attr.
        my $result_b = $result->_body();
        my $topic_index = $topic->_want_index( $topic_attrs_no_gr );
        for my $matched_topic_b (values %{$topic_index}) {

            my $inner_r = $topic->_new();
            $inner_r->_heading( $inner_h );
            $inner_r->_degree( scalar @{$inner} );
            my $inner_b = $inner_r->_body();
            for my $topic_t (values %{$matched_topic_b}) {
                my $inner_t
                    = {CORE::map { ($_ => $topic_t->{$_}) } @{$inner}};
                $inner_b->{$topic->_ident_str( $inner_t )} = $inner_t;
            }
            $inner_r->_cardinality(
                scalar CORE::keys %{$matched_topic_b} );
            my $outer_atvl = [$inner_r, $inner_r->which()];

            my $any_mtpt = (values %{$matched_topic_b})[0];

            my $result_t = {
                $outer => $outer_atvl,
                CORE::map { ($_ => $any_mtpt->{$_}) } @{$topic_attrs_no_gr}
            };
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
        $result->_cardinality( scalar CORE::keys %{$topic_index} );
    }

    return $result;
}

sub cmpl_group {
    my ($topic, $outer, $group_per) = @_;

    $topic->_assert_valid_atnm_arg( 'cmpl_group', '$outer', $outer );
    (my $group_per_h, $group_per)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
            'cmpl_group', '$group_per', $group_per );

    my $topic_h = $topic->_heading();

    confess q{cmpl_group(): Bad $group_per arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if notall { exists $topic_h->{$_} } @{$group_per};

    my $inner = [grep { !$group_per_h->{$_} } CORE::keys %{$topic_h}];
    my $inner_h = {CORE::map { $_ => undef } @{$inner}};

    my (undef, $topic_attrs_no_gr, undef)
        = $topic->_ptn_conj_and_disj( $topic_h, $inner_h );
    confess q{cmpl_group(): Bad $outer arg; that name for a new attr to}
            . q{ add to th invocant, consisting of grouped invocant attrs,}
            . q{ duplicates an attr of the invocant not being grouped.}
        if any { $_ eq $outer } @{$topic_attrs_no_gr};

    return $topic->_group( $outer, $inner, $topic_attrs_no_gr, $inner_h );
}

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

sub ungroup {
    my ($topic, $inner, $outer) = @_;

    (my $inner_h, $inner) = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'ungroup', '$inner', $inner );
    $topic->_assert_valid_atnm_arg( 'ungroup', '$outer', $outer );

    my $topic_h = $topic->_heading();

    confess q{ungroup(): Bad $outer arg; that attr name}
            . q{ doesn't match an attr of the invocant's heading.}
        if !exists $topic_h->{$outer};

    my $topic_h_except_outer = {%{$topic_h}};
    CORE::delete $topic_h_except_outer->{$outer};

    my ($inner_attrs_dupl_topic, $topic_attrs_no_ugr, undef)
        = $topic->_ptn_conj_and_disj( $topic_h_except_outer, $inner_h );
    confess q{ungroup(): Bad $inner arg; at least one name in that attr}
            . q{ list, which the invocant would be extended with when}
            . q{ ungrouping $topic{$outer}, duplicates an attr of the}
            . q{ invocant not being ungrouped.}
        if @{$inner_attrs_dupl_topic} > 0;

    my $topic_b = $topic->_body();

    for my $topic_t (values %{$topic_b}) {
        my $inner_r = $topic_t->{$outer}->[0];
        confess q{ungroup(): Can't ungroup $topic{$outer} because there is}
                . q{ not a same-heading relation val for the $outer attr}
                . q{ of every tuple of $topic whose head matches $inner.}
            if !blessed $inner_r or !$inner_r->isa( __PACKAGE__ )
                or !$topic->_is_identical_hkeys(
                    $inner_h, $inner_r->_heading() );
    }

    if ($topic->degree() == 1) {
        # Ungroup of a unary relation is the N-adic union of its sole
        # attribute's value across all tuples.
        return $topic->_new( $inner )
            ->_union( [CORE::map { $_->{$outer} } values %{$topic_b}] );
    }

    # If we get here, the input relation is not unary.

    my $result = $topic->_new();

    $result->_heading( {%{$topic_h_except_outer}, %{$inner_h}} );
    $result->_degree( @{$topic_attrs_no_ugr} + @{$inner} );

    my $topic_tuples_w_nonemp_inn
        = [grep { !$_->{$outer}->is_empty() } values %{$topic_b}];

    if (@{$topic_tuples_w_nonemp_inn} == 0) {
        # An empty post-basic-filtering $topic means an empty result.
        # So result body is already correct.
    }
    elsif (@{$inner} == 0) {
        # Ungroup of $outer adds zero attrs to $topic.
        # So this is a simple proj of post-basic-filt $topic excis $outer.
        my $result_b = $result->_body();
        for my $topic_t (@{$topic_tuples_w_nonemp_inn}) {
            my $result_t = {
                CORE::map { ($_ => $topic_t->{$_}) } @{$topic_attrs_no_ugr}
            };
            my $result_t_ident_str = $topic->_ident_str( $result_t );
            $result_b->{$result_t_ident_str} = $result_t;
        }
        $result->_cardinality( scalar @{$topic_tuples_w_nonemp_inn} );
    }
    else {
        # Result has at least 1 attr from $outer, at least 1 not from it.
        my $result_b = $result->_body();
        for my $topic_t (@{$topic_tuples_w_nonemp_inn}) {
            my $no_ugr_t = {CORE::map { ($_ => $topic_t->{$_}) }
                @{$topic_attrs_no_ugr}};
            my $inner_r = $topic_t->{$outer}->[0];
            for my $inner_t (values %{$inner_r->_body()}) {
                my $result_t = {%{$inner_t}, %{$no_ugr_t}};
                $result_b->{$topic->_ident_str( $result_t )} = $result_t;
            }
        }
        $result->_cardinality( scalar CORE::keys %{$result_b} );
    }

    return $result;
}

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

sub tclose {
    my ($topic) = @_;

    confess q{tclose(): This method may only be invoked on a}
            . q{ Set::Relation object with exactly 2 (same-typed) attrs.}
        if $topic->degree() != 2;

    if ($topic->cardinality() < 2) {
        # Can't create paths of 2+ arcs when not more than 1 arc exists.
        return $topic;
    }

    # If we get here, there are at least 2 arcs, so there is a chance they
    # may connect into longer paths.

    my ($atnm1, $atnm2) = sort (CORE::keys %{$topic->_heading()});

    return $topic->_rename( { 'x' => $atnm1, 'y' => $atnm2 } )
        ->_tclose_of_xy()
        ->_rename( { $atnm1 => 'x', $atnm2 => 'y' } );
}

# TODO: Reimplement tclose to do all the work internally rather
# than farming out to rename/join/projection/union/etc; this should make
# performance an order of magnitude better and without being complicated.

sub _tclose_of_xy {
    my ($xy) = @_;

    my $xyz = $xy->_rename( { 'y' => 'x', 'z' => 'y' } )
        ->_regular_join( $xy, ['y'], ['z'], ['x'] );

    if ($xyz->is_empty()) {
        # No paths of xy connect to any other paths of xy.
        return $xy;
    }

    # If we get here, then at least one pair of paths in xy can connect
    # to form a longer path.

    my $ttt = $xyz->_projection( ['x', 'z'] )
        ->_rename( { 'y' => 'z' } )
        ->_union( [$xy] );

    if ($ttt->_is_identical( $xy )) {
        # All the longer paths resulting from conn were already in xy.
        return $xy;
    }

    # If we get here, then at least one longer path produced above was not
    # already in xy and was added; so now we need to check if any
    # yet-longer paths can be made from the just-produced.

    return $ttt->_tclose_of_xy();
}

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

sub restriction {
    my ($topic, $func, $allow_dup_tuples) = @_;

    $topic->_assert_valid_func_arg( 'restriction', '$func', $func );

    if ($topic->is_empty()) {
        return $topic;
    }

    my $result = $topic->empty();

    my $topic_b = $topic->_body();
    my $result_b = $result->_body();

    for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
        my $topic_t = $topic_b->{$topic_t_ident_str};
        my $is_matched;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $is_matched = $func->();
        }
        if ($is_matched) {
            $result_b->{$topic_t_ident_str} = $topic_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

sub restr_and_cmpl {
    my ($topic, $func, $allow_dup_tuples) = @_;
    $topic->_assert_valid_func_arg( 'restr_and_cmpl', '$func', $func );
    return $topic->_restr_and_cmpl( $func );
}

sub _restr_and_cmpl {
    my ($topic, $func) = @_;

    if ($topic->is_empty()) {
        return [$topic, $topic];
    }

    my $pass_result = $topic->empty();
    my $fail_result = $topic->empty();

    my $topic_b = $topic->_body();
    my $pass_result_b = $pass_result->_body();
    my $fail_result_b = $fail_result->_body();

    for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
        my $topic_t = $topic_b->{$topic_t_ident_str};
        my $is_matched;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $is_matched = $func->();
        }
        if ($is_matched) {
            $pass_result_b->{$topic_t_ident_str} = $topic_t;
        }
        else {
            $fail_result_b->{$topic_t_ident_str} = $topic_t;
        }
    }
    $pass_result->_cardinality( scalar CORE::keys %{$pass_result_b} );
    $fail_result->_cardinality( scalar CORE::keys %{$fail_result_b} );

    return [$pass_result, $fail_result];
}

sub cmpl_restr {
    my ($topic, $func, $allow_dup_tuples) = @_;

    $topic->_assert_valid_func_arg( 'cmpl_restr', '$func', $func );

    if ($topic->is_empty()) {
        return $topic;
    }

    my $result = $topic->empty();

    my $topic_b = $topic->_body();
    my $result_b = $result->_body();

    for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
        my $topic_t = $topic_b->{$topic_t_ident_str};
        my $is_matched;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $is_matched = $func->();
        }
        if (!$is_matched) {
            $result_b->{$topic_t_ident_str} = $topic_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub classification {
    my ($topic, $func, $class_attr_name, $group_attr_name,
        $allow_dup_tuples) = @_;

    $topic->_assert_valid_func_arg( 'classification', '$func', $func );
    $topic->_assert_valid_atnm_arg(
        'classification', '$class_attr_name', $class_attr_name );
    $topic->_assert_valid_atnm_arg(
        'classification', '$group_attr_name', $group_attr_name );

    my $result = $topic->_new();

    $result->_heading(
        {$class_attr_name => undef, $group_attr_name => undef} );
    $result->_degree( 2 );

    if ($topic->is_empty()) {
        # An empty $topic means an empty result.
        # So result body is already correct.
        return $result;
    }

    my $topic_h = $topic->_heading();
    my $topic_degree = $topic->degree();
    my $topic_b = $topic->_body();

    my $tuples_per_class = {};

    for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
        my $topic_t = $topic_b->{$topic_t_ident_str};
        my $class;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $class = $func->();
        }
        my $class_ident_str = $topic->_ident_str( $class );
        if (!exists $tuples_per_class->{$class_ident_str}) {
            $tuples_per_class->{$class_ident_str} = [$class, []];
        }
        push @{$tuples_per_class->{$class_ident_str}->[1]},
            [$topic_t, $topic_t_ident_str];
    }

    my $result_b = $result->_body();
    for my $class_ident_str (CORE::keys %{$tuples_per_class}) {
        my ($class, $tuples_in_class)
            = @{$tuples_per_class->{$class_ident_str}};

        my $inner_r = $topic->_new();
        $inner_r->_heading( $topic_h );
        $inner_r->_degree( $topic_degree );
        my $inner_b = $inner_r->_body();
        for my $topic_t_w_ident (@{$tuples_in_class}) {
            my ($topic_t, $topic_t_ident_str) = @{$topic_t_w_ident};
            $inner_b->{$topic_t_ident_str} = $topic_t;
        }
        $inner_r->_cardinality( scalar @{$tuples_in_class} );
        my $outer_atvl = [$inner_r, $inner_r->which()];

        my $result_t = {
            $class_attr_name => [$class, $class_ident_str],
            $group_attr_name => $outer_atvl,
        };
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result_b->{$result_t_ident_str} = $result_t;
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub extension {
    my ($topic, $attr_names, $func, $allow_dup_tuples) = @_;

    (my $exten_h, $attr_names)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        'extension', '$attr_names', $attr_names );
    $topic->_assert_valid_func_arg( 'extension', '$func', $func );

    my ($both, undef, undef)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $exten_h );
    confess q{extension(): Bad $attr_names arg; that attr list}
            . q{ isn't disjoint with the invocant's heading.}
        if @{$both} > 0;

    return $topic->_extension( $attr_names, $func, $exten_h );
}

sub _extension {
    my ($topic, $attr_names, $func, $exten_h) = @_;

    if (@{$attr_names} == 0) {
        # Extension of input by zero attrs yields the input.
        return $topic;
    }

    my $result = $topic->_new();

    $result->_heading( {%{$topic->_heading()}, %{$exten_h}} );
    $result->_degree( $topic->degree() + @{$attr_names} );

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $exten_t;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $exten_t = $func->();
        }
        $topic->_assert_valid_tuple_result_of_func_arg(
            'extension', '$func', '$attr_names', $exten_t, $exten_h );
        $exten_t = $topic->_import_nfmt_tuple( $exten_t );
        my $result_t = {%{$topic_t}, %{$exten_t}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result_b->{$result_t_ident_str} = $result_t;
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

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

sub static_exten {
    my ($topic, $attrs) = @_;

    confess q{static_exten(): Bad $attrs arg; it isn't a hash-ref.}
        if ref $attrs ne 'HASH';

    my ($both, undef, undef)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $attrs );
    confess q{static_exten(): Bad $attrs arg; that attr list}
            . q{ isn't disjoint with the invocant's heading.}
        if @{$both} > 0;

    confess q{static_exten(): Bad $attrs arg;}
            . q{ it is a hash-ref, and there exist circular refs}
            . q{ between itself or its tuple-valued components.}
        if $topic->_tuple_arg_has_circular_refs( $attrs );

    return $topic->_static_exten( $attrs );
}

sub _static_exten {
    my ($topic, $attrs) = @_;

    if ((scalar CORE::keys %{$attrs}) == 0) {
        # Extension of input by zero attrs yields the input.
        return $topic;
    }

    $attrs = $topic->_import_nfmt_tuple( $attrs );

    my $result = $topic->_new();

    $result->_heading( {%{$topic->_heading()},
        CORE::map { ($_ => undef) } CORE::keys %{$attrs}} );
    $result->_degree( $topic->degree() + (scalar CORE::keys %{$attrs}) );

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $result_t = {%{$topic_t}, %{$attrs}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result_b->{$result_t_ident_str} = $result_t;
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

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

sub map {
    my ($topic, $result_attr_names, $func, $allow_dup_tuples) = @_;

    (my $result_h, $result_attr_names)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
            'map', '$result_attr_names', $result_attr_names );
    $topic->_assert_valid_func_arg( 'map', '$func', $func );

    if (@{$result_attr_names} == 0) {
        # Map to zero attrs yields identity relation zero or one.
        if ($topic->is_empty()) {
            return $topic->_new();
        }
        else {
            return $topic->_new( [ {} ] );
        }
    }

    my $result = $topic->_new();

    $result->_heading( $result_h );
    $result->_degree( scalar @{$result_attr_names} );

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $result_t;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $result_t = $func->();
        }
        $topic->_assert_valid_tuple_result_of_func_arg(
            'map', '$func', '$result_attr_names', $result_t, $result_h );
        $result_t = $topic->_import_nfmt_tuple( $result_t );
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        if (!exists $result_b->{$result_t_ident_str}) {
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub summary {
    my ($topic, $group_per, $summ_attr_names, $summ_func,
        $allow_dup_tuples) = @_;

    (my $group_per_h, $group_per)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
            'summary', '$group_per', $group_per );
    (my $exten_h, $summ_attr_names)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
            'summary', '$summ_attr_names', $summ_attr_names );
    $topic->_assert_valid_func_arg( 'summary', '$summ_func', $summ_func );

    my $topic_h = $topic->_heading();

    confess q{summary(): Bad $group_per arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if notall { exists $topic_h->{$_} } @{$group_per};

    confess q{summary(): Bad $summ_attr_names arg; one or more of those}
            . q{ names for new summary attrs to add to the invocant }
            . q{ duplicates an attr of the invocant not being grouped.}
        if any { exists $group_per_h->{$_} } @{$summ_attr_names};

    my $inner = [grep { !$group_per_h->{$_} } CORE::keys %{$topic_h}];
    my $inner_h = {CORE::map { $_ => undef } @{$inner}};

    my (undef, $topic_attrs_no_gr, undef)
        = $topic->_ptn_conj_and_disj( $topic_h, $inner_h );

    my $result = $topic->_new();

    $result->_heading( {%{$group_per_h}, %{$exten_h}} );
    $result->_degree( @{$group_per} + @{$summ_attr_names} );

    if ($topic->is_empty()) {
        # An empty $topic means an empty result.
        return $result;
    }

    # Note: We skipped a number of shortcuts that _group() has for
    # brevity, leaving just the general case; they might come back later.

    my $result_b = $result->_body();
    my $topic_index = $topic->_want_index( $topic_attrs_no_gr );
    for my $matched_topic_b (values %{$topic_index}) {

        my $inner_r = $topic->_new();
        $inner_r->_heading( $inner_h );
        $inner_r->_degree( scalar @{$inner} );
        my $inner_b = $inner_r->_body();
        for my $topic_t (values %{$matched_topic_b}) {
            my $inner_t = {CORE::map { ($_ => $topic_t->{$_}) } @{$inner}};
            $inner_b->{$topic->_ident_str( $inner_t )} = $inner_t;
        }
        $inner_r->_cardinality( scalar CORE::keys %{$matched_topic_b} );

        my $any_mtpt = (values %{$matched_topic_b})[0];
        my $group_per_t = {CORE::map { ($_ => $any_mtpt->{$_}) }
            @{$topic_attrs_no_gr}};

        my $exten_t;
        {
            local $_ = {
                'summarize' => $inner_r,
                'per' => $topic->_export_nfmt_tuple( $group_per_t ),
            };
            $exten_t = $summ_func->();
        }
        $topic->_assert_valid_tuple_result_of_func_arg( 'summary',
            '$summ_func', '$summ_attr_names', $exten_t, $exten_h );
        $exten_t = $topic->_import_nfmt_tuple( $exten_t );

        my $result_t = {%{$group_per_t}, %{$exten_t}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        if (!exists $result_b->{$result_t_ident_str}) {
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub cardinality_per_group {
    my ($topic, $count_attr_name, $group_per, $allow_dup_tuples) = @_;

    $topic->_assert_valid_atnm_arg(
        'cardinality_per_group', '$count_attr_name', $count_attr_name );
    (my $group_per_h, $group_per)
        = $topic->_atnms_hr_from_assert_valid_atnms_arg(
            'cardinality_per_group', '$group_per', $group_per );

    my $topic_h = $topic->_heading();

    confess q{cardinality_per_group(): Bad $group_per arg;}
            . q{ that attr list isn't a subset of the invocant's heading.}
        if notall { exists $topic_h->{$_} } @{$group_per};

    confess q{cardinality_per_group(): Bad $count_attr_name arg;}
            . q{ that name for a new attr to add to the invocant}
            . q{ duplicates an attr of the invocant not being grouped.}
        if exists $group_per_h->{$count_attr_name};

    my $inner = [grep { !$group_per_h->{$_} } CORE::keys %{$topic_h}];
    my $inner_h = {CORE::map { $_ => undef } @{$inner}};

    my (undef, $topic_attrs_no_gr, undef)
        = $topic->_ptn_conj_and_disj( $topic_h, $inner_h );

    my $result = $topic->_new();

    $result->_heading( {%{$group_per_h}, $count_attr_name => undef} );
    $result->_degree( @{$group_per} + 1 );

    if ($topic->is_empty()) {
        # An empty $topic means an empty result.
        return $result;
    }

    my $result_b = $result->_body();
    my $topic_index = $topic->_want_index( $topic_attrs_no_gr );
    for my $matched_topic_b (values %{$topic_index}) {
        my $count = scalar CORE::keys %{$matched_topic_b};
        my $any_mtpt = (values %{$matched_topic_b})[0];
        my $group_per_t = {CORE::map { ($_ => $any_mtpt->{$_}) }
            @{$topic_attrs_no_gr}};
        my $result_t = {%{$group_per_t}, $count_attr_name => $count};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        if (!exists $result_b->{$result_t_ident_str}) {
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

sub count_per_group {
    my ($self, @args) = @_;
    return $self->cardinality_per_group( @args );
}

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

sub _atnms_hr_from_assert_valid_atnms_arg {
    my ($self, $rtn_nm, $arg_nm, $atnms) = @_;

    if (defined $atnms and !ref $atnms) {
        $atnms = [$atnms];
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it must be an array-ref or a defined non-ref.}
        if ref $atnms ne 'ARRAY';
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it should be just be a list of attr names,}
            . q{ but at least one name is undefined or is a ref.}
        if notall { defined $_ and !ref $_ } @{$atnms};
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it specifies a list of}
            . q{ attr names with at least one duplicated name.}
        if (uniqstr @{$atnms}) != @{$atnms};

    my $heading = {CORE::map { ($_ => undef) } @{$atnms}};
    return ($heading, $atnms);
}

sub _assert_valid_atnm_arg {
    my ($self, $rtn_nm, $arg_nm, $atnm) = @_;
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it should be just be an attr name,}
            . q{ but it is undefined or is a ref.}
        if !defined $atnm or ref $atnm;
}

sub _assert_valid_nnint_arg {
    my ($self, $rtn_nm, $arg_nm, $atnm) = @_;
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it should be just be a non-negative integer,}
            . q{ but it is undefined or is a ref or is some other scalar.}
        if !defined $atnm or ref $atnm or not $atnm =~ /^[0-9]+$/;
}

sub _assert_valid_func_arg {
    my ($self, $rtn_nm, $arg_nm, $func) = @_;
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it must be a Perl subroutine reference.}
        if ref $func ne 'CODE';
}

sub _assert_valid_tuple_result_of_func_arg {
    my ($self, $rtn_nm, $arg_nm_func, $arg_nm_attrs, $result_t, $heading)
        = @_;
    confess qq{$rtn_nm(): Bad $arg_nm_func arg;}
            . q{ at least one result of executing that Perl subroutine}
            . q{ reference was not a hash-ref or it didn't have the same}
            . qq{ set of hkeys as specified by the $arg_nm_attrs arg.}
        if ref $result_t ne 'HASH'
            or !$self->_is_identical_hkeys( $heading, $result_t );
    confess qq{$rtn_nm(): Bad $arg_nm_func arg;}
            . q{ at least one result of executing that Perl subroutine}
            . q{ reference was a hash-ref, and there exist circular refs}
            . q{ between itself or its tuple-valued components.}
        if $self->_tuple_arg_has_circular_refs( $result_t );
}

sub _normalize_same_heading_relation_arg {
    my ($self, $rtn_nm, $arg_nm, $other) = @_;
    if (blessed $other and $other->can( 'does' )
            and $other->does( 'Set::Relation' )
            and !$other->isa( __PACKAGE__ )) {
        $other = $self->_new( $other );
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg; it isn't a Set::Relation}
            . q{ object, or it doesn't have exactly the}
            . q{ same set of attr names as the invocant.}
        if !blessed $other or !$other->isa( __PACKAGE__ )
            or !$self->_is_identical_hkeys(
                $self->_heading(), $other->_heading() );
    return $other;
}

sub _normalize_relation_arg {
    my ($self, $rtn_nm, $arg_nm, $other) = @_;
    if (blessed $other and $other->can( 'does' )
            and $other->does( 'Set::Relation' )
            and !$other->isa( __PACKAGE__ )) {
        $other = $self->_new( $other );
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it isn't a Set::Relation object.}
        if !blessed $other or !$other->isa( __PACKAGE__ );
    return $other;
}

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

sub is_identical {
    my ($topic, $other) = @_;
    $other = $topic->_normalize_relation_arg(
        'is_identical', '$other', $other );
    return $topic->_is_identical( $other );
}

sub _is_identical {
    my ($topic, $other) = @_;
    return ($topic->degree() == $other->degree()
        and $topic->cardinality() == $other->cardinality()
        and $topic->_is_identical_hkeys(
            $topic->_heading(), $other->_heading() )
        and $topic->_is_identical_hkeys(
            $topic->_body(), $other->_body() ));
}

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

sub is_subset {
    my ($topic, $other) = @_;
    $other = $topic->_normalize_same_heading_relation_arg(
        'is_subset', '$other', $other );
    my $other_b = $other->_body();
    return all { exists $other_b->{$_} }
        CORE::keys %{$topic->_body()};
}

sub is_superset {
    my ($topic, $other) = @_;
    $other = $topic->_normalize_same_heading_relation_arg(
        'is_superset', '$other', $other );
    my $topic_b = $topic->_body();
    return all { exists $topic_b->{$_} }
        CORE::keys %{$other->_body()};
}

sub is_proper_subset {
    my ($topic, $other) = @_;
    $other = $topic->_normalize_same_heading_relation_arg(
        'is_proper_subset', '$other', $other );
    my $other_b = $other->_body();
    return ($topic->cardinality() < $other->cardinality()
        and all { exists $other_b->{$_} }
            CORE::keys %{$topic->_body()});
}

sub is_proper_superset {
    my ($topic, $other) = @_;
    $other = $topic->_normalize_same_heading_relation_arg(
        'is_proper_superset', '$other', $other );
    my $topic_b = $topic->_body();
    return ($other->cardinality() < $topic->cardinality()
        and all { exists $topic_b->{$_} }
            CORE::keys %{$other->_body()});
}

sub is_disjoint {
    my ($topic, $other) = @_;
    $other = $topic->_normalize_same_heading_relation_arg(
        'is_disjoint', '$other', $other );
    return $topic->_intersection( [$other] )->is_empty();
}

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

sub union {
    my ($topic, $others) = @_;
    $others = $topic->_normalize_same_heading_relations_arg(
        'union', '$others', $others );
    return $topic->_union( $others );
}

sub _union {
    my ($topic, $others) = @_;

    my $inputs = [
        sort { $b->cardinality() <=> $a->cardinality() }
        grep { !$_->is_empty() } # filter out identity value instances
        $topic, @{$others}];

    if (@{$inputs} == 0) {
        # All inputs were the identity value; so is result.
        return $topic->empty();
    }
    if (@{$inputs} == 1) {
        # Only one non-identity value input; so it is the result.
        return $inputs->[0];
    }

    # If we get here, there are at least 2 non-empty input relations.

    my $largest = shift @{$inputs};

    my $result = $largest->_new( $largest );

    my $smaller_bs = [CORE::map { $_->_body() } @{$inputs}];
    my $result_b = $result->_body();

    for my $smaller_b (@{$smaller_bs}) {
        for my $tuple_ident_str (CORE::keys %{$smaller_b}) {
            if (!exists $result_b->{$tuple_ident_str}) {
                $result_b->{$tuple_ident_str}
                    = $smaller_b->{$tuple_ident_str};
            }
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub exclusion {
    # Also known as symmetric_diff().
    my ($topic, $others) = @_;

    $others = $topic->_normalize_same_heading_relations_arg(
        'exclusion', '$others', $others );

    my $inputs = [
        sort { $b->cardinality() <=> $a->cardinality() }
        grep { !$_->is_empty() } # filter out identity value instances
        $topic, @{$others}];

    if (@{$inputs} == 0) {
        # All inputs were the identity value; so is result.
        return $topic->empty();
    }
    if (@{$inputs} == 1) {
        # Only one non-identity value input; so it is the result.
        return $inputs->[0];
    }

    # If we get here, there are at least 2 non-empty input relations.

    my $largest = shift @{$inputs};

    my $result = $largest->_new( $largest );

    my $smaller_bs = [CORE::map { $_->_body() } @{$inputs}];
    my $result_b = $result->_body();

    for my $smaller_b (@{$smaller_bs}) {
        for my $tuple_ident_str (CORE::keys %{$smaller_b}) {
            if (exists $result_b->{$tuple_ident_str}) {
                CORE::delete $result_b->{$tuple_ident_str};
            }
            else {
                $result_b->{$tuple_ident_str}
                    = $smaller_b->{$tuple_ident_str};
            }
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

sub symmetric_diff {
    my ($self, @args) = @_;
    return $self->exclusion( @args );
}

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

sub intersection {
    my ($topic, $others) = @_;
    $others = $topic->_normalize_same_heading_relations_arg(
        'intersection', '$others', $others );
    return $topic->_intersection( $others );
}

sub _intersection {
    my ($topic, $others) = @_;

    if (@{$others} == 0) {
        return $topic;
    }

    my $inputs = [
        sort { $a->cardinality() <=> $b->cardinality() }
        $topic, @{$others}];

    my $smallest = shift @{$inputs};

    if ($smallest->is_empty()) {
        return $smallest;
    }

    # If we get here, there are at least 2 non-empty input relations.

    my $result = $smallest->empty();

    my $smallest_b = $smallest->_body();
    my $larger_bs = [CORE::map { $_->_body() } @{$inputs}];
    my $result_b = $result->_body();

    TUPLE:
    for my $tuple_ident_str (CORE::keys %{$smallest_b}) {
        for my $larger_b (@{$larger_bs}) {
            next TUPLE
                if !exists $larger_b->{$tuple_ident_str};
        }
        $result_b->{$tuple_ident_str} = $smallest_b->{$tuple_ident_str};
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub _normalize_same_heading_relations_arg {
    my ($self, $rtn_nm, $arg_nm, $others) = @_;

    my $self_h = $self->_heading();

    if (blessed $others and $others->can( 'does' )
            and $others->does( 'Set::Relation' )) {
        $others = [$others];
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it must be an array-ref or a Set::Relation object.}
        if ref $others ne 'ARRAY';
    $others = [CORE::map {
        my $other = $_;
        if (blessed $other and $other->can( 'does' )
                and $other->does( 'Set::Relation' )
                and !$other->isa( __PACKAGE__ )) {
            $other = $self->_new( $other );
        }
        confess qq{$rtn_nm(): Bad $arg_nm arg elem;}
                . q{ it isn't a Set::Relation object, or it doesn't have}
                . q{ exactly the same set of attr names as the invocant.}
            if !blessed $other or !$other->isa( __PACKAGE__ )
                or !$self->_is_identical_hkeys(
                    $self_h, $other->_heading() );
        $other;
    } @{$others}];

    return $others;
}

sub _normalize_relations_arg {
    my ($self, $rtn_nm, $arg_nm, $others) = @_;

    if (blessed $others and $others->can( 'does' )
            and $others->does( 'Set::Relation' )) {
        $others = [$others];
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it must be an array-ref or a Set::Relation object.}
        if ref $others ne 'ARRAY';
    $others = [CORE::map {
        my $other = $_;
        if (blessed $other and $other->can( 'does' )
                and $other->does( 'Set::Relation' )
                and !$other->isa( __PACKAGE__ )) {
            $other = $self->_new( $other );
        }
        confess qq{$rtn_nm(): Bad $arg_nm arg elem;}
                . q{ it isn't a Set::Relation object.}
            if !blessed $other or !$other->isa( __PACKAGE__ );
        $other;
    } @{$others}];

    return $others;
}

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

sub diff {
    my ($source, $filter) = @_;
    $filter = $source->_normalize_same_heading_relation_arg(
        'diff', '$other', $filter );
    return $source->_diff( $filter );
}

sub _diff {
    my ($source, $filter) = @_;
    if ($source->is_empty() or $filter->is_empty()) {
        return $source;
    }
    return $source->_regular_diff( $filter );
}

sub _regular_diff {
    my ($source, $filter) = @_;

    my $result = $source->empty();

    my $source_b = $source->_body();
    my $filter_b = $filter->_body();
    my $result_b = $result->_body();

    for my $tuple_ident_str (CORE::keys %{$source_b}) {
        if (!exists $filter_b->{$tuple_ident_str}) {
            $result_b->{$tuple_ident_str} = $source_b->{$tuple_ident_str};
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub semidiff {
    my ($source, $filter) = @_;
    $filter = $source->_normalize_relation_arg(
        'semidiff', '$filter', $filter );
    if ($source->is_empty() or $filter->is_empty()) {
        return $source;
    }
    return $source->_regular_diff( $source->_semijoin( $filter ) );
}

sub antijoin {
    my ($self, @args) = @_;
    return $self->semidiff( @args );
}

sub semijoin_and_diff {
    my ($source, $filter) = @_;
    $filter = $source->_normalize_relation_arg(
        'semijoin_and_diff', '$filter', $filter );
    return $source->_semijoin_and_diff( $filter );
}

sub _semijoin_and_diff {
    my ($source, $filter) = @_;
    if ($source->is_empty()) {
        return [$source, $source];
    }
    if ($filter->is_empty()) {
        return [$source->empty(), $source];
    }
    my $semijoin = $source->_semijoin( $filter );
    return [$semijoin, $source->_regular_diff( $semijoin )];
}

sub semijoin {
    my ($source, $filter) = @_;
    $filter = $source->_normalize_relation_arg(
        'semijoin', '$filter', $filter );
    return $source->_semijoin( $filter );
}

sub _semijoin {
    my ($source, $filter) = @_;

    if ($source->is_empty()) {
        return $source;
    }
    if ($filter->is_empty()) {
        return $source->empty();
    }

    # If we get here, both inputs have at least one tuple.

    if ($source->is_nullary() or $filter->is_nullary()) {
        return $source;
    }

    # If we get here, both inputs also have at least one attribute.

    my ($both, $source_only, $filter_only) = $source->_ptn_conj_and_disj(
        $source->_heading(), $filter->_heading() );

    if (@{$both} == 0) {
        # The inputs have disjoint headings; result is source.
        return $source;
    }
    if (@{$source_only} == 0 and @{$filter_only} == 0) {
        # The inputs have identical headings; result is intersection.
        return $source->_intersection( [$filter] );
    }

    # If we get here, the inputs also have overlapping non-ident headings.

    return $source->_regular_semijoin( $filter, $both );
}

sub _regular_semijoin {
    my ($source, $filter, $both) = @_;

    my $result = $source->empty();

    my ($sm, $lg) = ($source->cardinality() < $filter->cardinality())
        ? ($source, $filter) : ($filter, $source);

    my $sm_index = $sm->_want_index( $both );
    my $lg_index = $lg->_want_index( $both );
    my $source_index = $source->_want_index( $both );
    my $result_b = $result->_body();

    for my $subtuple_ident_str (CORE::keys %{$sm_index}) {
        if (exists $lg_index->{$subtuple_ident_str}) {
            my $matched_source_b = $source_index->{$subtuple_ident_str};
            for my $tuple_ident_str (CORE::keys %{$matched_source_b}) {
                $result_b->{$tuple_ident_str}
                    = $matched_source_b->{$tuple_ident_str};
            }
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub join {
    my ($topic, $others) = @_;
    $others = $topic->_normalize_relations_arg(
        'join', '$others', $others );
    return $topic->_join( $others );
}

sub _join {
    my ($topic, $others) = @_;

    if (@{$others} == 0) {
        return $topic;
    }

    my $inputs = [$topic, @{$others}];

    if (any { $_->is_empty() } @{$inputs}) {
        # At least one input has zero tuples; so does result.
        my $result = $topic->_new();
        my $result_h = {CORE::map { %{$_->_heading()} } @{$inputs}};
        $result->_heading( $result_h );
        $result->_degree( scalar CORE::keys %{$result_h} );
        return $result;
    }

    # If we get here, all inputs have at least one tuple.

    $inputs = [
        sort { $a->cardinality() <=> $b->cardinality() }
        grep { !$_->is_nullary() } # filter out identity value instances
        @{$inputs}];

    if (@{$inputs} == 0) {
        # All inputs were the identity value; so is result.
        return $topic;
    }
    if (@{$inputs} == 1) {
        # Only one non-identity value input; so it is the result.
        return $inputs->[0];
    }

    # If we get here, there are at least 2 non-empty non-nullary inp rels.

    my $result = shift @{$inputs};
    INPUT:
    for my $input (@{$inputs}) {
        # TODO: Optimize this better by determining more strategic order
        # to join the various inputs, such as by doing intersections first,
        # then semijoins, then regular joins, then cross-products.
        # But at least we're going min to max cardinality meanwhile.

        my ($both, $result_only, $input_only)
            = $result->_ptn_conj_and_disj(
                $result->_heading(), $input->_heading() );

        if (@{$both} == 0) {
            # The inputs have disjoint headings; result is cross-product.
            $result = $result->_regular_product( $input );
            next INPUT;
        }
        if (@{$result_only} == 0 and @{$input_only} == 0) {
            # The inputs have identical headings; result is intersection.
            $result = $result->_intersection( [$input] );
            next INPUT;
        }

        # If we get here, the inputs also have overlapping non-ident heads.

        if (@{$result_only} == 0) {
            # The first input's attrs are a proper subset of the second's;
            # result has same heading as second, a subset of sec's tuples.
            $result = $input->_regular_semijoin( $result, $both );
            next INPUT;
        }
        if (@{$input_only} == 0) {
            # The second input's attrs are a proper subset of the first's;
            # result has same heading as first, a subset of first's tuples.
            $result = $result->_regular_semijoin( $input, $both );
            next INPUT;
        }

        # If we get here, both inputs also have mini one attr of their own.

        $result = $result->_regular_join(
            $input, $both, $result_only, $input_only );
    }
    return $result;
}

sub _regular_join {
    my ($topic, $other, $both, $topic_only, $other_only) = @_;

    my $result = $topic->_new();

    $result->_heading( {CORE::map { ($_ => undef) }
        @{$both}, @{$topic_only}, @{$other_only}} );
    $result->_degree( @{$both} + @{$topic_only} + @{$other_only} );

    my ($sm, $lg) = ($topic->cardinality() < $other->cardinality())
        ? ($topic, $other) : ($other, $topic);

    my $sm_index = $sm->_want_index( $both );
    my $lg_index = $lg->_want_index( $both );
    my $result_b = {};

    for my $subtuple_ident_str (CORE::keys %{$sm_index}) {
        if (exists $lg_index->{$subtuple_ident_str}) {
            my $matched_sm_b = $sm_index->{$subtuple_ident_str};
            my $matched_lg_b = $lg_index->{$subtuple_ident_str};
            for my $sm_t (values %{$matched_sm_b}) {
                for my $lg_t (values %{$matched_lg_b}) {
                    my $result_t = {%{$sm_t}, %{$lg_t}};
                    $result_b->{$topic->_ident_str( $result_t )}
                        = $result_t;
                }
            }
        }
    }
    $result->_body( $result_b );
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub product {
    my ($topic, $others) = @_;

    $others = $topic->_normalize_relations_arg(
        'product', '$others', $others );

    if (@{$others} == 0) {
        return $topic;
    }

    my $inputs = [$topic, @{$others}];

    my $attr_names
        = [CORE::map { CORE::keys %{$_->_heading()} } @{$inputs}];

    confess q{product(): Bad $others arg;}
            . q{ one of its elems has an attr name duplicated by}
            . q{ either the invocant or another $others elem.}
        if (uniqstr @{$attr_names}) != @{$attr_names};

    if (any { $_->is_empty() } @{$inputs}) {
        # At least one input has zero tuples; so does result.
        my $result = $topic->_new();
        $result->_heading( {CORE::map { ($_ => undef) } @{$attr_names}} );
        $result->_degree( scalar @{$attr_names} );
        return $result;
    }

    # If we get here, all inputs have at least one tuple.

    $inputs = [
        sort { $a->cardinality() <=> $b->cardinality() }
        grep { !$_->is_nullary() } # filter out identity value instances
        @{$inputs}];

    if (@{$inputs} == 0) {
        # All inputs were the identity value; so is result.
        return $topic;
    }
    if (@{$inputs} == 1) {
        # Only one non-identity value input; so it is the result.
        return $inputs->[0];
    }

    # If we get here, there are at least 2 non-empty non-nullary inp rels.

    my $result = shift @{$inputs};
    for my $input (@{$inputs}) {
        $result = $result->_regular_product( $input );
    }
    return $result;
}

sub _regular_product {
    my ($topic, $other) = @_;

    my $result = $topic->_new();

    $result->_heading( {%{$topic->_heading()}, %{$other->_heading()}} );
    $result->_degree( $topic->degree() + $other->degree() );

    my ($sm, $lg) = ($topic->cardinality() < $other->cardinality())
        ? ($topic, $other) : ($other, $topic);

    my $sm_b = $sm->_body();
    my $lg_b = $lg->_body();
    my $result_b = {};

    for my $sm_t (values %{$sm_b}) {
        for my $lg_t (values %{$lg_b}) {
            my $result_t = {%{$sm_t}, %{$lg_t}};
            $result_b->{$topic->_ident_str( $result_t )} = $result_t;
        }
    }
    $result->_body( $result_b );
    $result->_cardinality( $topic->cardinality() * $other->cardinality() );

    return $result;
}

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

sub quotient {
    my ($dividend, $divisor) = @_;

    $divisor = $dividend->_normalize_relation_arg(
        'quotient', '$divisor', $divisor );

    my (undef, $dividend_only, $divisor_only)
        = $dividend->_ptn_conj_and_disj(
            $dividend->_heading(), $divisor->_heading() );

    confess q{quotient(): Bad $divisor arg;}
            . q{ its heading isn't a subset of the invocant's heading.}
        if @{$divisor_only} > 0;

    my $proj_of_dividend_only = $dividend->_projection( $dividend_only );

    if ($dividend->is_empty() or $divisor->is_empty()) {
        # At least one input has zero tup; res has all tup o dividend proj.
        return $proj_of_dividend_only;
    }

    # If we get here, both inputs have at least one tuple.

    if ($dividend->is_nullary() or $divisor->is_nullary()) {
        # Both inputs or just divisor is ident-one rel; result is dividend.
        return $dividend;
    }

    # If we get here, divisor has at least one attribute,
    # and divisor heading is proper subset of dividend heading.

    return $proj_of_dividend_only
        ->_diff( $proj_of_dividend_only
            ->_regular_product( $divisor )
            ->_diff( $dividend )
            ->_projection( $dividend_only )
        );
}

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

sub composition {
    my ($topic, $other) = @_;

    $other = $topic->_normalize_relation_arg(
        'composition', '$other', $other );

    my ($both, $topic_only, $other_only) = $topic->_ptn_conj_and_disj(
        $topic->_heading(), $other->_heading() );

    if ($topic->is_empty() or $other->is_empty()) {
        # At least one input has zero tuples; so does result.
        return $topic->_new( [@{$topic_only}, @{$other_only}] );
    }

    # If we get here, both inputs have at least one tuple.

    if ($topic->is_nullary()) {
        # First input is identity-one relation; result is second input.
        return $other;
    }
    if ($other->is_nullary()) {
        # Second input is identity-one relation; result is first input.
        return $topic;
    }

    # If we get here, both inputs also have at least one attribute.

    if (@{$both} == 0) {
        # The inputs have disjoint headings; result is cross-product.
        return $topic->_regular_product( $other );
    }
    if (@{$topic_only} == 0 and @{$other_only} == 0) {
        # The inputs have identical headings; result is ident-one relation.
        return $topic->_new( [ {} ] );
    }

    # If we get here, the inputs also have overlapping non-ident headings.

    if (@{$topic_only} == 0) {
        # The first input's attributes are a proper subset of the second's;
        # result has same heading as second, a subset of second's tuples.
        return $other->_regular_semijoin( $topic, $both )
            ->_projection( $other_only );
    }
    if (@{$other_only} == 0) {
        # The second input's attributes are a proper subset of the first's;
        # result has same heading as first, a subset of first's tuples.
        return $topic->_regular_semijoin( $other, $both )
            ->_projection( $topic_only );
    }

    # If we get here, both inputs also have at least one attr of their own.

    return $topic->_regular_join(
        $other, $both, $topic_only, $other_only )
            ->_projection( [@{$topic_only}, @{$other_only}] );
}

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

sub _ptn_conj_and_disj {
    # inputs are hashes, results are arrays
    my ($self, $src1, $src2) = @_;
    my $both = [grep { exists $src1->{$_} } CORE::keys %{$src2}];
    my $both_h = {CORE::map { ($_ => undef) } @{$both}};
    my $only1 = [grep { !exists $both_h->{$_} } CORE::keys %{$src1}];
    my $only2 = [grep { !exists $both_h->{$_} } CORE::keys %{$src2}];
    return ($both, $only1, $only2);
}

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

sub _want_index {
    my ($self, $atnms) = @_;
    my $subheading = {CORE::map { ($_ => undef) } @{$atnms}};
    my $subheading_ident_str = $self->_heading_ident_str( $subheading );
    my $indexes = $self->_indexes();
    if (!exists $indexes->{$subheading_ident_str}) {
        my $index_and_meta = $indexes->{$subheading_ident_str}
            = [ $subheading, {} ];
        my $index = $index_and_meta->[1];
        my $body = $self->_body();
        for my $tuple_ident_str (CORE::keys %{$body}) {
            my $tuple = $body->{$tuple_ident_str};
            my $subtuple_ident_str = $self->_ident_str(
                {CORE::map { ($_ => $tuple->{$_}) } @{$atnms}} );
            my $matched_b = $index->{$subtuple_ident_str} ||= {};
            $matched_b->{$tuple_ident_str} = $tuple;
        }
    }
    return $indexes->{$subheading_ident_str}->[1];
}

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

sub join_with_group {
    my ($primary, $secondary, $group_attr) = @_;

    $secondary = $primary->_normalize_relation_arg(
        'join_with_group', '$secondary', $secondary );
    $primary->_assert_valid_atnm_arg(
        'join_with_group', '$group_attr', $group_attr );

    my $primary_h = $primary->_heading();

    confess q{join_with_group(): Bad $group_attr arg;}
            . q{ that name for a new attr to add}
            . q{ to $primary, consisting of grouped $secondary-only attrs,}
            . q{ duplicates an attr of $primary (not being grouped).}
        if exists $primary_h->{$group_attr};

    # TODO: inline+merge what join/group do for better performance.

    my ($both, $primary_only, $inner) = $primary->_ptn_conj_and_disj(
            $primary_h, $secondary->_heading() );
    my $inner_h = {CORE::map { $_ => undef } @{$inner}};

    return $primary
        ->_join( [$secondary] )
        ->_group( $group_attr, $inner, [CORE::keys %{$primary_h}],
            $inner_h );
}

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

sub rank {
    my ($topic, $name, $ord_func) = @_;

    my $topic_h = $topic->_heading();

    $topic->_assert_valid_atnm_arg( 'rank', '$name', $name );
    confess q{rank(): Bad $name arg; that name for a new attr to add}
            . q{ to the invocant, consisting of each tuple's numeric rank,}
            . q{ duplicates an existing attr of the invocant.}
        if exists $topic_h->{$name};

    $topic->_assert_valid_func_arg( 'rank', '$ord_func', $ord_func );

    my $result = $topic->_new();

    $result->_heading( {%{$topic_h}, $name => undef} );
    $result->_degree( $topic->degree() + 1 );

    if ($topic->is_empty()) {
        return $result;
    }

    my $ext_topic_tuples = [];
    my $topic_tuples_by_ext_tt_ref = {};

    for my $topic_t (values %{$topic->_body()}) {
        my $ext_topic_t = $topic->_export_nfmt_tuple( $topic_t );
        push @{$ext_topic_tuples}, $ext_topic_t;
        $topic_tuples_by_ext_tt_ref->{refaddr $ext_topic_t} = $topic_t;
    }

    my $sorted_ext_topic_tuples = [sort {
        local $_ = { 'a' => $a, 'b' => $b };
        $ord_func->();
    } @{$ext_topic_tuples}];

    my $result_b = $result->_body();

    my $rank = -1;
    for my $ext_topic_t (@{$sorted_ext_topic_tuples}) {
        my $topic_t = $topic_tuples_by_ext_tt_ref->{refaddr $ext_topic_t};
        $rank ++;
        my $rank_atvl = [$rank, $topic->_ident_str( $rank )];
        my $result_t = {$name => $rank_atvl, %{$topic_t}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result_b->{$result_t_ident_str} = $result_t;
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

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

sub rank_by_attr_names {
    my ($topic, $name, $order_by) = @_;

    my $topic_h = $topic->_heading();

    $topic->_assert_valid_atnm_arg( 'rank_by_attr_names', '$name', $name );
    confess q{rank_by_attr_names(): Bad $name arg; that name for a new}
            . q{ attr to add to the invocant, consisting of each tuple's}
            . q{ numeric rank, duplicates an existing attr of th invocant.}
        if exists $topic_h->{$name};

    $order_by = $topic->_normalize_order_by_arg(
        'rank_by_attr_names', '$order_by', $order_by );

    my $result = $topic->_new();

    $result->_heading( {%{$topic_h}, $name => undef} );
    $result->_degree( $topic->degree() + 1 );

    if ($topic->is_empty()) {
        return $result;
    }

    my $sort_func = $topic->_sort_func_from_order_by( $order_by );

    my $result_b = $result->_body();

    my $rank = -1;
    for my $topic_t (@{$sort_func->( $topic )}) {
        $rank ++;
        my $rank_atvl = [$rank, $topic->_ident_str( $rank )];
        my $result_t = {$name => $rank_atvl, %{$topic_t}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        $result_b->{$result_t_ident_str} = $result_t;
    }
    $result->_cardinality( $topic->cardinality() );

    return $result;
}

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

sub _normalize_order_by_arg {
    my ($topic, $rtn_nm, $arg_nm, $order_by) = @_;

    if (defined $order_by and !ref $order_by) {
        $order_by = [$order_by];
    }
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it must be an array-ref or a defined non-ref.}
        if ref $order_by ne 'ARRAY';

    $order_by = [CORE::map {
              (ref $_ ne 'ARRAY') ? [$_, 0, 'cmp']
            : (@{$_} == 1)        ? [@{$_}, 0, 'cmp']
            : (@{$_} == 2)        ? [@{$_}, 'cmp']
            :                       $_
        } @{$order_by}];
    confess qq{$rtn_nm(): Bad $arg_nm arg elem;}
            . q{ it must be a 1-3 elem array-ref or a defined non-ref,}
            . q{ its first elem must be a valid attr name (defin non-ref),}
            . q{ and its third elem must be undef or one of 'cmp'|'<=>'.}
        if notall {
                ref $_ eq 'ARRAY' and @{$_} == 3
                and defined $_->[0] and !ref $_->[0]
                and (!defined $_->[2]
                    or $_->[2] eq 'cmp' or $_->[2] eq '<=>')
            } @{$order_by};

    my $atnms = [CORE::map { $_->[0] } @{$order_by}];
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ it specifies a list of}
            . q{ attr names with at least one duplicated name.}
        if (uniqstr @{$atnms}) != @{$atnms};

    my $topic_h = $topic->_heading();
    confess qq{$rtn_nm(): Bad $arg_nm arg;}
            . q{ the list of attr names it specifies isn't a subset of the}
            . q{ heading of the relation defined by the $members arg.}
        if notall { exists $topic_h->{$_} } @{$atnms};

    return $order_by;
}

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

sub _sort_func_from_order_by {
    my ($topic, $order_by) = @_;
    my $sort_func_perl
    = "sub {\n"
        . "my (\$topic) = \@_;\n"
        . "return [sort {\n"
            . (CORE::join ' || ', '0', CORE::map {
                    my ($name, $is_reverse_order, $compare_op) = @{$_};
                    $compare_op ||= 'cmp';
                    ($is_reverse_order
                        ? "\$b->{'$name'} $compare_op \$a->{'$name'}"
                        : "\$a->{'$name'} $compare_op \$b->{'$name'}");
                } @{$order_by}) . "\n"
        . "} values \%{\$topic->_body()}];\n"
    . "}\n"
    ;
    my $sort_func = eval $sort_func_perl;
    if (my $err = $@) {
        confess qq{Oops, failed to compile Perl sort func from order by;\n}
            . qq{  error message is [[$err]];\n}
            . qq{  source code is [[$sort_func_perl]].}
    }
    return $sort_func;
}

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

sub limit {
    my ($topic, $ord_func, $min_rank, $max_rank) = @_;

    $topic->_assert_valid_func_arg( 'limit', '$ord_func', $ord_func );

    $topic->_assert_valid_nnint_arg( 'limit', '$min_rank', $min_rank );
    $topic->_assert_valid_nnint_arg( 'limit', '$max_rank', $max_rank );
    confess q{limit(): The $max_rank arg can't be less than the $min_rank.}
        if $max_rank < $min_rank;

    if ($topic->is_empty()) {
        return $topic;
    }

    my $topic_b = $topic->_body();

    my $ext_topic_tuples = [];
    my $topic_tuples_by_ext_tt_ref = {};

    for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
        my $topic_t = $topic_b->{$topic_t_ident_str};
        my $ext_topic_t = $topic->_export_nfmt_tuple( $topic_t );
        push @{$ext_topic_tuples}, $ext_topic_t;
        $topic_tuples_by_ext_tt_ref->{refaddr $ext_topic_t}
            = $topic_t_ident_str;
    }

    my $sorted_ext_topic_tuples = [sort {
        local $_ = { 'a' => $a, 'b' => $b };
        $ord_func->();
    } @{$ext_topic_tuples}];

    my $result = $topic->empty();

    my $result_b = $result->_body();

    for my $ext_topic_t
            (@{$sorted_ext_topic_tuples}[$min_rank..$max_rank]) {
        my $topic_t_ident_str
            = $topic_tuples_by_ext_tt_ref->{refaddr $ext_topic_t};
        $result_b->{$topic_t_ident_str} = $topic_b->{$topic_t_ident_str};
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub limit_by_attr_names {
    my ($topic, $order_by, $min_rank, $max_rank) = @_;

    $order_by = $topic->_normalize_order_by_arg(
        'limit_by_attr_names', '$order_by', $order_by );

    $topic->_assert_valid_nnint_arg(
        'limit_by_attr_names', '$min_rank', $min_rank );
    $topic->_assert_valid_nnint_arg(
        'limit_by_attr_names', '$max_rank', $max_rank );
    confess q{limit_by_attr_names():}
            . q{ The $max_rank arg can't be less than the $min_rank.}
        if $max_rank < $min_rank;

    if ($topic->is_empty()) {
        return $topic;
    }

    my $sort_func = $topic->_sort_func_from_order_by( $order_by );

    my $topic_b = $topic->_body();

    my $topic_tists_by_tt_ref = {};

    for my $topic_t_ident_str (CORE::keys %{$topic_b}) {
        my $topic_t = $topic_b->{$topic_t_ident_str};
        $topic_tists_by_tt_ref->{refaddr $topic_t} = $topic_t_ident_str;
    }

    my $result = $topic->empty();

    my $result_b = $result->_body();

    for my $topic_t (@{$sort_func->( $topic )}[$min_rank..$max_rank]) {
        my $topic_t_ident_str = $topic_tists_by_tt_ref->{refaddr $topic_t};
        $result_b->{$topic_t_ident_str} = $topic_t;
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub substitution {
    my ($topic, $attr_names, $func, $allow_dup_tuples) = @_;
    (my $subst_h, $attr_names)
        = $topic->_atnms_hr_from_assert_valid_subst_args(
        'substitution', '$attr_names', '$func', $attr_names, $func );
    return $topic->_substitution(
        'substitution', '$attr_names', '$func',
        $attr_names, $func, $subst_h );
}

sub _atnms_hr_from_assert_valid_subst_args {
    my ($topic, $rtn_nm, $arg_nm_atnms, $arg_nm_func, $atnms, $func) = @_;

    (my $subst_h, $atnms) = $topic->_atnms_hr_from_assert_valid_atnms_arg(
        $rtn_nm, $arg_nm_atnms, $atnms );
    my (undef, undef, $subst_only)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $subst_h );
    confess qq{$rtn_nm(): Bad $arg_nm_atnms arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if @{$subst_only} > 0;

    $topic->_assert_valid_func_arg( $rtn_nm, $arg_nm_func, $func );

    return ($subst_h, $atnms);
}

sub _substitution {
    my ($topic, $rtn_nm, $arg_nm_attrs, $arg_nm_func, $attrs, $func,
        $subst_h) = @_;

    if ($topic->is_empty()) {
        return $topic;
    }
    if (@{$attrs} == 0) {
        # Substitution in zero attrs of input yields the input.
        return $topic;
    }

    my $result = $topic->empty();

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $subst_t;
        {
            local $_ = $topic->_export_nfmt_tuple( $topic_t );
            $subst_t = $func->();
        }
        $topic->_assert_valid_tuple_result_of_func_arg(
            $rtn_nm, $arg_nm_func, $arg_nm_attrs, $subst_t, $subst_h );
        $subst_t = $topic->_import_nfmt_tuple( $subst_t );
        my $result_t = {%{$topic_t}, %{$subst_t}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        if (!exists $result_b->{$result_t_ident_str}) {
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub static_subst {
    my ($topic, $attrs) = @_;
    $topic->_assert_valid_static_subst_args(
        'static_subst', '$attrs', $attrs );
    return $topic->_static_subst( $attrs );
}

sub _assert_valid_static_subst_args {
    my ($topic, $rtn_nm, $arg_nm_attrs, $attrs) = @_;

    confess qq{$rtn_nm(): Bad $arg_nm_attrs arg; it isn't a hash-ref.}
        if ref $attrs ne 'HASH';

    my (undef, undef, $subst_only)
        = $topic->_ptn_conj_and_disj( $topic->_heading(), $attrs );
    confess qq{$rtn_nm(): Bad $arg_nm_attrs arg; that attr list}
            . q{ isn't a subset of the invocant's heading.}
        if @{$subst_only} > 0;

    confess qq{$rtn_nm(): Bad $arg_nm_attrs arg;}
            . q{ it is a hash-ref, and there exist circular refs}
            . q{ between itself or its tuple-valued components.}
        if $topic->_tuple_arg_has_circular_refs( $attrs );

    return;
}

sub _static_subst {
    my ($topic, $attrs) = @_;

    if ($topic->is_empty()) {
        return $topic;
    }
    if ((scalar CORE::keys %{$attrs}) == 0) {
        # Substitution in zero attrs of input yields the input.
        return $topic;
    }

    $attrs = $topic->_import_nfmt_tuple( $attrs );

    my $result = $topic->empty();

    my $result_b = $result->_body();

    for my $topic_t (values %{$topic->_body()}) {
        my $result_t = {%{$topic_t}, %{$attrs}};
        my $result_t_ident_str = $topic->_ident_str( $result_t );
        if (!exists $result_b->{$result_t_ident_str}) {
            $result_b->{$result_t_ident_str} = $result_t;
        }
    }
    $result->_cardinality( scalar CORE::keys %{$result_b} );

    return $result;
}

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

sub subst_in_restr {
    my ($topic, $restr_func, $subst_attr_names, $subst_func,
        $allow_dup_tuples) = @_;

    $topic->_assert_valid_func_arg(
        'subst_in_restr', '$restr_func', $restr_func );

    (my $subst_h, $subst_attr_names) = $topic
        ->_atnms_hr_from_assert_valid_subst_args( 'subst_in_restr',
            '$subst_attr_names', '$subst_func',
            $subst_attr_names, $subst_func );

    my ($topic_to_subst, $topic_no_subst)
        = @{$topic->_restr_and_cmpl( $restr_func )};

    return $topic_to_subst
        ->_substitution( 'subst_in_restr', '$subst_attr_names',
            '$subst_func', $subst_attr_names, $subst_func, $subst_h )
        ->_union( [$topic_no_subst] );
}

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

sub static_subst_in_restr {
    my ($topic, $restr_func, $subst, $allow_dup_tuples) = @_;

    $topic->_assert_valid_func_arg(
        'static_subst_in_restr', '$restr_func', $restr_func );

    $topic->_assert_valid_static_subst_args(
        'static_subst_in_restr', '$subst', $subst );

    my ($topic_to_subst, $topic_no_subst)
        = @{$topic->_restr_and_cmpl( $restr_func )};

    return $topic_to_subst
        ->_static_subst( $subst )
        ->_union( [$topic_no_subst] );
}

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

sub subst_in_semijoin {
    my ($topic, $restr, $subst_attr_names, $subst_func, $allow_dup_tuples)
        = @_;

    $restr = $topic->_normalize_relation_arg(
        'subst_in_semijoin', '$restr', $restr );

    (my $subst_h, $subst_attr_names) = $topic
        ->_atnms_hr_from_assert_valid_subst_args( 'subst_in_semijoin',
            '$subst_attr_names', '$subst_func',
            $subst_attr_names, $subst_func );

    my ($topic_to_subst, $topic_no_subst)
        = @{$topic->_semijoin_and_diff( $restr )};

    return $topic_to_subst
        ->_substitution( 'subst_in_semijoin', '$subst_attr_names',
            '$subst_func', $subst_attr_names, $subst_func, $subst_h )
        ->_union( [$topic_no_subst] );
}

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

sub static_subst_in_semijoin {
    my ($topic, $restr, $subst) = @_;

    $restr = $topic->_normalize_relation_arg(
        'static_subst_in_semijoin', '$restr', $restr );

    $topic->_assert_valid_static_subst_args(
        'static_subst_in_semijoin', '$subst', $subst );

    my ($topic_to_subst, $topic_no_subst)
        = @{$topic->_semijoin_and_diff( $restr )};

    return $topic_to_subst
        ->_static_subst( $subst )
        ->_union( [$topic_no_subst] );
}

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

sub outer_join_with_group {
    my ($primary, $secondary, $group_attr) = @_;

    $secondary = $primary->_normalize_relation_arg(
        'outer_join_with_group', '$secondary', $secondary );
    $primary->_assert_valid_atnm_arg(
        'outer_join_with_group', '$group_attr', $group_attr );

    my $primary_h = $primary->_heading();

    confess q{outer_join_with_group(): Bad $group_attr arg;}
            . q{ that name for a new attr to add}
            . q{ to $primary, consisting of grouped $secondary-only attrs,}
            . q{ duplicates an attr of $primary (not being grouped).}
        if exists $primary_h->{$group_attr};

    # TODO: inline+merge what join/group/etc do for better performance.

    my ($both, $primary_only, $inner) = $primary->_ptn_conj_and_disj(
            $primary_h, $secondary->_heading() );
    my $inner_h = {CORE::map { $_ => undef } @{$inner}};

    my ($pri_matched, $pri_nonmatched)
        = @{$primary->_semijoin_and_diff( $secondary )};

    my $result_matched = $pri_matched
        ->_join( [$secondary] )
        ->_group( $group_attr, $inner, [CORE::keys %{$primary_h}],
            $inner_h );

    my $result_nonmatched = $pri_nonmatched
        ->_static_exten( {$group_attr => $primary->_new( $inner )} );

    return $result_matched->_union( [$result_nonmatched] );
}

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

sub outer_join_with_undefs {
    my ($primary, $secondary) = @_;

    $secondary = $primary->_normalize_relation_arg(
        'outer_join_with_undefs', '$secondary', $secondary );

    my (undef, undef, $exten_attrs) = $primary->_ptn_conj_and_disj(
        $primary->_heading(), $secondary->_heading() );
    my $filler = {CORE::map { $_ => undef } @{$exten_attrs}};

    my ($pri_matched, $pri_nonmatched)
        = @{$primary->_semijoin_and_diff( $secondary )};

    my $result_matched = $pri_matched->_join( [$secondary] );

    my $result_nonmatched = $pri_nonmatched->_static_exten( $filler );

    return $result_matched->_union( [$result_nonmatched] );
}

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

sub outer_join_with_static_exten {
    my ($primary, $secondary, $filler) = @_;

    $secondary = $primary->_normalize_relation_arg(
        'outer_join_with_static_exten', '$secondary', $secondary );

    confess q{outer_join_with_static_exten(): Bad $filler arg;}
            . q{ it isn't a hash-ref.}
        if ref $filler ne 'HASH';
    confess q{outer_join_with_static_exten(): Bad $filler arg;}
            . q{ it is a hash-ref, and there exist circular refs}
            . q{ between itself or its tuple-valued components.}
        if $primary->_tuple_arg_has_circular_refs( $filler );

    my (undef, undef, $exten_attrs) = $primary->_ptn_conj_and_disj(
        $primary->_heading(), $secondary->_heading() );
    my $exten_h = {CORE::map { $_ => undef } @{$exten_attrs}};

    confess q{outer_join_with_static_exten(): Bad $filler arg elem;}
            . q{ it doesn't have exactly the}
            . q{ same set of attr names as the sub-heading of $secondary}
            . q{ that doesn't overlap with the heading of $primary.}
        if !$primary->_is_identical_hkeys( $exten_h, $filler );

    my ($pri_matched, $pri_nonmatched)
        = @{$primary->_semijoin_and_diff( $secondary )};

    my $result_matched = $pri_matched->_join( [$secondary] );

    my $result_nonmatched = $pri_nonmatched->_static_exten( $filler );

    return $result_matched->_union( [$result_nonmatched] );
}

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

sub outer_join_with_exten {
    my ($primary, $secondary, $exten_func, $allow_dup_tuples) = @_;

    $secondary = $primary->_normalize_relation_arg(
        'outer_join_with_exten', '$secondary', $secondary );
    $primary->_assert_valid_func_arg(
        'outer_join_with_exten', '$exten_func', $exten_func );

    my (undef, undef, $exten_attrs) = $primary->_ptn_conj_and_disj(
        $primary->_heading(), $secondary->_heading() );
    my $exten_h = {CORE::map { $_ => undef } @{$exten_attrs}};

    my ($pri_matched, $pri_nonmatched)
        = @{$primary->_semijoin_and_diff( $secondary )};

    my $result_matched = $pri_matched->_join( [$secondary] );

    # Note: if '_extension' dies due to what $exten_func did it would
    # state the error is reported by 'extension' and with some wrong
    # details; todo fix later; on correct it won't affect users though.
    my $result_nonmatched = $pri_nonmatched
        ->_extension( $exten_attrs, $exten_func, $exten_h );

    return $result_matched->_union( [$result_nonmatched] );
}

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

sub clone {
    my ($self) = @_;
    return $self->_new( $self );
}

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

sub freeze_identity {
    my ($self) = @_;
    $self->_has_frozen_identity( 1 );
    return;
}

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

sub evacuate {
    my ($topic) = @_;
    confess q{evacuate(): Can't mutate invocant having a frozen identity.}
        if $topic->_has_frozen_identity();
    $topic->_body( {} );
    $topic->_cardinality( 0 );
    return $topic;
}

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

sub insert {
    my ($r, $t) = @_;
    confess q{insert(): Can't mutate invocant that has a frozen identity.}
        if $r->_has_frozen_identity();
    $t = $r->_normalize_same_heading_tuples_arg( 'insert', '$t', $t );
    for my $tuple (@{$t}) {
        confess q{insert(): Bad $t arg; it contains the invocant}
                . q{ Set::Relation object as a tuple-valued component,}
                . q{ so the invocant would be frozen as a side-effect.}
            if $r->_self_is_component_of_tuple_arg( $tuple );
    }
    return $r->_insert( $t );
}

sub _insert {
    my ($r, $t) = @_;

    my $r_b = $r->_body();
    my $r_indexes = $r->_indexes();
    my $r_keys = $r->_keys();

    for my $tuple (@{$t}) {
        $tuple = $r->_import_nfmt_tuple( $tuple );
        my $tuple_ident_str = $r->_ident_str( $tuple );
        if (!exists $r_b->{$tuple_ident_str}) {
            $r_b->{$tuple_ident_str} = $tuple;

            for my $subheading_ident_str (CORE::keys %{$r_indexes}) {
                my ($subheading, $index)
                    = @{$r_indexes->{$subheading_ident_str}};
                my $subtuple_ident_str = $r->_ident_str(
                    {CORE::map { ($_ => $tuple->{$_}) }
                        CORE::keys %{$subheading}} );
                my $matched_b = $index->{$subtuple_ident_str} ||= {};
                $matched_b->{$tuple_ident_str} = $tuple;

                if (exists $r_keys->{$subheading_ident_str}) {
                    if ((CORE::keys %{$matched_b}) == 1) {
                        # A candidate key is still satisfied.
                        $r_keys->{$subheading_ident_str} = $subheading;
                    }
                    else {
                        # A candidate key is now violated.
                        CORE::delete $r_keys->{$subheading_ident_str};
                    }
                }

            }

        }
    }
    $r->_cardinality( scalar CORE::keys %{$r_b} );

    return $r;
}

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

sub delete {
    my ($r, $t) = @_;
    confess q{delete(): Can't mutate invocant that has a frozen identity.}
        if $r->_has_frozen_identity();
    $t = $r->_normalize_same_heading_tuples_arg( 'delete', '$t', $t );
    for my $tuple (@{$t}) {
        confess q{delete(): Bad $t arg; it contains the invocant}
                . q{ Set::Relation object as a tuple-valued component,}
                . q{ so the invocant would be frozen as a side-effect.}
            if $r->_self_is_component_of_tuple_arg( $tuple );
    }
    return $r->_delete( $t );
}

sub _delete {
    my ($r, $t) = @_;

    my $r_b = $r->_body();
    my $r_indexes = $r->_indexes();

    for my $tuple (@{$t}) {
        $tuple = $r->_import_nfmt_tuple( $tuple );
        my $tuple_ident_str = $r->_ident_str( $tuple );
        if (exists $r_b->{$tuple_ident_str}) {
            CORE::delete $r_b->{$tuple_ident_str};

            for my $subheading_ident_str (CORE::keys %{$r_indexes}) {
                my ($subheading, $index)
                    = @{$r_indexes->{$subheading_ident_str}};
                my $subtuple_ident_str = $r->_ident_str(
                    {CORE::map { ($_ => $tuple->{$_}) }
                        CORE::keys %{$subheading}} );
                my $matched_b = $index->{$subtuple_ident_str};
                CORE::delete $matched_b->{$tuple_ident_str};
                if ((scalar CORE::keys %{$matched_b}) == 0) {
                    CORE::delete $index->{$subtuple_ident_str};
                }
            }

        }
    }
    $r->_cardinality( scalar CORE::keys %{$r_b} );

    return $r;
}

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

} # class Set::Relation::V1

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

1;