File Coverage

blib/lib/Math/Logic/Ternary/Word.pm

Criterion	Covered	Total	%
statement	532	572	93.0
branch	156	168	92.8
condition	20	27	74.0
subroutine	106	106	100.0
pod	57	57	100.0
total	871	930	93.6

# Copyright (c) 2012-2017 Martin Becker, Blaubeuren.  All rights reserved.
# This package is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

package Math::Logic::Ternary::Word;

use 5.008;
use strict;
use warnings;
use Carp qw(croak);
use Scalar::Util qw(blessed);
use Role::Basic qw(with);
use Math::BigInt;
use Math::Logic::Ternary::Trit;
with qw(Math::Logic::Ternary::Object);

# ----- static data -----

our $VERSION = '0.004';
our @CARP_NOT = qw(Math::Logic::Ternary);

use constant MAX_SIZE      => 19683;
use constant MAX_IV_SIZE   => 18;
use constant W_SIZE        => 0;
use constant W_TRITS       => 1;
use constant TRIT_PREFIX   => Math::Logic::Ternary::Trit::TRIT_PREFIX();
use constant BASE3_PREFIX  => '@';
use constant BASE27_PREFIX => '%';

my $zero = Math::Logic::Ternary::Trit->nil;
my $one  = Math::Logic::Ternary::Trit->true;
my $two  = Math::Logic::Ternary::Trit->false;
my @int_trits = ($zero, $one, $two);

my @base3_chars = qw(n t f);
my %base3_trits =
    map {
        my $ch = $base3_chars[$_->as_int_u];
        (lc $ch => $_, uc $ch => $_)
    } @int_trits;
my @base27_chars = qw(_ a b c d e f g h i j k l m N O P Q R S T U V W X Y Z);
my %base27_words =
    map {
        my $ch = $base27_chars[$_];
        my $w  = Math::Logic::Ternary::Word->from_int(3, $_);
        (lc $ch => $w, uc $ch => $w)
    } -13..13;
my @comparison_relations = (
    [gt => 'eqt'],
    [lt => 'eqf'],
    [ge => 'nef'],
    [le => 'net'],
);
my @suffixes  = ('',  'u',  'v');
my @_suffixes = ('', '_u', '_v');

my @word_operators = (
    ['Neg',    'W',  'W',  0],
    ['Negv',   'Wt', 'WT', 2],
    ['Lshift', 'Wt', 'WT'],
    ['Rshift', 'Wt', 'WT'],
    (
        map {
            my ($i, $sfx) = ($_, $suffixes[$_]);
            ["Sign$sfx",  'W',   'T',   $i],
            ["Incr$sfx",  'Wt',  'WT',  $i],
            ["Decr$sfx",  'Wt',  'WT',  $i],
            ["Dpl$sfx",   'Wt',  'WT',  $i],
            (
                map {
                    ["$_$sfx", 'WWt', 'T', $i]
                } qw(Cmp Asc Gt Lt Ge Le)
            ),
            ["Sort2$sfx", 'WW',  'WW',   $i],
            ["Tlr$sfx",   'WW',  'W',    $i],
            ["Tgr$sfx",   'WW',  'W',    $i],
            ["Add$sfx",   'WWt', 'WT',   $i],
            ["Subt$sfx",  'WWt', 'WT',   $i],
            ["Sort3$sfx", 'WWW', 'WWW',  $i],
            ["Min$sfx",   'WWW', 'W',    $i],
            ["Med$sfx",   'WWW', 'W',    $i],
            ["Max$sfx",   'WWW', 'W',    $i],
            ["Mul$sfx",   'WWw', 'WW' . ('v' eq $sfx && 'T'), $i],
            ["Div$sfx",   'WW',  'WWT',  $i],
            ["Ldiv$sfx",  'WWW', 'WWWT', $i],
        } 0 .. $#suffixes
    ),
    (
        map {
            my ($i, $sfx) = ($_, $suffixes[$_]);
#           ["Hlv$sfx",   'Wt',   'WT',  $i],
#           ["Amn$sfx",   'WWt',  'WT',  $i],
            ["Sum$sfx",   'WWWt', 'WT',  $i],
        } 0, 1
    ),
    ['Mpx',  'WWWW', 'W' ],
);
my @word_formatters = (
    ['as_string'],
    ['as_base27'],
    (
        map {
            my ($i, $_sfx) = ($_, $_suffixes[$_]);
            ["as_int$_sfx",    $i],
            ["as_modint$_sfx", $i],
        } 0 .. $#_suffixes
    ),
);

