Bernstein basis polynomials: Difference between revisions

Content added Content deleted
(Added Go)
(→‎{{header|ALGOL 68}}: Simplify a little using features of Algol 68 not in Algol 60)
Line 337: Line 337:
# Note the "Subrptoghram (n) designations are as specified in the #
# Note the "Subrptoghram (n) designations are as specified in the #
# task #
# task #

MODE BERNTWO = STRUCT( STRING label, REAL b0, b1, b2 );
MODE BERNTHREE = STRUCT( STRING label, REAL b0, b1, b2, b3 );

PRIO EVAL = 5; # set the priority of the dyadic EVAL #


# Subprogram (1): transform monomial coefficients #
# Subprogram (1): transform monomial coefficients #
# a0, a1, a2 to Bernstein coefficients b0, b1, b2 #
# a0, a1, a2 to Bernstein coefficients b0, b1, b2 #
PROC tobern2 = ( REAL a0, a1, a2, REF REAL b0, b1, b2 )VOID:
PROC tobern2 = ( REAL a0, a1, a2, REF BERNTWO b )VOID:
BEGIN
BEGIN
b0 := a0;
b0 OF b := a0;
b1 := a0 + ((1/2) * a1);
b1 OF b := a0 + ((1/2) * a1);
b2 := a0 + a1 + a2
b2 OF b := a0 + a1 + a2
END # tobern2 # ;
END # tobern2 # ;


Line 350: Line 355:
# Bernstein coefficients b0, b1, b2. Use de Casteljau's #
# Bernstein coefficients b0, b1, b2. Use de Casteljau's #
# algorithm #
# algorithm #
PROC evalbern2 = ( REAL b0, b1, b2, t )REAL:
OP EVAL = ( BERNTWO b, REAL t )REAL:
BEGIN
BEGIN
REAL s = 1 - t;
REAL s = 1 - t;
REAL b01 = (s * b0) + (t * b1);
REAL b01 = (s * b0 OF b) + (t * b1 OF b);
REAL b12 = (s * b1) + (t * b2);
REAL b12 = (s * b1 OF b) + (t * b2 OF b);
(s * b01) + (t * b12)
(s * b01) + (t * b12)
END # evalbern2 # ;
END # EVAL # ;


# Subprogram (3): transform monomial coefficients #
# Subprogram (3): transform monomial coefficients #
# a0, a1, a2, a3 to Bernstein coefficients b0, b1, #
# a0, a1, a2, a3 to Bernstein coefficients b0, b1, #
# b2, b3 #
# b2, b3 #
PROC tobern3 = ( REAL a0, a1, a2, a3, REF REAL b0, b1, b2, b3 )VOID:
PROC tobern3 = ( REAL a0, a1, a2, a3, REF BERNTHREE b )VOID:
BEGIN
BEGIN
b0 := a0;
b0 OF b := a0;
b1 := a0 + ((1/3) * a1);
b1 OF b := a0 + ((1/3) * a1);
b2 := a0 + ((2/3) * a1) + ((1/3) * a2);
b2 OF b := a0 + ((2/3) * a1) + ((1/3) * a2);
b3 := a0 + a1 + a2 + a3
b3 OF b := a0 + a1 + a2 + a3
END # tobern3 # ;
END # tobern3 # ;


Line 372: Line 377:
# with Bernstein coefficients b0, b1, b2, b3. Use #
# with Bernstein coefficients b0, b1, b2, b3. Use #
# de Casteljau's algorithm #
# de Casteljau's algorithm #
PROC evalbern3 = ( REAL b0, b1, b2, b3, t )REAL:
OP EVAL = ( BERNTHREE b, REAL t )REAL:
BEGIN
BEGIN
REAL s = 1 - t;
REAL s = 1 - t;
REAL b01 = (s * b0) + (t * b1);
REAL b01 = (s * b0 OF b) + (t * b1 OF b);
REAL b12 = (s * b1) + (t * b2);
REAL b12 = (s * b1 OF b) + (t * b2 OF b);
REAL b23 = (s * b2) + (t * b3);
REAL b23 = (s * b2 OF b) + (t * b3 OF b);
REAL b012 = (s * b01) + (t * b12);
REAL b012 = (s * b01) + (t * b12);
REAL b123 = (s * b12) + (t * b23);
REAL b123 = (s * b12) + (t * b23);
(s * b012) + (t * b123)
(s * b012) + (t * b123)
END # evalbern3 #;
END # EVAL #;


