# # 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;