Triangular numbers: Difference between revisions
(Triangular numbers in FreeBASIC) |
(Added Algol 68) |
||
Line 74: | Line 74: | ||
=={{header|ALGOL 68}}== |
|||
Assumes LONG INT is at least 64 bits. |
|||
<br> |
|||
Some roots that should be integers have non-integral values when calculated by the formulae in the task. |
|||
To get the correct values (if possible), the root procedures used here calculate float value and then use the nearest integer or nearest integer + 1 if they are exact. |
|||
<syntaxhighlight lang="algol68"> |
|||
BEGIN # show some triangular, tetrahedral, ... numbers and roots # |
|||
# prints a row of LONG INTs, with a title, newlines after every per-line # |
|||
# and each number in the specified width # |
|||
PROC show values = ( STRING title, []LONG INT v, INT per line, INT width )VOID: |
|||
BEGIN |
|||
print( ( title, ":", newline ) ); |
|||
INT on line := 0; |
|||
FOR i FROM LWB v TO UPB v DO |
|||
print( ( whole( v[ i ], -width ) ) ); |
|||
IF ( on line +:= 1 ) = per line THEN |
|||
print( ( newline ) ); |
|||
on line := 0 |
|||
FI |
|||
OD; |
|||
IF on line /= 0 THEN print( ( newline ) ) FI; |
|||
print( ( newline ) ) |
|||
END # show values # ; |
|||
# calculate the first 30 triangular, tetrahedral, etc. numbers # |
|||
[ 1 : 30 ]LONG INT triangular; triangular[ 1 ] := 0; |
|||
[ 1 : 30 ]LONG INT tetrahedral; tetrahedral[ 1 ] := 0; |
|||
[ 1 : 30 ]LONG INT pentatopic; pentatopic[ 1 ] := 0; |
|||
[ 1 : 30 ]LONG INT simplex12; simplex12[ 1 ] := 0; |
|||
FOR i FROM 2 TO 30 DO |
|||
triangular[ i ] := triangular[ i - 1 ] + i - 1; |
|||
tetrahedral[ i ] := tetrahedral[ i - 1 ] + triangular[ i ]; |
|||
pentatopic[ i ] := pentatopic[ i - 1 ] + tetrahedral[ i ]; |
|||
simplex12[ i ] := pentatopic[ i ] |
|||
OD; |
|||
FROM 5 TO 12 DO |
|||
FOR i FROM 2 TO 30 DO |
|||
simplex12[ i ] +:= simplex12[ i - 1 ] |
|||
OD |
|||
OD; |
|||
show values( "First 30 Triangular numbers", triangular, 6, 4 ); |
|||
show values( "First 30 Tetrahedral numbers", tetrahedral, 6, 5 ); |
|||
show values( "First 30 Pentatopic numbers", pentatopic, 6, 6 ); |
|||
show values( "First 30 12-Simplex numbers", simplex12, 6, 12 ); |
|||
# show some triangular, tetrahedral, etc. roots # |
|||
# returns the cube root of x # |
|||
PROC long crt = ( LONG REAL x )LONG REAL: long exp( long ln( x ) / 3 ); |
|||
# returns a LONG REAL approximation to the triangular root of x # |
|||
PROC real triangular root = ( LONG INT x )LONG REAL: ( long sqrt( 8 * x ) - 1 ) / 2; |
|||
# returns a LONG REAL approximation to the tetrahedral root of x # |
|||
PROC real tetrahedral root = ( LONG INT x )LONG REAL: |
|||
BEGIN |
|||
LONG REAL t = long sqrt( ( 9 * x * x ) - ( 1 / 27 ) ); |
|||
long crt( ( 3 * x ) + t ) + long crt( ( 3 * x ) - t ) - 1 |
|||
END # tetrahedral root # ; |
|||
# returns a LONG REAL approximation to the pentatopic root of x # |
|||
PROC real pentatopic root = ( LONG INT x )LONG REAL: |
|||
( long sqrt( 5 + ( 4 * long sqrt( ( 24 * x ) + 1 ) ) ) - 3 ) / 2; |
|||
# returns an integer root of x, if the approximation (possibly + 1 ) = x # |
|||
# the approximation otherwise # |
|||
PROC try integer root = ( LONG INT x, LONG REAL real root, PROC( LONG INT )LONG INT f )LONG REAL: |
|||
IF LONG INT ir = ENTIER real root; |
|||
f( ir ) = x |
|||
THEN ir |
|||
ELIF f( ir + 1 ) = x |
|||
THEN ir + 1 |
|||
ELSE real root |
|||
FI # try integer root # ; |
|||
# returns the triangular root of x # |
|||
PROC triangular root = ( LONG INT x )LONG REAL: |
|||
try integer root( x |
|||
, real triangular root( x ) |
|||
, ( LONG INT n )LONG INT: ( n * ( n + 1 ) ) OVER 2 |
|||
); |
|||
# returns the tetrahedral root of x # |
|||
PROC tetrahedral root = ( LONG INT x )LONG REAL: |
|||
try integer root( x |
|||
, real tetrahedral root( x ) |
|||
, ( LONG INT n )LONG INT: ( n * ( n + 1 ) * ( n + 2 ) ) OVER 6 |
|||
); |
|||
# returns the pentatopic root of x # |
|||
PROC pentatopic root = ( LONG INT x )LONG REAL: |
|||
try integer root( x |
|||
, real pentatopic root( x ) |
|||
, ( LONG INT n )LONG INT: ( n * ( n + 1 ) * ( n + 2 ) * ( n + 3 ) ) OVER 24 |
|||
); |
|||
[]LONG INT root test = ( 7140, 21408696, 26728085384, 14545501785001 ); |
|||
FOR i FROM LWB root test TO UPB root test DO |
|||
PROC show = ( LONG REAL x )STRING: |
|||
IF ENTIER x = x THEN whole( x, -6 ) + " " ELSE fixed( x, -12, 5 ) FI; |
|||
print( ( "Roots of ", whole( root test[ i ], 0 ), newline, " " ) ); |
|||
print( ( " triangular: ", show( triangular root( root test[ i ] ) ) ) ); |
|||
print( ( " tetrahedral: ", show( tetrahedral root( root test[ i ] ) ) ) ); |
|||
print( ( " pentatopic: ", show( pentatopic root( root test[ i ] ) ) ) ); |
|||
print( ( newline ) ) |
|||
OD |
|||
END |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
First 30 Triangular numbers: |
|||
0 1 3 6 10 15 |
|||
21 28 36 45 55 66 |
|||
78 91 105 120 136 153 |
|||
171 190 210 231 253 276 |
|||
300 325 351 378 406 435 |
|||
First 30 Tetrahedral numbers: |
|||
0 1 4 10 20 35 |
|||
56 84 120 165 220 286 |
|||
364 455 560 680 816 969 |
|||
1140 1330 1540 1771 2024 2300 |
|||
2600 2925 3276 3654 4060 4495 |
|||
First 30 Pentatopic numbers: |
|||
0 1 5 15 35 70 |
|||
126 210 330 495 715 1001 |
|||
1365 1820 2380 3060 3876 4845 |
|||
5985 7315 8855 10626 12650 14950 |
|||
17550 20475 23751 27405 31465 35960 |
|||
First 30 12-Simplex numbers: |
|||
0 1 13 91 455 1820 |
|||
6188 18564 50388 125970 293930 646646 |
|||
1352078 2704156 5200300 9657700 17383860 30421755 |
|||
51895935 86493225 141120525 225792840 354817320 548354040 |
|||
834451800 1251677700 1852482996 2707475148 3910797436 5586853480 |
|||
Roots of 7140 |
|||
triangular: 119 tetrahedral: 34 pentatopic: 18.87665 |
|||
Roots of 21408696 |
|||
triangular: 6543 tetrahedral: 503.56183 pentatopic: 149.06095 |
|||
Roots of 26728085384 |
|||
triangular: 231205.40556 tetrahedral: 5432 pentatopic: 893.44246 |
|||
Roots of 14545501785001 |
|||
triangular: 5393607.1581 tetrahedral: 44355.77738 pentatopic: 4321 |
|||
</pre> |
|||
=={{header|AppleScript}}== |
=={{header|AppleScript}}== |
||
Revision as of 15:38, 12 February 2023
A triangular number is a count of objects arranged into an equilateral triangle. Much like how a square number is a count of objects arranged into a square.
The nth triangular number is the sum of the first n non-negative integers.
Triangular numbers may be calculated by the explicit formulas:
where is the binomial coefficient "n plus one choose two".
Analogous to square roots, we may also calculate a triangular root. Numbers that have an integer triangular
root are triangular numbers.
The real triangular root of a number x may be found using:
Similar to how cubic numbers are square numbers extended into a third dimension, triangular numbers extended into a third dimension are known as tetrahedral numbers.
The nth tetrahedral number is the sum of the first n triangular numbers.
Or, may be calculated directly: (Binomial "n plus two choose three".)
One may find the real tetrahedral root of x using the formula:
Depending on the math precision of your particular language, may need to be rounded to the nearest 1e-16 or so.
Extending into a fourth dimension we get pentatopic numbers.
Again, the nth pentatope is the sum of the first n tetrahedral numbers,
or explicitly: (Binomial "n plus three choose four".)
The pentatopic real root of x may be found using:
In general, these all belong to the class figurate numbers as they are
based on r dimensional geometric figures. Sometimes they are referred to as r-simplex
numbers. In geometry a simplex is the simplest possible r-dimensional
object.
You may easily extend to an arbitrary dimension r using binomials. Each term n in dimension r is
There is no known general formula to find higher r-simplex roots.
- Task
- Find and display the first 30 triangular numbers (r = 2).
- Find and display the first 30 tetrahedral numbers (r = 3).
- Find and display the first 30 pentatopic numbers (r = 4).
- Find and display the first 30 12-simplex numbers (r = 12).
- Find and display the triangular root, the tetrahedral root, and the pentatopic root for the integers:
- 7140
- 21408696
- 26728085384
- 14545501785001
- See also
- Wikipedia: Triangular numbers
- Wikipedia: Tetrahedral numbers
- Wikipedia: Pentatopic numbers
- Wikipedia: Figurate numbers
- Wikipedia: Simplex(geometry)
- OEIS:A000217 - Triangular numbers: a(n) = binomial(n+1,2)
- OEIS:A000292 - Tetrahedral numbers: a(n) = binomial(n+2,3)
- OEIS:A000332 - Pentatope numbers: a(n) = binomial(n+3,4)
- Related task: Evaluate binomial coefficients
- Related task: Pascal's triangle
ALGOL 68
Assumes LONG INT is at least 64 bits.
Some roots that should be integers have non-integral values when calculated by the formulae in the task.
To get the correct values (if possible), the root procedures used here calculate float value and then use the nearest integer or nearest integer + 1 if they are exact.
BEGIN # show some triangular, tetrahedral, ... numbers and roots #
# prints a row of LONG INTs, with a title, newlines after every per-line #
# and each number in the specified width #
PROC show values = ( STRING title, []LONG INT v, INT per line, INT width )VOID:
BEGIN
print( ( title, ":", newline ) );
INT on line := 0;
FOR i FROM LWB v TO UPB v DO
print( ( whole( v[ i ], -width ) ) );
IF ( on line +:= 1 ) = per line THEN
print( ( newline ) );
on line := 0
FI
OD;
IF on line /= 0 THEN print( ( newline ) ) FI;
print( ( newline ) )
END # show values # ;
# calculate the first 30 triangular, tetrahedral, etc. numbers #
[ 1 : 30 ]LONG INT triangular; triangular[ 1 ] := 0;
[ 1 : 30 ]LONG INT tetrahedral; tetrahedral[ 1 ] := 0;
[ 1 : 30 ]LONG INT pentatopic; pentatopic[ 1 ] := 0;
[ 1 : 30 ]LONG INT simplex12; simplex12[ 1 ] := 0;
FOR i FROM 2 TO 30 DO
triangular[ i ] := triangular[ i - 1 ] + i - 1;
tetrahedral[ i ] := tetrahedral[ i - 1 ] + triangular[ i ];
pentatopic[ i ] := pentatopic[ i - 1 ] + tetrahedral[ i ];
simplex12[ i ] := pentatopic[ i ]
OD;
FROM 5 TO 12 DO
FOR i FROM 2 TO 30 DO
simplex12[ i ] +:= simplex12[ i - 1 ]
OD
OD;
show values( "First 30 Triangular numbers", triangular, 6, 4 );
show values( "First 30 Tetrahedral numbers", tetrahedral, 6, 5 );
show values( "First 30 Pentatopic numbers", pentatopic, 6, 6 );
show values( "First 30 12-Simplex numbers", simplex12, 6, 12 );
# show some triangular, tetrahedral, etc. roots #
# returns the cube root of x #
PROC long crt = ( LONG REAL x )LONG REAL: long exp( long ln( x ) / 3 );
# returns a LONG REAL approximation to the triangular root of x #
PROC real triangular root = ( LONG INT x )LONG REAL: ( long sqrt( 8 * x ) - 1 ) / 2;
# returns a LONG REAL approximation to the tetrahedral root of x #
PROC real tetrahedral root = ( LONG INT x )LONG REAL:
BEGIN
LONG REAL t = long sqrt( ( 9 * x * x ) - ( 1 / 27 ) );
long crt( ( 3 * x ) + t ) + long crt( ( 3 * x ) - t ) - 1
END # tetrahedral root # ;
# returns a LONG REAL approximation to the pentatopic root of x #
PROC real pentatopic root = ( LONG INT x )LONG REAL:
( long sqrt( 5 + ( 4 * long sqrt( ( 24 * x ) + 1 ) ) ) - 3 ) / 2;
# returns an integer root of x, if the approximation (possibly + 1 ) = x #
# the approximation otherwise #
PROC try integer root = ( LONG INT x, LONG REAL real root, PROC( LONG INT )LONG INT f )LONG REAL:
IF LONG INT ir = ENTIER real root;
f( ir ) = x
THEN ir
ELIF f( ir + 1 ) = x
THEN ir + 1
ELSE real root
FI # try integer root # ;
# returns the triangular root of x #
PROC triangular root = ( LONG INT x )LONG REAL:
try integer root( x
, real triangular root( x )
, ( LONG INT n )LONG INT: ( n * ( n + 1 ) ) OVER 2
);
# returns the tetrahedral root of x #
PROC tetrahedral root = ( LONG INT x )LONG REAL:
try integer root( x
, real tetrahedral root( x )
, ( LONG INT n )LONG INT: ( n * ( n + 1 ) * ( n + 2 ) ) OVER 6
);
# returns the pentatopic root of x #
PROC pentatopic root = ( LONG INT x )LONG REAL:
try integer root( x
, real pentatopic root( x )
, ( LONG INT n )LONG INT: ( n * ( n + 1 ) * ( n + 2 ) * ( n + 3 ) ) OVER 24
);
[]LONG INT root test = ( 7140, 21408696, 26728085384, 14545501785001 );
FOR i FROM LWB root test TO UPB root test DO
PROC show = ( LONG REAL x )STRING:
IF ENTIER x = x THEN whole( x, -6 ) + " " ELSE fixed( x, -12, 5 ) FI;
print( ( "Roots of ", whole( root test[ i ], 0 ), newline, " " ) );
print( ( " triangular: ", show( triangular root( root test[ i ] ) ) ) );
print( ( " tetrahedral: ", show( tetrahedral root( root test[ i ] ) ) ) );
print( ( " pentatopic: ", show( pentatopic root( root test[ i ] ) ) ) );
print( ( newline ) )
OD
END
- Output:
First 30 Triangular numbers: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 First 30 Tetrahedral numbers: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 First 30 Pentatopic numbers: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 First 30 12-Simplex numbers: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140 triangular: 119 tetrahedral: 34 pentatopic: 18.87665 Roots of 21408696 triangular: 6543 tetrahedral: 503.56183 pentatopic: 149.06095 Roots of 26728085384 triangular: 231205.40556 tetrahedral: 5432 pentatopic: 893.44246 Roots of 14545501785001 triangular: 5393607.1581 tetrahedral: 44355.77738 pentatopic: 4321
AppleScript
on rSimplexNumber(r, n)
set n to n - 1 -- "nth" is 0-based in the formula!
set numerator to n
set denominator to 1
repeat with dimension from 2 to r
set numerator to numerator * (n + dimension - 1)
set denominator to denominator * dimension
end repeat
return numerator div denominator
end rSimplexNumber
on triangularRoot(x)
return ((8 * x + 1) ^ 0.5 - 1) / 2
end triangularRoot
on tetrahedralRoot(x)
-- NOT (((9 * (x ^ 2) - 1 / 27) ^ 0.5 + 3 * x) ^ (1 / 3)) * 2 - 1 !
return (((9 * (x ^ 2) - 1 / 27) ^ 0.5 + 3 * x) ^ (1 / 3)) - 1
end tetrahedralRoot
on pentatopicRoot(x)
return (((24 * x + 1) ^ 0.5 * 4 + 5) ^ 0.5 - 3) / 2
end pentatopicRoot
on intToText(int)
set txt to ""
repeat while (int > 99999999)
set txt to ((100000000 + int mod 100000000) as integer as text)'s text 2 thru 9 & txt
set int to int div 100000000
end repeat
return (int as text) & txt
end intToText
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
on task()
set output to {}
set padding to " "
set columnWidth to (count intToText(rSimplexNumber(12, 30))) + 2
repeat with rt in {{2, "triangular"}, {3, "tetrahedral"}, {5, "pentatopic"}, {12, "12-simplex"}}
set {r, type} to rt
set end of output to linefeed & "First thirty " & type & " numbers:"
set these6 to {}
repeat with n from 1 to 30
set this to intToText(rSimplexNumber(r, n))
set these6's end to (padding & this)'s text -columnWidth thru -1
if (n mod 6 = 0) then
set end of output to join(these6, "")
set these6 to {}
end if
end repeat
end repeat
repeat with n in {7140, 21408696, 2.6728085384E+10, 1.4545501785001E+13}
set end of output to linefeed & "Roots of " & intToText(n) & ":"
set end of output to " Triangular root: " & triangularRoot(n)
set end of output to " Tetrahedral root: " & tetrahedralRoot(n)
set end of output to " Pentatopic root: " & pentatopicRoot(n)
end repeat
return join(output, linefeed)
end task
return task()
- Output:
"
First thirty triangular numbers:
0 1 3 6 10 15
21 28 36 45 55 66
78 91 105 120 136 153
171 190 210 231 253 276
300 325 351 378 406 435
First thirty tetrahedral numbers:
0 1 4 10 20 35
56 84 120 165 220 286
364 455 560 680 816 969
1140 1330 1540 1771 2024 2300
2600 2925 3276 3654 4060 4495
First thirty pentatopic numbers:
0 1 6 21 56 126
252 462 792 1287 2002 3003
4368 6188 8568 11628 15504 20349
26334 33649 42504 53130 65780 80730
98280 118755 142506 169911 201376 237336
First thirty 12-simplex numbers:
0 1 13 91 455 1820
6188 18564 50388 125970 293930 646646
1352078 2704156 5200300 9657700 17383860 30421755
51895935 86493225 141120525 225792840 354817320 548354040
834451800 1251677700 1852482996 2707475148 3910797436 5586853480
Roots of 7140:
Triangular root: 119.0
Tetrahedral root: 33.990473597552
Pentatopic root: 18.876646615928
Roots of 21408696:
Triangular root: 6543.0
Tetrahedral root: 503.561166334548
Pentatopic root: 149.060947375266
Roots of 26728085384:
Triangular root: 2.312054055653E+5
Tetrahedral root: 5431.99993864654
Pentatopic root: 893.442456751685
Roots of 14545501785001:
Triangular root: 5.393607158145E+6
Tetrahedral root: 4.435577737656E+4
Pentatopic root: 4321.0"
FreeBASIC
Dim As Integer n, r, t(0 To 30)
t(0) = 0
Print "The first 30 triangular numbers are:"
For n = 1 To 30
t(n) = t(n-1) + n - 1
If n Mod 6 = 0 Then Print Using "####"; t(n) Else Print Using "####"; t(n);
Next n
Print !"\nThe first 30 tetrahedral numbers are:"
For n = 1 To 30
t(n) += t(n-1)
Print Using "#####"; t(n);
If n Mod 6 = 0 Then Print
Next n
Print !"\nThe first 30 pentatopic numbers are:"
For n = 1 To 30
t(n) += t(n-1)
Print Using "######"; t(n);
If n Mod 6 = 0 Then Print
Next n
Print !"\nThe first 30 12-simplex numbers are:"
For r = 5 To 12
For n = 1 To 30
t(n) += t(n-1)
If r = 12 Then
Print Using "###########"; t(n);
If n Mod 6 = 0 Then Print
End If
Next n
Next r
#define cRec27 1/sqr(27)
Dim As Integer xs(1 To 4) = {7140, 21408696, 26728085384, 14545501785001}
Dim As Double x, y, z
For i As Byte = 1 To 4
z = xs(i)
Print !"\nRoots of"; xs(i); ":"
Print " triangular:"; (Sqr(8*z+1)-1)/2
y = 3*z
x = Sqr((y-cRec27)*(y+cRec27))
Print "tetrahedral:"; Iif(x < y, Exp(Log(y+x)/3)+Exp(Log(y-x)/3)-1, Exp(Log(6)/3)*Exp(Log(z)/3)-1)
Print " pentatopic:"; (Sqr(5+4*Sqr(24*z+1))-3)/2
Next i
Sleep
- Output:
The first 30 triangular numbers are: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 The first 30 tetrahedral numbers are: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 The first 30 pentatopic numbers are: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 The first 30 12-simplex numbers are: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140: triangular: 119 tetrahedral: 34.00000000179027 pentatopic: 18.87664661592801 Roots of 21408696: triangular: 6543 tetrahedral: 503.5611663345483 pentatopic: 149.0609473752659 Roots of 26728085384: triangular: 231205.4055652559 tetrahedral: 5431.99993864654 pentatopic: 893.4424567516849 Roots of 14545501785001: triangular: 5393607.158145173 tetrahedral: 44355.77737655847 pentatopic: 4321
Go
I've had to use a third party library to calculate cube roots as the big.Float type in the standard library doesn't have a function for this. The results (to 24 d.p) are the same as the Raku example with the exception of the tetrahedral root for the largest integer which differs in the last three places.
package main
import (
"fmt"
"github.com/ALTree/bigfloat"
"math/big"
"rcu"
)
func main() {
t := make([]int, 30)
for n := 1; n < 30; n++ {
t[n] = t[n-1] + n
}
fmt.Println("The first 30 triangular numbers are:")
rcu.PrintTable(t, 6, 3, false)
for n := 1; n < 30; n++ {
t[n] += t[n-1]
}
fmt.Println("\nThe first 30 tetrahedral numbers are:")
rcu.PrintTable(t, 6, 4, false)
for n := 1; n < 30; n++ {
t[n] += t[n-1]
}
fmt.Println("\nThe first 30 pentatopic numbers are:")
rcu.PrintTable(t, 6, 5, false)
for r := 5; r <= 12; r++ {
for n := 1; n < 30; n++ {
t[n] += t[n-1]
}
}
fmt.Println("\nThe first 30 12-simplex numbers are:")
rcu.PrintTable(t, 6, 10, false)
const prec = 256
xs := []float64{7140, 21408696, 26728085384, 14545501785001}
root := new(big.Float)
temp := new(big.Float)
temp2 := new(big.Float)
one := big.NewFloat(1)
two := big.NewFloat(2)
three := big.NewFloat(3)
four := big.NewFloat(4)
five := big.NewFloat(5)
eight := big.NewFloat(8)
nine := big.NewFloat(9)
twentyFour := big.NewFloat(24)
twentySeven := big.NewFloat(27)
third := new(big.Float).SetPrec(prec).Quo(one, three)
for _, x := range xs {
bx := big.NewFloat(x).SetPrec(prec)
fmt.Printf("\nRoots of %d:\n", int(x))
root.Mul(bx, eight)
root.Add(root, one)
root.Sqrt(root)
root.Sub(root, one)
root.Quo(root, two)
fmt.Printf("%14s: %.24f\n", "triangular", root)
temp.Mul(bx, bx)
temp.Mul(temp, nine)
temp.Sub(temp, new(big.Float).SetPrec(prec).Quo(one, twentySeven))
temp.Sqrt(temp)
temp2.Mul(bx, three)
temp2.Sub(temp2, temp)
temp2 = bigfloat.Pow(temp2, third)
root.Mul(bx, three)
root.Add(root, temp)
root = bigfloat.Pow(root, third)
root.Add(root, temp2)
root.Sub(root, one)
fmt.Printf("%14s: %.24f\n", "tetrahedral", root)
root.Mul(bx, twentyFour)
root.Add(root, one)
root.Sqrt(root)
root.Mul(root, four)
root.Add(root, five)
root.Sqrt(root)
root.Sub(root, three)
root.Quo(root, two)
fmt.Printf("%14s: %.24f\n", "pentatonic", root)
}
}
- Output:
The first 30 triangular numbers are: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 The first 30 tetrahedral numbers are: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 The first 30 pentatopic numbers are: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 The first 30 12-simplex numbers are: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140: triangular: 119.000000000000000000000000 tetrahedral: 34.000000000000000000000000 pentatonic: 18.876646615928006607901783 Roots of 21408696: triangular: 6543.000000000000000000000000 tetrahedral: 503.561826974636514048196130 pentatonic: 149.060947375265867484387575 Roots of 26728085384: triangular: 231205.405565255836957291031961 tetrahedral: 5432.000000000000000000000000 pentatonic: 893.442456751684869888466212 Roots of 14545501785001: triangular: 5393607.158145172316497304724655 tetrahedral: 44355.777384073256052620916889 pentatonic: 4321.000000000000000000000000
J
In J, it's usually more natural to start counting from 0 rather than 1. That shows up subtly in this task, since the specified roots assume counting starts from 1.
Anyways:
tri=: [!+
2 tri 1+i.5 6
3 6 10 15 21 28
36 45 55 66 78 91
105 120 136 153 171 190
210 231 253 276 300 325
351 378 406 435 465 496
3 tri 1+i.5 6
4 10 20 35 56 84
120 165 220 286 364 455
560 680 816 969 1140 1330
1540 1771 2024 2300 2600 2925
3276 3654 4060 4495 4960 5456
4 tri 1+i.5 6
5 15 35 70 126 210
330 495 715 1001 1365 1820
2380 3060 3876 4845 5985 7315
8855 10626 12650 14950 17550 20475
23751 27405 31465 35960 40920 46376
12 tri 1+i.10 3
13 91 455
1820 6188 18564
50388 125970 293930
646646 1352078 2704156
5200300 9657700 17383860
30421755 51895935 86493225
141120525 225792840 354817320
548354040 834451800 1251677700
1852482996 2707475148 3910797436
5586853480 7898654920 11058116888
And, for the roots:
r2=: 2 %~ _1 + 2 %: 1 8&p.
r3=: _1 + 0 3&p. (+ +&(3%:]) -) 2 %: _1r27 0 9&p.
r4=: 2 %~ _3 + 2 %: 5 + 4 * 2 %: 1 + 24 * ]
(r2,r3,r4) 7140
119 34 18.8766
(r2,r3,r4) 21408696
6543 503.564 149.061
(r2,r3,r4) 26728085384
231205 5432 893.442
(r2,r3,r4) 14545501785001
5.39361e6 44356.2 4321
Julia
""" rosettacode.org task Triangular_numbers """
polytopic(r, range) = map(n -> binomial(n + r - 1, r), range)
triangular_root(x) = (sqrt(8x + 1) - 1) / 2
function tetrahedral_root(x)
return Float64(round((3x + sqrt(9 * x^big"2" - big"1"/27))^(big"1"/3) +
(3x - sqrt(9 * x^big"2" - big"1"/27))^(big"1"/3) - 1, digits=18))
end
pentatopic_root(x) = (sqrt(5 + 4 * sqrt(24x + 1)) - 3) / 2
function valuelisting(a, N=6)
c = maximum(length, string.(a)) + 1
return join([join([lpad(x, c) for x in v]) for v in Iterators.partition(a, N)], "\n")
end
for (r, name) in [[2, "triangular"], [3, "tetrahedral"], [4, "pentatopic"], [12, "12-simplex"]]
println("\nFirst 30 $name numbers:\n", valuelisting(polytopic(r, 0:29)))
end
for n in [7140, 21408696, 26728085384, 14545501785001]
println("\nRoots of $n:")
println(" triangular-root: ", triangular_root(n))
println(" tetrahedral-root: ", tetrahedral_root(n))
println(" pentatopic-root: ", pentatopic_root(n))
end
- Output:
First 30 triangular numbers: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 First 30 tetrahedral numbers: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 First 30 pentatopic numbers: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 First 30 12-simplex numbers: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140: triangular-root: 119.0 tetrahedral-root: 34.0 pentatopic-root: 18.876646615928006 Roots of 21408696: triangular-root: 6543.0 tetrahedral-root: 503.5618269746365 pentatopic-root: 149.06094737526587 Roots of 26728085384: triangular-root: 231205.40556525585 tetrahedral-root: 5432.0 pentatopic-root: 893.4424567516849 Roots of 14545501785001: triangular-root: 5.3936071581451725e6 tetrahedral-root: 44355.777384073255 pentatopic-root: 4321.0
Pascal
Pascal
Using only extended isn't that precise for tetrahedral roots.
sqrt(sqr(3x)+1/27) is nearly 3x for bigger x values.
program XangularNumbers;
const
MAXIDX = 29;
MAXLINECNT = 13;
cNames : array[0..4] of string =
('','','triangular','tetrahedral','pentatopic');
cCheckRootValues :array[0..3] of Uint64 =
(7140,21408696,26728085384,14545501785001) ;
type
tOneLine = array[0..MAXIDX+2] of Uint64;
tpOneLine = ^tOneLine;
tSimplexs = array[0..MAXLINECNT-1] of tOneLine;
procedure OutLine(var S:tSimplexs;idx: NativeInt);
const
cColCnt = 6;cColWidth = 80 DIV cColCnt;
var
i,colcnt : NativeInt;
begin
if idx > High(cNames) then
writeln('First ',MAXIDX+1,' ',idx,'-simplex numbers')
else
writeln('First ',MAXIDX+1,' ',cNames[idx],' numbers');
colcnt := cColCnt;
For i := 0 to MAXIDX do
begin
write(S[idx,i]:cColWidth);
dec(colCnt);
if ColCnt = 0 then
Begin
writeln;
ColCnt := cColCnt;
end;
end;
if ColCnt < cColCnt then
writeln;
writeln;
end;
procedure CalcNextLine(var S:tSimplexs;idx: NativeInt);
var
s1,s2: Uint64;
i : NativeInt;
begin
s1 := S[idx,0];
S[idx+1,0] := s1;
For i := 1 to MAXIDX do
begin
s2:= S[idx,i];
S[idx+1,i] := s1+s2;
inc(s1,s2);
end;
end;
procedure InitSimplexs(var S:tSimplexs);
var
i: NativeInt;
begin
fillChar(S,Sizeof(S),#0);
For i := 1 to MAXIDX do
S[0,i] := 1;
For i := 0 to MAXLINECNT-2 do
CalcNextLine(S,i);
end;
function TriangularRoot(n: Uint64): extended;
begin
if n < High(Uint64) DIV 8 then
TriangularRoot := (sqrt(8*n+1)-1) / 2
else
TriangularRoot := (sqrt(8)*sqrt(n)-1)/2;
end;
function tetrahedralRoot(n: Uint64): extended;
const
cRec27 = 1/sqrt(27);
var
x,y : extended;
begin
y := 3.0*n;
x := sqrt((y-cRec27)*(y+cRec27));//sqrt(sqr(3*n)-1/27)
if x < y then
tetrahedralRoot := exp(ln(y+x)/3.0)+exp(ln(y-x)/3.0)-1.0
else
//( 6*n)^(1/3)-1
tetrahedralRoot :=exp(ln(6)/3.0)*exp(ln(n)/3.0)-1.0; //6^(1/3)* n^(1/3)-1
end;
function PentatopicRoot(n: Uint64): extended;
begin
PentatopicRoot := (sqrt(5 + 4 * sqrt(24*n + 1)) - 3) / 2;
end;
var
Simplexs : tSimplexs;
n : Uint64;
i : NativeInt;
Begin
InitSimplexs(Simplexs);
OutLine(Simplexs,2);
OutLine(Simplexs,3);
OutLine(Simplexs,4);
OutLine(Simplexs,12);
For i := 0 to High(cCheckRootValues) do
begin
n := cCheckRootValues[i];
writeln('Roots of ',n,':');
writeln('triangular -root : ',TriangularRoot(n):20:12);
writeln('tetrahedral-root : ',tetrahedralRoot(n):20:12);
writeln('pentatopic -root : ',PentatopicRoot(n):20:12);
writeln;
end;
end.
- Output:
First 30 triangular numbers 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 First 30 tetrahedral numbers 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 First 30 pentatopic numbers 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 First 30 12-simplex numbers 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140: triangular -root : 119.000000000000 tetrahedral-root : 34.000000000003 pentatopic -root : 18.876646615928 Roots of 21408696: triangular -root : 6543.000000000000 tetrahedral-root : 503.561826261328 pentatopic -root : 149.060947375266 Roots of 26728085384: triangular -root : 231205.405565255837 tetrahedral-root : 5431.999938646542 <<== pentatopic -root : 893.442456751685 Roots of 14545501785001: triangular -root : 5393607.158145172316 tetrahedral-root : 44355.777376558433 pentatopic -root : 4321.000000000000
Raku
use Math::Root;
my \ε = FatRat.new: 1, 10**24;
sub binomial { [×] ($^n … 0) Z/ 1 .. $^p }
sub polytopic (Int $r, @range) { @range.map: { binomial $_ + $r - 1, $r } }
sub triangular-root ($x) { round ((8 × $x + 1).&root - 1) / 2, ε }
sub tetrahedral-root ($x) {
((3 × $x + (9 × $x² - 1/27).&root).&root(3) +
(3 × $x - (9 × $x² - 1/27).&root).&root(3) - 1).round: ε
}
sub pentatopic-root ($x) { round ((5 + 4 × (24 × $x + 1).&root).&root - 3) / 2, ε }
sub display (@values) {
my $c = @values.max.chars;
@values.batch(6)».fmt("%{$c}d").join: "\n";
}
for 2, 'triangular', 3, 'tetrahedral', 4, 'pentatopic', 12, '12-simplex'
-> $r, $name { say "\nFirst 30 $name numbers:\n" ~ display polytopic $r, ^30 }
say '';
for 7140, 21408696, 26728085384, 14545501785001 {
say qq:to/R/;
Roots of $_:
triangular-root: {.&triangular-root}
tetrahedral-root: {.&tetrahedral-root}
pentatopic-root: {.&pentatopic-root}
R
}
- Output:
First 30 triangular numbers: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 First 30 tetrahedral numbers: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 First 30 pentatopic numbers: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 First 30 12-simplex numbers: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140: triangular-root: 119 tetrahedral-root: 34 pentatopic-root: 18.876646615928006607901783 Roots of 21408696: triangular-root: 6543 tetrahedral-root: 503.56182697463651404819613 pentatopic-root: 149.060947375265867484387575 Roots of 26728085384: triangular-root: 231205.405565255836957291031961 tetrahedral-root: 5432 pentatopic-root: 893.442456751684869888466212 Roots of 14545501785001: triangular-root: 5393607.158145172316497304724655 tetrahedral-root: 44355.777384073256052620916903 pentatopic-root: 4321
Wren
import "./fmt" for Fmt
import "./big" for BigRat
var t = List.filled(30, 0)
for (n in 1..29) t[n] = t[n-1] + n
System.print("The first 30 triangular numbers are:")
Fmt.tprint("$3d", t, 6)
for (n in 1..29) t[n] = t[n] + t[n-1]
System.print("\nThe first 30 tetrahedral numbers are:")
Fmt.tprint("$4d", t, 6)
for (n in 1..29) t[n] = t[n] + t[n-1]
System.print("\nThe first 30 pentatopic numbers are:")
Fmt.tprint("$5d", t, 6)
for (r in 5..12) {
for (n in 1..29) t[n] = t[n] + t[n-1]
}
System.print("\nThe first 30 12-simplex numbers are:")
Fmt.tprint("$10d", t, 6)
var xs = [7140, 21408696, 26728085384, 14545501785001]
var digs = 16
for (x in xs) {
var bx = BigRat.new(x)
System.print("\nRoots of %(x):")
var root = ((bx*8 + 1).sqrt(digs) - 1)/2
Fmt.print("$14s: $s", "triangular", root.toDecimal(digs-5))
var temp = (bx*bx*9 - BigRat.new(1, 27)).sqrt(digs)
root = (bx*3 + temp).cbrt(digs) + (bx*3 - temp).cbrt(digs) - 1
Fmt.print("$14s: $s", "tetrahedral", root.toDecimal(digs-5))
root = (((bx*24 + 1).sqrt(digs)*4 + 5).sqrt(digs) - 3) / 2
Fmt.print("$14s: $s", "pentatopic", root.toDecimal(digs-5))
}
- Output:
The first 30 triangular numbers are: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 The first 30 tetrahedral numbers are: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 The first 30 pentatopic numbers are: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 The first 30 12-simplex numbers are: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140: triangular: 119 tetrahedral: 34.00000000000 pentatopic: 18.87664661593 Roots of 21408696: triangular: 6543 tetrahedral: 503.56182697464 pentatopic: 149.06094737527 Roots of 26728085384: triangular: 231205.40556525584 tetrahedral: 5432.00000000000 pentatopic: 893.44245675168 Roots of 14545501785001: triangular: 5393607.15814517232 tetrahedral: 44355.77738407326 pentatopic: 4321
XPL0
Some "interesting" loss of precision in the Pow function....
real T(13, 30);
proc ShowRoots(X);
real X, SR, CR1, CR2;
[Format(1, 0);
Text(0, "Roots of "); RlOut(0, X); CrLf(0);
Format(7, 13);
Text(0, " triangular: ");
RlOut(0, (sqrt(8.*X + 1.) - 1.) / 2.);
Text(0, "^m^jtetrahedral: ");
SR:= sqrt(9.*X*X - 1./27.);
CR1:= Pow(3.*X + SR, 1./3.);
CR2:= Pow(3.*X - SR, 1./3.);
RlOut(0, CR1 + CR2 -1.);
Text(0, "^m^j pentatopic: ");
RlOut(0, (sqrt(5. + 4.*sqrt(24.*X + 1.)) - 3.) / 2.);
CrLf(0); CrLf(0);
];
proc Print(Str, Places, R);
int Str, Places, R, N;
[Text(0, Str); CrLf(0);
Format(Places, 0);
for N:= 0 to 29 do
[RlOut(0, T(R,N));
if rem(N/6) = 5 then CrLf(0);
];
CrLf(0);
];
int R, N;
[for N:= 0 to 29 do
T(1,N):= float(N);
for R:= 2 to 12 do
[T(R,0):= 0.;
for N:= 1 to 29 do
T(R,N):= T(R,N-1) + T(R-1,N);
];
Print("The first 30 triangular numbers are:", 4, 2);
Print("The first 30 tetrahedral numbers are:", 5, 3);
Print("The first 30 pentatopic numbers are:", 6, 4);
Print("The first 30 12-simplex numbers are:", 11, 12);
ShowRoots(7140.);
ShowRoots(21408696.);
ShowRoots(26728085384.);
ShowRoots(14_545_501_785_001.);
]
- Output:
The first 30 triangular numbers are: 0 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 231 253 276 300 325 351 378 406 435 The first 30 tetrahedral numbers are: 0 1 4 10 20 35 56 84 120 165 220 286 364 455 560 680 816 969 1140 1330 1540 1771 2024 2300 2600 2925 3276 3654 4060 4495 The first 30 pentatopic numbers are: 0 1 5 15 35 70 126 210 330 495 715 1001 1365 1820 2380 3060 3876 4845 5985 7315 8855 10626 12650 14950 17550 20475 23751 27405 31465 35960 The first 30 12-simplex numbers are: 0 1 13 91 455 1820 6188 18564 50388 125970 293930 646646 1352078 2704156 5200300 9657700 17383860 30421755 51895935 86493225 141120525 225792840 354817320 548354040 834451800 1251677700 1852482996 2707475148 3910797436 5586853480 Roots of 7140 triangular: 119.0000000000000 tetrahedral: 34.0000000017903 pentatopic: 18.8766466159280 Roots of 21408696 triangular: 6543.0000000000000 tetrahedral: 503.5611663345480 pentatopic: 149.0609473752660 Roots of 26728085384 triangular: 231205.4055652560000 tetrahedral: 5431.9999386465400 pentatopic: 893.4424567516850 Roots of 14545501785001 triangular: 5393607.1581451700000 tetrahedral: 44355.7773765584000 pentatopic: 4321.0000000000000