my $modint_loaded = 0;

# ----- other initializations -----

_load_generated_methods();

# ----- private subroutines -----

sub _declare {
    my ($name, $ref) = @_;
    my $fqname = __PACKAGE__ . '::' . $name;
    no strict 'refs';
    *{$fqname} = $ref;
}

sub _parse_int {
    my ($class, $size, $int, $tval, $base) = @_;
    croak 'missing size information'  if !$size;
    croak 'integer argument expected' if $int !~ /^[-+]?\d+\z/;
    if ($size > MAX_IV_SIZE && !ref $int) {
        $int = Math::BigInt->new($int);
    }
    my @trits = ();
    while ($int) {
        croak "number too large for word size $size" if $size <= @trits;
        my $trit = $int_trits[$int % 3];
        $int = ($int - $trit->$tval) / $base;
        push @trits, $trit;
    }
    return $class->from_trits($size, @trits);
}

sub _parse_base {
    my ($class, $size, $string, $base, $thash) = @_;
    my @words =
        map {
            exists($thash->{$_}) ? $thash->{$_} :
            q[ ] eq $_           ? ()           :
            croak qq{illegal base$base character "$_"}
        }
        split //, reverse $string;
    return $class->from_words($size, @words);
}

sub _as_int {
    my ($this, $tval, $base) = @_;
    my ($size, $trits) = @{$this}[W_SIZE, W_TRITS];
    my $int = $size <= MAX_IV_SIZE? 0: Math::BigInt->new(0);
    foreach my $trit (reverse @{$trits}) {
        $int = $int * $base + $trit->$tval;
    }
    return $int;
}

sub _modulus {
    my ($size) = @_;
    my $modulus = ($size <= MAX_IV_SIZE? 3: Math::BigInt->new(3)) ** $size;
    return $modulus;
}

sub _max_int_v {
    my ($size) = @_;
    my $max_int_v =  $size <= MAX_IV_SIZE? 0: Math::BigInt->new(0);
    for (my $exp = 0; $exp < $size; $exp += 2) {
        $max_int_v = $max_int_v * 9 + 2;
    }
    return $max_int_v;
}

sub _as_modint {
    my ($this, $residue) = @_;
    my $size = $this->Trits;
    if (!$modint_loaded) {
        require Math::ModInt;
        $modint_loaded = 1;
    }
    return Math::ModInt->new($residue, _modulus($size));
}

sub _check_modint_modulus {
    my ($size, $modint) = @_;
    my $given_mod = $modint->modulus;
    if ($size) {
        my ($wanted_mod) = _modulus($size);
        if ($given_mod != $wanted_mod) {
            croak qq{wrong modulus for this size, expected $wanted_mod};
        }
    }
    else {
        my $power = $given_mod;
        $size = 0;
        while (1) {
            croak qq{modulus is not a power of 3} if 0 != $power % 3;
            $power /= 3;
            ++$size;
            last if $power <= 1;
        }
    }
    return $size;
}

# ascending trits iterator factory
sub _trits_asc {
    my ($this) = @_;
    my $i = 0;
    return sub { $this->Trit($i++) };
}

# descending trits iterator factory, takes number of trits
sub _trits_desc {
    my ($this, $i) = @_;
    return sub { $this->Trit(--$i) };
}

# logical operator factory, takes number of operands and a name
sub _logical {
    my ($argc, $op) = @_;
    return sub {
        my $this = shift;
        my @args = map { $_->Sign } @_;
        return $this->Sign->$op(@args);
    };
}

