Triangular numbers: Difference between revisions
→{{header|Raku}}: perpend Free Pascal
Thundergnat (talk | contribs) m (minor clarifications) |
(→{{header|Raku}}: perpend Free Pascal) |
||
Line 154:
tetrahedral-root: 44355.77738407323
pentatopic-root: 4321.0
</pre>
=={{header|Pascal}}==
==={{header|Pascal}}===
Using only extended isn't that precise for tetrahedral roots.<br>
sqrt(sqr(3x)+1/27) is nearly 3x for bigger x values.
<syntaxhighlight lang="pascal">
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.</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 -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
</pre>
| |||