Bernstein basis polynomials: Difference between revisions

Added XPL0 example.
(→‎{{header|Wren}}: Added optional part.)
(Added XPL0 example.)
Line 1,269:
mono [1, 1, 1] --> bern [1, 1, 1, 1]
mono [1, 2, 6] --> bern [1, 1.6666666666667, 3.3333333333333, 6]
</pre>
 
=={{header|XPL0}}==
{{trans|ALGOL 60}}
<syntaxhighlight lang "XPL0">procedure ToBern2 (A0, A1, A2, B0, B1, B2);
real A0, A1, A2; \pass by value
real B0, B1, B2; \pass by reference
\Subprogram (1): transform monomial coefficients
\ A0, A1, A2 to Bernstein coefficients B0, B1, B2;
begin
B0(0) := A0;
B1(0) := A0 + ((1./2.) * A1);
B2(0) := A0 + A1 + A2
end \ToBern2\;
 
function real EvalBern2 (B0, B1, B2, T);
real B0, B1, B2, T;
\Subprogram (2): evaluate, at T, the polynomial with
\ Bernstein coefficients B0, B1, B2. Use de Casteljau's
\ algorithm;
real S, B01, B12, B012;
begin
S := 1. - T;
B01 := (S * B0) + (T * B1);
B12 := (S * B1) + (T * B2);
B012 := (S * B01) + (T * B12);
return B012
end \EvalBern2\;
 
procedure ToBern3 (A0, A1, A2, A3, B0, B1, B2, B3);
real A0, A1, A2, A3;
real B0, B1, B2, B3;
\Subprogram (3): transform monomial coefficients
\ A0, A1, A2, A3 to Bernstein coefficients B0, B1,
\ B2, B3;
begin
B0(0) := A0;
B1(0) := A0 + ((1./3.) * A1);
B2(0) := A0 + ((2./3.) * A1) + ((1./3.) * A2);
B3(0) := A0 + A1 + A2 + A3
end \ToBern3\;
 
function real EvalBern3 (B0, B1, B2, B3, T);
real B0, B1, B2, B3, T;
\Subprogram (4): evaluate, at t, the polynomial
\ with Bernstein coefficients b0, b1, b2, b3. Use
\ de Casteljau's algorithm;
real S, B01, B12, B23, B012, B123, B0123;
begin
S := 1. - T;
B01 := (S * B0) + (T * B1);
B12 := (S * B1) + (T * B2);
B23 := (S * B2) + (T * B3);
B012 := (S * B01) + (T * B12);
B123 := (S * B12) + (T * B23);
B0123 := (S * B012) + (T * B123);
return B0123
end \EvalBern3\;
 
procedure Bern2To3 (Q0, Q1, Q2, C0, C1, C2, C3);
real Q0, Q1, Q2;
real C0, C1, C2, C3;
\Subprogram (5): transform the quadratic Bernstein
\ coefficients q0, q1, q2 to the cubic Bernstein
\ coefficients c0, c1, c2, c3;
begin
C0(0) := Q0;
C1(0) := ((1./3.) * Q0) + ((2./3.) * Q1);
C2(0) := ((2./3.) * Q1) + ((1./3.) * Q2);
C3(0) := Q2
end \Bern2To3\;
 
real P0M, P1M, P2M;
real Q0M, Q1M, Q2M;
real R0M, R1M, R2M, R3M;
 
real P0B2, P1B2, P2B2;
real Q0B2, Q1B2, Q2B2;
 
real P0B3, P1B3, P2B3, P3B3;
real Q0B3, Q1B3, Q2B3, Q3B3;
real R0B3, R1B3, R2B3, R3B3;
 
real PC0, PC1, PC2, PC3;
real QC0, QC1, QC2, QC3;
 
real X, Y;
 
begin
P0M := 1.; P1M := 0.; P2M := 0.;
Q0M := 1.; Q1M := 2.; Q2M := 3.;
R0M := 1.; R1M := 2.; R2M := 3.; R3M := 4.;
 
Format(1, 2);
ToBern2 (P0M, P1M, P2M, @P0B2, @P1B2, @P2B2);
ToBern2 (Q0M, Q1M, Q2M, @Q0B2, @Q1B2, @Q2B2);
Text (0, "Subprogram (1) examples:^m^j");
Text (0, " mono ( ");
RlOut (0, P0M); Text (0, ", ");
RlOut (0, P1M); Text (0, ", ");
RlOut (0, P2M); Text (0, ") --> bern ( ");
RlOut (0, P0B2); Text (0, ", ");
RlOut (0, P1B2); Text (0, ", ");
RlOut (0, P2B2); Text (0, ")^m^j");
Text (0, " mono ( ");
RlOut (0, Q0M); Text (0, ", ");
RlOut (0, Q1M); Text (0, ", ");
RlOut (0, Q2M); Text (0, ") --> bern ( ");
RlOut (0, Q0B2); Text (0, ", ");
RlOut (0, Q1B2); Text (0, ", ");
RlOut (0, Q2B2); Text (0, ")^m^j");
 
