Rosetta Code

Bernstein basis polynomials: Difference between revisions

Page Discussion

Bernstein basis polynomials (view source)

Revision as of 16:27, 28 May 2023

400 bytes removed ,  11 months ago
→‎{{header|ALGOL 68}}: Simplify a little using features of Algol 68 not in Algol 60
(Added Go)
(→‎{{header|ALGOL 68}}: Simplify a little using features of Algol 68 not in Algol 60)
Line 337:
# Note the "Subrptoghram (n) designations are as specified in the #
# 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 #
# a0, a1, a2 to Bernstein coefficients b0, b1, b2 #
PROC tobern2 = ( REAL a0, a1, a2, REF REALBERNTWO b0, b1, b2b )VOID:
BEGIN
b0 OF b := a0;
b1 OF b := a0 + ((1/2) * a1);
b2 OF b := a0 + a1 + a2
END # tobern2 # ;
 
Line 350 ⟶ 355:
# Bernstein coefficients b0, b1, b2. Use de Casteljau's #
# algorithm #
PROCOP evalbern2EVAL = ( REALBERNTWO b0b, b1, b2,REAL t )REAL:
BEGIN
REAL s = 1 - t;
REAL b01 = (s * b0 OF b) + (t * b1 OF b);
REAL b12 = (s * b1 OF b) + (t * b2 OF b);
(s * b01) + (t * b12)
END # evalbern2EVAL # ;
 
# Subprogram (3): transform monomial coefficients #
# a0, a1, a2, a3 to Bernstein coefficients b0, b1, #
# b2, b3 #
PROC tobern3 = ( REAL a0, a1, a2, a3, REF REALBERNTHREE b0, b1, b2, b3b )VOID:
BEGIN
b0 OF b := a0;
b1 OF b := a0 + ((1/3) * a1);
b2 OF b := a0 + ((2/3) * a1) + ((1/3) * a2);
b3 OF b := a0 + a1 + a2 + a3
END # tobern3 # ;
 
Line 372 ⟶ 377:
# with Bernstein coefficients b0, b1, b2, b3. Use #
# de Casteljau's algorithm #
PROCOP evalbern3EVAL = ( REALBERNTHREE b0b, b1, b2, b3,REAL t )REAL:
BEGIN
REAL s = 1 - t;
REAL b01 = (s * b0 OF b) + (t * b1 OF b);
REAL b12 = (s * b1 OF b) + (t * b2 OF b);
REAL b23 = (s * b2 OF b) + (t * b3 OF b);
REAL b012 = (s * b01) + (t * b12);
REAL b123 = (s * b12) + (t * b23);
(s * b012) + (t * b123)
END # evalbern3EVAL #;
 
# Subprogram (5): transform the quadratic Bernstein #
# coefficients q0, q1, q2 to the cubic Bernstein #
# coefficients c0, c1, c2, c3; #
PROC bern2to3 = ( REALBERNTWO q0, q1, q2q, REF REAL c0, c1, c2, c3 )VOID:
BEGIN
c0 := q0b0 OF q;
c1 := ((1/3) * q0b0 OF q) + ((2/3) * q1b1 OF q);
c2 := ((2/3) * q1b1 OF q) + ((1/3) * q2b2 OF q);
c3 := q2b2 OF q
END # bern2to3 # ;
 
Line 414 ⟶ 419:
END # f # ;
 
REALPRIO p0b2SHOWEVAL := 0, p1b2 := 0, p2b2 := 05;
REAL# q0b2prints :=the 0,result q1b2of :=evaluating 0,p q2b2with :=x 0; #
OP SHOWEVAL = ( BERNTWO p, REAL x )VOID:
 
REAL p0b3 := 0 print( ( " ", p1b3label :=OF 0p, p2b3" :=( 0", p3b3f( x ), " ) := 0", f( p EVAL x ), newline ) );
REAL# q0b3prints :=the 0,result q1b3of :=evaluating 0,p q2b3with :=x 0, q3b3 := 0; #
REALOP r0b3 := 0,SHOWEVAL r1b3 := 0,( r2b3BERNTHREE := 0p, r3b3REAL x )VOID:= 0;
print( ( " ", label OF p, " ( ", f( x ), " ) = ", f( yp EVAL x ), newline ) );▼
REAL x, y;▼
yBERNTWO p2 := evalbern2BERNTWO ( p0b2"p", p1b20, p2b20, x0 );▼
yBERNTWO q2 := evalbern2BERNTWO ( q0b2"q", q1b20, q2b20, x0 );▼
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 qc0 := 0, qc1 := 0, qc2 := 0, qc3 := 0;
 