# tritwise operator factory, takes number of operands and a name
sub _tritwise {
    my ($argc, $op) = @_;
    return sub {
        my $this = shift;
        my @args = map { _trits_asc($_) } @_;
        my @trits = map { $_->$op(map { $_->() } @args) } $this->Trits;
        return $this->convert_trits(@trits);
    };
}

# lower to higher significance cascading numerical operator factory
# takes argument count and names of principal and carry operator
# and optional default carry trit
# resulting op takes given number of numerical arguments and optional
# carry trit, by default 0, and returns numerical result and carry trit
sub _cascading {
    my ($arity, $op, $cop, $default_carry) = (@_, $zero);
    return sub {
        croak "missing arguments" if @_ < $arity;
        croak "array context expected" if !wantarray;
        my $this    = shift;
        my @those   = map { (shift)->_trits_asc } 2..$arity;
        my ($carry) = (@_, $default_carry);
        my @trits   = $this->Trits;
        foreach my $trit (@trits) {
            my @args = map { $_->() } @those;
            ($trit, $carry) =
                ($trit->$op(@args, $carry), $trit->$cop(@args, $carry));
        }
        return ($this->convert_trits(@trits), $carry);
    };
}

# # higher to lower significance extended cascading operator factory
# # takes names of three logical operators (result trit, carry trit, second
# # carry trit) and numeric addition operator
# # resulting op takes given number of numerical arguments and optional
# # carry trits and returns numerical result and carry trits
# sub _ext_casc {
#     my ($arity, $op, $cop, $sop, $Aop) = @_;
#     return sub {
#         croak "missing arguments" if @_ < $arity;
#         croak "array context expected" if !wantarray;
#         my $this    = shift;
#         my $wsiz    = $this->Trits;
#         my @those   = map { (shift)->_trits_dsc($wsiz) } 2..$arity;
#         my ($carry, $sec_carry) = (@_, $zero, $zero);
#         my @trits   = $this->Trits;
#         my @secs    = ();
#         croak 'NYI';
#     };
# }

# higher to lower significance cascading comparison operator factory
# takes name of logical comparison operator and optional name of
# result modifier function
# resulting op takes two numerical arguments and optional carry trit
# and returns result trit
sub _lexical {
    my ($cmp, $map) = @_;
    return sub {
        my ($this, $that, $carry) = @_;
        croak 'missing arguments' if @_ < 2;
        $carry = (2 == @_)? $zero: $carry->Sign;
        my $i  = $this->Trits;
        my $i1 = $this->_trits_desc($i);
        my $i2 = $that->_trits_desc($i);
        while ($carry->is_nil && $i--) {
            $carry = $i1->()->$cmp($i2->());
        }
        return $map? $carry->$map: $carry;
    };
}

# base-3 comparison operator factory
# takes optional name of result modifier function
# resulting op takes two numerical arguments and optional carry trit
# and returns result trit
sub _cmpv {
    my ($map) = @_;
    my @op  = ('cmpu', 'ascu');
    return sub {
        my ($this, $that, $carry) = @_;
        croak 'missing arguments' if @_ < 2;
        $carry = (2 == @_)? $zero: $carry->Sign;
        my $i  = $this->Trits;
        my $i1 = $this->_trits_desc($i);
        my $i2 = $that->_trits_desc($i);
        while ($carry->is_nil && $i--) {
            my $cmp = $op[$i & 1];
            $carry = $i1->()->$cmp($i2->());
        }
        return $map? $carry->$map: $carry;
    }
}

# binary sorting factory
# takes numerical comparison name and one or more rank numbers
# resulting op takes two numerical arguments
# and returns the selected item or items from those
sub _sort2 {
    my ($cmp, @sel) = @_;
    return sub {
        croak 'missing arguments' if @_ < 2;
        croak 'array context expected' if !wantarray;
        my ($this, $that) = @_;
        my $rel = $this->$cmp($that);
        my @items = $rel->is_true? ($that, $this): ($this, $that);
        return @items[@sel];
    };
}

