Rosetta Code

Faulhaber's triangle: Difference between revisions

Page Discussion

Faulhaber's triangle (view source)

Revision as of 12:21, 10 September 2023

1,089 bytes added ,  8 months ago
→‎{{header|ALGOL 68}}: Tweak and andle the stretch goal
(→‎{{header|ALGOL 68}}: Tweak and andle the stretch goal)
Line 38:
 
=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release 2.8.3.win32}}
Using code from the Algol 68 samples for the [[Arithmetic/Rational]] and [[Bernoulli numbers]] tasks and the Algol W sample for the [[Evaluate binomial coefficients]] task. The code to calculate the coefficients for a row of the triangle is based on the C sample.<br>
Note that in the Bernoulli numbers task, the Algol 68 sample returns -1/2 for B(1) - this is modified here so B(1) is 1/2.<br>
Assumes LONG LONG INT is long enough to calculate the 17th power sum, the default precision of LONG LONG INT in ALGOL 68G is large enough.
<syntaxhighlight lang="algol68">
BEGIN # show some rows of Faulhaber's triangle #
Line 48 ⟶ 50:
OP PAD = ( INT width, STRING v )STRING: # left blank pad v to width #
IF LENGTH v >= width THEN v ELSE ( " " * ( width - LENGTH v ) ) + v FI;
 
MODE INTEGER = LONG LONG INT; # mode for FRAC numberator & denominator #
OP TOINTEGER = ( INT n )INTEGER: n; # force widening n to INTEGER #
 
# Code from the Arithmetic/Rational task #
MODE FRAC = STRUCT( INTINTEGER num #erator#, den #ominator#);
 
PROC gcd = (INTINTEGER a, b) INTINTEGER: # greatest common divisor #
(a = 0 | b |: b = 0 | a |: ABS a > ABS b | gcd(b, a MOD b) | gcd(a, b MOD a));
PROC lcm = (INTINTEGER a, b)INTINTEGER: # least common multiple #
a OVER gcd(a, b) * b;
PRIO // = 9; # higher then the ** operator #
OP // = (INTINTEGER num, den)FRAC: ( # initialise and normalise #
INTINTEGER common = gcd(num, den);
IF den < 0 THEN
( -num OVER common, -den OVER common)
Line 70 ⟶ 75:
 
OP + = (FRAC a, b)FRAC: (
INTINTEGER common = lcm(den OF a, den OF b);
FRAC result := ( common OVER den OF a * num OF a + common OVER den OF b * num OF b, common );
num OF result//den OF result
Line 77 ⟶ 82:
OP - = (FRAC a, b)FRAC: a + -b,
* = (FRAC a, b)FRAC: (
INTINTEGER num = num OF a * num OF b,
den = den OF a * den OF b;
INTINTEGER common = gcd(num, den);
(num OVER common) // (den OVER common)
);
Line 87 ⟶ 92:
# end code from the Arithmetic/Rational task #
 
# returns a + b alternative // operator for standard size INT values #
OP * // = ( INT anum, FRAC b den)FRAC: (TOINTEGER num OF b * a ) // TOINTEGER den OF b;
# returns a * b * ( sign // 1 )#▼
OP * = ( INT a, FRAC b )FRAC: ( num OF b * a ) // den OF b;
OP * = ( INTEGER a, FRAC b )FRAC: ( num OF b * a ) // den OF b;
# sets a to a + b and returns a * ( binomial coefficient( p + 1, j ) // 1 )#▼
OP +:= = ( REF FRAC a, FRAC b )FRAC: a := a + b;
# sets a to - a and returns a #
OP -=: = ( REF FRAC a )FRAC: BEGIN num OF a := - num OF a; a END;
 
# returns the nth Bernoulli number, n must be >= 0 #
Line 106 ⟶ 118:
 
# returns n! / k! #
PROC factorial over factorial = ( INT n, k )INTINTEGER:
IF k > n THEN 0
ELIF k = n THEN 1
ELSE # k < n #
INTINTEGER f := 1;
FOR i FROM k + 1 TO n DO f *:= i OD;
f
Line 116 ⟶ 128:
 
# returns n! #
PROC factorial = ( INT n )INTINTEGER:
BEGIN
INTINTEGER f := 1;
FOR i FROM 2 TO n DO f *:= i OD;
f
Line 124 ⟶ 136:
 
# returns the binomial coefficient of (n k) #
PROC binomial coefficient = ( INT n, k )INTINTEGER:
IF n - k > k
THEN factorial over factorial( n, n - k ) OVER factorial( k )
Line 134 ⟶ 146:
whole( num OF a, 0 ) + IF den OF a = 1 THEN "" ELSE "/" + whole( den OF a, 0 ) FI;
 
# returns the pth row of Faulhaber's triangle - based on the C sample #
OP FAULHABER = ( INT p )[]FRAC:
BEGIN
FRAC q := -1 // ( p + 1 );
INT sign := -1;▼
[ 0 : p ]FRAC coeffs;
FOR j FROM 0 TO p DO
signcoeffs[ p - j ] := 0binomial coefficient( p + 1, j ) * BERNOULLI j * -=: sign;q
coeffs[ p - j ] := q
▲ * ( sign // 1 )
▲ * ( binomial coefficient( p + 1, j ) // 1 )
* BERNOULLI j
OD;
coeffs
END # faulhaber # ;
 
FOR i FROM 0 TO 9 DO # show the triabngle's first 10 rows #
[]FRAC frow = FAULHABER i;
FOR j FROM LWB frow TO UPB frow DO
Line 156 ⟶ 163:
OD;
print( ( newline ) )
OD;
BEGIN # compute the sum of k^17 for k = 1 to 1000 using triangle row 18 #
 
[]FRAC frow = FAULHABER 17;
▲ FRAC INT signsum := -0 // 1;
INTEGER kn := 1;
FOR j FROM LWB frow TO UPB frow DO
VOID( sum +:= ( kn *:= 1000 ) * frow[ j ] )
OD;
print( ( TOSTRING sum, newline ) )
END
END
</syntaxhighlight>
Line 172 ⟶ 187:
-1/30 0 2/9 0 -7/15 0 2/3 1/2 1/9
0 -3/20 0 1/2 0 -7/10 0 3/4 1/2 1/10
56056972216555580111030077961944183400198333273050000
</pre>
 
Tigerofdarkness
3,028

edits

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