# Subprogram (5): transform the quadratic Bernstein #
# Subprogram (5): transform the quadratic Bernstein #
# coefficients q0, q1, q2 to the cubic Bernstein #
# coefficients q0, q1, q2 to the cubic Bernstein #
# coefficients c0, c1, c2, c3; #
# coefficients c0, c1, c2, c3; #
PROC bern2to3 = ( REAL q0, q1, q2, REF REAL c0, c1, c2, c3 )VOID:
PROC bern2to3 = ( BERNTWO q, REF REAL c0, c1, c2, c3 )VOID:
BEGIN
BEGIN
c0 := q0;
c0 := b0 OF q;
c1 := ((1/3) * q0) + ((2/3) * q1);
c1 := ((1/3) * b0 OF q) + ((2/3) * b1 OF q);
c2 := ((2/3) * q1) + ((1/3) * q2);
c2 := ((2/3) * b1 OF q) + ((1/3) * b2 OF q);
c3 := q2
c3 := b2 OF q
END # bern2to3 # ;
END # bern2to3 # ;


Line 414: Line 419:
END # f # ;
END # f # ;


REAL p0b2 := 0, p1b2 := 0, p2b2 := 0;
PRIO SHOWEVAL = 5;
REAL q0b2 := 0, q1b2 := 0, q2b2 := 0;
# prints the result of evaluating p with x #
OP SHOWEVAL = ( BERNTWO p, REAL x )VOID:

REAL p0b3 := 0, p1b3 := 0, p2b3 := 0, p3b3 := 0;
print( ( " ", label OF p, " ( ", f( x ), " ) = ", f( p EVAL x ), newline ) );
REAL q0b3 := 0, q1b3 := 0, q2b3 := 0, q3b3 := 0;
# prints the result of evaluating p with x #
REAL r0b3 := 0, r1b3 := 0, r2b3 := 0, r3b3 := 0;
OP SHOWEVAL = ( BERNTHREE p, REAL x )VOID:
⚫
print( ( " ", label OF p, " ( ", f( x ), " ) = ", f( p EVAL x ), newline ) );
⚫
⚫
BERNTWO p2 := BERNTWO ( "p", 0, 0, 0 );
⚫
BERNTWO q2 := BERNTWO ( "q", 0, 0, 0 );
BERNTHREE p3 := BERNTHREE( "p", 0, 0, 0, 0 );
BERNTHREE q3 := BERNTHREE( "q", 0, 0, 0, 0 );
BERNTHREE r3 := BERNTHREE( "r", 0, 0, 0, 0 );


REAL pc0 := 0, pc1 := 0, pc2 := 0, pc3 := 0;
REAL pc0 := 0, pc1 := 0, pc2 := 0, pc3 := 0;
REAL qc0 := 0, qc1 := 0, qc2 := 0, qc3 := 0;
REAL qc0 := 0, qc1 := 0, qc2 := 0, qc3 := 0;

⚫
REAL x, y;


REAL p0m = 1, p1m = 0, p2m = 0;
REAL p0m = 1, p1m = 0, p2m = 0;
Line 430: Line 441:
REAL r0m = 1, r1m = 2, r2m = 3, r3m = 4;
REAL r0m = 1, r1m = 2, r2m = 3, r3m = 4;


tobern2( p0m, p1m, p2m, p0b2, p1b2, p2b2 );
tobern2( p0m, p1m, p2m, p2 );
tobern2( q0m, q1m, q2m, q0b2, q1b2, q2b2 );
tobern2( q0m, q1m, q2m, q2 );
print( ( "Subprogram (1) examples:", newline ) );
print( ( "Subprogram (1) examples:", newline ) );
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m )
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m )
, " ) --> bern ( ", f( p0b2 ), ", ", f( p1b2 ), ", ", f( p2b2 )
, " ) --> bern ( ", f( b0 OF p2 ), ", ", f( b1 OF p2 ), ", ", f( b2 OF p2 )
, " )", newline
, " )", newline
)
)
);
);
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m )
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m )
, " ) --> bern ( ", f( q0b2 ), ", ", f( q1b2 ), ", ", f( q2b2 )
, " ) --> bern ( ", f( b0 OF q2 ), ", ", f( b1 OF q2 ), ", ", f( b2 OF q2 )
, " )", newline
, " )", newline
)
)
Line 445: Line 456:


