Data update
This commit is contained in:
parent
81fd053722
commit
52a6ef48dd
10248 changed files with 63654 additions and 6775 deletions
|
|
@ -46,7 +46,7 @@ BEGIN # Steffenses's method - translated from the ATS sample #
|
|||
|
||||
PROC implicit equation = ( REAL x, y )REAL: ( 5 * x * x ) + y - 5;
|
||||
|
||||
PROC f = ( REAL t )REAL: # find fixed points of this function #
|
||||
PROC fn = ( REAL t )REAL: # find fixed points of this function #
|
||||
BEGIN
|
||||
REAL x = x convex left parabola( t );
|
||||
REAL y = y convex left parabola( t );
|
||||
|
|
@ -60,7 +60,7 @@ BEGIN # Steffenses's method - translated from the ATS sample #
|
|||
REAL t0 := 0;
|
||||
TO 11 DO
|
||||
print( ( "t0 = ", FMT t0, " : " ) );
|
||||
CASE steffensen aitken( f, t0, 0.00000001, 1000 )
|
||||
CASE steffensen aitken( fn, t0, 0.00000001, 1000 )
|
||||
IN ( VOID ): print( ( "no answer", newline) )
|
||||
, ( REAL t ):
|
||||
IF REAL x = x convex left parabola( t )
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ int main() {
|
|||
cout << "t0 = " << setprecision(1) << t0 << " : ";
|
||||
t = steffensenAitken(f, t0, 0.00000001, 1000);
|
||||
if (isnan(t)) {
|
||||
cout << "no answer << endl;
|
||||
cout << "no answer" << endl;
|
||||
} else {
|
||||
x = xConvexLeftParabola(t);
|
||||
y = yConvexRightParabola(t);
|
||||
|
|
|
|||
63
Task/Steffensens-method/Perl/steffensens-method.pl
Normal file
63
Task/Steffensens-method/Perl/steffensens-method.pl
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
# 20240922 Perl programming solution
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
sub aitken {
|
||||
my ($f, $p0) = @_;
|
||||
my $p2 = $f->( my $p1 = $f->($p0) );
|
||||
return $p0 - ($p1 - $p0)**2 / ($p2 - 2 * $p1 + $p0);
|
||||
}
|
||||
|
||||
sub steffensenAitken {
|
||||
my ($f, $pinit, $tol, $maxiter) = @_;
|
||||
my ($iter,$p) = (1, aitken($f, my $p0 = $pinit) );
|
||||
|
||||
while (abs($p - $p0) > $tol && $iter < $maxiter) {
|
||||
$p = aitken($f, $p0 = $p);
|
||||
$iter++
|
||||
}
|
||||
return abs($p - $p0) > $tol ? 'NaN' : $p;
|
||||
}
|
||||
|
||||
sub deCasteljau {
|
||||
my ($c0, $c1, $c2, $t) = @_;
|
||||
my $s = 1.0 - $t;
|
||||
return $s * ($s * $c0 + $t * $c1) + $t * ($s * $c1 + $t * $c2);
|
||||
}
|
||||
|
||||
sub xConvexLeftParabola {
|
||||
my ($t) = @_;
|
||||
return deCasteljau(2.0, -8.0, 2.0, $t);
|
||||
}
|
||||
|
||||
sub yConvexRightParabola {
|
||||
my ($t) = @_;
|
||||
return deCasteljau(1.0, 2.0, 3.0, $t);
|
||||
}
|
||||
|
||||
sub implicitEquation {
|
||||
my ($x, $y) = @_;
|
||||
return 5.0 * ($x ** 2) + $y - 5.0;
|
||||
}
|
||||
|
||||
sub f {
|
||||
my ($t) = @_;
|
||||
return implicitEquation(xConvexLeftParabola($t), yConvexRightParabola($t)) + $t;
|
||||
}
|
||||
|
||||
for (my $t0 = 0.0, my $i = 0; $i < 11; ++$i) {
|
||||
printf("t0 = %.1f : ", $t0);
|
||||
my $t = steffensenAitken(\&f, $t0, 1e-8, 1000);
|
||||
|
||||
if ($t eq 'NaN') {
|
||||
print "no answer\n";
|
||||
} else {
|
||||
my ($x, $y) = (xConvexLeftParabola($t), yConvexRightParabola($t));
|
||||
if (abs(implicitEquation($x, $y)) <= 1e-6) {
|
||||
printf("intersection at (%f, %f)\n", $x, $y);
|
||||
} else {
|
||||
print "spurious solution\n";
|
||||
}
|
||||
}
|
||||
$t0 += 0.1;
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue