Ternary logic: Difference between revisions

Content deleted Content added
Kburtch (talk | contribs)
No edit summary
SqrtNegInf (talk | contribs)
m →‎{{header|Perl}}: a single file of runnable code
Line 4,269:
 
=={{header|Perl}}==
#Logic values are: -1 = false ;, 0 = maybe ;, 1 = true
File <TT>Trit.pm</TT>:
<syntaxhighlight lang="perl">packageuse Tritstrict;
use warnings;
use feature 'say';
 
package Trit;
# -1 = false ; 0 = maybe ; 1 = true
 
our @ISA = qw(Exporter);
use Exporter 'import';
constour @EXPORT => [qw(TRUE FALSE MAYBE)],;
 
our @EXPORT_OK = qw(TRUE FALSE MAYBE is_true is_false is_maybe);
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
const => [qw(TRUE FALSE MAYBE)],
bool => [qw(is_true is_false is_maybe)],
);
 
use List::Util qw(min max);
Line 4,303 ⟶ 4,299:
;
 
sub new {
my ($class, $v) = @_;
{
my ($class, $v)ret = @_;
!defined($v) ? 0 :
my $ret =
!defined( $v) eq 'true' ? 01 :
$v eq 'truefalse' ? -1 :
$v eq 'falsemaybe'? -10 :
$v eq> 0 'maybe'? 01 :
$v >< 0 ? -1 :
$v < 0 ? -1 : 0;
return bless \$ret, $class;
0;
return bless \$ret, $class;
}
 
Line 4,321 ⟶ 4,316:
sub MAYBE() { new Trit( 0) }
 
sub clone {
my $ret = ${$_[0]};
{
my $ret = return bless \${ret, ref($_[0]});
return bless \$ret, ref($_[0]);
}
 
sub tostr { ${$_[0]} > 0 ? "'true"' : ${$_[0]} < 0 ? "'false"' : "'maybe"' }
sub tonum { ${$_[0]} }
 
sub is_true { ${$_[0]} > 0 }
sub is_false { ${$_[0]} < 0 }
sub is_maybe { ${$_[0]} == 0 }
 
sub cmp { ${$_[0]} <=> ${$_[1]} }
Line 4,339 ⟶ 4,329:
sub or { new Trit(max(${$_[0]}, ${$_[1]}) ) }
 
sub equiv { new Trit( ${$_[0]} * ${$_[1]} ) }</syntaxhighlight>
 
File <TT>test.pl</TT>:
package main;
<syntaxhighlight lang="perl">use Trit ':all';
Trit->import;
 
my @a = (TRUE(), MAYBE(), FALSE());
 
# prefix ! (not) ['~' also can be used]
printsay "\naa\tNOT a\n";
print "$_\t".(!$_)."\n" for @a; # Example of use of prefix operator NOT. Tilde ~ also can be used.
print "\nOR$_\t".join("\t",@a!$_)."\n" for @a;
 
# infix & (and)
printsay "\nAND\t" . join("\t",@a)."\n";
for my $a (@a) { print $a; print "\t" . ($a & $_) for @a; say '' }
 
# infix | (or)
print "\nAND\t".join("\t",@a)."\n";
printsay "\n==nOR\t".join("\t",@a)."\n";
for my $a (@a) {
for my $a (@a) { print $a; print "\t" . ($a | $_) for @a; say '' }
print $a;
for my $b (@a) {
print "\t".($a & $b); # Example of use of infix & (and)
}
print "\n";
}
 
# infix eq (equivalence)
print "\nOR\t".join("\t",@a)."\n";
printsay "\nEQV\t".join("\t",@a)."\n";
for my $a (@a) {
for my $a (@a) { print $a; print "\t" . ($a eq $_) for @a; say '' }
print $a;
for my $b (@a) {
print "\t".($a | $b); # Example of use of infix | (or)
}
print "\n";
}
 
print "\nEQV\t".join("\t",@a)."\n";
for my $a (@a) {
print $a;
for my $b (@a) {
print "\t".($a eq $b); # Example of use of infix eq (equivalence)
}
print "\n";
}
 
# infix == (equality)
print "\n==\t".join("\t",@a)."\n";
say "\n==\t".join("\t",@a);
for my $a (@a) {
for my $a (@a) { print $a; print "\t" . ($a == $_) for @a; say '' }</syntaxhighlight>
print $a;
for my $b (@a) {
print "\t".($a == $b); # Example of use of infix == (equality)
}
print "\n";
}</syntaxhighlight>
{{out}}
<pre>a NOT a