aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

70
Task/Fibonacci-n-step-number-sequences/Pascal/fibonacci-n-step-number-sequences-1.pas Normal file
View file

@ -0,0 +1,70 @@
program FibbonacciN (output);
type
TintArray = array of integer;
const
Name: array[2..11] of string = ('Fibonacci: ',
'Tribonacci: ',
'Tetranacci: ',
'Pentanacci: ',
'Hexanacci: ',
'Heptanacci: ',
'Octonacci: ',
'Nonanacci: ',
'Decanacci: ',
'Lucas: '
);
var
sequence: TintArray;
j, k: integer;
function CreateFibbo(n: integer): TintArray;
var
i: integer;
begin
setlength(CreateFibbo, n);
CreateFibbo[0] := 1;
CreateFibbo[1] := 1;
i := 2;
while i < n do
begin
CreateFibbo[i] := CreateFibbo[i-1] * 2;
inc(i);
end;
end;
procedure Fibbonacci(var start: TintArray);
const
No_of_examples = 11;
var
n, i, j: integer;
begin
n := length(start);
setlength(start, No_of_examples);
for i := n to high(start) do
begin
start[i] := 0;
for j := 1 to n do
start[i] := start[i] + start[i-j]
end;
end;
begin
for j := 2 to 10 do
begin
sequence := CreateFibbo(j);
Fibbonacci(sequence);
write (Name[j]);
for k := low(sequence) to high(sequence) do
write(sequence[k], ' ');
writeln;
end;
setlength(sequence, 2);
sequence[0] := 2;
sequence[1] := 1;
Fibbonacci(sequence);
write (Name[11]);
for k := low(sequence) to high(sequence) do
write(sequence[k], ' ');
writeln;
end.

113
Task/Fibonacci-n-step-number-sequences/Pascal/fibonacci-n-step-number-sequences-2.pas Normal file
View file

@ -0,0 +1,113 @@
program FibbonacciN (output);
{$IFNDEF FPC}
{$APPTYPE CONSOLE}
{$ENDIF}
const
MAX_Nacci = 10;
No_of_examples = 11;// max 90; (golden ratio)^No < 2^64
Name: array[2..11] of string = ('Fibonacci: ',
'Tribonacci: ',
'Tetranacci: ',
'Pentanacci: ',
'Hexanacci: ',
'Heptanacci: ',
'Octonacci: ',
'Nonanacci: ',
'Decanacci: ',
'Lucas: '
);
type
tfibIdx = 0..MAX_Nacci;
tNacVal = Uint64;// longWord
tNacci = record
ncSum : tNacVal;
ncLastFib : array[tFibIdx] of tNacVal;
ncNextIdx : array[tFibIdx] of tFibIdx;
ncIdx : tFibIdx;
ncValue : tFibIdx;
end;
function CreateNacci(n: tFibIdx): TNacci;
var
i : tFibIdx;
sum :tNacVal;
begin
//With result do
with CreateNacci do
begin
ncLastFib[0] := 1;
ncLastFib[1] := 1;
For i := 2 to n-1 do
ncLastFib[i] := ncLastFib[i-1] * 2;
Sum := 0;
For i := 0 to n-1 do
sum := sum +ncLastFib[i];
ncSum := Sum;
//No need to do a compare
//inc(idx);
//if idx>= n then
// idx := 0;
//idx := nextIdx[idx]
For i := 0 to n-2 do
ncNextIdx[i] := i+1;
ncNextIdx[n-1] := 0;
ncIdx := 0;
end;
end;
function LehmerCreate:TNacci;
begin
with LehmerCreate do
begin
ncLastFib[0] := 2;
ncLastFib[1] := 1;
ncSum := 3;
ncNextIdx[0] := 1;
ncNextIdx[1] := 0;
ncIdx := 0;
end;
end;
function NextNacci(var Nacci:tNacci):tNacVal;
var
NewSum :tNacVal;
begin
with Nacci do
begin
NewSum := 2*ncSum- ncLastFib[ncIdx];
ncLastFib[ncIdx] := ncSum;
ncIdx := ncNextIdx[ncIdx];
NextNacci := ncSum;
ncSum := NewSum;
end;
end;
var
Nacci : tNacci;
j, k: integer;
BEGIN
for j := 2 to 10 do
begin
Nacci := CreateNacci(j);
write (Name[j]);
For k := 0 to j-1 do
write(Nacci.ncLastFib[k],' ');
For k := j to No_of_examples-1 do
write(NextNacci(Nacci),' ');
writeln;
end;
write (Name[11]);
j := 2;
Nacci := LehmerCreate;
For k := 0 to j-1 do
write(Nacci.ncLastFib[k],' ');
For k := j to No_of_examples-1 do
write(NextNacci(Nacci),' ');
writeln;
END.