#
# This software is Copyright 2005 by Elsevier Inc.  You may use it
# under the terms of the license at http://perl.plover.com/hop/LICENSE.txt .
#



###
### Equation.pm
###

## Chapter 9 section 4.1

sub new {
  my ($base, %self) = @_;
  $class = ref($base) || $base;
  $self{""} = 0 unless exists $self{""};
  for my $k (keys %self) {
    if ($self{$k} == 0 && $k ne "") { delete $self{$k} }
  }
  bless \%self => $class;
}


## Chapter 9 section 4.1.2

BEGIN { $Zero = Equation->new() }
sub coefficient {
  my ($self, $name) = @_;
  $self->{$name} || 0;
}
# Constant part of an equation
sub constant {
  $_[0]->coefficient("");
}
sub varlist {
  my $self = shift;
  grep $_ ne "", keys %$self;
}


## Chapter 9 section 4.1.2

sub arithmetic {
  my ($a, $ac, $b, $bc) = @_;
  my %new;
  for my $k (keys(%$a), keys %$b) {
    my ($av) = $a->coefficient($k);
    my ($bv) = $b->coefficient($k);
    $new{$k} = $ac * $av + $bc * $bv;
  }
  $a->new(%new);
}
sub add_equations {
  my ($a, $b) = @_;

  arithmetic($a, 1, $b, 1);
}
sub subtract_equations {
  my ($a, $b) = @_;

  arithmetic($a, 1, $b, -1);
}
sub scale_equation {
  my ($a, $c) = @_;
  arithmetic($a, $c, $Zero, 0);
}


## Chapter 9 section 4.1.2

# Destructive
sub substitute_for {
  my ($self, $var, $value) = @_;
  my $a = $self->coefficient($var);
  return if $a == 0;
  my $b = $value->coefficient($var);
  die "Oh NO" if $b == 0;  # Should never happen

  my $result = arithmetic($self, 1, $value, -$a/$b);
  %$self = %$result;
}


## Chapter 9 section 4.1.2

sub a_var {
  my $self = shift;
  my ($var) = $self->varlist;
  $var;
}


## Chapter 9 section 4.1.2

package Equation::System;

sub new {
  my ($base, @eqns) = @_;
  my $class = ref $base || $base;
  bless \@eqns => $class;
}
package Equation;

sub is_tautology {
  my $self = shift;
  return $self->constant == 0 && $self->varlist == 0;
}
package Equation::System;

sub equations {
  my $self = shift;
  grep defined, @$self;
}
sub apply {
  my ($self, $func) = @_;
  for my $eq ($self->equations) {
    $func->($eq);
  }
}
sub solve {
  my $self = shift;
  my $N = my @E = $self->equations;
  for my $i (0 .. $N-1) {
    next unless defined $E[$i];
    my $var = $E[$i]->a_var;
    for my $j (0 .. $N-1) {
      next if $i == $j;
      next unless defined $E[$j];
      next unless $E[$j]->coefficient($var);
      $E[$j]->substitute_for($var, $E[$i]);
      if ($E[$j]->is_tautology) { 
        undef $E[$j]; 
      } elsif ($E[$j]->is_inconsistent) {
        return ;
      }
    }
  }
  $self->normalize;
  return 1;
}


## Chapter 9 section 4.1.2

package Equation;

sub is_inconsistent {
  my $self = shift;
  return $self->constant != 0 && $self->varlist == 0;
}


## Chapter 9 section 4.1.2

package Equation::System;

sub normalize {
  my $self = shift;
  $self->apply(sub { $_[0]->normalize });
}
package Equation;

sub normalize {
  my $self = shift;
  my $var = $self->a_var;
  return unless defined $var;
  %$self = %{$self->scale_equation(1/$self->coefficient($var))};
}
sub defines_var {
  my $self = shift;
  my @keys = keys %$self;
  return unless @keys == 2;
  my $var = $keys[0] || $keys[1];
  return $self->{$var} == 1 ? $var : () ;
}
package Equation::System;

sub values {
  my $self = shift;
  my %values;
  $self->solve;
  for my $eqn ($self->equations) {
    if (my $name = $eqn->defines_var) {
      $values{$name} = -$eqn->constant;
    }
  }
  %values;
}

1;