Rosetta Code

Ternary logic: Difference between revisions

Page Discussion

Ternary logic (view source)

Revision as of 17:05, 22 March 2023

666 bytes added ,  1 year ago
→‎{{header|Perl}}: Use modern Perl, avoid hard-coded values, be more careful in testing logic.
(→‎{{header|Perl}}: Use modern Perl, avoid hard-coded values, be more careful in testing logic.)
Line 4,479:
 
=={{header|Perl}}==
<syntaxhighlight lang="perl">use strictv5.36;▼
Logic values are: -1 = false, 0 = maybe, 1 = true
▲<syntaxhighlight lang="perl">use strict;
use warnings;
use feature 'say';
 
package Trit;
use List::Util qw(min max);▼
 
our @ISA = qw(Exporter);
our @EXPORT = qw(TRUE FALSE MAYBE%E);
 
my %E = (true => 1, false => -1, maybe => 0);
▲use List::Util qw(min max);
 
use overload
'<=>' => sub ($a,$b) { $_[0]a->clonecmp($b) },
'<=>cmp' => sub ($a,$b) { $_[0]a->cmp($_[1]b) },
'cmp==' => sub ($a,$b,$) { $_[0]->cmp($_[1])a == $$b },
'==eq' => sub { (${a,$_[0]}b,$) == ${ $a->equiv($_[1]}b) },
'eq>' => sub ($a,$b,$) { $_[0]-$a >equiv( $_[1])E{$b} },
'><' => sub ($a,$b,$) { ${$_[0]}a < > $E{$_[1]b} },
'<>=' => sub ($a,$b,$) { ${$_[0]}a <>= ${$_[1]}b },
'><=' => sub ($a,$b,$) { ${$_[0]}a ><= ${$_[1]}b },
'<=|' => sub { (${a,$_[0]}b,$,$,$) <={ ${a->or($_[1]}b) },
'|&' => sub ($a,$b,$,$,$) { $_[0]a->orand($_[1]b) },
'&!' => sub ($a,$,$) { $_[0]a->andnot($_[1]) },
'!~' => sub ($a,$,$,$,$) { $_[0]a->not() },
'~neg' => sub ($a,$,$) { $_[0]->not()$$a },
'""' => sub ($a,$,$) { $_[0]a->tostr() },
'0+' => sub ($a,$,$) { $_[0]a->tonum() },
;
 
sub neweqv ($a,$b) {
$$a == $E{maybe} || $E{$b} == $E{maybe} ? $E{maybe} : # either arg 'maybe', return 'maybe'
my ($class, $v) = @_;
$$a == $E{false} && $E{$b} == $E{false} ? $E{true} : # both args 'false', return 'true'
my $ret =▼
min $$a, $E{$b} # either arg 'false', return 'false', otherwise 'true'
!defined($v) ? 0 :▼
$v eq 'true' ? 1 :▼
$v eq 'false'? -1 :
$v eq 'maybe'? 0 :▼
$v > 0 ? 1 :▼
$v < 0 ? -1 :▼
0;
return bless \$ret, $class;▼
}
 
# do tests in a manner that avoids overloaded operators
sub TRUE() { new Trit( 1) }
sub FALSE() { new Trit(-1$class, $v) }{
▲ my $retvalue =
sub MAYBE() { new Trit( 0) }
▲ ! defined( $v) ? 0$E{maybe} :
 
▲ $v eq=~ '/true'/ ? 1$E{true} :
sub clone {
my $retv =~ /false/ ? $E{$_[0]false}; :
▲ $v eq=~ '/maybe'/ ? 0$E{maybe} :
return bless \$ret, ref($_[0]);
▲ $v >gt 0$E{maybe} ? 1$E{true} :
▲ $v <lt 0$E{maybe} ? -1$E{false} :
$E{maybe} ;
▲ return bless \$retvalue, $class;
}
 
sub tostr ($a) { ${$_[0]}a > 0$E{maybe} ? 'true' : ${$_[0]}a < 0$E{maybe} ? 'false' : 'maybe' }
sub tonum ($a) { ${$_[0]}a }
 
sub cmpnot { ($a) {$_[0]} <=Trit->new( -${$_[1]}a ) }
sub notcmp { new Trit(-$a,$b) { Trit->new( $_[0]}a <=> $b ) }
sub and { new ($a,$b) { Trit->new( min( ${$_[0]}a, ${$_[1]})b ) }
sub or { new ($a,$b) { Trit->new( max( ${$_[0]}a, ${$_[1]})b ) }
sub equiv ($a,$b) { Trit->new( eqv $a, $b ) }
 
sub equiv { new Trit( ${$_[0]} * ${$_[1]} ) }
 
package main;
Trit->import;
 
my @a = (TRUE Trit->new($E{true}), MAYBETrit->new($E{maybe}), FALSETrit->new($E{false}) );
printf "Codes for logic values: %6s = %d %6s = %d %6s = %d\n", @a[0, 0, 1, 1, 2, 2];
 
# prefix ! (not) ['~' also can be used]
say "a\na\tNOT a";
print "$_\t".(!$_)."\n" for @a;
 
Line 4,555 ⟶ 4,550:
 
# infix | (or)
say "\nOR\t" . join("\t",@a);
for my $a (@a) { print $a; print "\t" . ($a | $_) for @a; say '' }
 
# infix eq (equivalence)
say "\nEQV\t" . join("\t",@a);
for my $a (@a) { print $a; print "\t" . ($a eq $_) for @a; say '' }
 
# infix == (equality)
say "\n==\t" . join("\t",@a);
for my $a (@a) { print $a; print "\t" . ($a == $_) for @a; say '' }</syntaxhighlight>
{{out}}
<pre>Codes for logic values: true = 1 maybe = 0 false = -1
<pre>a NOT a▼
 
▲<pre>a NOT a
true false
maybe maybe
SqrtNegInf
2,392

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/339150"