Text (0, "Subprogram (2) examples:^m^j");
X := 0.25;
Y := EvalBern2 (P0B2, P1B2, P2B2, X);
Text (0, " p ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 7.50;
Y := EvalBern2 (P0B2, P1B2, P2B2, X);
Text (0, " p ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 0.25;
Y := EvalBern2 (Q0B2, Q1B2, Q2B2, X);
Text (0, " q ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 7.50;
Y := EvalBern2 (Q0B2, Q1B2, Q2B2, X);
Text (0, " q ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
 
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);
Text (0, "Subprogram (3) examples:^m^j");
Text (0, " mono ( ");
RlOut (0, P0M); Text (0, ", ");
RlOut (0, P1M); Text (0, ", ");
RlOut (0, P2M); Text (0, ", ");
RlOut (0, 0.); Text (0, ") --> bern ( ");
RlOut (0, P0B3); Text (0, ", ");
RlOut (0, P1B3); Text (0, ", ");
RlOut (0, P2B3); Text (0, ", ");
RlOut (0, P3B3); Text (0, ")^m^j");
Text (0, " mono ( ");
RlOut (0, Q0M); Text (0, ", ");
RlOut (0, Q1M); Text (0, ", ");
RlOut (0, Q2M); Text (0, ", ");
RlOut (0, 0.); Text (0, ") --> bern ( ");
RlOut (0, Q0B3); Text (0, ", ");
RlOut (0, Q1B3); Text (0, ", ");
RlOut (0, Q2B3); Text (0, ", ");
RlOut (0, Q3B3); Text (0, ")^m^j");
Text (0, " mono ( ");
RlOut (0, R0M); Text (0, ", ");
RlOut (0, R1M); Text (0, ", ");
RlOut (0, R2M); Text (0, ", ");
RlOut (0, R3M); Text (0, ") --> bern ( ");
RlOut (0, R0B3); Text (0, ", ");
RlOut (0, R1B3); Text (0, ", ");
RlOut (0, R2B3); Text (0, ", ");
RlOut (0, R3B3); Text (0, ")^m^j");
 
Text (0, "Subprogram (4) examples:^m^j");
X := 0.25;
Y := EvalBern3 (P0B3, P1B3, P2B3, P3B3, X);
Text (0, " p ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 7.50;
Y := EvalBern3 (P0B3, P1B3, P2B3, P3B3, X);
Text (0, " p ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 0.25;
Y := EvalBern3 (Q0B3, Q1B3, Q2B3, Q3B3, X);
Text (0, " q ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 7.50;
Y := EvalBern3 (Q0B3, Q1B3, Q2B3, Q3B3, X);
Text (0, " q ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 0.25;
Y := EvalBern3 (R0B3, R1B3, R2B3, R3B3, X);
Text (0, " r ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
X := 7.50;
Y := EvalBern3 (R0B3, R1B3, R2B3, R3B3, X);
Text (0, " r ( "); RlOut (0, X);
Text (0, ") = "); RlOut (0, Y);
Text (0, "^m^j");
 
Bern2To3 (P0B2, P1B2, P2B2, @PC0, @PC1, @PC2, @PC3);
Bern2To3 (Q0B2, Q1B2, Q2B2, @QC0, @QC1, @QC2, @QC3);
Text (0, "Subprogram (5) examples:^m^j");
Text (0, " bern ( ");
RlOut (0, P0B2); Text (0, ", ");
RlOut (0, P1B2); Text (0, ", ");
RlOut (0, P2B2); Text (0, ") --> bern ( ");
RlOut (0, PC0); Text (0, ", ");
RlOut (0, PC1); Text (0, ", ");
RlOut (0, PC2); Text (0, ", ");
RlOut (0, PC3); Text (0, ")^m^j");
Text (0, " bern ( ");
RlOut (0, Q0B2); Text (0, ", ");
RlOut (0, Q1B2); Text (0, ", ");
RlOut (0, Q2B2); Text (0, ") --> bern ( ");
RlOut (0, QC0); Text (0, ", ");
RlOut (0, QC1); Text (0, ", ");
RlOut (0, QC2); Text (0, ", ");
RlOut (0, QC3); Text (0, ")^m^j")
end</syntaxhighlight>
{{out}}
<pre>
Subprogram (1) examples:
mono ( 1.00, 0.00, 0.00) --> bern ( 1.00, 1.00, 1.00)
mono ( 1.00, 2.00, 3.00) --> bern ( 1.00, 2.00, 6.00)
Subprogram (2) examples:
p ( 0.25) = 1.00
p ( 7.50) = 1.00
q ( 0.25) = 1.69
q ( 7.50) = 184.75
Subprogram (3) examples:
mono ( 1.00, 0.00, 0.00, 0.00) --> bern ( 1.00, 1.00, 1.00, 1.00)
mono ( 1.00, 2.00, 3.00, 0.00) --> bern ( 1.00, 1.67, 3.33, 6.00)
mono ( 1.00, 2.00, 3.00, 4.00) --> bern ( 1.00, 1.67, 3.33, 10.00)
Subprogram (4) examples:
p ( 0.25) = 1.00
p ( 7.50) = 1.00
q ( 0.25) = 1.69
q ( 7.50) = 184.75
r ( 0.25) = 1.75
r ( 7.50) = 1872.25
Subprogram (5) examples:
bern ( 1.00, 1.00, 1.00) --> bern ( 1.00, 1.00, 1.00, 1.00)
bern ( 1.00, 2.00, 6.00) --> bern ( 1.00, 1.67, 3.33, 6.00)
</pre>
297

edits