▲ REAL x, y;
 
REAL p0m = 1, p1m = 0, p2m = 0;
Line 430 ⟶ 441:
REAL r0m = 1, r1m = 2, r2m = 3, r3m = 4;
 
tobern2( p0m, p1m, p2m, p0b2, p1b2, p2b2p2 );
tobern2( q0m, q1m, q2m, q0b2, q1b2, q2b2q2 );
print( ( "Subprogram (1) examples:", newline ) );
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m )
, " ) --> bern ( ", f( p0b2b0 OF p2 ), ", ", f( p1b2b1 OF p2 ), ", ", f( p2b2b2 OF p2 )
, " )", newline
)
);
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m )
, " ) --> bern ( ", f( q0b2b0 OF q2 ), ", ", f( q1b2b1 OF q2 ), ", ", f( q2b2b2 OF q2 )
, " )", newline
)
Line 445 ⟶ 456:
 
print( ( "Subprogram (2) examples:", newline ) );
xp2 :=SHOWEVAL 0.25;
yp2 :=SHOWEVAL evalbern2( p0b2, p1b2, p2b2, x )7.50;
xq2 :=SHOWEVAL 0.25;▼
▲ print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
xq2 :=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, p3b3p3 );
tobern3( q0m, q1m, q2m, 0, q0b3, q1b3, q2b3, q3b3q3 );
tobern3( r0m, r1m, r2m, r3m, r0b3, r1b3, r2b3, r3b3r3 );
print( ( "Subprogram (3) examples:", newline ) );
print( ( " mono ( ", f( p0m ), ", ", f( p1m ), ", ", f( p2m ), ", ", f( 0 )
, " ) --> bern ( ", f( p0b3b0 OF p3 ), ", ", f( p1b3b1 OF p3 ), ", ", f( p2b3b2 OF p3 ), ", ", f( p3b3b3 OF p3 )
, " )", newline
)
);
print( ( " mono ( ", f( q0m ), ", ", f( q1m ), ", ", f( q2m ), ", ", f( 0 )
, " ) --> bern ( ", f( q0b3b0 OF q3 ), ", ", f( q1b3b1 OF q3 ), ", ", f( q2b3b2 OF q3 ), ", ", f( q3b3b3 OF q3 )
, " )", newline
)
);
print( ( " mono ( ", f( r0m ), ", ", f( r1m ), ", ", f( r2m ), ", ", f( r3m )
, " ) --> bern ( ", f( r0b3b0 OF r3 ), ", ", f( r1b3b1 OF r3 ), ", ", f( r2b3b2 OF r3 ), ", ", f( r3b3b3 OF r3 )
, " )", newline
)
Line 479 ⟶ 482:
 
print( ( "Subprogram (4) examples:", newline ) );
xp3 :=SHOWEVAL 0.25;
▲ xp3 :=SHOWEVAL 7.50;
y := evalbern3( p0b3, p1b3, p2b3, p3b3, x );
xq3 :=SHOWEVAL 0.25;▼
print( ( " p ( ", f( x ), " ) = ", f( y ), newline ) );
xq3 :=SHOWEVAL 7.50;
xr3 :=SHOWEVAL 0.25;▼
y := evalbern3( p0b3, p1b3, p2b3, p3b3, x );
xr3 :=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, p2b2p2, pc0, pc1, pc2, pc3 );
bern2to3( q0b2, q1b2, q2b2q2, qc0, qc1, qc2, qc3 );
print( ( "Subprogram (5) examples:", newline ) );
print( ( " bern ( ", f( p0b2b0 OF p2 ), ", ", f( p1b2b1 OF p2 ), ", ", f( p2b2b2 OF p2 )
, " ) --> bern ( ", f( pc0 ), ", ", f( pc1 ), ", ", f( pc2 ), ", ", f( pc3 )
, " )", newline
)
);
print( ( " bern ( ", f( q0b2b0 OF q2 ), ", ", f( q1b2b1 OF q2 ), ", ", f( q2b2b2 OF q2 )
, " ) --> bern ( ", f( qc0 ), ", ", f( qc1 ), ", ", f( qc2 ), ", ", f( qc3 )
, " )", newline
Tigerofdarkness
3,021

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/343374"