# ternary sorting factory
# takes numerical comparison name and one or more rank numbers
# resulting op takes three numerical arguments
# and returns the selected item or items from those
sub _sort3 {
    my $cmp = shift;
    my @sel = qw(cmin cmed cmax)[@_];
    return sub {
        croak 'missing arguments' if @_ < 3;
        croak 'array context expected' if 1 < @sel && !wantarray;
        my $r01 = $_[0]->$cmp($_[1]);
        my $r02 = $_[0]->$cmp($_[2]);
        my $r12 = $_[1]->$cmp($_[2]);
        return map { $r01->$_($r02, $r12)->Mpx(@_) } @sel;
    };
}

sub _w2i2w {
    my ($sfx) = @_;
    if ('' ne $sfx) {
        $sfx = "_$sfx";
    }
    return ("as_int$sfx", "convert_int$sfx");
}

# create an object like left side holding least significant trits of right side
sub _truncate {
    my ($this, $that) = @_;
    my $size  = $this->Trits;
    my @trits = $that->Rtrits;
    if ($size < @trits) {
        splice @trits, $size;
        while (@trits && $trits[-1]->is_nil) {
            pop @trits;
        }
    }
    return bless [$size, \@trits], ref $this;
}

# COMING_UP (emulated with binary arithmetic for now)
sub _divmod {
    my ($sfx) = @_;
    my $ldiv = "Ldiv$sfx";
    return sub {
        croak 'missing arguments' if @_ < 2;
        croak 'array context expected' if !wantarray;
        my ($this, $that) = @_;
        my ($lsw, $msw, $rem, $err) = $this->$ldiv($zero, $that);
        if ($err->is_nil && $msw->Rtrits) {
            $err = $two;
        }
        return ($lsw, $rem, $err);
    };
}

# COMING_UP (emulated with binary arithmetic for now)
sub _long_divmod {
    my ($sfx) = @_;
    my ($as_int, $convert) = _w2i2w($sfx);
    return sub {
        croak 'missing arguments' if @_ < 3;
        croak 'array context expected' if !wantarray;
        my ($this, $over, $that) = @_;
        my $size = $this->Trits;
        $over = $this->_truncate($over);
        $that = $this->_truncate($that);
        my $acc = Math::Logic::Ternary::Word->from_words(
            $size * 2 + 1, $this, $over
        );
        my $num = $acc->$as_int;
        my $den = $that->$as_int;
        return ($this, $over, $that, $one) if 0 == $den;
        my $rem;
        if ($den < 0) {
            $rem = $num % -$den;
            if ($rem) {
                $rem += $den;
            }
        }
        else {
            $rem = $num % $den;
        }
        my $quot = ($num - $rem) / $den;
        my ($lsw, $msw, $xsw) = $acc->$convert($quot)->Words($size);
        return ($lsw, $msw, $this->$convert($rem), $xsw->Rtrits? $two: $zero);
    };
}

