Skip to content

Commit

Permalink
initial draft of boolean context
Browse files Browse the repository at this point in the history
  • Loading branch information
drdrew42 committed Mar 9, 2024
1 parent a9d9280 commit 15b2636
Showing 1 changed file with 160 additions and 0 deletions.
160 changes: 160 additions & 0 deletions macros/contexts/contextBoolean.pl
Original file line number Diff line number Diff line change
@@ -0,0 +1,160 @@
## contextBoolean.pl

sub _contextBoolean_init { context::Boolean::Init() }

package context::Boolean;

sub Init {
my $context = $main::context{Boolean} = Parser::Context->getCopy("Numeric");
$context->{name} = "Boolean";
$context->{value}{Formula} = "context::Boolean::Formula";

## Disable unwanted operations and functions
$context->functions->disable('All');
# $context->parens->undefine('<');
$context->operators->undefine('-', '/', ' /', '/ ', '//', '^', '**', 'u+', '!');
$context->operators->redefine('><');

## Re-enable necessary operations
$context->operators->set(
'+' => { class => "Parser::BOP::or", string => ' or ', TeX => '\vee ', perl => '||' },
'or' => { class => "Parser::BOP::or", string => ' or ', TeX => '\vee ', perl => '||' },
'and' => { class => "Parser::BOP::and", string => ' and ', TeX => '\wedge ', perl => '&&' },
'*' => { class => "Parser::BOP::and", string => ' and ', TeX => '\wedge ', perl => '&&' },
' *' => { class => "Parser::BOP::and", string => ' and ', TeX => '\wedge ', perl => '&&' },
'* ' => { class => "Parser::BOP::and", string => ' and ', TeX => '\wedge ', perl => '&&' },
# implicit multiplication must have string '*' for Parser::Op (L#314)
' ' => { class => "Parser::BOP::and", string => ' *', TeX => '\wedge ' },
'u-' => { class => "Parser::UOP::not", string => '-', TeX => '\mathord{\sim}' },
'><' => { class => "Parser::BOP::xor", string => ' xor ', TeX => '\oplus ' },
'xor' => { class => "Parser::BOP::xor", string => ' xor ', TeX => '\oplus ' },
);

## Set default variables 'p' and 'q'
$context->variables->are(
p => 'Real',
q => 'Real',
);
}

## Subclass Value::Formula for boolean formulas
package context::Boolean::Formula;
our @ISA = ('Value::Formula');

sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);

my @variables = $self->{context}->variables->names;
my @points;
my @values;

my $f = $self->{f} = $self->perlFunction(undef, \@variables);

foreach my $combination (0 .. 2**@variables - 1) {
my @point = map { $combination & 2**$_ ? 1 : 0 } (0 .. $#variables);
my $value = &$f(@point) ? 1 : 0;
push @points, \@point;
push @values, $value;
}

$self->{test_points} = \@points;
$self->{test_values} = \@values;

return $self;
}

package Parser::BOP::or;
our @ISA = qw(Parser::BOP);

sub _check {
my $self = shift;
# Add logic to check compatibility for logical 'or'
return 1;
}

sub _eval { return $_[1] || $_[2] ? 1 : 0 }

sub _reduce {
my $self = shift;
# Implement reduction for logical 'or'
return 1;
}

sub perl {
my $self = shift;
my $perl = $self->SUPER::perl(@_);
return "($perl ? 1 : 0)";
}

package Parser::BOP::and;
our @ISA = qw(Parser::BOP);

sub _check {
my $self = shift;
# Add logic to check compatibility for logical 'and'
return 1;
}

sub _eval { return $_[1] && $_[2] ? 1 : 0 }

sub _reduce {
my $self = shift;
# Implement reduction for logical 'and'
return 1;
}

sub perl {
my $self = shift;
my $perl = $self->SUPER::perl(@_);
return "($perl ? 1 : 0)";
}

package Parser::UOP::not;
our @ISA = qw(Parser::UOP);

sub _check {
my $self = shift;
# Add logic to check compatibility for logical 'not'
}

sub _eval { !($_[1]) ? 1 : 0 }

sub _reduce {
my $self = shift;
# Implement reduction for logical 'not'
}

sub perl {
my $self = shift;
my $perl = $self->SUPER::perl(@_);
return "($perl ? 1 : 0)";
}

package Parser::BOP::xor;
our @ISA = qw(Parser::BOP);

sub _check {
my $self = shift;
# Add logic to check compatibility for logical 'not'
}

sub _eval { ($_[1] ? !$_[2] : !!$_[2]) ? 1 : 0 }

sub perl {
my $self = shift;
return
'('
. '('
. $self->{lop}->perl(1) . ' ? ' . '!'
. $self->{rop}->perl(1) . ' : ' . '!!'
. $self->{rop}->perl(1)
. ') ? 1 : 0)';
}

sub _reduce {
my $self = shift;
# Implement reduction for logical 'not'
}

1;

0 comments on commit 15b2636

Please sign in to comment.