Bernstein basis polynomials: Difference between revisions
Added Algol 68 translation of the Algol 60 sample
m (Pointing out more rounding errors.) |
(Added Algol 68 translation of the Algol 60 sample) |
||
Line 331:
bern ( 1 , 1 , 1 ) --> bern ( 1 , 1 , 1 , 1 )
bern ( 1 , 2 , 6 ) --> bern ( 1 , 1.66666666667 , 3.33333333333 , 6 )</pre>
=={{header|ALGOL 68}}==
<syntaxhighlight lang="algol68">
BEGIN # Bernstein Basis Polynomials - translated from the Algol 60 #
# Note the "Subrptoghram (n) designations are as specified in the #
# task #
# Subprogram (1): transform monomial coefficients #
# a0, a1, a2 to Bernstein coefficients b0, b1, b2 #
PROC tobern2 = ( REAL a0, a1, a2, REF REAL b0, b1, b2 )VOID:
BEGIN
b0 := a0;
b1 := a0 + ((1/2) * a1);
b2 := a0 + a1 + a2
END # tobern2 # ;
# Subprogram (2): evaluate, at t, the polynomial with #
# Bernstein coefficients b0, b1, b2. Use de Casteljau's #
# algorithm #
PROC evalbern2 = ( REAL b0, b1, b2, t )REAL:
BEGIN
REAL s = 1 - t;
REAL b01 = (s * b0) + (t * b1);
REAL b12 = (s * b1) + (t * b2);
(s * b01) + (t * b12)
END # evalbern2 # ;
# Subprogram (3): transform monomial coefficients #
# a0, a1, a2, a3 to Bernstein coefficients b0, b1, #
# b2, b3 #
PROC tobern3 = ( REAL a0, a1, a2, a3, REF REAL b0, b1, b2, b3 )VOID:
BEGIN
b0 := a0;
b1 := a0 + ((1/3) * a1);
b2 := a0 + ((2/3) * a1) + ((1/3) * a2);
b3 := a0 + a1 + a2 + a3
END # tobern3 # ;
# Subprogram (4): evaluate, at t, the polynomial #
# with Bernstein coefficients b0, b1, b2, b3. Use #
# de Casteljau's algorithm #
PROC evalbern3 = ( REAL b0, b1, b2, b3, t )REAL:
BEGIN
REAL s = 1 - t;
REAL b01 = (s * b0) + (t * b1);
REAL b12 = (s * b1) + (t * b2);
REAL b23 = (s * b2) + (t * b3);
REAL b012 = (s * b01) + (t * b12);
REAL b123 = (s * b12) + (t * b23);
(s * b012) + (t * b123)
END # evalbern3 #;
# Subprogram (5): transform the quadratic Bernstein #
# coefficients q0, q1, q2 to the cubic Bernstein #
# coefficients c0, c1, c2, c3; #
PROC bern2to3 = ( REAL q0, q1, q2, REF REAL c0, c1, c2, c3 )VOID:
BEGIN
c0 := q0;
c1 := ((1/3) * q0) + ((2/3) * q1);
c2 := ((2/3) * q1) + ((1/3) * q2);
c3 := q2
END # bern2to3 # ;
BEGIN
# returns x as a string without trailing 0 decoimals #
PROC f = ( REAL x )STRING:
BEGIN
STRING v := fixed( x, -14, 11 );
INT end pos := UPB v;
WHILE IF end pos < LWB v THEN FALSE ELSE v[ end pos ] = "0" FI DO
end pos -:= 1
OD;
IF end pos >= LWB v THEN
IF v[ end pos ] = "." THEN end pos -:= 1 FI
FI;
INT start pos := LWB v;
WHILE IF start pos > end pos THEN FALSE ELSE v[ start pos ] = " " FI DO
start pos +:= 1
OD;
IF end pos < start pos THEN "0" ELSE v[ start pos : end pos ] FI
END # f # ;
REAL p0b2 := 0, p1b2 := 0, p2b2 := 0;
REAL q0b2 := 0, q1b2 := 0, q2b2 := 0;
REAL p0b3 := 0, p1b3 := 0, p2b3 := 0, p3b3 := 0;
REAL q0b3 := 0, q1b3 := 0, q2b3 := 0, q3b3 := 0;
REAL r0b3 := 0, r1b3 := 0, r2b3 := 0, r3b3 := 0;
REAL pc0 := 0, pc1 := 0, pc2 := 0, pc3 := 0;
REAL qc0 := 0, qc1 := 0, qc2 := 0, qc3 := 0;
REAL x, y;
REAL p0m = 1, p1m = 0, p2m = 0;
REAL q0m = 1, q1m = 2, q2m = 3;
REAL r0m = 1, r1m = 2, r2m = 3, r3m = 4;
tobern2( p0m, p1m, p2m, p0b2, p1b2, p2b2 );
tobern2( q0m, q1m, q2m, q0b2, q1b2, q2b2 );
print( ( "Subprogram (1) examples:", newline ) );
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m )
, " ) --> bern ( ", f( p0b2 ), ", ", f( p1b2 ), ", ", f( p2b2 )
, " )", newline
)
);
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m )
, " ) --> bern ( ", f( q0b2 ), ", ", f( q1b2 ), ", ", f( q2b2 )
, " )", newline
)
);
print( ( "Subprogram (2) examples:", newline ) );
x := 0.25;
y := evalbern2( p0b2, p1b2, p2b2, x );
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
y := evalbern2( p0b2, p1b2, p2b2, x );
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
x := 0.25;
y := evalbern2( q0b2, q1b2, q2b2, x );
print( ( " q ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
y := evalbern2( q0b2, q1b2, q2b2, x );
print( ( " q ( ", f( x ), " ) = ", f( y ), newline ) );
tobern3( p0m, p1m, p2m, 0, p0b3, p1b3, p2b3, p3b3 );
tobern3( q0m, q1m, q2m, 0, q0b3, q1b3, q2b3, q3b3 );
tobern3( r0m, r1m, r2m, r3m, r0b3, r1b3, r2b3, r3b3 );
print( ( "Subprogram (3) examples:", newline ) );
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m ), ", ", f( 0 )
, " ) --> bern ( ", f( p0b3 ), ", ", f( p1b3 ), ", ", f( p2b3 ), ", ", f( p3b3 )
, " )", newline
)
);
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m ), ", ", f( 0 )
, " ) --> bern ( ", f( q0b3 ), ", ", f( q1b3 ), ", ", f( q2b3 ), ", ", f( q3b3 )
, " )", newline
)
);
print( ( " mono ( ", f( r0m ), ", ", f( r1m ), ", ", f( r2m ), ", ", f( r3m )
, " ) --> bern ( ", f( r0b3 ), ", ", f( r1b3 ), ", ", f( r2b3 ), ", ", f( r3b3 )
, " )", newline
)
);
print( ( "Subprogram (4) examples:", newline ) );
x := 0.25;
y := evalbern3( p0b3, p1b3, p2b3, p3b3, x );
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
y := evalbern3( p0b3, p1b3, p2b3, p3b3, x );
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
x := 0.25;
y := evalbern3( q0b3, q1b3, q2b3, q3b3, x );
print( ( " q ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
y := evalbern3( q0b3, q1b3, q2b3, q3b3, x );
print( ( " q ( ", f( x ), " ) = ", f( y ), newline ) );
x := 0.25;
y := evalbern3( r0b3, r1b3, r2b3, r3b3, x );
print( ( " r ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
y := evalbern3( r0b3, r1b3, r2b3, r3b3, x );
print( ( " r ( ", f( x ), " ) = ", f( y ), newline ) );
bern2to3( p0b2, p1b2, p2b2, pc0, pc1, pc2, pc3 );
bern2to3( q0b2, q1b2, q2b2, qc0, qc1, qc2, qc3 );
print( ( "Subprogram (5) examples:", newline ) );
print( ( " bern ( ", f( p0b2 ), ", ", f( p1b2 ), ", ", f( p2b2 )
, " ) --> bern ( ", f( pc0 ), ", ", f( pc1 ), ", ", f( pc2 ), ", ", f( pc3 )
, " )", newline
)
);
print( ( " bern ( ", f( q0b2 ), ", ", f( q1b2 ), ", ", f( q2b2 )
, " ) --> bern ( ", f( qc0 ), ", ", f( qc1 ), ", ", f( qc2 ), ", ", f( qc3 )
, " )", newline
)
)
END
END
</syntaxhighlight>
{{out}}
<pre>
Subprogram (1) examples:
mono ( 1, 0, 0 ) --> bern ( 1, 1, 1 )
mono ( 1, 2, 3 ) --> bern ( 1, 2, 6 )
Subprogram (2) examples:
p ( 0.25 ) = 1
p ( 7.5 ) = 1
q ( 0.25 ) = 1.6875
q ( 7.5 ) = 184.75
Subprogram (3) examples:
mono ( 1, 0, 0, 0 ) --> bern ( 1, 1, 1, 1 )
mono ( 1, 2, 3, 0 ) --> bern ( 1, 1.66666666667, 3.33333333333, 6 )
mono ( 1, 2, 3, 4 ) --> bern ( 1, 1.66666666667, 3.33333333333, 10 )
Subprogram (4) examples:
p ( 0.25 ) = 1
p ( 7.5 ) = 1
q ( 0.25 ) = 1.6875
q ( 7.5 ) = 184.75
r ( 0.25 ) = 1.75
r ( 7.5 ) = 1872.25
Subprogram (5) examples:
bern ( 1, 1, 1 ) --> bern ( 1, 1, 1, 1 )
bern ( 1, 2, 6 ) --> bern ( 1, 1.66666666667, 3.33333333333, 6 )
</pre>
=={{header|ATS}}==
| |||