sub _load_generated_methods {
    my @ops = Math::Logic::Ternary::Trit->trit_operators;
    foreach my $opr (@ops) {
        my ($name, $argc) = @{$opr};
        _declare($name, _tritwise($argc, $name));
        _declare(uc($name), _logical($argc, $name));
    }
    *Neg = \¬
    *Negv = _cascading(1, 'dpl', 'negcv');
    foreach my $sfx ('', 'u') {
        my $asc = "asc$sfx";
        my $cmp = "cmp$sfx";
        _declare(ucfirst($asc), _lexical($asc));
        _declare(ucfirst($cmp), _lexical($cmp));
        foreach my $cr (@comparison_relations) {
            my ($rel, $map) = @{$cr};
            _declare(ucfirst("$rel$sfx"), _lexical($cmp, $map));
        }
    }
    *Cmpv = _cmpv();
    *Ascv = _cmpv('not');
    foreach my $cr (@comparison_relations) {
        my ($rel, $map) = @{$cr};
        _declare(ucfirst($rel . 'v'), _cmpv($map));
    }
    foreach my $sfx ('', 'u', 'v') {
        my $Cmp = "Cmp$sfx";
        _declare("Sort2$sfx", _sort2($Cmp, 0..1));
        _declare(  "Tlr$sfx", _sort2($Cmp, 0));
        _declare(  "Tgr$sfx", _sort2($Cmp, 1));
        _declare("Sort3$sfx", _sort3($Cmp, 0..2));
        _declare(  "Min$sfx", _sort3($Cmp, 0));
        _declare(  "Med$sfx", _sort3($Cmp, 1));
        _declare(  "Max$sfx", _sort3($Cmp, 2));
        _declare( "Incr$sfx", _cascading(1, 'incr', "incc$sfx", $one));
        _declare( "Decr$sfx", _cascading(1, 'decr', "decc$sfx", $one));
        _declare(  "Dpl$sfx", _cascading(1, 'dpl',  "dplc$sfx"));
        _declare(  "Add$sfx", _cascading(2, 'add',  "addc$sfx"));
        _declare( "Subt$sfx", _cascading(2, 'subt', "subc$sfx"));
        _declare(  "Div$sfx", _divmod($sfx));
        _declare( "Ldiv$sfx", _long_divmod($sfx));
        next if 'v' eq $sfx;            # ops below are not not for base(-3)
#       _declare(  "Hlv$sfx",
#           _ext_casc(1, 'hlv', "hlvc$sfx", "hlvs$sfx", "Add$sfx"));
#       _declare(  "Amn$sfx",
#           _ext_casc(2, 'amn', "amnc$sfx", "amns$sfx", "Add$sfx"));
        _declare(  "Sum$sfx", _cascading(3, 'sum',  "sumc$sfx"));
    }
    return;
}

# ----- class methods -----

sub from_trits {
    my ($class, $size, @trits) = @_;
    if (!$size) {
        croak 'missing arguments' if !@trits;
        $size = @trits;
    }
    croak 'illegal size, use 1..' . MAX_SIZE if $size < 1 || MAX_SIZE < $size;
    while (@trits && $trits[-1]->is_nil) {
        pop @trits;
    }
    croak "too many trits for word size $size" if $size < @trits;
    return bless [$size, \@trits], $class;
}

sub from_words {
    my ($class, $size, @words) = @_;
    return $class->from_trits($size, map { $_->Trits } @words);
}

sub from_bools {
    my ($class, $size, @bools) = @_;
    my @trits = map { Math::Logic::Ternary::Trit->from_bool($_) } @bools;
    return $class->from_trits($size, @trits);
}

sub from_int {
    my ($class, $size, $int) = @_;
    return $class->_parse_int($size, $int, 'as_int', 3);
}

sub from_int_u {
    my ($class, $size, $int) = @_;
    croak 'negative number has no unbalanced representation' if $int < 0;
    return $class->_parse_int($size, $int, 'as_int_u', 3);
}

sub from_int_v {
    my ($class, $size, $int) = @_;
    return $class->_parse_int($size, $int, 'as_int_u', -3);
}

sub from_base27 {
    my ($class, $size, $string) = @_;
    if (BASE27_PREFIX eq substr $string, 0, 1) {
        $string = substr $string, 1;
    }
    return $class->_parse_base($size, $string, 27, \%base27_words);
}

sub from_string {
    my ($class, $size, $string) = @_;
    my $prefix = substr $string, 0, 1;
    if (BASE3_PREFIX eq $prefix) {
        $string = substr $string, 1;
        return $class->_parse_base($size, $string, 3, \%base3_trits);
    }
    if (BASE27_PREFIX eq $prefix) {
        $string = substr $string, 1;
        return $class->_parse_base($size, $string, 27, \%base27_words);
    }
    if (TRIT_PREFIX eq $prefix) {
        my $trit = Math::Logic::Ternary::Trit->from_string($string);
        return $size? $class->from_trits($size, $trit): $trit;
    }
    return $class->_parse_base($size, $string, 3, \%base3_trits);
}

sub from_modint {
    my ($class, $size, $modint) = @_;
    $size = _check_modint_modulus($size, $modint);
    return $class->from_int($size, $modint->signed_residue);
}

