1package Math::Logic ; # Documented at the __END__. 2 3# $Id: Logic.pm,v 1.16 2000/05/25 19:15:01 root Exp root $ 4 5 6require 5.004 ; 7 8use strict ; 9use integer ; # Forces us to quote all hash keys in 5.004. 10 11use Carp qw( croak carp ) ; 12 13use vars qw( $VERSION @ISA @EXPORT_OK %EXPORT_TAGS ) ; 14$VERSION = '1.19' ; 15 16use Exporter() ; 17 18@ISA = qw( Exporter ) ; 19 20@EXPORT_OK = qw( $TRUE $FALSE $UNDEF TRUE FALSE UNDEF 21 $STR_TRUE $STR_FALSE $STR_UNDEF STR_TRUE STR_FALSE STR_UNDEF ) ; 22%EXPORT_TAGS = ( 23 ALL => [ @EXPORT_OK ], 24 NUM => [ qw( $TRUE $FALSE $UNDEF TRUE FALSE UNDEF ) ], 25 STR => [ qw( $STR_TRUE $STR_FALSE $STR_UNDEF STR_TRUE STR_FALSE STR_UNDEF ) ], 26 ) ; 27 28 29### Public class constants 30 31use vars qw( $TRUE $FALSE $UNDEF $STR_TRUE $STR_FALSE $STR_UNDEF ) ; 32*TRUE = \1 ; 33*FALSE = \0 ; 34*UNDEF = \-1 ; 35 36*STR_TRUE = \'TRUE' ; 37*STR_FALSE = \'FALSE' ; 38*STR_UNDEF = \'UNDEF' ; 39 40### Public class constants -- DEPRECATED 41 42use constant TRUE => $TRUE ; 43use constant FALSE => $FALSE ; 44use constant UNDEF => $UNDEF ; 45 46use constant STR_TRUE => $STR_TRUE ; 47use constant STR_FALSE => $STR_FALSE ; 48use constant STR_UNDEF => $STR_UNDEF ; 49 50 51### Private class constants 52 53my $DEF_VALUE = $FALSE ; 54my $DEF_DEGREE = 3 ; 55my $MIN_DEGREE = 2 ; 56my $DEF_PROPAGATE = $FALSE ; 57 58 59### Object keys (there are no class keys) 60# 61# -value 62# -degree 63# -propagate 64 65 66### Private data and methods 67# 68# _set object 69# _get object 70# _cmp object 71# 72 73{ 74 sub _set { # Object method 75 # Caller is responsible for ensuring the assigned value is valid 76 my $self = shift ; 77# my $class = ref( $self ) || $self ; 78 my $field = shift ; 79 80 $self->{$field} = shift ; 81 } 82 83 84 sub _get { # Object method 85 my $self = shift ; 86# my $class = ref( $self ) || $self ; 87 88 $self->{shift()} ; 89 } 90 91 92 sub _cmp { # Object method 93 my $self = shift ; 94# my $class = ref( $self ) || $self ; 95 my $comp = shift ; 96 97 $comp = $self->new( '-value' => $comp ) unless ref $comp ; 98 { my $err ; croak $err if $err = $self->incompatible( $comp ) } 99 100 $self->value <=> $comp->value ; 101 } 102 103} 104 105 106### Public methods 107 108sub new_from_string { # Class and object method 109 my $self = shift ; 110 my $class = ref( $self ) || $self ; 111 my $string = shift ; 112 113 my @arg = $string =~ /\(?\s*([^,\s\%]+)\%?,\s*([^,\s]+)(?:,\s*([^,\s]+))?\)?/o ; 114 115 if( defined $arg[0] ) { 116 # 1, 0 and -1 pass through unchanged; -1 will be silently converted to 117 # 0 except for 3-degree logic in $class->new 118 $arg[0] = $TRUE if $arg[0] =~ /^-?[tT]/o ; 119 $arg[0] = $FALSE if $arg[0] =~ /^-?[fF]/o ; 120 $arg[0] = $UNDEF if $arg[0] =~ /^-?[uU]/o ; 121 } 122 $arg[2] = $arg[2] =~ /^-?[tTpP1]/o ? 123 $TRUE : $FALSE if defined $arg[2] ; 124 125 # Ignores settings of calling object if called as an object method. 126 $class->new( 127 '-value' => $arg[0] || $DEF_VALUE, 128 '-degree' => $arg[1] || $DEF_DEGREE, 129 '-propagate' => $arg[2] || $DEF_PROPAGATE, 130 ) ; 131} 132 133 134sub new { # Class and object method 135 my $self = shift ; 136 my $class = ref( $self ) || $self ; 137 my $object = ref $self ? $self : undef ; 138 my %arg = @_ ; 139 140 # Set defaults plus parameters 141 $self = { 142 '-value' => $DEF_VALUE, 143 '-degree' => $DEF_DEGREE, 144 '-propagate' => $DEF_PROPAGATE, 145 %arg 146 } ; 147 148 # If called as an object method use the calling object's settings unless a 149 # parameter has overridden 150 if( defined $object ) { 151 $self->{'-value'} = $object->value 152 unless exists $arg{'-value'} ; 153 $self->{'-degree'} = $object->degree 154 unless exists $arg{'-degree'} ; 155 $self->{'-propagate'} = $object->propagate 156 unless exists $arg{'-propagate'} ; 157 } 158 159 # Ensure the settings are valid 160 $self->{'-propagate'} = $self->{'-propagate'} ? $TRUE : $FALSE ; 161 162 $self->{'-degree'} = $DEF_DEGREE 163 unless $self->{'-degree'} =~ /^\d+$/o ; 164 $self->{'-degree'} = $MIN_DEGREE 165 if $self->{'-degree'} < $MIN_DEGREE ; 166 167 $self->{'-value'} = $DEF_VALUE 168 if not defined $self->{'-value'} or $self->{'-value'} !~ /^(?:\d+|-1)$/o ; 169 170 if( $self->{'-degree'} == 2 ) { # 2-degree logic 171 $self->{'-value'} = ( $self->{'-value'} CORE::and 172 $self->{'-value'} != $UNDEF ) ? 173 $TRUE : $FALSE ; 174 delete $self->{'-propagate'} ; # Don't store what we don't use 175 } 176 elsif( $self->{'-degree'} == 3 ) { # 3-degree logic 177 if( $self->{'-value'} != $UNDEF ) { 178 $self->{'-value'} = $self->{'-value'} ? $TRUE : $FALSE ; 179 } 180 } 181 else { # Multi-degree logic 182 $self->{'-value'} = $FALSE if $self->{'-value'} == $UNDEF ; 183 $self->{'-value'} = $self->{'-degree'} 184 if $self->{'-value'} > $self->{'-degree'} ; 185 delete $self->{'-propagate'} ; # Don't store what we don't use 186 } 187 188 bless $self, $class ; 189} 190 191 192use overload 193 '""' => \&as_string, 194 '0+' => \&value, 195 'bool' => \&value, 196 '<=>' => \&_cmp, 197 '&' => \&and, 198 '|' => \&or, 199 '^' => \&xor, 200 '!' => \¬, 201 # Avoid surprises 202 '=' => sub { croak "=() not overloaded" }, 203 '+' => sub { croak "+() unsupported" }, 204 '-' => sub { croak "-() unsupported" }, 205 '*' => sub { croak "*() unsupported" }, 206 '/' => sub { croak "/() unsupported" }, 207 '%' => sub { croak "%() unsupported" }, 208 'x' => sub { croak "x() unsupported" }, 209 '**' => sub { croak "**() unsupported" }, 210 '<<' => sub { croak "<<() unsupported" }, 211 '>>' => sub { croak ">>() unsupported" }, 212 '+=' => sub { croak "+=() unsupported" }, 213 '-=' => sub { croak "-=() unsupported" }, 214 '*=' => sub { croak "*=() unsupported" }, 215 '/=' => sub { croak "/=() unsupported" }, 216 '%=' => sub { croak "%=() unsupported" }, 217 'x=' => sub { croak "x=() unsupported" }, 218 '++' => sub { croak "++() unsupported" }, 219 '--' => sub { croak "--() unsupported" }, 220 'lt' => sub { croak "lt() unsupported" }, 221 'le' => sub { croak "le() unsupported" }, 222 'gt' => sub { croak "gt() unsupported" }, 223 'ge' => sub { croak "ge() unsupported" }, 224 'eq' => sub { croak "eq() unsupported; use == instead" }, 225 'ne' => sub { croak "ne() unsupported; use != instead" }, 226 '**=' => sub { croak "**=() unsupported" }, 227 '<<=' => sub { croak "<<=() unsupported" }, 228 '>>=' => sub { croak ">>=() unsupported" }, 229 'cmp' => sub { croak "cmp() unsupported; use <=> instead" }, 230 'neg' => sub { croak "neg() unsupported" }, 231 'nomethod' => sub { croak @_ . "() unsupported" }, 232 ; 233 234 235sub value { # Object method 236 my $self = shift ; 237# my $class = ref( $self ) || $self ; 238 my $value = shift ; 239 240 if( defined $value ) { 241 my $result ; 242 243 if( $self->degree == 2 ) { # 2-degree logic 244 $result = ( $value CORE::and $value != $UNDEF ) ? $TRUE : $FALSE ; 245 } 246 elsif( $self->degree == 3 ) { # 3-degree logic 247 $result = $value ? $TRUE : $FALSE ; 248 $result = $UNDEF if $value == $UNDEF ; 249 } 250 else { # Multi-degree logic 251 $result = $value ; 252 # $UNDEF is -1 which doesn't match the pattern, hence we can 253 # abbreviate the following line 254 # $result = $FALSE if $value == $UNDEF CORE::or $value !~ /^\d+$/o ; 255 $result = $FALSE if $value !~ /^\d+$/o ; 256 $result = $self->degree if $result > $self->degree ; 257 } 258 259 $self->_set( '-value' => $result ) ; 260 } 261 262 $self->_get( '-value' ) ; 263} 264 265 266sub degree { # Object method 267 my $self = shift ; 268# my $class = ref( $self ) || $self ; 269 270 carp "degree is read-only" if @_ ; 271 272 $self->_get( '-degree' ) ; 273} 274 275 276sub propagate { # Object method 277 my $self = shift ; 278# my $class = ref( $self ) || $self ; 279 280 carp "propagate is read-only" if @_ ; 281 282 $self->degree == 3 ? $self->_get( '-propagate' ) : $FALSE ; 283} 284 285 286sub incompatible { # Object method 287 my $self = shift ; 288 my $class = ref( $self ) || $self ; 289 my $comp = shift ; 290 291 croak "operator can only be applied to $class objects not " . 292 ( ref( $comp ) || $comp ) 293 if ( CORE::not ref $comp ) CORE::or 294 ( CORE::not $comp->can( 'degree' ) ) CORE::or 295 ( CORE::not $comp->can( 'propagate' ) ) ; 296 297 ( $self->degree == $comp->degree CORE::and 298 $self->propagate == $comp->propagate ) ? 0 : 299 ref( $self ) . "(" . $self->degree . "," . $self->propagate . ")" . 300 " and " . 301 ref( $comp ) . "(" . $comp->degree . "," . $comp->propagate . ")" . 302 " are incompatible" ; 303} 304 305 306sub compatible { # DEPRECATED Object method 307 my $self = shift ; 308 my $class = ref( $self ) || $self ; 309 my $comp = shift ; 310 311 croak "can only be applied to $class objects not " . ( ref( $comp ) || $comp ) 312 if ( CORE::not ref $comp ) CORE::or 313 ( CORE::not $comp->can( 'degree' ) ) CORE::or 314 ( CORE::not $comp->can( 'propagate' ) ) ; 315 316 $self->degree == $comp->degree CORE::and 317 $self->propagate == $comp->propagate ; 318} 319 320 321sub as_string { # Object method 322 my $self = shift ; 323# my $class = ref( $self ) || $self ; 324 my $full = shift || 0 ; 325 $full = 0 unless $full eq '1' CORE::or $full eq '-full' ; 326 327 my $result = '' ; 328 329 if( $self->degree == 2 ) { # 2-degree logic 330 $result = $self->value ? $STR_TRUE : $STR_FALSE ; 331 } 332 elsif( $self->degree == 3 ) { # 3-degree logic 333 $result = $self->value ? $STR_TRUE : $STR_FALSE ; 334 $result = $STR_UNDEF if $self->value == $UNDEF ; 335 } 336 else { # Multi-degree logic 337 if( $self->value == $FALSE ) { 338 $result = $STR_FALSE ; 339 } 340 elsif( $self->value == $self->degree ) { 341 $result = $STR_TRUE ; 342 } 343 else { 344 $result = $self->value ; 345 $result .= '%' if $self->degree == 100 CORE::and $full ; 346 } 347 } 348 349 # e.g. $logic->as_string( -full ) ; 350 $result = "($result," . $self->degree . 351 ( $self->propagate ? "," . '-propagate' : '' ) . ")" if $full ; 352 353 $result ; 354} 355 356 357sub and { # Object method 358 my $self = shift ; 359# my $class = ref( $self ) || $self ; 360 my $comp = shift ; 361 362 $comp = $self->new( '-value' => $comp ) unless ref $comp ; 363 { my $err ; croak $err if $err = $self->incompatible( $comp ) } 364 365 my $value ; 366 my $result = $self->new ; 367 368 if( $self->degree == 2 ) { # 2-degree logic 369 $value = ( $self->value CORE::and $comp->value ) ? $TRUE : $FALSE ; 370 } 371 elsif( $self->degree == 3 ) { # 3-degree logic 372 if( $self->propagate ) { 373 if( $self->value == $UNDEF CORE::or $comp->value == $UNDEF ) { 374 # At least one is undefined which propagates. 375 $value = $UNDEF ; 376 } 377 elsif( $self->value == $TRUE CORE::and $comp->value == $TRUE ) { 378 # They're both defined and true. 379 $value = $TRUE ; 380 } 381 else { 382 # They're both defined and at least one is false. 383 $value = $FALSE ; 384 } 385 } 386 else { 387 if( $self->value == $TRUE CORE::and $comp->value == $TRUE ) { 388 # Both are defined and true. 389 $value = $TRUE ; 390 } 391 elsif( $self->value == $FALSE CORE::or $comp->value == $FALSE ) { 392 # At least one is defined and false. 393 $value = $FALSE ; 394 } 395 else { 396 # Either both are undefined or only one is defined and true. 397 $value = $UNDEF ; 398 } 399 } 400 } 401 else { # Multi-degree logic 402 # and is the lowest value 403 $value = $self->value < $comp->value ? $self->value : $comp->value ; 404 } 405 406 $result->value( $value ) ; 407 408 $result ; 409} 410 411 412sub or { # Object method 413 my $self = shift ; 414# my $class = ref( $self ) || $self ; 415 my $comp = shift ; 416 417 $comp = $self->new( '-value' => $comp ) unless ref $comp ; 418 { my $err ; croak $err if $err = $self->incompatible( $comp ) } 419 420 my $value ; 421 my $result = $self->new ; 422 423 if( $self->degree == 2 ) { # 2-degree logic 424 $value = ( $self->value CORE::or $comp->value ) ? $TRUE : $FALSE ; 425 } 426 elsif( $self->degree == 3 ) { # 3-degree logic 427 if( $self->propagate ) { 428 if( $self->value == $UNDEF CORE::or $comp->value == $UNDEF ) { 429 # At least one is undefined which propagates. 430 $value = $UNDEF ; 431 } 432 elsif( $self->value == $TRUE CORE::or $comp->value == $TRUE ) { 433 # They're both defined and at least one is true. 434 $value = $TRUE ; 435 } 436 else { 437 # They're both defined and both are false. 438 $value = $FALSE ; 439 } 440 } 441 else { 442 if( $self->value == $TRUE CORE::or $comp->value == $TRUE ) { 443 # At least one is defined and true. 444 $value = $TRUE ; 445 } 446 elsif( $self->value == $FALSE CORE::and $comp->value == $FALSE ) { 447 # They're both defined and false. 448 $value = $FALSE ; 449 } 450 else { 451 # Either both are undefined or one is defined and false. 452 $value = $UNDEF ; 453 } 454 } 455 } 456 else { # Multi-degree logic 457 # or is the greatest value 458 $value = $self->value > $comp->value ? $self->value : $comp->value ; 459 } 460 461 $result->value( $value ) ; 462 463 $result ; 464} 465 466 467sub xor { # Object method 468 my $self = shift ; 469# my $class = ref( $self ) || $self ; 470 my $comp = shift ; 471 472 $comp = $self->new( '-value' => $comp ) unless ref $comp ; 473 { my $err ; croak $err if $err = $self->incompatible( $comp ) } 474 475 my $value ; 476 my $result = $self->new ; 477 478 if( $self->degree == 2 ) { # 2-degree logic 479 $value = ( $self->value CORE::xor $comp->value ) ? $TRUE : $FALSE ; 480 } 481 elsif( $self->degree == 3 ) { # 3-degree logic 482 # Same truth table whether propagating or not. 483 if( $self->value == $UNDEF CORE::or $comp->value == $UNDEF ) { 484 # At least one is undefined which propagates. 485 $value = $UNDEF ; 486 } 487 elsif( $self->value == $comp->value ) { 488 # Both are defined and they're both the same. 489 $value = $FALSE ; 490 } 491 else { 492 # Both are defined and they're different. 493 $value = $TRUE ; 494 } 495 } 496 else { # Multi-degree logic 497 # By truth table xor(a,b) == and(or(a,b),not(and(a,b))) 498 # We could write it thus, but prefer not to use overloading within the 499 # module itself: 500 # my $temp = ( $self | $comp ) & ( ! ( $self & $comp ) ) ; 501 # $value = $temp->value ; 502 $value = $self->or( $comp )->and( $self->and( $comp )->not )->value ; 503 } 504 505 $result->value( $value ) ; 506 507 $result ; 508} 509 510 511sub not { # Object method 512 my $self = shift ; 513# my $class = ref( $self ) || $self ; 514 515 my $value ; 516 my $result = $self->new ; 517 518 if( $self->degree == 2 ) { # 2-degree logic 519 $value = ( $self->value ? $FALSE : $TRUE ) ; 520 } 521 elsif( $self->degree == 3 ) { # 3-degree logic 522 # Same truth table whether propagating or not. 523 if( $self->value == $UNDEF ) { 524 # It's undefined which propogates. 525 $value = $UNDEF ; 526 } 527 elsif( $self->value == $TRUE ) { 528 # It's defined and true so return false. 529 $value = $FALSE ; 530 } 531 else { 532 # It's defined and false so return true. 533 $value = $TRUE ; 534 } 535 } 536 else { # Multi-degree logic 537 $value = $self->degree - $self->value ; 538 } 539 540 $result->value( $value ) ; 541 542 $result ; 543} 544 545 546DESTROY { # Object method 547 ; # Noop 548} 549 550 5511 ; 552 553 554__END__ 555 556=head1 NAME 557 558Math::Logic - Provides pure 2, 3 or multi-value logic. 559 560=head1 SYNOPSIS 561 562 use Math::Logic qw( $TRUE $FALSE $UNDEF $STR_TRUE $STR_FALSE $STR_UNDEF ) ; 563 # 1 0 -1 'TRUE' 'FALSE' 'UNDEF' 564 565 use Math::Logic ':NUM' ; # $TRUE $FALSE $UNDEF -- what you normally want 566 567 use Math::Logic ':ALL' ; # All the constants 568 569 use Math::Logic ':STR' ; # $STR_TRUE $STR_FALSE $STR_UNDEF 570 571 # 2-degree logic 572 my $true = Math::Logic->new( -value => $TRUE, -degree => 2 ) ; 573 my $false = Math::Logic->new( -value => $FALSE, -degree => 2 ) ; 574 my $x = Math::Logic->new_from_string( 'TRUE,2' ) ; 575 576 print "true" if $true ; 577 578 # 3-degree logic (non-propagating) 579 my $true = Math::Logic->new( -value => $TRUE, -degree => 3 ) ; 580 my $false = Math::Logic->new( -value => $FALSE, -degree => 3 ) ; 581 my $undef = Math::Logic->new( -value => $UNDEF, -degree => 3 ) ; 582 my $x = Math::Logic->new_from_string( 'FALSE,3' ) ; 583 584 print "true" if ( $true | $undef ) == $TRUE ; 585 586 # 3-degree logic (propagating) 587 my $true = Math::Logic->new( -value => $TRUE, -degree => 3, -propagate => 1 ) ; 588 my $false = Math::Logic->new( -value => $FALSE, -degree => 3, -propagate => 1 ) ; 589 my $undef = Math::Logic->new( -value => $UNDEF, -degree => 3, -propagate => 1 ) ; 590 my $x = Math::Logic->new_from_string( '( UNDEF, 3, -propagate )' ) ; 591 592 print "undef" if ( $true | $undef ) == $UNDEF ; 593 594 # multi-degree logic 595 my $True = 100 ; # Define our own true 596 my $False = $FALSE ; 597 my $true = Math::Logic->new( -value => $True, -degree => $True ) ; 598 my $very = Math::Logic->new( -value => 67, -degree => $True ) ; 599 my $fairly = Math::Logic->new( -value => 33, -degree => $True ) ; 600 my $false = Math::Logic->new( -value => $False, -degree => $True ) ; 601 my $x = Math::Logic->new_from_string( "25,$True" ) ; 602 603 print "maybe" if ( $very | $fairly ) > 50 ; 604 605 # We can have arbitrarily complex expressions; the result is a Math::Logic 606 # object; all arguments must be Math::Logic objects or things which can be 607 # promoted into such and must all be compatible. The outcome depends on 608 # which kind of logic is being used. 609 my $xor = ( $x | $y ) & ( ! ( $x & $y ) ) ; 610 # This is identical to: 611 my $xor = $x ^ $y ; 612 613 614=head1 DESCRIPTION 615 616Perl's built-in logical operators, C<and>, C<or>, C<xor> and C<not> support 6172-value logic. This means that they always produce a result which is either 618true or false. In fact perl sometimes returns 0 and sometimes returns undef 619for false depending on the operator and the order of the arguments. For "true" 620Perl generally returns the first value that evaluated to true which turns out 621to be extremely useful in practice. Given the choice Perl's built-in logical 622operators are to be preferred -- but when you really want pure 2-degree logic 623or 3-degree logic or multi-degree logic they are available through this module. 624 625The only 2-degree logic values are 1 (TRUE) and 0 (FALSE). 626 627The only 3-degree logic values are 1 (TRUE), 0 (FALSE) and -1 (UNDEF). Note 628that UNDEF is -1 I<not> C<undef>! 629 630The only multi-degree logic values are 0 (FALSE)..C<-degree> -- the value of 631TRUE is equal to the degree, usually 100. 632 633The C<-degree> is the maximum value (except for 2 and 3-degree logic); i.e. 634logic of I<n>-degree is I<n+1>-value logic, e.g. 100-degree logic has 101 635values, 0..100. 636 637Although some useful constants may be exported, this is an object module and 638the results of logical comparisons are Math::Logic objects. 639 640=head2 2-degree logic 641 6422-degree logic has one simple truth table for each logical operator. 643 644 Perl Logic Perl Logic Perl Logic 645 A B and and A B or or A B xor xor 646 - - --- --- - - -- -- - - --- --- 647 F F F F F F F F F F F F 648 T T T T T T T T T T F F 649 T F F F T F T T T F T T 650 F T F F F T T T F T T T 651 652 Perl Logic 653 A not not 654 - --- --- 655 F T T 656 T F F 657 658In the above tables when dealing with Perl's built-in logic T and F are any 659true and any false value respectively; with Math::Logic they are objects whose 660values are 1 and 0 respectively. Note that whilst Perl may return 0 or undef 661for false and any other value for true, Math::Logic returns an object whose 662value is either 0 (FALSE) or 1 (TRUE) only. 663 664 my $true = Math::Logic->new( -value => $TRUE, -degree => 2 ) ; 665 my $false = Math::Logic->new( -value => $FALSE, -degree => 2 ) ; 666 667 my $result = $true & $false ; # my $result = $true->and( $false ) ; 668 669 print $result if $result == $FALSE ; 670 671=head2 3-degree logic 672 6733-degree logic has two different truth tables for "and" and "or"; this module 674supports both. In the Perl column F means false or undefined; and T, F and U 675under Math::Logic are objects with values 1 (TRUE), 0 (FALSE) and -1 (UNDEF) 676respectively. The + signifies propagating nulls (UNDEFs). 677 678 Perl Logic Perl Logic Perl Logic 679 A B and and+ and A B or or+ or A B xor xor+ xor(same) 680 - - --- --- --- - - -- -- -- - - --- --- --- 681 U U F U U U U F U U U U F U U 682 U F F U F U F F U U U F F U U 683 F U F U F F U F U U F U F U U 684 F F F F F F F F F F F F F F F 685 U T F U U U T T U T U T T U U 686 T U F U U T U T U T T U T U U 687 T T T T T T T T T T T T F F F 688 T F F F F T F T T T T F T T T 689 F T F F F F T T T T F T T T T 690 691 Perl Logic 692 A not not+ not(same) 693 - --- --- --- 694 U T U U 695 U T U U 696 F T T T 697 T F F F 698 699 # 3-degree logic (non-propagating) 700 my $true = Math::Logic->new( -value => $TRUE, -degree => 3 ) ; 701 my $false = Math::Logic->new( -value => $FALSE, -degree => 3 ) ; 702 my $undef = Math::Logic->new( -value => $UNDEF, -degree => 3 ) ; 703 704 my $result = $undef & $false ; # my $result = $undef->and( $false ) ; 705 706 print $result if $result == $FALSE ; 707 708 # 3-degree logic (propagating) 709 my $true = Math::Logic->new( -value => $TRUE, -degree => 3, -propagate => 1 ) ; 710 my $false = Math::Logic->new( -value => $FALSE, -degree => 3, -propagate => 1 ) ; 711 my $undef = Math::Logic->new( -value => $UNDEF, -degree => 3, -propagate => 1 ) ; 712 713 my $result = $undef & $false ; # my $result = $undef->and( $false ) ; 714 715 print $result if $result == $UNDEF ; 716 717=head2 multi-degree logic 718 719This is used in `fuzzy' logic. Typically we set the C<-degree> to 100 720representing 100% likely, i.e. true; 0 represents 0% likely, i.e. false, and 721any integer in-between is a probability. 722 723The truth tables for multi-degree logic work like this: 724 725 and lowest value is the result; 726 or highest value is the result; 727 xor by truth table xor(a,b) == and(or(a,b),not(and(a,b))) 728 not degree minus the value is the result. 729 730 Logic 731 A B and or xor 732 --- --- --- --- --- 733 0 0 0 0 0 734 0 100 0 100 100 735 100 0 0 100 100 736 100 100 100 100 0 737 0 33 0 33 33 738 33 0 0 33 33 739 33 100 33 100 67 740 33 33 33 33 33 741 100 33 33 100 67 742 0 67 0 67 67 743 67 0 0 67 67 744 67 100 67 100 33 745 67 67 67 67 33 746 100 67 67 100 33 747 33 67 33 67 67 748 67 33 33 67 67 749 750 A not 751 --- --- 752 0 100 753 33 67 754 67 33 755 100 0 756 757 # multi-degree logic 758 my $True = 100 ; # Define our own TRUE and FALSE 759 my $False = $FALSE ; 760 $true = Math::Logic->new( -value => $True, -degree => $True ) ; 761 $very = Math::Logic->new( -value => 67, -degree => $True ) ; 762 $fairly = Math::Logic->new( -value => 33, -degree => $True ) ; 763 $false = Math::Logic->new( -value => $False, -degree => $True ) ; 764 765 my $result = $fairly & $very ; # my $result = $fairly->and( $very ) ; 766 767 print $result if $result == $fairly ; 768 769=head2 Public methods 770 771 new class object (also used for assignment) 772 new_from_string class object 773 value object 774 degree object 775 propagate object 776 incompatible object 777 compatible object (deprecated) 778 as_string object 779 and object (same as &) 780 or object (same as |) 781 xor object (same as ^) 782 not object (same as !) 783 "" object (see as_string) 784 0+ object (automatically handled) 785 <=> object (comparisons) 786 & object (logical and) 787 | object (logical or) 788 ^ object (logical xor) 789 ! object (logical not) 790 791=head2 new (class and object method) 792 793 my $x = Math::Logic->new ; 794 795 my $y = Math::Logic->new( -value => $FALSE, -degree => 3, -propagate => 0 ); 796 797 my $a = $x->new ; 798 799 my $b = $y->new( -value => $TRUE ) ; 800 801This creates new Math::Logic objects. C<new> should never fail because it will 802munge any arguments into something `sensible'; in particular if the value is 803set to -1 (UNDEF) for 2 or multi-degree logic it is silently converted to 0 804(FALSE). In all other cases anything that is true in Perl is converted to 1 805(TRUE) and everything else to 0 (FALSE). 806 807 808If used as an object method, e.g. for assignment then the settings are those 809of the original object unless overridden. If used as a class method with no 810arguments then default values are used. 811 812C<-degree> an integer indicating the number of possible truth values; 813typically set to 2, 3 or 100 (to represent percentages). Minimum value is 2. 814 815C<-propagate> a true/false integer indicating whether NULLs (UNDEF) should 816propagate; only applicable for 3-degree logic where it influences which truth 817table is used. 818 819C<-value> an integer representing the truth value. For 2-degree logic only 1 820and 0 are valid (TRUE and FALSE); for 3-degree logic 1, 0, and -1 are valid 821(TRUE, FALSE and UNDEF); for multi-degree logic any positive integer less than 822or equal to the C<-degree> is valid. 823 824=head2 new_from_string (class and object method) 825 826 my $x = Math::Logic->new_from_string( '1,2' ) ; 827 my $y = Math::Logic->new_from_string( 'TRUE,3,-propagate' ) ; 828 my $z = Math::Logic->new_from_string( '( FALSE, 3, -propagate )' ) ; 829 my $m = Math::Logic->new_from_string( '33,100' ) ; 830 my $n = Math::Logic->new_from_string( '67%,100' ) ; 831 832This creates new Math::Logic objects. The string B<must> include the first two 833values, which are C<-value> and C<-degree> respectively. 834 835True values can be expressed as 1, T or any word beginning with T, e.g. 836TRUE or -true; the pattern is /^-?[tT]/. 837False values can be expressed as 0, F or any word beginning with F, e.g. 838FALSE or -false; the pattern is /^-?[fF]/. 839Undef values can be expressed as -1, U or any word beginning with U, e.g. 840UNDEF or -undef; the pattern is /^-?[uU]/. 841Propagate is set to true by adding a third parameter matching /^-?[tTpP1]/, 842e.g. -propagate. To set propagate to false either don't include a third 843parameter or include it as 0 (zero). 844 845=head2 value (object method) 846 847 print $x->value ; 848 print $x ; 849 850This returns the numeric value of the object. For 2-degree logic this will 851always be 1 or 0; for 3-degree logic the value will be 1, 0 or -1; for 852multi-degree logic the value will be a positive integer <= C<-degree>. 853 854=head2 degree (object method) 855 856 print $x->degree ; 857 858This returns the degree of the object, i.e. the number of possible truth 859values the object may hold; it is always 2 or more. 860 861=head2 propagate (object method) 862 863 print $x->propagate ; 864 865This returns whether or not the object propagates NULLs (UNDEF). Objects using 8662 or multi-degree logic always return FALSE; 3-degree logic objects may return 867TRUE or FALSE. 868 869=head2 incompatible (object method) 870 871 print $x & $y unless $x->incompatible( $y ) ; 872 873Returns FALSE if the objects are compatible; returns an error string if 874incompatible (which Perl treats as TRUE), e.g.: 875 876 $x = Math::Logic->new_from_string('1,2') ; 877 $y = Math::Logic->new_from_string('0,3') ; 878 # The above are incompatible because the first uses 2-degree logic and the 879 # second uses 3-degree logic. 880 print $x->incompatible( $y ) if $x->incompatible( $y ) ; 881 # This will print something like: 882 Math::Logic(2,0) and Math::Logic(3,0) are incompatible at ./logic.t line 2102 883 # The first number given is the degree and the second the propagate setting 884 885Objects are compatible if they have the same C<-degree> and in the case of 8863-degree logic the same C<-propagate>. Logical operators will only work on 887compatible objects, there is no type-coersion (but see typecasting later). 888 889=head2 compatible DEPRECATED (object method) 890 891 print $x->compatible( $y ) ; 892 893Returns TRUE or FALSE depending on whether the two objects are compatible. 894Objects are compatible if they have the same C<-degree> and in the case of 8953-degree logic the same C<-propagate>. Logical operators will only work on 896compatible objects, there is no type-coersion (but see typecasting later). 897 898=head2 as_string and "" (object method) 899 # output: 900 print $x->as_string ; # TRUE 901 print $x->as_string( 1 ) ; # (TRUE,2) 902 print $x->as_string( -full ) ; # (TRUE,2) 903 904 print $x ; # TRUE 905 print $x->value ; # 1 906 907 print $m ; # 33 908 print $m->value ; # 33 909 print $m->as_string( 1 ) ; # (33%,100) 910 911Usually you won't have to bother using C<as_string> since Perl will invoke it 912for you as necessary; however if you want a string that can be saved, (perhaps 913to be read in using C<new_from_string> later), you can pass an argument to 914C<as_string>. 915 916=head2 and and & (object method) 917 918 print "true" if ( $y & $z ) == $TRUE ; 919 print "yes" if $y & 1 ; 920 print "yes" if $TRUE & $y ; 921 922 $r = $y & $z ; # Creates a new Math::Logic object with the resultant truth value 923 924 print "true" if $y->and( $z ) == $TRUE ; 925 926Applies logical and to two objects. The truth table used depends on the 927object's C<-degree> (and in the case of 3-degree logic on the C<-propagate>). 928(See the truth tables above.) 929 930=head2 or and | (object method) 931 932 print "true" if ( $y | $z ) == $TRUE ; 933 print "yes" if $y | 1 ; 934 print "yes" if $TRUE | $y ; 935 936 $r = $y | $z ; # Creates a new Math::Logic object with the resultant truth value 937 938 print "true" if $y->or( $z ) == $TRUE ; 939 940Applies logical or to two objects. The truth table used depends on the 941object's C<-degree> (and in the case of 3-degree logic on the C<-propagate>). 942(See the truth tables above.) 943 944=head2 xor and ^ (object method) 945 946 print "true" if ( $y ^ $z ) == $TRUE ; 947 print "yes" if $y ^ 0 ; 948 print "yes" if $TRUE ^ $y ; 949 950 $r = $y ^ $z ; # Creates a new Math::Logic object with the resultant truth value 951 952 print "true" if $y->xor( $z ) == $TRUE ; 953 954Applies logical xor to two objects. The truth table used depends on the 955object's C<-degree>. (See the truth tables above.) 956 957=head2 not and ! (object method) 958 959 print "true" if ! $y == $TRUE ; 960 961 $r = ! $y ; # Creates a new Math::Logic object with the resultant truth value 962 963 print "true" if $y->not == $TRUE ; 964 965Applies logical not to the object. The truth table used depends on the 966object's C<-degree>. (See the truth tables above.) 967 968=head2 comparisons and <=> (object method) 969 970All the standard (numeric) comparison operators may be applied to Math::Logic 971objects, i.e. <, <=, >, =>, ==, != and <=>. 972 973=head2 typecasting 974 975The only typecasting that appears to make sense is between 2 and 3-degree 976logic. There is no direct support for it but it can be achieved thus: 977 978 my $x = Math::Logic->new_from_string( '1,2' ) ; # TRUE 2-degree 979 my $y = Math::Logic->new_from_string( '0,3' ) ; # FALSE 3-degree 980 my $z = Math::Logic->new_from_string( '-1,3' ) ; # UNDEF 3-degree 981 982 $x3 = $x->new( -degree => 3 ) ; 983 $y2 = $y->new( -degree => 2 ) ; 984 $z2 = $y->new( -degree => 2 ) ; # UNDEF converted silently to FALSE 985 986=head1 BUGS 987 988Multi-degree logic has a minimum degree of 4, i.e. 5-value, 0..4. 989 990If you use & on two incompatible Math::Logic objects perl dies; I believe that 991this is due to a problem with overload: it does not occur with perl 5.6.0. 992 993=head1 CHANGES 994 9952000/05/25 996 997No changes; just corrected an error in the tarball that meant the test would 998fail in some cases due to permissions problem. 999 10002000/05/22 1001 1002Dropped use of readonly pragma. 1003 1004 10052000/04/26 1006 1007Deleted quite a lot of internal error checks to improve speed. 1008 1009Class is now inheritable. 1010 1011 10122000/04/15 1013 1014Have switched constants to readonly scalars, i.e. $TRUE instead of TRUE etc. 1015This makes them easier to use for certain things, e.g. string interpolation 1016and as array indexes or hash keys. The (now deprecated) constants still work 1017but you are recommended to use the constant scalars instead. You will need 1018to install C<readonly.pm> which should be available from wherever you got 1019Math::Logic. 1020 1021The bugs with overload do not occur with perl 5.6.0. Added two tests which are 1022run if perl's version is > 5.005. 1023 1024 10252000/02/27 1026 1027Numerous minor documentation changes to clarify terminology. 1028 1029Two bugs noted. 1030 1031More tests added. 1032 1033 10342000/02/23 1035 1036Corrected multi-degree xor to match the truth table equivalence, i.e. 1037 1038 xor(a,b) == and(or(a,b),not(and(a,b))) 1039 1040which can be expressed in Math::Logic as 1041 1042 $a->xor( $b ) == $a->or( $b )->and( $a->and( $b )->not ) 1043 1044or as 1045 1046 $a ^ $b == ( $a | $b ) & ( ! ( $a & $b ) ) 1047 1048 10492000/02/22 1050 1051Minor correction to _croak so that error messages don't list filename and line 1052twice; plus other minor cleanups to improve error output. 1053 1054Changed the way new_from_string handles string truth values; numeric truth 1055values operate as before. 1056 1057 1058 10592000/02/21 1060 1061Added incompatible method and now deprecate compatible method; this provides 1062better error messages; updated test script. 1063 1064 10652000/02/20 1066 1067Minor documentation fixes. Also eliminated a warning that occurred under 10685.005. 1069 1070 10712000/02/19 1072 1073First version. Ideas taken from my Math::Logic3 and (unpublished) Math::Fuzzy; 1074this module is intended to supercede both. 1075 1076=head1 AUTHOR 1077 1078Mark Summerfield. I can be contacted as <summer@perlpress.com> - 1079please include the word 'logic' in the subject line. 1080 1081=head1 COPYRIGHT 1082 1083Copyright (c) Mark Summerfield 2000. All Rights Reserved. 1084 1085This module may be used/distributed/modified under the LGPL. 1086 1087=cut 1088 1089