[system] / trunk / pg / lib / Value / Formula.pm Repository:
ViewVC logotype

Diff of /trunk/pg/lib/Value/Formula.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 5989 Revision 5990
186 # tolerance, and causes problems when the values 186 # tolerance, and causes problems when the values
187 # differ in magnitude by much. Gavin has found several 187 # differ in magnitude by much. Gavin has found several
188 # situations where this is a problem. 188 # situations where this is a problem.
189 # 189 #
190 if ($l->AdaptParameters($r,$self->{context}->variables->parameters)) { 190 if ($l->AdaptParameters($r,$self->{context}->variables->parameters)) {
191 my $avalues = $l->{test_adapt}; 191 my $avalues = $l->{test_adapt};
192 my $tolerance = $self->getFlag('tolerance',1E-4); 192 my $tolerance = $self->getFlag('tolerance',1E-4);
193 my $isRelative = $self->getFlag('tolType','relative') eq 'relative'; 193 my $isRelative = $self->getFlag('tolType','relative') eq 'relative';
194 my $zeroLevel = $self->getFlag('zeroLevel',1E-14); 194 my $zeroLevel = $self->getFlag('zeroLevel',1E-14);
195 my $zeroLevelTol = $self->getFlag('zeroLevelTol',1E-12); 195 my $zeroLevelTol = $self->getFlag('zeroLevelTol',1E-12);
196 foreach $i (0..scalar(@{$lvalues})-1) { 196 foreach $i (0..scalar(@{$lvalues})-1) {
215 if (ref($lvalues->[$i]) eq 'UNDEF' ^ ref($rvalues->[$i]) eq 'UNDEF') {$domainError = 1; next} 215 if (ref($lvalues->[$i]) eq 'UNDEF' ^ ref($rvalues->[$i]) eq 'UNDEF') {$domainError = 1; next}
216 $cmp = $lvalues->[$i] <=> $rvalues->[$i]; 216 $cmp = $lvalues->[$i] <=> $rvalues->[$i];
217 return $cmp if $cmp; 217 return $cmp if $cmp;
218 } 218 }
219 $l->{domainMismatch} = $domainError; # return this value 219 $l->{domainMismatch} = $domainError; # return this value
220}
221
222#
223# Inherit should make sure the tree is copied
224# (so it's nodes point to the correct equation, for one thing)
225#
226sub inherit {
227 my $self = shift;
228 $self = $self->SUPER::inherit(@_);
229 $self->{tree} = $self->{tree}->copy($self);
230 return $self;
220} 231}
221 232
222# 233#
223# Don't inherit test values or adapted values, or other temporary items 234# Don't inherit test values or adapted values, or other temporary items
224# 235#
461 # 472 #
462 my $M = MatrixReal1->new($d,$d); $M->[0] = \@A; 473 my $M = MatrixReal1->new($d,$d); $M->[0] = \@A;
463 my $B = MatrixReal1->new($d,1); $B->[0] = \@b; 474 my $B = MatrixReal1->new($d,1); $B->[0] = \@b;
464 ($M,$B) = $M->normalize($B); 475 ($M,$B) = $M->normalize($B);
465 $M = $M->decompose_LR; 476 $M = $M->decompose_LR;
477 if (abs($M->det_LR) > 1E-6) {
466 if (($D,$B,$M) = $M->solve_LR($B)) { 478 if (($D,$B,$M) = $M->solve_LR($B)) {
467 if ($D == 0) { 479 if ($D == 0) {
468 # 480 #
469 # Get parameter values and recompute the points using them 481 # Get parameter values and recompute the points using them
470 # 482 #
471 my @a; my $i = 0; my $max = $l->getFlag('max_adapt',1E8); 483 my @a; my $i = 0; my $max = $l->getFlag('max_adapt',1E8);
472 foreach my $row (@{$B->[0]}) { 484 foreach my $row (@{$B->[0]}) {
473 if (abs($row->[0]) > $max) { 485 if (abs($row->[0]) > $max) {
474 $max = Value::makeValue($max); $row->[0] = Value::makeValue($row->[0]); 486 $max = Value::makeValue($max); $row->[0] = Value::makeValue($row->[0]);
475 $l->Error(["Constant of integration is too large: %s\n(maximum allowed is %s)", 487 $l->Error(["Constant of integration is too large: %s\n(maximum allowed is %s)",
476 $row->[0]->string,$max->string]) if $params[$i] eq 'C0' or $params[$i] eq 'n00'; 488 $row->[0]->string,$max->string]) if $params[$i] eq 'C0' or $params[$i] eq 'n00';
477 $l->Error(["Adaptive constant is too large: %s = %s\n(maximum allowed is %s)", 489 $l->Error(["Adaptive constant is too large: %s = %s\n(maximum allowed is %s)",
478 $params[$i],$row->[0]->string,$max->string]); 490 $params[$i],$row->[0]->string,$max->string]);
491 }
492 push @a, $row->[0]; $i++;
479 } 493 }
480 push @a, $row->[0]; $i++;
481 }
482 my $context = $l->context; 494 my $context = $l->context;
483 foreach my $i (0..$#a) {$context->{variables}{$params[$i]}{value} = $a[$i]} 495 foreach my $i (0..$#a) {$context->{variables}{$params[$i]}{value} = $a[$i]}
484 $l->{parameters} = [@a]; 496 $l->{parameters} = [@a];
485 $l->createAdaptedValues; 497 $l->createAdaptedValues;
486 return 1; 498 return 1;
499 }
487 } 500 }
488 } 501 }
489 } 502 }
490 $l->Error("Can't solve for adaptive parameters"); 503 $l->Error("Can't solve for adaptive parameters");
491} 504}

Legend:
Removed from v.5989  
changed lines
  Added in v.5990

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9