sub from_modint_u {
    my ($class, $size, $modint) = @_;
    $size = _check_modint_modulus($size, $modint);
    return $class->from_int_u($size, $modint->residue);
}

sub from_modint_v {
    my ($class, $size, $modint) = @_;
    $size = _check_modint_modulus($size, $modint);
    my $modulus   = _modulus($size);
    my $max_int_v = _max_int_v($size);
    my $residue   = $modint->residue;
    my $is_neg    = $max_int_v < $residue;
    $residue -= $modulus if $is_neg;
    return $class->from_int_v($size, $residue);
}

sub from_various {
    my ($class, $size, @args) = @_;
    return $class->from_trits($size) if !@args;
    my $arg  = $args[0];
    my $type = blessed $arg;
    if ($type) {
        return $class->from_words($size, @args)
            if eval { $type->DOES('Math::Logic::Ternary::Object') };
        croak qq{cannot convert multiple "$type" objects into ternary word}
            if 1 < @args;
        return $class->from_int($size, $arg)
            if eval { $type->isa('Math::BigInt') };
        return $class->from_modint($size, $arg)
            if eval { $type->isa('Math::ModInt') };
        croak qq{cannot convert "$type" object into ternary word};
    }
    $type = ref $arg;
    croak qq{cannot convert $type reference into ternary word} if $type;
    return $class->from_bools($size, @args) if 1 < @args;
    my $prefix = substr $arg, 0, 1;
    return $class->from_int($size, $arg) if $prefix =~ /^[\+\-\d]/;
    return $class->from_string($size, $arg);
}

sub word_operators {
    return map {
        my ($name, $sig, $rsig, @more) = @{$_};
        my $min_args = $sig  =~ tr/A-Z//;
        my $var_args = $sig  =~ tr/a-z//;
        my $ret_vals = $rsig =~ tr/A-Z//;
        [$name, $min_args, $var_args, $ret_vals, @more]
    } @word_operators;
}

sub word_formatters { map { [@{$_}] } @word_formatters }

# ----- object methods -----

sub convert_trits {
    my $this = shift;
    my $size = $this->Trits;
    return ref($this)->from_trits($size, @_);
}

sub convert_words {
    my $this = shift;
    my $size = $this->Trits;
    return ref($this)->from_words($size, @_);
}

sub convert_bools {
    my $this = shift;
    my $size = $this->Trits;
    return ref($this)->from_bools($size, @_);
}

sub convert_int {
    my ($this, $int) = @_;
    my $size = $this->Trits;
    return ref($this)->from_int($size, $int);
}

sub convert_int_u {
    my ($this, $int) = @_;
    my $size = $this->Trits;
    return ref($this)->from_int_u($size, $int);
}

sub convert_int_v {
    my ($this, $int) = @_;
    my $size = $this->Trits;
    return ref($this)->from_int_v($size, $int);
}

sub convert_modint {
    my ($this, $modint) = @_;
    my $size = $this->Trits;
    return ref($this)->from_modint($size, $modint);
}

sub convert_modint_u {
    my ($this, $modint) = @_;
    my $size = $this->Trits;
    return ref($this)->from_modint_u($size, $modint);
}

sub convert_modint_v {
    my ($this, $modint) = @_;
    my $size = $this->Trits;
    return ref($this)->from_modint_v($size, $modint);
}

sub convert_base27 {
    my ($this, $string) = @_;
    my $size = $this->Trits;
    return ref($this)->from_base27($size, $string);
}

sub convert_string {
    my ($this, $string) = @_;
    my $size = $this->Trits;
    return ref($this)->from_string($size, $string);
}

sub convert_various {
    my $this = shift;
    my $size = $this->Trits;
    return ref($this)->from_various($size, @_);
}

sub is_equal {
    my ($this, $that) = @_;
    my $rtrits = $this->[W_TRITS];
    return q[] if @{$rtrits} != $that->Rtrits;
    my $pos = @{$rtrits};
    while (--$pos >= 0) {
        return q[] if $rtrits->[$pos]->as_int != $that->Trit($pos)->as_int;
    }
    return 1;
}

