Bernstein basis polynomials: Difference between revisions
Content added Content deleted
m (Pointing out more rounding errors.) |
(Added Algol 68 translation of the Algol 60 sample) |
||
Line 331: | Line 331: | ||
bern ( 1 , 1 , 1 ) --> bern ( 1 , 1 , 1 , 1 ) |
bern ( 1 , 1 , 1 ) --> bern ( 1 , 1 , 1 , 1 ) |
||
bern ( 1 , 2 , 6 ) --> bern ( 1 , 1.66666666667 , 3.33333333333 , 6 )</pre> |
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}}== |
=={{header|ATS}}== |