1#!/usr/bin/perl 2 3# Opp.pm - A perl representation mathematicall expressions. 4# (c) Copyright 1998 Hakan Ardo <hakan@debian.org> 5# 6# This program is free software; you can redistribute it and/or modify 7# it under the terms of the GNU General Public License as published by 8# the Free Software Foundation; either version 2 of the License, or 9# any later version. 10# 11# This program is distributed in the hope that it will be useful, 12# but WITHOUT ANY WARRANTY; without even the implied warranty of 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14# GNU General Public License for more details. 15# 16# You should have received a copy of the GNU General Public License 17# along with this program; if not, write to the Free Software 18# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20=head1 NAME 21 22 Math::Expr::Opp - Represents one operation in the parsed expression 23 tree 24 25=head1 SYNOPSIS 26 27 require Math::Expr::Opp; 28 require Math::Expr::Var; 29 require Math::Expr::Num; 30 31 # To represent the expression "x+7": 32 $n=new Math::Expr::Opp("+"); 33 $n->SetOpp(0,new Math::Expr::Var("x")); 34 $n->SetOpp(1,new Math::Expr::Num(7)); 35 print $n->tostr . "\n"; 36 37=head1 DESCRIPTION 38 39 Used by the Math::Expr to represent algebraic expressions. This class 40 represents one operation or function with a set of operands, which 41 in turn can be other Math::Expr::Opp objects. And in that way we are 42 able to represent entire expression. 43 44 Operations like a+b and functions like sin(a) or f(a,b) are all 45 represented by this kind of objects with "+", "sin" and "f" as the 46 operation- or function names and Math::Expr::Var(a) and 47 Math::Expr::Var(b) as operands (only a in the sin example). 48 49=head1 METHODS 50 51=cut 52 53package Math::Expr::Opp; 54use strict; 55 56use Math::Expr qw ($Pri $OppDB); 57require Math::Expr::MatchSet; 58require Math::Expr::Node; 59require Math::Expr::VarSet; 60use vars qw(@ISA); 61 62use Math::Expr::Node; 63@ISA = qw(Math::Expr::Node); 64 65=head2 $e=new Math::Expr::Opp($name,$db) 66 67 Creates a new operation object with the operation- or function-name 68 $name. Using the operations defined in $db. See 69 L<Math::Expr::OpperationDB> for more info. 70 71=cut 72 73sub new { 74 my($class, $val) = @_; 75 my $self = bless { }, $class; 76 77 if (!ref $OppDB || !ref $Pri) { 78 warn "OppDB not initiated, please set it using SetOppDB(...)"; 79 } 80 81 $self->{'Val'}=$val; 82 $self->Breakable(0); 83 84 $self; 85 86} 87 88=head2 $e->SetOpp($i, $v) 89 90 Sets operand number $i to $v. 91 92=cut 93 94sub SetOpp { 95 my ($self, $i, $val) = @_; 96 97 # Sanity checks 98 defined $i || warn "Bad param i."; 99 $val->isa("Math::Expr::Node") || warn "Bad param val: $val"; 100 !$self->InTable || warn "Can't edit items in the table"; 101 102 delete $self->{'Op'}; 103 104 $self->{'Opps'}[$i]=$val; 105} 106 107=head2 $e->Opp($i) 108 109 Returns operand to number $i. 110 111=cut 112 113sub Opp { 114 my ($self, $i) = @_; 115 116 # Sanity checks 117 defined $i || warn "Bad param i."; 118 119 $self->{'Opps'}[$i]; 120} 121 122=head2 $e->tostr 123 124 Returns a string representation of the entire expression to be 125 used for debugging. 126 127=cut 128 129sub tostr { 130 my $self = shift; 131 my $str=$self->{'Val'}."("; 132 my $i; 133 134 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 135 if (ref $self->{'Opps'}[$i]) { 136 $str .= $self->{'Opps'}[$i]->tostr; 137 } else { 138 $str .= "?"; 139 } 140 if ($i+1<=$#{$self->{'Opps'}}) { 141 $str .= ","; 142 } 143 } 144 "$str)"; 145} 146 147=head2 $e->strtype 148 149 Returns a string representation of this expressions entire type, 150 without simplifying it. In the same notation as the tostr method. 151 152=cut 153 154sub strtype { 155 my $self = shift; 156 my $str=$self->{'Val'}."("; 157 my $i; 158 159 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 160 $str .= $self->{'Opps'}[$i]->strtype; 161 if ($i+1<=$#{$self->{'Opps'}}) { 162 $str .= ","; 163 } 164 } 165 "$str)"; 166} 167 168=head2 $n->Simplify 169 170 Simplifys the expression to some normal from. 171 172=cut 173 174sub op { 175 my ($self, $force)=@_; 176 if ($force || !$self->{'Op'}) { 177 $self->{'Op'}=$OppDB->Find($self->DBType); 178 } 179 return $self->{'Op'}; 180} 181 182sub Simplify { 183 my ($self)=@_; 184 my $i; 185 my $op; 186 187 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 188 $self->{'Opps'}[$i]=$self->{'Opps'}[$i]->Simplify; 189 } 190 191 $op=$self->op(1); 192 193 # Type specific simplification rules 194 if ($op->{'simp'}) { 195 my $vs=new Math::Expr::VarSet; 196 197 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 198 $vs->Set(chr(97+$i), $self->{'Opps'}[$i]); 199 } 200# print $vs->tostr . "\n"; 201 202 my $e=$op->{'simp'}->Copy; 203 $e=$e->Subs($vs); 204 205# print $e->tostr . "\n"; 206 207 foreach (keys %{$e}) { 208 $self->{$_}=$e->{$_}; 209 } 210 $op=$self->op(1); 211 } 212 213 # (a+b)+c => a+b+c 214 if ($op->{'ass'}) { 215 my @nopp; 216 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 217 if ($self->{'Val'} eq $self->{'Opps'}[$i]{'Val'}) { 218 foreach (@{$self->{'Opps'}[$i]{'Opps'}}) { 219 push(@nopp, $_); 220 } 221 } else { 222 push (@nopp, $self->{'Opps'}[$i]); 223 } 224 } 225 $self->{'Opps'}=\@nopp; 226 } 227 228 # a+c+b => a+b+c 229 if ($op->{'com'}) { 230 my @nopp = sort {$a->tostr cmp $b->tostr} @{$self->{'Opps'}}; 231 $self->{'Opps'}=\@nopp; 232 } 233 delete $self->{'Op'}; 234 return $self->IntoTable; 235} 236 237 238=head2 $n->BaseType 239 240 Returns a string type of this expression simplifyed as much as 241 possible. 242 243=cut 244 245sub BaseType { 246 my ($self)=@_; 247 my $op; 248 my $str=$self->DBType; 249 250 $op= $self->op; 251 if ($op) {$str=$op->{'out'}} 252 253 $str; 254} 255 256sub DBType { 257 my ($self)=@_; 258 my $str=$self->{'Val'}."("; 259 my $i; 260 261 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 262 $str .= $self->{'Opps'}[$i]->BaseType; 263 if ($i+1<=$#{$self->{'Opps'}}) { 264 $str .= ","; 265 } 266 } 267 "$str)"; 268} 269 270sub power { 271 my ($a, $b) = @_; 272 my $i; 273 my $sum=1; 274 275 for ($i=0; $i<$b; $i++) { 276 $sum=$sum*$a 277 } 278 $sum; 279} 280 281=head2 $n->SubMatch($rules,$match) 282 283 Tries to match $rules to this expretions and adds the substitutions 284 needed to $match.Returns 1 if the match excists and the substitutions 285 needed can coexcist with those already in $match otherwise 0. 286 287=cut 288 289sub _SubMatch { 290 my ($self, $rule, $mset) = @_; 291 my $op=$self->op; 292 293 $self->InTable || warn "self not in table!"; 294 $rule->InTable || warn "rule not in table!"; 295 296 if ($rule->isa('Math::Expr::Var') && 297 $rule->BaseType eq $self->BaseType 298 ) { 299 return $mset->SetAll($rule->{'Val'},$self); 300 } 301 elsif ($rule->isa('Math::Expr::Opp') && 302 $rule->{'Val'} eq $self->{'Val'}) { 303 if ($op->{'ass'}) { 304 if ($op->{'com'}) { 305 my @part; 306 my @pcnt; 307 my ($i,$j,$cnt); 308 my $p=$#{$rule->{'Opps'}} + 1; 309 my $s=$#{$self->{'Opps'}} + 1; 310 my $ps=power($p,$s) - 1; 311 my $resset = new Math::Expr::MatchSet; 312 my $m; 313 my $t; 314 my $a; 315 my $ok; 316 317 for ($i=1; $i<$ps; $i++) { 318 for ($j=0; $j<$p; $j++) { 319 $part[$j]=new Math::Expr::Opp($self->{'Val'}); 320 $pcnt[$j]=0; 321 } 322 $cnt=0; 323 324 $t=$i; 325 for ($j=0; $j<$s; $j++) { 326 $a= $t % $p; 327 $part[$a]->{'Opps'}[$pcnt[$a]]=$self->{'Opps'}[$cnt]; 328 $pcnt[$a]++; 329 $cnt++; 330 $t=int($t/$p); 331 } 332 333 $a=1; 334 for ($j=0; $j<$p; $j++) { 335# print $part[$j]->tostr . "\t"; 336 if (!defined $part[$j]->{'Opps'}[0]) {$a=0; last;} 337 if (!defined $part[$j]->{'Opps'}[1]) { 338 $part[$j]=$part[$j]->{'Opps'}[0]; 339 } 340 $part[$j]=$part[$j]->IntoTable; 341 } 342# print "\n"; 343 344 if ($a) { 345 $m=$mset->Copy; 346 $m->AddPos("($i)"); 347# print "m:\n" . $m->tostr . "\n"; 348 $ok=1; 349 for ($j=0; $j<$p; $j++) { 350 my $t=$part[$j]->SubMatch($rule->{'Opps'}[$j],$m); 351 if (!$t) { 352 $ok=0; 353 } 354 } 355 if ($ok) {$resset->Insert($m);} 356 } 357 } 358 359# print "res:\n" . $resset->tostr . "\n"; 360 361 $mset->Clear; 362 $mset->Insert($resset); 363 return 1; 364 } else { 365 #FIXME: Handle ass only objs... 366 } 367 } 368 elsif ($#{$self->{'Opps'}} eq $#{$rule->{'Opps'}}) { 369 my $ok=1; 370 my $i; 371 372 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 373 if (!$self->{'Opps'}[$i]->SubMatch($rule->{'Opps'}[$i],$mset)) { 374 $ok=0; 375 last; 376 } 377 } 378 return $ok; 379 } else { 380 return 0; 381 } 382 } else { 383 return 0; 384 } 385} 386 387=head2 $n->Match($rules) 388 389 Tries to match $rules to this expretions and to all its subexpretions. 390 Returns a MatchSet object specifying where the matches ocored and what 391 substitutions they represent. 392 393=cut 394 395sub _Match { 396 my ($self, $rule, $pos, $pre) = @_; 397 my $i; 398 my $mset = new Math::Expr::MatchSet; 399 my $op=$self->op; 400 401 $self->InTable || warn "self not in table!"; 402 $rule->InTable || warn "rule not in table!"; 403 404 if (!defined $pos) {$pos="";} 405 if (!defined $pre) {$pre=new Math::Expr::VarSet} 406 407 $mset->Set($pos, $pre->Copy); 408 if (!$self->SubMatch($rule, $mset)) { 409 $mset->del($pos); 410 } 411 412 if ($pos ne "") {$pos .=","} 413 414 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 415 my $m=$self->SubExpr($i)->IntoTable->Match($rule, "$pos$i", $pre->Copy); 416 $mset->Insert($m); 417 } 418 419 $mset; 420} 421 422sub SubOpp { 423 my ($self, $a,$b) = @_; 424 my $i; 425 my $o= new Math::Expr::Opp($self->{'Val'}); 426 427 # Sanity checks 428 defined $a|| warn("Bad param a."); 429 defined $b|| warn("Bad param b."); 430 431 if ($a==$b) {return $self->{'Opps'}[$a]} 432 433 for ($i=$a; $i<=$b; $i++) { 434 $o->SetOpp($i-$a,$self->{'Opps'}[$i]); 435 } 436 return $o->IntoTable; 437} 438 439=head2 $n->Subs($vars) 440 441 Substitues all variables in the expretion with there vaules in $vars. 442 443=cut 444 445sub _Subs { 446 my ($self, $vars) = @_; 447 my $i; 448 my $n = new Math::Expr::Opp($self->{'Val'}); 449 450 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 451 $n->{'Opps'}[$i]=$self->{'Opps'}[$i]->Subs($vars); 452 } 453 $n; 454} 455 456=head2 $n->Copy 457 458Returns a copy of this object. 459 460=cut 461 462sub _Copy { 463 my $self = shift; 464 my $n = new Math::Expr::Opp($self->{'Val'}); 465 my $i; 466 467 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 468 $n->{'Opps'}[$i]=$self->{'Opps'}[$i]->Copy; 469 } 470 $n; 471} 472 473=head2 $n->Breakable 474 475 Used by the parser to indikate if this object was created using 476 parantesis or if he should break it up to preserve the rules of order 477 between the diffrent opperations. 478 479=cut 480 481sub _Breakable { 482 my $self=shift; 483 my $val=shift; 484 485 if (defined $val) {$self->{'Breakable'}=$val} 486 $self->{'Breakable'} 487} 488 489=head2 $n->Find($pos) 490 491 Returns an object pointer to the subexpression represented by the 492 string $pos. 493 494=cut 495 496sub Find { 497 my ($self, $pos) = @_; 498 499 # Sanity checks 500 defined $pos || warn "Bad param pos."; 501 502 if ($pos =~ s/^(\d+),?//) { 503 return $self->SubExpr($1)->Find($pos); 504 } else { 505 return $self; 506 } 507} 508 509sub SubExpr { 510 my ($self, $pos, $rest) = @_; 511 my $op=$self->op; 512 513 # Sanity checks 514 defined $pos || warn "Bad param pos."; 515 if (ref $rest) { 516 $rest->isa("Math::Expr::Opp") || warn "Bad param rest: $rest"; 517 !$rest->InTable || warn "Can't edit items in the table"; 518 } 519 elsif(defined $rest) { 520 warn "Bad param rest: $rest"; 521 } 522 523 if ($op->{'ass'} && $op->{'com'}) { 524 my ($part, $j); 525 my $cnt=0; 526 my $rcnt=0; 527 528 $part=new Math::Expr::Opp($self->{'Val'}); 529 530 for($j=0; $j<=$#{$self->{'Opps'}}; $j++) { 531 if ($j!=$pos) { 532 $part->{'Opps'}[$cnt]=$self->{'Opps'}[$j]; 533 $cnt++; 534 } 535 elsif(ref $rest) { 536 $rest->{'Opps'}[$rcnt]=$self->{'Opps'}[$j]; 537 $rcnt++; 538 } 539 } 540 541 if (!defined $part->{'Opps'}[1]) {$part=$part->{'Opps'}[0];} 542 return $part; #->IntoTable; 543 } else { 544 return $self->{'Opps'}[$pos]; 545 } 546} 547 548=head2 $n->Set($pos, $val) 549 550 Replaces the subexpression at position $pos with $val. 551 552=cut 553 554sub _Set { 555 my ($self, $pos, $val) = @_; 556 my $op=$self->op; 557 558 $pos =~ s/\(\d+\)//g; 559 560 if ($pos eq "") { 561 return $val; 562 } else { 563 $pos =~ s/^(\d+),?//; 564 my $i=$1; 565 566 if ($op->{'ass'} && $op->{'com'}) { 567 my $rest=new Math::Expr::Opp($self->{'Val'}); 568 my $part=$self->SubExpr($i, $rest)->Set($pos,$val); 569 my $n=new Math::Expr::Opp($self->{'Val'}); 570 571 if (!defined $rest->{'Opps'}[1]) {$rest=$rest->{'Opps'}[0];} 572 573 $n->{'Opps'}[0]=$rest; 574 $n->{'Opps'}[1]=$part; 575 return $n; 576 } else { 577 $self->{'Opps'}[$i]=$self->{'Opps'}[$i]->Set($pos,$val); 578 } 579 return $self; 580 } 581} 582 583sub _toMathML { 584 my $self = shift; 585 my @p; 586 my $i; 587 my $op = $self->op; 588 589 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 590 $p[$i]=$self->{'Opps'}[$i]->toMathML; 591 if (!defined $op->{'noparammathml'} || !eval($op->{'noparammathml'})) { 592 if ($self->{'Opps'}[$i]->isa('Math::Expr::Opp')) { 593 if (!$op->{'ass'} || $self->{'Opps'}[$i]{'Val'} ne $self->{'Val'}) { 594 if (defined $Pri->{$self->{'Val'}} && 595 defined $Pri->{$self->{'Opps'}[$i]{'Val'}}) { 596 if ($Pri->{$self->{'Val'}} >= 597 $Pri->{$self->{'Opps'}[$i]{'Val'}}) { 598 $p[$i]='<mrow><mo fence="true">(</mo>'.$p[$i]. 599 '<mo fence="true">)</mo></mrow>'; 600 } 601 } 602 } 603 } 604 } 605 } 606 607 if (defined $op->{'prmathml'}) { 608 eval($op->{'prmathml'}); 609 } else { 610 if ($self->{'Val'} =~ /^[^a-zA-Z0-9\(\)\,\.\:]+$/) { 611 "<mrow>".join ("<mo>".$self->{'Val'}."</mo>", @p)."</mrow>"; 612 } else { 613 '<mrow><mi fontstyle="normal">'.$self->{'Val'}.'</mi>'. 614 '<mo fence="true">(</mo>'.join (", ", @p) . "". 615 '<mo fence="true">)</mo></mrow>' 616 } 617 } 618} 619 620sub toText { 621 my $self = shift; 622 my @p; 623 my $i; 624 my $op = $self->op; 625 626 for ($i=0; $i<=$#{$self->{'Opps'}}; $i++) { 627 $p[$i]=$self->{'Opps'}[$i]->toText; 628 if ($self->{'Opps'}[$i]->isa('Math::Expr::Opp')) { 629 if (!$op->{'ass'} || $self->{'Opps'}[$i]{'Val'} ne $self->{'Val'}) { 630 if (defined $Pri->{$self->{'Val'}} && 631 defined $Pri->{$self->{'Opps'}[$i]{'Val'}}) { 632 if ($Pri->{$self->{'Val'}} >= 633 $Pri->{$self->{'Opps'}[$i]{'Val'}}) { 634 $p[$i]='('.$p[$i].')'; 635 } 636 } 637 } 638 } 639 } 640 641 if ($self->{'Val'} =~ /^[^a-zA-Z0-9\(\)\,\.\:]+$/) { 642 join ($self->{'Val'}, @p); 643 } else { 644 $self->{'Val'}.'('.join (", ", @p).')' 645 } 646} 647 648=head1 AUTHOR 649 650 Hakan Ardo <hakan@debian.org> 651 652=head1 SEE ALSO 653 654 L<Math::Expr> 655 656=cut 657 6581; 659