sub Rtrits {
    my ($this) = @_;
    my $rtrits = $this->[W_TRITS];
    return @{$rtrits};
}

sub Sign {
    my ($this) = @_;
    my $rtrits = $this->[W_TRITS];
    return @{$rtrits}? $rtrits->[-1]: $zero;
}

sub Signu {
    my ($this) = @_;
    my $rtrits = $this->[W_TRITS];
    return @{$rtrits}? $one: $zero;
}

sub Signv {
    my ($this) = @_;
    my $rtrits = $this->[W_TRITS];
    return @{$rtrits} & 1? $one: @{$rtrits}? $two: $zero;
}

sub Trit {
    my ($this, $pos) = @_;
    my ($size, $trits) = @{$this}[W_SIZE, W_TRITS];
    if ($pos < 0) {
        $pos += $size;
        return $zero if $pos < 0;
    }
    return $pos < @{$trits}? $trits->[$pos]: $zero;
}

sub Trits {
    my ($this) = @_;
    my ($size, $trits) = @{$this}[W_SIZE, W_TRITS];
    return $size if !wantarray;
    return (@{$trits}, ($zero) x ($size - @{$trits}));
}

sub Words {
    my ($this, $size) = @_;
    my $class = ref $this;
    my @trits = $this->Trits;
    my @words = ();
    while (@trits) {
        push @words, $class->from_trits($size, splice @trits, 0, $size);
    }
    return @words;
}

sub as_int   { $_[0]->_as_int('as_int',    3) }
sub as_int_u { $_[0]->_as_int('as_int_u',  3) }
sub as_int_v { $_[0]->_as_int('as_int_u', -3) }
sub res_mod3 { $_[0]->Trit(0)->res_mod3       }

sub as_modint   { $_[0]->_as_modint($_[0]->as_int  ) }
sub as_modint_u { $_[0]->_as_modint($_[0]->as_int_u) }
sub as_modint_v { $_[0]->_as_modint($_[0]->as_int_v) }

sub as_base27 {
    my ($this) = @_;
    my @ints = map { $_->as_int } $this->Words(3);
    return scalar reverse @base27_chars[@ints], BASE27_PREFIX;
}

sub as_string {
    my ($this) = @_;
    my @ints = map { $_->as_int_u } $this->Trits;
    return scalar reverse @base3_chars[@ints], BASE3_PREFIX;
}

sub Mul {
    croak 'missing arguments' if @_ < 2;
    croak 'array context expected' if !wantarray;
    my ($this, $that, $over) = (@_, $zero);
    $that = $this->_truncate($that);
    $over = $this->_truncate($over);
    my $size = $this->Trits;
    my @trits = $over->Rtrits;
    my $i = 0;
    foreach my $a ($this->Rtrits) {
        my $j = $i;
        my $c = $zero;
        foreach my $b ($that->Rtrits) {
            my $p = $a->eqv($b);
            if ($j < @trits) {
                my $t      = $trits[$j];
                $trits[$j] = $p->add( $c, $t);
                $c         = $p->addc($c, $t);
            }
            else {
                $trits[$j] = $p->incr($c);
                $c         = $p->incc($c);
            }
            ++$j;
        }
        while (!$c->is_nil) {
            if ($j < @trits) {
                my $t      = $trits[$j];
                $trits[$j] = $t->incr($c);
                $c         = $t->incc($c);
            }
            else {
                $trits[$j] = $c;
                $c         = $zero;
            }
            ++$j;
        }
        ++$i;
    }
    my @lst = splice @trits, 0, $size;
    return ($this->convert_trits(@lst), $this->convert_trits(@trits));
}