print( ( "Subprogram (2) examples:", newline ) );
print( ( "Subprogram (2) examples:", newline ) );
x := 0.25;
p2 SHOWEVAL 0.25;
y := evalbern2( p0b2, p1b2, p2b2, x );
p2 SHOWEVAL 7.50;
⚫
q2 SHOWEVAL 0.25;
⚫
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
q2 SHOWEVAL 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( p0m, p1m, p2m, 0, p3 );
tobern3( q0m, q1m, q2m, 0, q0b3, q1b3, q2b3, q3b3 );
tobern3( q0m, q1m, q2m, 0, q3 );
tobern3( r0m, r1m, r2m, r3m, r0b3, r1b3, r2b3, r3b3 );
tobern3( r0m, r1m, r2m, r3m, r3 );
print( ( "Subprogram (3) examples:", newline ) );
print( ( "Subprogram (3) examples:", newline ) );
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m ), ", ", f( 0 )
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m ), ", ", f( 0 )
, " ) --> bern ( ", f( p0b3 ), ", ", f( p1b3 ), ", ", f( p2b3 ), ", ", f( p3b3 )
, " ) --> bern ( ", f( b0 OF p3 ), ", ", f( b1 OF p3 ), ", ", f( b2 OF p3 ), ", ", f( b3 OF p3 )
, " )", newline
, " )", newline
)
)
);
);
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m ), ", ", f( 0 )
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m ), ", ", f( 0 )
, " ) --> bern ( ", f( q0b3 ), ", ", f( q1b3 ), ", ", f( q2b3 ), ", ", f( q3b3 )
, " ) --> bern ( ", f( b0 OF q3 ), ", ", f( b1 OF q3 ), ", ", f( b2 OF q3 ), ", ", f( b3 OF q3 )
, " )", newline
, " )", newline
)
)
);
);
print( ( " mono ( ", f( r0m ), ", ", f( r1m ), ", ", f( r2m ), ", ", f( r3m )
print( ( " mono ( ", f( r0m ), ", ", f( r1m ), ", ", f( r2m ), ", ", f( r3m )
, " ) --> bern ( ", f( r0b3 ), ", ", f( r1b3 ), ", ", f( r2b3 ), ", ", f( r3b3 )
, " ) --> bern ( ", f( b0 OF r3 ), ", ", f( b1 OF r3 ), ", ", f( b2 OF r3 ), ", ", f( b3 OF r3 )
, " )", newline
, " )", newline
)
)
Line 479: Line 482:


print( ( "Subprogram (4) examples:", newline ) );
print( ( "Subprogram (4) examples:", newline ) );
x := 0.25;
p3 SHOWEVAL 0.25;
⚫
p3 SHOWEVAL 7.50;
y := evalbern3( p0b3, p1b3, p2b3, p3b3, x );
⚫
q3 SHOWEVAL 0.25;
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
x := 7.50;
q3 SHOWEVAL 7.50;
⚫
r3 SHOWEVAL 0.25;
y := evalbern3( p0b3, p1b3, p2b3, p3b3, x );
⚫
r3 SHOWEVAL 7.50;
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( p2, pc0, pc1, pc2, pc3 );
bern2to3( q0b2, q1b2, q2b2, qc0, qc1, qc2, qc3 );
bern2to3( q2, qc0, qc1, qc2, qc3 );
print( ( "Subprogram (5) examples:", newline ) );
print( ( "Subprogram (5) examples:", newline ) );
print( ( " bern ( ", f( p0b2 ), ", ", f( p1b2 ), ", ", f( p2b2 )
print( ( " bern ( ", f( b0 OF p2 ), ", ", f( b1 OF p2 ), ", ", f( b2 OF p2 )
, " ) --> bern ( ", f( pc0 ), ", ", f( pc1 ), ", ", f( pc2 ), ", ", f( pc3 )
, " ) --> bern ( ", f( pc0 ), ", ", f( pc1 ), ", ", f( pc2 ), ", ", f( pc3 )
, " )", newline
, " )", newline
)
)
);
);
print( ( " bern ( ", f( q0b2 ), ", ", f( q1b2 ), ", ", f( q2b2 )
print( ( " bern ( ", f( b0 OF q2 ), ", ", f( b1 OF q2 ), ", ", f( b2 OF q2 )
, " ) --> bern ( ", f( qc0 ), ", ", f( qc1 ), ", ", f( qc2 ), ", ", f( qc3 )
, " ) --> bern ( ", f( qc0 ), ", ", f( qc1 ), ", ", f( qc2 ), ", ", f( qc3 )
, " )", newline
, " )", newline
Retrieved from "https://rosettacode.org/wiki/Bernstein_basis_polynomials"