sub Mulu {
    croak 'missing arguments' if @_ < 2;
    croak 'array context expected' if !wantarray;
    my ($this, $that, $over) = (@_, $zero);
    $that = $this->_truncate($that);
    $over = $this->_truncate($over);
    my $size = $this->Trits;
    my @trits = $over->Rtrits;
    my $i = 0;
    foreach my $a ($this->Rtrits) {
        my $j = $i;
        my $c = $zero;
        foreach my $b ($that->Rtrits) {
            my $p  = $a->eqv($b);
            my $pc = $a->mulcu($b);
            if ($j < @trits) {
                my $t      = $trits[$j];
                $trits[$j] = $p->add(  $c, $t);
                $c         = $p->addcu($c, $t)->incr($pc);
            }
            else {
                $trits[$j] = $p->incr( $c);
                $c         = $p->inccu($c)->incr($pc);
            }
            ++$j;
        }
        while (!$c->is_nil) {
            if ($j < @trits) {
                my $t      = $trits[$j];
                $trits[$j] = $t->incr( $c);
                $c         = $t->inccu($c);
            }
            else {
                $trits[$j] = $c;
                $c         = $zero;
            }
            ++$j;
        }
        ++$i;
    }
    my @lst = splice @trits, 0, $size;
    return ($this->convert_trits(@lst), $this->convert_trits(@trits));
}

sub Mulv {
    croak 'missing arguments' if @_ < 2;
    croak 'array context expected' if !wantarray;
    my ($this, $that, $over) = (@_, $zero);
    $that = $this->_truncate($that);
    $over = $this->_truncate($over);
    my $size = $this->Trits;
    my @trits = $over->Rtrits;
    my $i = 0;
    foreach my $a ($this->Rtrits) {
        my $j = $i;
        foreach my $b ($that->Rtrits) {
            my $p  = $a->eqv($b);
            my $pc = $a->mulcu($b)->not;
            my $t  = $j < @trits? $trits[$j]: $zero;
            $trits[$j] = $t->incr($p);
            my $c  = $t->inccu($p)->not;
            my $k  = $j;
            while (!$c->is_nil || !$pc->is_nil) {
                $t         = ++$k < @trits? $trits[$k]: $zero;
                $trits[$k] = $t->add($pc, $c);
                $c         = $t->addcx($pc, $c);
                $pc        = $zero;
            }
            ++$j;
        }
        ++$i;
    }
    my @lst = splice @trits, 0, $size;
    my @mst = splice @trits, 0, $size;
    my ($tt) = (@trits, $zero);
    return ($this->convert_trits(@lst), $this->convert_trits(@mst), $tt);
}

sub Mpx { (shift)->Sign->Mpx(@_) }

# generic logical operator
sub GENERIC {
    my ($this, $op, @args) = @_;
    return $this->Sign->generic($op, map { $_->Sign } @args);
}

# generic tritwise operator
sub generic {
    my ($this, $op, @argws) = @_;
    my $trit_op = Math::Logic::Ternary::Trit->make_generic($op);
    my @args    = map { _trits_asc($_) } @argws;
    my @trits   = map { $trit_op->($_, map { $_->() } @args) } $this->Trits;
    return $this->convert_trits(@trits);
}

sub Lshift {
    croak 'array context expected' if !wantarray;
    my ($this, $carry) = (@_, $zero);
    my @trits = ($carry, $this->Trits);
    $carry = pop @trits;
    return ($this->convert_trits(@trits), $carry);
}

sub Rshift {
    croak 'array context expected' if !wantarray;
    my $this = shift;
    my ($carry, @trits) = @_? ($this->Trits, shift): ($this->Rtrits, $zero);
    return ($this->convert_trits(@trits), $carry);
}

sub min_int   { $_[0]->sf }
sub max_int   { $_[0]->st }
sub min_int_u { $_[0]->sn }
sub max_int_u { $_[0]->sf }

sub min_int_v {
    my ($this) = @_;
    my @trits = map { ($zero, $two)[$_ & 1] } 0 .. $this->Trits - 1;
    return $this->convert_trits(@trits);
}

sub max_int_v {
    my ($this) = @_;
    my @trits = map { ($two, $zero)[$_ & 1] } 0 .. $this->Trits - 1;
    return $this->convert_trits(@trits);
}

1;
__END__