func fermat_number(n) {
    2**(2**n) + 1
}

func fermat_one_factor(n) {
    fermat_number(n).ecm_factor
}

for n in (0..9) {
    say "F_#{n} = #{fermat_number(n)}"
}

say ''

for n in (0..13) {
    var f = fermat_one_factor(n)
    say ("F_#{n} = ", join(' * ', f.shift,
      f.map { <C P>[.is_prime] + .len }...))
}


namespace import ::tcl::mathop::*
package require math::numtheory 1.1.1; # Buggy before tcllib-1.20

proc fermat n {
	+ [** 2 [** 2 $n]] 1
}

for {set i 0} {$i < 10} {incr i} {
	puts "F$i = [fermat $i]"
}

for {set i 1} {1} {incr i} {
	puts -nonewline "F$i... "
	flush stdout
	set F [fermat $i]
	set factors [math::numtheory::primeFactors $F]
	if {[llength $factors] == 1} {
		puts "is prime"
	} else {
		puts "factors: $factors"
	}
}


import "/big" for BigInt

var fermat = Fn.new { |n| BigInt.two.pow(2.pow(n)) + 1 }

var fns = List.filled(10, null)
System.print("The first 10 Fermat numbers are:")
for (i in 0..9) {
    fns[i] = fermat.call(i)
    System.print("F%(String.fromCodePoint(0x2080+i)) = %(fns[i])")
}

System.print("\nFactors of the first 7 Fermat numbers:")
for (i in 0..6) {
    System.write("F%(String.fromCodePoint(0x2080+i)) = ")
    var factors = BigInt.primeFactors(fns[i])
    System.write("%(factors)")
    if (factors.count == 1) {
        System.print(" (prime)")
    } else if (!factors[1].isProbablePrime(5)) {
        System.print(" (second factor is composite)")
    } else {
        System.print()
    }
}


program copyfile
	file open fin using `1', read text
	file open fout using `2', write text replace

	file read fin line
	while !r(eof) {
		file write fout `"`line'"' _newline
		file read fin line
	}
	file close fin
	file close fout
end

copyfile input.txt output.txt


set in [open "input.txt" r]
set out [open "output.txt" w]
# Obviously, arbitrary transformations could be added to the data at this point
puts -nonewline $out [read $in]
close $in
close $out


( source dest -- )
{
  value| source dest size buffer |
  {
    {
      [ "W" file.open to dest ] is open-dest
      [ "R" file.open to source ] is open-source
      [ open-dest open-source ]
    } is open-files
    {
      [ source file.size to size ] is obtain-size
      [ size malloc to buffer ] is allocate-buffer
      [ obtain-size allocate-buffer ]
    } is create-buffer
    [ source dest and 0 <> ] is check
    [ open-files create-buffer check ]
  } is prepare
  [ source buffer size file.read drop ] is read-source
  [ dest buffer size file.write drop ] is write-dest
  [ source file.close dest file.close ] is close-files
  [ prepare [ read-source write-dest close-files ] ifTrue ]
} is copy-file


fermatsW:=[0..].tweak(fcn(n){ BI(2).pow(BI(2).pow(n)) + 1 });
println("First 10 Fermat numbers:");
foreach n in (10){ println("F",n,": ",fermatsW.next()) }


$$ MODE TUSCRIPT
ERROR/STOP CREATE ("input.txt", seq-o,-std-)
ERROR/STOP CREATE ("output.txt",seq-o,-std-)

FILE/ERASE "input.txt" = "Some irrelevant content"
path2input =FULLNAME(TUSTEP,"input.txt", -std-)
status=READ (path2input,contentinput)

path2output=FULLNAME(TUSTEP,"output.txt",-std-)
status=WRITE(path2output,contentinput)


(let ((var (file-get-string "input.txt")))
  (file-put-string "output.txt" var))


#!/bin/sh
while IFS= read -r a; do
    printf '%s\n' "$a"
done <input.txt >output.txt


decl file input output
decl string contents
input.open "input.txt"
output.create "output.txt"
output.open "output.txt"
set contents (input.readall)
out contents output


#import std

#executable ('parameterized','')

fileio = ~command.files; &h.path.&h:= 'output.txt'!


Option Explicit

Sub Main()
Dim s As String, FF As Integer

'read a file line by line
FF = FreeFile
Open "C:\Users\" & Environ("username") & "\Desktop\input.txt" For Input As #FF
While Not EOF(FF)
    Line Input #FF, s
    Debug.Print s
Wend
Close #FF

'read a file
FF = FreeFile
Open "C:\Users\" & Environ("username") & "\Desktop\input.txt" For Input As #FF
    s = Input(LOF(1), #FF)
Close #FF
Debug.Print s

'write a file
FF = FreeFile
Open "C:\Users\" & Environ("username") & "\Desktop\output.txt" For Output As #FF
    Print #FF, s
Close #FF
End Sub


File_Open("input.txt")
File_Save_As("output.txt", NOMSG)
Buf_Close(NOMSG)


'byte copy
My.Computer.FileSystem.WriteAllBytes("output.txt", _
  My.Computer.FileSystem.ReadAllBytes("input.txt"), False)

'text copy
Using input = IO.File.OpenText("input.txt"), _
      output As New IO.StreamWriter(IO.File.OpenWrite("output.txt"))
  output.Write(input.ReadToEnd)
End Using

'Line by line text copy
Using input = IO.File.OpenText("input.txt"), _
      output As New IO.StreamWriter(IO.File.OpenWrite("output.txt"))
  Do Until input.EndOfStream
    output.WriteLine(input.ReadLine)
  Loop
End Using


with infile "input.txt"
  with outfile "output.txt"
    whilet line (read_line)
      prn line


import "io" for File

var contents = File.read("input.txt")
File.create("output.txt") {|file|
    file.writeBytes(contents)
}


include c:\cxpl\codes;
int  I, C;
char IntermediateVariable;
[IntermediateVariable:= GetHp;
I:= 0;
repeat  C:= ChIn(1);
        IntermediateVariable(I):= C;
        I:= I+1;
until C = $1A; \EOF
I:= 0;
repeat  C:= IntermediateVariable(I);
        I:= I+1;
        ChOut(0, C);
until C = $1A; \EOF
]


var d=File("input.txt").read();
(f:=File("output.txt","w")).write(d); f.close(); // one read, one write copy
File("output.txt").pump(Console); // verify by printing


const std = @import("std");

pub fn main() !void {
    var in = try std.fs.cwd().openFile("input.txt", .{});
    defer in.close();
    var out = try std.fs.cwd().openFile("output.txt", .{ .mode = .write_only });
    defer out.close();
    var file_reader = in.reader();
    var file_writer = out.writer();
    var buf: [100]u8 = undefined;
    var read: usize = 1;
    while (read > 0) {
        read = try file_reader.readAll(&buf);
        try file_writer.writeAll(buf[0..read]);
    }
}


T Fiblike
   Int addnum
   [Int] memo

   F (start)
      .addnum = start.len
      .memo = copy(start)

   F ()(n)
      X.try
         R .memo[n]
      X.catch IndexError
         V ans = sum((n - .addnum .< n).map(i -> (.)(i)))
         .memo.append(ans)
         R ans

V fibo = Fiblike([1, 1])
print((0.<10).map(i -> fibo(i)))

V lucas = Fiblike([2, 1])
print((0.<10).map(i -> lucas(i)))

L(n, name) zip(2..10, ‘fibo tribo tetra penta hexa hepta octo nona deca’.split(‘ ’))
   V fibber = Fiblike([1] [+] (0 .< n - 1).map(i -> Int(2 ^ i)))
   print(‘n=#2, #5nacci -> #. ...’.format(n, name, (0.<15).map(i -> String(@fibber(i))).join(‘ ’)))


*        Fibonacci n-step number sequences - 14/04/2020
FIBONS   CSECT
         USING  FIBONS,R13         base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         SAVE   (14,12)            save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,2               i=2
       DO WHILE=(C,R6,LE,=F'7')    do i=2 to 7
         ST     R6,IR                ir=i
       IF     C,R6,EQ,=F'7' THEN     if i=7 then - Lucas
         LA     R0,2                   2
         ST     R0,IR                  ir=2
       ENDIF    ,                    endif
         LA     R0,1                 1
         ST     R0,T                 t(1)=1
       IF     C,R6,EQ,=F'7' THEN     if i=7 then - Lucas
         LA     R0,2                 2
         ST     R0,T                 t(1)=2
       ENDIF    ,                    endif
         LA     R0,1                 1
         ST     R0,T+4               t(2)=1
         LA     R7,3                 j=3
       DO WHILE=(C,R7,LE,=A(NMAX))   do j=3 to nmax
         SR     R0,R0                  0
         ST     R0,SUM                 sum=0
         LR     R11,R7                 j
         S      R11,IR                 j-ir
         LR     R8,R7                  k=j
         BCTR   R8,0                   k=j-1
       DO WHILE=(CR,R8,GE,R11)         do k=j-1 to j-ir by -1
       IF   LTR,R8,P,R8 THEN             if k>0 then
         LR     R1,R8                      k
         SLA    R1,2                       ~
         L      R2,T-4(R1)                 t(k)
         L      R1,SUM                     sum
         AR     R1,R2                      +
         ST     R1,SUM                     sum=sum+t(k)
       ENDIF    ,                        endif
         BCTR   R8,0                     k--
       ENDDO    ,                      enddo k
         L      R0,SUM                 sum
         LR     R1,R7                  j
         SLA    R1,2                   ~
         ST     R0,T-4(R1)             t(j)=sum
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         MVC    PG,=CL120' '         clear buffer
         LA     R9,PG                @buffer
         LR     R1,R6                i
         BCTR   R1,0                 i-1
         MH     R1,=H'5'             ~
         LA     R4,BONACCI-5(R1)     @bonacci(i-1)
         MVC    0(5,R9),0(R4)        output bonacci(i-1)
         LA     R9,5(R9)             @buffer
       IF     C,R6,NE,=F'7' THEN     if i<>7 then
         MVC    0(7,R9),=C'nacci: '    output 'nacci: '
       ELSE     ,                    else
         MVC    0(7,R9),=C'     : '    output '     : '
       ENDIF    ,                    endif
         LA     R9,7(R9)             @buffer
         LA     R7,1                 j=1
       DO WHILE=(C,R7,LE,=A(NMAX))   do j=1 to nmax
         LR     R1,R7                  j
         SLA    R1,2                   ~
         L      R2,T-4(R1)             t(j)
         XDECO  R2,XDEC                edit t(j)
         MVC    0(6,R9),XDEC+6         output t(j)
         LA     R9,6(R9)               @buffer
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         XPRNT  PG,L'PG              print buffer
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         RETURN (14,12),RC=0       restore registers from calling sav
NMAX     EQU    18                 sequence length
BONACCI  DC     CL5' fibo',CL5'tribo',CL5'tetra',CL5'penta',CL5' hexa'
         DC     CL5'lucas'         bonacci(6)
IR       DS     F                  ir
SUM      DS     F                  sum
T        DS     (NMAX)F            t(nmax)
XDEC     DS     CL12               temp for xdeco
PG       DS     CL120              buffer
         REGEQU
         END    FIBONS


(defun sum (xs)
   (if (endp xs)
       0
       (+ (first xs)
          (sum (rest xs)))))

(defun n-bonacci (prevs limit)
   (if (zp limit)
       nil
       (let ((next (append (rest prevs)
                           (list (sum prevs)))))
            (cons (first next)
                  (n-bonacci next (1- limit))))))


DEFINE MAX="15"

PROC GenerateSeq(CARD ARRAY init BYTE nInit CARD ARRAY seq BYTE nSeq)
  CARD next
  BYTE i,j,n

  IF nInit<nSeq THEN
    n=nInit
  ELSE
    n=nSeq
  FI

  FOR i=0 TO n-1
  DO
    seq(i)=init(i)
  OD

  FOR i=n TO nSeq-1
  DO
    next=0
    FOR j=i-nInit TO i-1
    DO
      next==+seq(j)
    OD
    seq(i)=next
  OD
RETURN

PROC PrintSeq(CHAR ARRAY name CARD ARRAY seq BYTE n)
  BYTE i

  PrintF("%S=[",name)
  FOR i=0 TO n-1
  DO
    PrintC(seq(i))
    IF i<n-1 THEN
      Print(" ")
    ELSE
      PrintE("]")
    FI
  OD
RETURN

PROC SetInverseVideo(CHAR ARRAY text)
  BYTE i

  FOR i=1 TO text(0)
  DO
    text(i)=text(i) OR $80
  OD
RETURN

PROC Test(CHAR ARRAY name CARD ARRAY init CARD ARRAY nInit BYTE nSeq)
  CARD ARRAY seq(MAX)

  SetInverseVideo(name)
  GenerateSeq(init,nInit,seq,nSeq)
  PrintSeq(name,seq,nSeq)
RETURN

PROC Main()
  CARD ARRAY fibInit=[1 1 2 4 8 16 32 64 128 256 512]
  CARD ARRAY lucInit=[2 1]

  Test("lucas",lucInit,2,MAX)
  Test("fibonacci",fibInit,2,MAX)
  Test("tribonacci",fibInit,3,MAX)
  Test("tetranacci",fibInit,4,MAX)
  Test("pentanacci",fibInit,5,MAX)
  Test("hexanacci",fibInit,6,MAX)
  Test("heptanacci",fibInit,7,MAX)
  Test("octanacci",fibInit,8,MAX)
  Test("nonanacci",fibInit,9,MAX)
  Test("decanacci",fibInit,10,MAX)
RETURN


package Bonacci is

   type Sequence is array(Positive range <>) of Positive;

   function Generate(Start: Sequence; Length: Positive := 10) return Sequence;

   Start_Fibonacci:  constant Sequence := (1, 1);
   Start_Tribonacci: constant Sequence := (1, 1, 2);
   Start_Tetranacci: constant Sequence := (1, 1, 2, 4);
   Start_Lucas:      constant Sequence := (2, 1);
end Bonacci;


# returns an array of the first required count elements of an a n-step fibonacci sequence #
# the initial values are taken from the init array                                        #
PROC n step fibonacci sequence = ( []INT init, INT required count )[]INT:
     BEGIN
         [ 1 : required count ]INT result;
         []INT initial values = init[ AT 1 ];
         INT step             = UPB initial values;
         # install the initial values                                                     #
         FOR n TO step DO result[ n ] := initial values[ n ] OD;
         # calculate the rest of the sequence                                             #
         FOR n FROM step + 1 TO required count DO
             result[ n ] := 0;
             FOR p FROM n - step TO n - 1 DO result[ n ] +:= result[ p ] OD
         OD;
         result
     END; # required count #

# prints the elements of a sequence                                                       #
PROC print sequence = ( STRING legend, []INT sequence )VOID:
     BEGIN
        print( ( legend, ":" ) );
        FOR e FROM LWB sequence TO UPB sequence DO print( ( " ", whole( sequence[ e ], 0 ) ) ) OD;
        print( ( newline ) )
     END; # print sequence #

# print some sequences                                                                    #
print sequence( "fibonacci   ", n step fibonacci sequence( ( 1, 1 ),       10 ) );
print sequence( "tribonacci  ", n step fibonacci sequence( ( 1, 1, 2 ),    10 ) );
print sequence( "tetrabonacci", n step fibonacci sequence( ( 1, 1, 2, 4 ), 10 ) );
print sequence( "lucus       ", n step fibonacci sequence( ( 2, 1 ),       10 ) )


nStep ← {⊃(1↓⊢,+/)⍣(⍺-1)⊢⍵}
nacci ← 2*0⌈¯2+⍳
↑((⍳10)nStep¨⊂)¨(nacci¨2 3 4),⊂2 1


use AppleScript version "2.4"
use framework "Foundation"
use scripting additions

-- Start sequence -> Number of terms -> terms
-- takeNFibs :: [Int] -> Int -> [Int]
on takeNFibs(xs, n)
    script go
        on |λ|(xs, n)
            if 0 < n and 0 < length of xs then
                cons(head(xs), ¬
                    |λ|(append(tail(xs), {sum(xs)}), n - 1))
            else
                {}
            end if
        end |λ|
    end script
    go's |λ|(xs, n)
end takeNFibs

-- fibInit :: Int -> [Int]
on fibInit(n)
    script powerOfTwo
        on |λ|(x)
            2 ^ x as integer
        end |λ|
    end script
    cons(1, map(powerOfTwo, enumFromToInt(0, n - 2)))
end fibInit

-- TEST ---------------------------------------------------
on run
    set intTerms to 15
    script series
        on |λ|(s, n)
            justifyLeft(12, space, s & "nacci") & " -> " & ¬
                showJSON(takeNFibs(fibInit(n), intTerms))
        end |λ|
    end script

    set strTable to unlines(zipWith(series, ¬
        words of ("fibo tribo tetra penta hexa hepta octo nona deca"), ¬
        enumFromToInt(2, 10)))

    justifyLeft(12, space, "Lucas ") & " -> " & ¬
        showJSON(takeNFibs({2, 1}, intTerms)) & linefeed & strTable
end run

-- GENERIC FUNCTIONS --------------------------------------

-- Append two lists.
-- append (++) :: [a] -> [a] -> [a]
-- append (++) :: String -> String -> String
on append(xs, ys)
    xs & ys
end append

-- cons :: a -> [a] -> [a]
on cons(x, xs)
    if list is class of xs then
        {x} & xs
    else
        x & xs
    end if
end cons

-- enumFromToInt :: Int -> Int -> [Int]
on enumFromToInt(m, n)
    if m ≤ n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        return lst
    else
        return {}
    end if
end enumFromToInt

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- head :: [a] -> a
on head(xs)
    if xs = {} then
        missing value
    else
        item 1 of xs
    end if
end head

-- justifyLeft :: Int -> Char -> String -> String
on justifyLeft(n, cFiller, strText)
    if n > length of strText then
        text 1 thru n of (strText & replicate(n, cFiller))
    else
        strText
    end if
end justifyLeft

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- Egyptian multiplication - progressively doubling a list, appending
-- stages of doubling to an accumulator where needed for binary
-- assembly of a target length
-- replicate :: Int -> a -> [a]
on replicate(n, a)
    set out to {}
    if n < 1 then return out
    set dbl to {a}

    repeat while (n > 1)
        if (n mod 2) > 0 then set out to out & dbl
        set n to (n div 2)
        set dbl to (dbl & dbl)
    end repeat
    return out & dbl
end replicate

-- showJSON :: a -> String
on showJSON(x)
    set c to class of x
    if (c is list) or (c is record) then
        set ca to current application
        set {json, e} to ca's NSJSONSerialization's ¬
            dataWithJSONObject:x options:0 |error|:(reference)
        if json is missing value then
            e's localizedDescription() as text
        else
            (ca's NSString's alloc()'s ¬
                initWithData:json encoding:(ca's NSUTF8StringEncoding)) as text
        end if
    else if c is date then
        "\"" & ((x - (time to GMT)) as «class isot» as string) & ".000Z" & "\""
    else if c is text then
        "\"" & x & "\""
    else if (c is integer or c is real) then
        x as text
    else if c is class then
        "null"
    else
        try
            x as text
        on error
            ("«" & c as text) & "»"
        end try
    end if
end showJSON

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum

-- tail :: [a] -> [a]
on tail(xs)
    set blnText to text is class of xs
    if blnText then
        set unit to ""
    else
        set unit to {}
    end if
    set lng to length of xs
    if 1 > lng then
        missing value
    else if 2 > lng then
        unit
    else
        if blnText then
            text 2 thru -1 of xs
        else
            rest of xs
        end if
    end if
end tail

-- unlines :: [String] -> String
on unlines(xs)
    set {dlm, my text item delimiters} to ¬
        {my text item delimiters, linefeed}
    set str to xs as text
    set my text item delimiters to dlm
    str
end unlines

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(length of xs, length of ys)
    if 1 > lng then return {}
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, item i of ys)
        end repeat
        return lst
    end tell
end zipWith


for i, seq in ["nacci", "lucas"]
    Loop, 9 {
        Out .= seq "(" A_Index + 1 "): "
        for key, val in NStepSequence(i, 1, A_Index + 1, 15)
            Out .= val (A_Index = 15 ? "`n" : "`, ")
    }
MsgBox, % Out

NStepSequence(v1, v2, n, k) {
    a := [v1, v2]
    Loop, % k - 2 {
        a[j := A_Index + 2] := 0
        Loop, % j < n + 2 ? j - 1 : n
            a[j] += a[j - A_Index]
    }
    return, a
}


function sequence(values, howmany) {
	init_length = length(values)
	for (i=init_length + 1; i<=howmany; i++) {
	   values[i] = 0
           for (j=1; j<=init_length; j++) {
             values[i] += values[i-j]
	   }
        }
	result = ""
        for (i in values) {
          result = result values[i] " "
        }
	delete values
	return result
}

# print some sequences
END	{
		a[1] = 1; a[2] = 1
		print("fibonacci :\t",sequence(a, 10))

		a[1] = 1; a[2] = 1; a[3] = 2
		print("tribonacci :\t",sequence(a, 10))

		a[1] = 1 ; a[2] = 1 ; a[3] = 2 ; a[4] = 4
		print("tetrabonacci :\t",sequence(a, 10))

		a[1] = 2; a[2] = 1
		print("lucas :\t\t",sequence(a, 10))
	}


# Rosetta Code problem: https://www.rosettacode.org/wiki/Fibonacci_n-step_number_sequences
# by Jjuanhdez, 06/2022

arraybase 1
print "  fibonacci =>";
dim a = {1,1}
call fib (a)
print " tribonacci =>";
dim a = {1,1,2}
call fib (a)
print " tetranacci =>";
dim a = {1,1,2,4}
call fib (a)
print " pentanacci =>";
dim a = {1,1,2,4,8}
call fib (a)
print "  hexanacci =>";
dim a = {1,1,2,4,8,16}
call fib (a)
print " heptanacci =>";
dim a = {1,1,2,4,8,16,32}
call fib (a)
print " octonacci  =>";
dim a = {1,1,2,4,8,16,32,64}
call fib (a)
print " nonanacci  =>";
dim a = {1,1,2,4,8,16,32,64,128}
call fib (a)
print "  decanacci =>";
dim a = {1,1,2,4,8,16,32,64,128,256}
call fib (a)
print "      lucas =>";
dim a = {2,1}
call fib (a)
end

subroutine fib (a)
    dim f(24) fill 0
    b = 0
    for x = 1 to a[?]
        b += 1
        f[x] = a[x]
    next x
    for i = b to 13 + b
        print rjust(f[i-b+1], 5);
        if i <> 13 + b then print ","; else print ", ..."
        for j = (i-b+1) to i
            f[i+1] = f[i+1] + f[j]
        next j
    next i
end subroutine


@echo off

echo Fibonacci Sequence:
call:nfib 1 1
echo.

echo Tribonacci Sequence:
call:nfib 1 1 2
echo.

echo Tetranacci Sequence:
call:nfib 1 1 2 4
echo.

echo Lucas Numbers:
call:nfib 2 1
echo.

pause>nul
exit /b

:nfib
setlocal enabledelayedexpansion

for %%i in (%*) do (
  set /a count+=1
  set seq=!seq! %%i
)
set "seq=%seq% ^| "
set n=-%count%
set /a n+=1
for %%i in (%*) do (
  set F!n!=%%i
  set /a n+=1
)

for /l %%i in (1,1,10) do (
  set /a termstart=%%i-%count%%
  set /a termend=%%i-1
  for /l %%j in (!termstart!,1,!termend!) do (
    set /a F%%i+=!F%%j!
  )
  set seq=!seq! !F%%i!
)
echo %seq%

endlocal
exit /b


      @% = 5 : REM Column width

      PRINT "Fibonacci:"
      DIM f2%(1) : f2%() = 1,1
      FOR i% = 1 TO 12 : PRINT f2%(0); : PROCfibn(f2%()) : NEXT : PRINT " ..."

      PRINT "Tribonacci:"
      DIM f3%(2) : f3%() = 1,1,2
      FOR i% = 1 TO 12 : PRINT f3%(0); : PROCfibn(f3%()) : NEXT : PRINT " ..."

      PRINT "Tetranacci:"
      DIM f4%(3) : f4%() = 1,1,2,4
      FOR i% = 1 TO 12 : PRINT f4%(0); : PROCfibn(f4%()) : NEXT : PRINT " ..."

      PRINT "Lucas:"
      DIM fl%(1) : fl%() = 2,1
      FOR i% = 1 TO 12 : PRINT fl%(0); : PROCfibn(fl%()) : NEXT : PRINT " ..."
      END

      DEF PROCfibn(f%())
      LOCAL i%, s%
      s% = SUM(f%())
      FOR i% = 1 TO DIM(f%(),1)
        f%(i%-1) = f%(i%)
      NEXT
      f%(i%-1) = s%
      ENDPROC


( ( nacci
  =   Init Cnt N made tail
    .   ( plus
        =   n
          .   !arg:#%?n ?arg&!n+plus$!arg
            | 0
        )
      & !arg:(?Init.?Cnt)
      & !Init:? [?N
      & !Init:?made
      & !Cnt+-1*!N:?times
      & -1+-1*!N:?M
      &   whl
        ' ( !times+-1:~<0:?times
          & !made:? [!M ?tail
          & !made plus$!tail:?made
          )
      & !made
  )
& ( pad
  =   len w
    .   @(!arg:? [?len)
      & @("          ":? [!len ?w)
      & !w !arg
  )
&     (fibonacci.1 1)
      (tribonacci.1 1 2)
      (tetranacci.1 1 2 4)
      (pentanacci.1 1 2 4 8)
      (hexanacci.1 1 2 4 8 16)
      (heptanacci.1 1 2 4 8 16 32)
      (octonacci.1 1 2 4 8 16 32 64)
      (nonanacci.1 1 2 4 8 16 32 64 128)
      (decanacci.1 1 2 4 8 16 32 64 128 256)
      (lucas.2 1)
  : ?L
&   whl
  ' ( !L:(?name.?Init) ?L
    & out$(str$(pad$!name ": ") nacci$(!Init.12))
    )
);


NStep ← ⊑(1↓⊢∾+´)∘⊢⍟⊣
Nacci ← (2⋆0∾↕)∘(⊢-1˙)

>((↕10) NStep¨ <)¨ (Nacci¨ 2‿3‿4) ∾ <2‿1


/*
The function anynacci determines the n-arity of the sequence from the number of seed elements. 0 ended arrays are used since C does not have a way of determining the length of dynamic and function-passed integer arrays.*/

#include<stdlib.h>
#include<stdio.h>

int *
anynacci (int *seedArray, int howMany)
{
  int *result = malloc (howMany * sizeof (int));
  int i, j, initialCardinality;

  for (i = 0; seedArray[i] != 0; i++);
  initialCardinality = i;

  for (i = 0; i < initialCardinality; i++)
    result[i] = seedArray[i];

  for (i = initialCardinality; i < howMany; i++)
    {
      result[i] = 0;
      for (j = i - initialCardinality; j < i; j++)
        result[i] += result[j];
    }
  return result;
}

int
main ()
{
  int fibo[] = { 1, 1, 0 }, tribo[] = { 1, 1, 2, 0 }, tetra[] = { 1, 1, 2, 4, 0 }, luca[] = { 2, 1, 0 };
  int *fibonacci = anynacci (fibo, 10), *tribonacci = anynacci (tribo, 10), *tetranacci = anynacci (tetra, 10),
      *lucas = anynacci(luca, 10);
  int i;

  printf ("\nFibonacci\tTribonacci\tTetranacci\tLucas\n");

  for (i = 0; i < 10; i++)
    printf ("\n%d\t\t%d\t\t%d\t\t%d", fibonacci[i], tribonacci[i],
            tetranacci[i], lucas[i]);

  return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;

namespace Fibonacci
{
    class Program
    {
        static void Main(string[] args)
        {
            PrintNumberSequence("Fibonacci", GetNnacciNumbers(2, 10));
            PrintNumberSequence("Lucas", GetLucasNumbers(10));
            PrintNumberSequence("Tribonacci", GetNnacciNumbers(3, 10));
            PrintNumberSequence("Tetranacci", GetNnacciNumbers(4, 10));
            Console.ReadKey();
        }

        private static IList<ulong> GetLucasNumbers(int length)
        {
            IList<ulong> seedSequence = new List<ulong>() { 2, 1 };
            return GetFibLikeSequence(seedSequence, length);
        }

        private static IList<ulong> GetNnacciNumbers(int seedLength, int length)
        {
            return GetFibLikeSequence(GetNacciSeed(seedLength), length);
        }

        private static IList<ulong> GetNacciSeed(int seedLength)
        {
            IList<ulong> seedSquence = new List<ulong>() { 1 };

            for (uint i = 0; i < seedLength - 1; i++)
            {
                seedSquence.Add((ulong)Math.Pow(2, i));
            }

            return seedSquence;
        }

        private static IList<ulong> GetFibLikeSequence(IList<ulong> seedSequence, int length)
        {
            IList<ulong> sequence = new List<ulong>();

            int count = seedSequence.Count();

            if (length <= count)
            {
                sequence = seedSequence.Take((int)length).ToList();
            }
            else
            {
                sequence = seedSequence;

                for (int i = count; i < length; i++)
                {
                    ulong num = 0;

                    for (int j = 0; j < count; j++)
                    {
                        num += sequence[sequence.Count - 1 - j];
                    }

                    sequence.Add(num);
                }
            }

            return sequence;
        }

        private static void PrintNumberSequence(string Title, IList<ulong> numbersequence)
        {
            StringBuilder output = new StringBuilder(Title).Append("   ");

            foreach (long item in numbersequence)
            {
                output.AppendFormat("{0}, ", item);
            }

            Console.WriteLine(output.ToString());
        }
    }
}


#include <vector>
#include <iostream>
#include <numeric>
#include <iterator>
#include <memory>
#include <string>
#include <algorithm>
#include <iomanip>

std::vector<int> nacci ( const std::vector<int> & start , int arity ) {
   std::vector<int> result ( start ) ;
   int sumstart = 1 ;//summing starts at vector's begin + sumstart as
                     //soon as the vector is longer than arity
   while ( result.size( ) < 15 ) { //we print out the first 15 numbers
      if ( result.size( ) <= arity )
	 result.push_back( std::accumulate( result.begin( ) ,
		  result.begin( ) + result.size( ) , 0 ) ) ;
      else {
	 result.push_back( std::accumulate ( result.begin( ) +
	  sumstart , result.begin( ) + sumstart + arity  , 0 )) ;
	 sumstart++ ;
      }
   }
   return std::move ( result ) ;
}

int main( ) {
   std::vector<std::string> naccinames {"fibo" , "tribo" ,
      "tetra" , "penta" , "hexa" , "hepta" , "octo" , "nona" , "deca" } ;
   const std::vector<int> fibo { 1 , 1 } , lucas { 2 , 1 } ;
   for ( int i = 2 ; i < 11 ; i++ ) {
      std::vector<int> numberrow = nacci ( fibo , i ) ;
      std::cout << std::left << std::setw( 10 ) <<
	 naccinames[ i - 2 ].append( "nacci" ) <<
	 std::setw( 2 ) << " : " ;
      std::copy ( numberrow.begin( ) , numberrow.end( ) ,
	    std::ostream_iterator<int>( std::cout , " " ) ) ;
      std::cout << "...\n" ;
      numberrow = nacci ( lucas , i ) ;
      std::cout << "Lucas-" << i ;
      if ( i < 10 )               //for formatting purposes
	 std::cout << "    : " ;
      else
	 std::cout << "   : " ;
      std::copy ( numberrow.begin( ) , numberrow.end( ) ,
	    std::ostream_iterator<int>( std::cout , " " ) ) ;
      std::cout << "...\n" ;
   }
   return 0 ;
}


(defn nacci [init]
  (letfn [(s [] (lazy-cat init (apply map + (map #(drop % (s)) (range (count init))))))]
    (s)))

(let [show (fn [name init] (println "first 20" name (take 20 (nacci init))))]
  (show "Fibonacci" [1 1])
  (show "Tribonacci" [1 1 2])
  (show "Tetranacci" [1 1 2 4])
  (show "Lucas" [2 1]))


% Find the Nth element of a given n-step sequence
n_step = proc (seq: sequence[int], n: int) returns (int)
    a: array[int] := sequence[int]$s2a(seq)
    for i: int in int$from_to(1,n) do
        sum: int := 0
        for x: int in array[int]$elements(a) do
            sum := sum + x
        end
        array[int]$reml(a)
        array[int]$addh(a,sum)
    end
    return(array[int]$bottom(a))
end n_step

% Generate the initial sequence for the Fibonacci n-step sequence of length N
anynacci = proc (n: int) returns (sequence[int])
    a: array[int] := array[int]$[1]
    for i: int in int$from_to(0,n-2) do
        array[int]$addh(a, 2**i)
    end
    return(sequence[int]$a2s(a))
end anynacci

% Given an initial sequence, print the first N elements
print_n = proc (seq: sequence[int], n: int)
    po: stream := stream$primary_output()
    for i: int in int$from_to(0, n-1) do
        stream$putright(po, int$unparse(n_step(seq, i)), 4)
    end
    stream$putl(po, "")
end print_n

start_up = proc ()
    s = struct[name: string, seq: sequence[int]]
    po: stream := stream$primary_output()
    seqs: array[s] := array[s]$[
        s${name: "Fibonacci", seq: anynacci(2)},
        s${name: "Tribonacci", seq: anynacci(3)},
        s${name: "Tetranacci", seq: anynacci(4)},
        s${name: "Lucas", seq: sequence[int]$[2,1]}
    ]

    for seq: s in array[s]$elements(seqs) do
        stream$putleft(po, seq.name, 12)
        print_n(seq.seq, 10)
    end
end start_up


(defun gen-fib (lst m)
  "Return the first m members of a generalized Fibonacci sequence using lst as initial values
   and the length of lst as step."
  (let ((l (- (length lst) 1)))
       (do* ((fib-list (reverse lst) (cons (loop for i from 0 to l sum (nth i fib-list)) fib-list))
	     (c (+ l 2) (+ c 1)))
	    ((> c m) (reverse fib-list)))))

(defun initial-values (n)
  "Return the initial values of the Fibonacci n-step sequence"
  (cons 1
        (loop for i from 0 to (- n 2)
              collect (expt 2 i))))

(defun start ()
  (format t "Lucas series: ~a~%" (gen-fib '(2 1) 10))
  (loop for i from 2 to 4
        do (format t "Fibonacci ~a-step sequence: ~a~%" i (gen-fib (initial-values i) 10))))


void main() {
    import std.stdio, std.algorithm, std.range, std.conv;

    const(int)[] memo;
    size_t addNum;

    void setHead(int[] head) nothrow @safe {
        memo = head;
        addNum = head.length;
    }

    int fibber(in size_t n) nothrow @safe {
        if (n >= memo.length)
            memo ~= iota(n - addNum, n).map!fibber.sum;
        return memo[n];
    }

    setHead([1, 1]);
    10.iota.map!fibber.writeln;
    setHead([2, 1]);
    10.iota.map!fibber.writeln;

    const prefixes = "fibo tribo tetra penta hexa hepta octo nona deca";
    foreach (immutable n, const name; prefixes.split.enumerate(2)) {
        setHead(1 ~ iota(n - 1).map!q{2 ^^ a}.array);
        writefln("n=%2d, %5snacci -> %(%d %) ...", n, name,
                 15.iota.map!fibber);
    }
}


;; generate a recursive lambda() for a x-nacci
;; equip it with memoïzation
;; bind it to its name
(define (make-nacci name seed)
		(define len (1+ (vector-length seed)))
		(define-global name
			`(lambda(n) (for/sum ((i (in-range (1- n) (- n ,len) -1)))  (,name i))))
		(remember name seed)
		name)

(define nacci-family `(
	(Fibonacci #(1 1))
	(Tribonacci #(1 1 2))
	(Tetranacci #(1 1 2 4))
	(Decanacci #(1 1 2 4 8 16 32 64 128 256))
	(Random-😜-nacci ,(list->vector (take 6 (shuffle (iota 100)))))
	(Lucas #(2 1))))

(define (task naccis)
	(for ((nacci naccis))
		(define-values (name seed) nacci)
		(make-nacci name seed)
		(printf "%s[%d]  → %d" name (vector-length seed) (take name 16))))


defmodule RC do
  def anynacci(start_sequence, count) do
    n = length(start_sequence)
    anynacci(Enum.reverse(start_sequence), count-n, n)
  end

  def anynacci(seq, 0, _), do: Enum.reverse(seq)
  def anynacci(seq, count, n) do
    next = Enum.sum(Enum.take(seq, n))
    anynacci([next|seq], count-1, n)
  end
end

IO.inspect RC.anynacci([1,1], 15)

naccis = [ lucus:      [2,1],
           fibonacci:  [1,1],
           tribonacci: [1,1,2],
           tetranacci: [1,1,2,4],
           pentanacci: [1,1,2,4,8],
           hexanacci:  [1,1,2,4,8,16],
           heptanacci: [1,1,2,4,8,16,32],
           octonacci:  [1,1,2,4,8,16,32,64],
           nonanacci:  [1,1,2,4,8,16,32,64,128],
           decanacci:  [1,1,2,4,8,16,32,64,128,256] ]
Enum.each(naccis, fn {name, list} ->
  :io.format("~11s: ", [name])
  IO.inspect RC.anynacci(list, 15)
end)


-module( fibonacci_nstep ).

-export( [nacci/2, task/0] ).

nacci( N, Ns ) when N =< erlang:length(Ns) ->
	{Sequence, _Not_sequence} = lists:split( N, Ns ),
	Sequence;
nacci( N, Ns ) ->
	Nth = erlang:length( Ns ),
	{_Nth, Sequence_reversed} = lists:foldl( fun nacci_foldl/2, {Nth, lists:reverse(Ns)}, lists:seq(Nth+1, N) ),
	lists:reverse( Sequence_reversed ).

task() ->
	Names_and_funs = [{X, fun (N) -> nacci( N, Y ) end} || {X, Y} <- [{fibonacci, [1, 1]}, {tribonacci, [1, 1, 2]}, {tetranacci, [1, 1, 2, 4]}, {lukas, [2, 1]}]],
	[io:fwrite( "~p: ~p~n", [X, Y(10)] ) || {X, Y} <- Names_and_funs].

nacci_foldl( _N, {Nth, Ns} ) ->
	{Sum_ns, _Not_sum_ns} = lists:split( Nth, Ns ),
	{Nth, [lists:sum(Sum_ns) | Ns]}.


PROGRAM FIBON

!
! for rosettacode.org
!

DIM F[20]

PROCEDURE FIB(TIPO$,F$)
 FOR I%=0 TO 20 DO
   F[I%]=0
 END FOR
 B=0
 LOOP
  Q=INSTR(F$,",")
  B=B+1
  IF Q=0 THEN
      F[B]=VAL(F$)
      EXIT
    ELSE
      F[B]=VAL(MID$(F$,1,Q-1))
      F$=MID$(F$,Q+1)
  END IF
 END LOOP

 PRINT(TIPO$;" =>";)
 FOR I=B TO 14+B DO
    IF I<>B THEN PRINT(",";) END IF
    PRINT(F[I-B+1];)
    FOR J=(I-B)+1 TO I DO
        F[I+1]=F[I+1]+F[J]
    END FOR
 END FOR
 PRINT
END PROCEDURE

BEGIN
   PRINT(CHR$(12);) ! CLS
   FIB("Fibonacci","1,1")
   FIB("Tribonacci","1,1,2")
   FIB("Tetranacci","1,1,2,4")
   FIB("Lucas","2,1")
END PROGRAM


let fibinit = Seq.append (Seq.singleton 1) (Seq.unfold (fun n -> Some(n, 2*n)) 1)

let fiblike init =
    Seq.append
        (Seq.ofList init)
        (Seq.unfold
            (function   | least :: rest ->
                            let this = least + Seq.reduce (+) rest
                            Some(this, rest @ [this])
                        | _ -> None) init)

let lucas = fiblike [2; 1]

let nacci n = Seq.take n fibinit |> Seq.toList |> fiblike

[<EntryPoint>]
let main argv =
    let start s = Seq.take 15 s |> Seq.toList
    let prefix = "fibo tribo tetra penta hexa hepta octo nona deca".Split()
    Seq.iter
        (fun (p, n) -> printfn "n=%2i, %5snacci -> %A" n p (start (nacci n)))
        (Seq.init prefix.Length (fun i -> (prefix.[i], i+2)))
    printfn "      lucas      -> %A" (start (fiblike [2; 1]))
    0


USING: formatting fry kernel make math namespaces qw sequences ;

: n-bonacci ( n initial -- seq ) [
        [ [ , ] each ] [ length - ] [ length ] tri
        '[ building get _ tail* sum , ] times
    ] { } make ;

qw{ fibonacci tribonacci tetranacci lucas }
{ { 1 1 } { 1 1 2 } { 1 1 2 4 } { 2 1 } }
[ 10 swap n-bonacci "%-10s %[%3d, %]\n" printf ] 2each


: length @ ;                          \ length of an array is stored at its address
: a{ here cell allot ;
: } , here over - cell / over ! ;

defer nacci

: step ( a- i n -- a- i m )
    >r 1- 2dup nacci r> + ;

: steps ( a- i n -- m )
    0 tuck do step loop nip nip ;

:noname ( a- i -- n )
    over length over >                \ if i is within the array
    if cells + @                      \ fetch i...if not,
    else over length 1- steps         \ get length of array for calling step and recurse
    then ; is nacci

: show-nacci 11 1 do dup i nacci . loop cr drop ;

." fibonacci: " a{ 1 , 1 } show-nacci
." tribonacci: " a{ 1 , 1 , 2 } show-nacci
." tetranacci: " a{ 1 , 1 , 2 , 4 } show-nacci
." lucas: " a{ 2 , 1 } show-nacci


! save this program as file f.f08
! gnu-linux command to  build and test
! $ a=./f && gfortran -Wall -std=f2008 $a.f08 -o $a && echo -e 2\\n5\\n\\n | $a

! -*- mode: compilation; default-directory: "/tmp/" -*-
! Compilation started at Fri Apr  4 23:20:27
!
! a=./f && gfortran -Wall -std=f2008 $a.f08 -o $a && echo -e 2\\n8\\ny\\n | $a
! Enter the number of terms to sum: Show the the first how many terms of the sequence?   Accept this initial sequence (y/n)?
!            1           1
!            1           1           2           3           5           8          13          21
!
! Compilation finished at Fri Apr  4 23:20:27

program f
  implicit none
  integer :: n, terms
  integer, allocatable, dimension(:) :: sequence
  integer :: i
  character :: answer
  write(6,'(a)',advance='no')'Enter the number of terms to sum: '
  read(5,*) n
  if ((n < 2) .or. (29 < n)) stop'Unreasonable!  Exit.'
  write(6,'(a)',advance='no')'Show the the first how many terms of the sequence?  '
  read(5,*) terms
  if (terms < 1) stop'Lazy programmer has not implemented backward sequences.'
  n = min(n, terms)
  allocate(sequence(1:terms))
  sequence(1) = 1
  do i = 0, n - 2
     sequence(i+2) = 2**i
  end do
  write(6,*)'Accept this initial sequence (y/n)?'
  write(6,*) sequence(:n)
  read(5,*) answer
  if (answer .eq. 'n') then
     write(6,*) 'Fine.  Enter the initial terms.'
     do i=1, n
        write(6, '(i2,a2)', advance = 'no') i, ': '
        read(5, *) sequence(i)
     end do
  end if
  call nacci(n, sequence)
  write(6,*) sequence(:terms)
  deallocate(sequence)

contains

    subroutine nacci(n, s)
      ! nacci =:  (] , +/@{.)^:([email protected]#@]`(-#)`])
      integer, intent(in) :: n
      integer, intent(inout), dimension(:) :: s
      integer :: i, terms
      terms = size(s)
!      do i = n+1, terms
 !        s(i) = sum(s(i-n:i-1))
  !    end do
      i = n+1
      if (n+1 .le. terms) s(i) = sum(s(i-n:i-1))
      do i = n + 2, terms
         s(i) = 2*s(i-1) - s(i-(n+1))
      end do
    end subroutine nacci
end program f


' FB 1.05.0 Win64

' Deduces the step, n, from the length of the dynamic array passed in
' and fills it out to 'size' elements
Sub fibN (a() As Integer, size As Integer)
  Dim lb As Integer = LBound(a)
  Dim ub As Integer = UBound(a)
  Dim length As Integer = ub - lb + 1
  If length < 2 OrElse length >= size Then Return
  ub = lb + size - 1
  Redim Preserve a(lb To ub)
  Dim sum As Integer
  For i As Integer = lb + length to ub
    sum = 0
    For j As Integer = 1 To Length
      sum += a(i - j)
    Next j
    a(i) = sum
  Next i
End Sub

Sub printSeries(a() As Integer, name_ As String) '' name is a keyword
  Print name_; " =>";
  For i As Integer = LBound(a) To UBound(a)
    Print Using "####"; a(i);
    Print " ";
  Next
  Print
End Sub

Const size As Integer = 13 '' say
Redim a(1 To 2) As Integer
a(1) = 1 : a(2) = 1
fibN(a(), size)
printSeries(a(), "fibonacci ")
Redim Preserve a(1 To 3)
a(3) = 2
fibN(a(), size)
printSeries(a(), "tribonacci")
Redim Preserve a(1 To 4)
a(4) = 4
fibN(a(), size)
printSeries(a(), "tetranacci")
erase a
Redim a(1 To 2)
a(1) = 2 : a(2) = 1
fibN(a(), size)
printSeries(a(), "lucas     ")
Print
Print "Press any key to quit"
Sleep


import util.TextTable
native scala.collection.mutable.Queue

def fibLike( init ) =
  q = Queue()

  for i <- init do q.enqueue( i )

  def fib =
    q.enqueue( sum(q) )
    q.dequeue() # fib()

  0 # fib()

def fibN( n ) = fibLike( [1] + [2^i | i <- 0:n-1] )

val lucas = fibLike( [2, 1] )

t = TextTable()
t.header( 'k', 'Fibonacci', 'Tribonacci', 'Tetranacci', 'Lucas' )
t.line()

for i <- 1..5
  t.rightAlignment( i )

seqs = (fibN(2), fibN(3), fibN(4), lucas)

for k <- 1..10
  t.row( ([k] + [seqs(i)(k) | i <- 0:4]).toIndexedSeq() )

print( t )


package main

import "fmt"

func g(i []int, c chan<- int) {
	var sum int
	b := append([]int(nil), i...) // make a copy
	for _, t := range b {
		c <- t
		sum += t
	}
	for {
		for j, t := range b {
			c <- sum
			b[j], sum = sum, sum+sum-t
		}
	}
}

func main() {
	for _, s := range [...]struct {
		seq string
		i   []int
	}{
		{"Fibonacci", []int{1, 1}},
		{"Tribonacci", []int{1, 1, 2}},
		{"Tetranacci", []int{1, 1, 2, 4}},
		{"Lucas", []int{2, 1}},
	} {
		fmt.Printf("%10s:", s.seq)
		c := make(chan int)
		// Note/warning: these goroutines are leaked.
		go g(s.i, c)
		for j := 0; j < 10; j++ {
			fmt.Print(" ", <-c)
		}
		fmt.Println()
	}
}


def fib = { List seed, int k=10 ->
    assert seed : "The seed list must be non-null and non-empty"
    assert seed.every { it instanceof Number } : "Every member of the seed must be a number"
    def n = seed.size()
    assert n > 1 : "The seed must contain at least two elements"
    List result = [] + seed
    if (k < n) {
        result[0..k]
    } else {
        (n..k).inject(result) { res, kk ->
            res << res[-n..-1].sum()
        }
    }
}


import Data.List (tails)
import Control.Monad (zipWithM_)

fiblike :: [Integer] -> [Integer]
fiblike st = xs where
  xs = st ++ map (sum . take n) (tails xs)
  n = length st

nstep :: Int -> [Integer]
nstep n = fiblike $ take n $ 1 : iterate (2*) 1

main :: IO ()
main = do
  print $ take 10 $ fiblike [1,1]
  print $ take 10 $ fiblike [2,1]
  zipWithM_ (\n name -> do putStr (name ++ "nacci -> ")
                           print $ take 15 $ nstep n)
    [2..] (words "fibo tribo tetra penta hexa hepta octo nona deca")


procedure main(A)
    every writes("F2:\t"|right((fnsGen(1,1))\14,5) | "\n")
    every writes("F3:\t"|right((fnsGen(1,1,2))\14,5) | "\n")
    every writes("F4:\t"|right((fnsGen(1,1,2,4))\14,5) | "\n")
    every writes("Lucas:\t"|right((fnsGen(2,1))\14,5) | "\n")
    every writes("F?:\t"|right((fnsGen!A)\14,5) | "\n")
end

procedure fnsGen(cache[])
    n := *cache
    every i := seq() do {
        if i > *cache then every (put(cache,0),cache[i] +:= cache[i-n to i-1])
        suspend cache[i]
        }
end


class Fibonacci
{
  public static int[] lucas(int n, int numRequested)
  {
    if (n < 2)
      throw new IllegalArgumentException("Fibonacci value must be at least 2");
    return fibonacci((n == 2) ? new int[] { 2, 1 } : lucas(n - 1, n), numRequested);
  }

  public static int[] fibonacci(int n, int numRequested)
  {
    if (n < 2)
      throw new IllegalArgumentException("Fibonacci value must be at least 2");
    return fibonacci((n == 2) ? new int[] { 1, 1 } : fibonacci(n - 1, n), numRequested);
  }

  public static int[] fibonacci(int[] startingValues, int numRequested)
  {
    int[] output = new int[numRequested];
    int n = startingValues.length;
    System.arraycopy(startingValues, 0, output, 0, n);
    for (int i = n; i < numRequested; i++)
      for (int j = 1; j <= n; j++)
        output[i] += output[i - j];
    return output;
  }

  public static void main(String[] args)
  {
    for (int n = 2; n <= 10; n++)
    {
      System.out.print("nacci(" + n + "):");
      for (int value : fibonacci(n, 15))
        System.out.print(" " + value);
      System.out.println();
    }
    for (int n = 2; n <= 10; n++)
    {
      System.out.print("lucas(" + n + "):");
      for (int value : lucas(n, 15))
        System.out.print(" " + value);
      System.out.println();
    }
  }
}


function fib(arity, len) {
    return nacci(nacci([1,1], arity, arity), arity, len);
}

function lucas(arity, len) {
    return nacci(nacci([2,1], arity, arity), arity, len);
}

function nacci(a, arity, len) {
    while (a.length < len) {
        var sum = 0;
        for (var i = Math.max(0, a.length - arity); i < a.length; i++)
            sum += a[i];
        a.push(sum);
    }
    return a;
}

function main() {
    for (var arity = 2; arity <= 10; arity++)
        console.log("fib(" + arity + "): " + fib(arity, 15));
    for (var arity = 2; arity <= 10; arity++)
        console.log("lucas(" + arity + "): " + lucas(arity, 15));
}

main();


# Input: the initial array
def nacci(arity; len):
  arity as $arity | len as $len
  | reduce range(length; $len) as $i
      (.;
       ([0, (length - $arity)] | max ) as $lower
       | . + [ .[ ($lower) : length] | add] ) ;

def fib(arity; len):
  arity as $arity | len as $len
  | [1,1] | nacci($arity; $arity) | nacci($arity; $len) ;

def lucas(arity; len):
  arity as $arity | len as $len
  | [2,1] | nacci($arity; $arity) | nacci($arity; $len) ;


type NFib{T<:Integer}
    n::T
    klim::T
    seeder::Function
end

type FState
    a::Array{BigInt,1}
    adex::Integer
    k::Integer
end

function Base.start{T<:Integer}(nf::NFib{T})
    a = nf.seeder(nf.n)
    adex = 1
    k = 1
    return FState(a, adex, k)
end

function Base.done{T<:Integer}(nf::NFib{T}, fs::FState)
    fs.k > nf.klim
end

function Base.next{T<:Integer}(nf::NFib{T}, fs::FState)
    f = sum(fs.a)
    fs.a[fs.adex] = f
    fs.adex = rem1(fs.adex+1, nf.n)
    fs.k += 1
    return (f, fs)
end


// version 1.1.2

fun fibN(initial: IntArray, numTerms: Int) : IntArray {
    val n = initial.size
    require(n >= 2 && numTerms >= 0)
    val fibs = initial.copyOf(numTerms)
    if (numTerms <= n) return fibs
    for (i in n until numTerms) {
        var sum = 0
        for (j in i - n until i) sum += fibs[j]
        fibs[i] = sum
    }
    return fibs
}

fun main(args: Array<String>) {
    val names = arrayOf("fibonacci",  "tribonacci", "tetranacci", "pentanacci", "hexanacci",
                        "heptanacci", "octonacci",  "nonanacci",  "decanacci")
    val initial = intArrayOf(1, 1, 2, 4, 8, 16, 32, 64, 128, 256)
    println(" n  name        values")
    var values = fibN(intArrayOf(2, 1), 15).joinToString(", ")
    println("%2d  %-10s  %s".format(2, "lucas", values))
    for (i in 0..8) {
        values = fibN(initial.sliceArray(0 until i + 2), 15).joinToString(", ")
        println("%2d  %-10s  %s".format(i + 2, names[i], values))
    }
}


function nStepFibs (seq, limit)
    local iMax, sum = #seq - 1
    while #seq < limit do
        sum = 0
        for i = 0, iMax do sum = sum + seq[#seq - i] end
        table.insert(seq, sum)
    end
    return seq
end

local fibSeqs = {
    {name = "Fibonacci",  values = {1, 1}      },
    {name = "Tribonacci", values = {1, 1, 2}   },
    {name = "Tetranacci", values = {1, 1, 2, 4}},
    {name = "Lucas",      values = {2, 1}      }
}
for _, sequence in pairs(fibSeqs) do
    io.write(sequence.name .. ": ")
    print(table.concat(nStepFibs(sequence.values, 10), " "))
end


numSequence := proc(initValues :: Array)
	local n, i, values;
	n := numelems(initValues);
	values := copy(initValues);
	for i from (n+1) to 15 do
		values(i) := add(values[i-n..i-1]);
	end do;
	return values;
end proc:

initValues := Array([1]):
for i from 2 to 10 do
	initValues(i) := add(initValues):
	printf ("nacci(%d): %a\n", i, convert(numSequence(initValues), list));
end do:
printf ("lucas: %a\n", convert(numSequence(Array([2, 1])), list));


import sequtils, strutils

proc fiblike(start: seq[int]): auto =
  var memo = start
  proc fibber(n: int): int =
    if n < memo.len:
      return memo[n]
    else:
      var ans = 0
      for i in n-start.len ..< n:
        ans += fibber(i)
      memo.add ans
      return ans
  return fibber

let fibo = fiblike(@[1,1])
echo toSeq(0..9).map(fibo)
let lucas = fiblike(@[2,1])
echo toSeq(0..9).map(lucas)

for n, name in items({2: "fibo", 3: "tribo", 4: "tetra", 5: "penta", 6: "hexa",
                      7: "hepta", 8: "octo", 9: "nona", 10: "deca"}):
  var se = @[1]
  for i in 0..n-2:
    se.add(1 shl i)
  let fibber = fiblike(se)
  echo "n = ", align($n, 2), ", ", align(name, 5), "nacci -> ", toSeq(0..14).mapIt($fibber(it)).join(" "), " ..."


(define (n-fib-iterator ll)
   (cons (car ll)
         (lambda ()
            (n-fib-iterator (append (cdr ll) (list (fold + 0 ll)))))))


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.


use strict;
use warnings;
use feature <say signatures>;
no warnings 'experimental';
use List::Util <max sum>;

sub fib_n ($n = 2, $xs = [1], $max = 100) {
    my @xs = @$xs;
    while ( $max > (my $len = @xs) ) {
        push @xs, sum @xs[ max($len - $n, 0) .. $len-1 ];
    }
    @xs
}

say $_-1 . ': ' . join ' ', (fib_n $_)[0..19] for 2..10;
say "\nLucas: " . join ' ',  fib_n(2, [2,1], 20);


with javascript_semantics
function nacci_noo(integer n, s, l)
    if n<2 then return n+n*l end if
    if n=2 then return 1 end if
    atom res = nacci_noo(n-1,s,l)
    for i=2 to min(s,n-1) do
        res += nacci_noo(n-i,s,l)
    end for
    return res
end function

constant names = split("lucas fibo tribo tetra penta hexa hepta octo nona deca")
sequence f = repeat(0,10)
for i=1 to 4 do
    for j=1 to 10 do
        f[j] = nacci_noo(j,i+(i=1),i=1)
    end for
    printf(1,"%snacci: %v\n",{names[i],f})
end for


<?php
/**
 * @author Elad Yosifon
 */

/**
 * @param int $x
 * @param array $series
 * @param int $n
 * @return array
 */
function fib_n_step($x, &$series = array(1, 1), $n = 15)
{
	$count = count($series);

	if($count > $x && $count == $n) // exit point
	{
		return $series;
	}

	if($count < $n)
	{
		if($count >= $x) // 4 or less
		{
			fib($series, $x, $count);
			return fib_n_step($x, $series, $n);
		}
		else // 5 or more
		{
			while(count($series) < $x )
			{
				$count = count($series);
				fib($series, $count, $count);
			}
			return fib_n_step($x, $series, $n);
		}
	}

	return $series;
}

/**
 * @param array $series
 * @param int $n
 * @param int $i
 */
function fib(&$series, $n, $i)
{
	$end = 0;
	for($j = $n; $j > 0; $j--)
	{
		$end += $series[$i-$j];
	}
	$series[$i] = $end;
}

/*===================  OUTPUT ============================*/

header('Content-Type: text/plain');
$steps = array(
	'LUCAS' => 		array(2, 	array(2, 1)),
	'FIBONACCI' => 	array(2, 	array(1, 1)),
	'TRIBONACCI' =>	array(3, 	array(1, 1, 2)),
	'TETRANACCI' =>	array(4, 	array(1, 1, 2, 4)),
	'PENTANACCI' =>	array(5,	array(1, 1, 2, 4)),
	'HEXANACCI' =>	array(6, 	array(1, 1, 2, 4)),
	'HEPTANACCI' =>	array(7,	array(1, 1, 2, 4)),
	'OCTONACCI' =>	array(8, 	array(1, 1, 2, 4)),
	'NONANACCI' =>	array(9, 	array(1, 1, 2, 4)),
	'DECANACCI' =>	array(10, 	array(1, 1, 2, 4)),
);

foreach($steps as $name=>$pair)
{
	$ser = fib_n_step($pair[0],$pair[1]);
	$n = count($ser)-1;

	echo $name." => ".implode(',', $ser) . "\n";
}


(de nacci (Init Cnt)
   (let N (length Init)
      (make
         (made Init)
         (do (- Cnt N)
            (link (apply + (tail N (made)))) ) ) ) )


(subscriptrange, fixedoverflow, size):
n_step_Fibonacci: procedure options (main);
   declare line character (100) varying;
   declare (i, j, k) fixed binary;

   put ('n-step Fibonacci series: Please type the initial values on one line:');
   get edit (line) (L);
   line = trim(line);
   k = tally(line, ' ') - tally(line, '  ') + 1; /* count values */

   begin;
      declare (n(k), s) fixed decimal (15);
      get string (line || ' ') list ( n );

      if n(1) = 2 then put ('We have a Lusas series');
      else put ('We have a ' || trim(k) || '-step Fibonacci series.');

      put skip edit ( (trim(n(i)) do i = 1 to k) ) (a, x(1));
      do j = k+1 to 20; /* In toto, generate 20 values in the series. */
         s = sum(n); /* the next value in the series */
         put edit (trim(s)) (x(1), a);
         do i = lbound(n,1)+1 to k; /* Discard the oldest value */
            n(i-1) = n(i);
         end;
         n(k) = s; /* and insert the new value */
      end;
   end;
end n_step_Fibonacci;


#Create generator of extended fibonaci
Function Get-ExtendedFibonaciGenerator($InitialValues ){
    $Values = $InitialValues
    {
        #exhaust initial values first before calculating next values by summation
        if ($InitialValues.Length -gt 0) {
            $NextValue = $InitialValues[0]
            $Script:InitialValues = $InitialValues | Select -Skip 1
            return $NextValue
        }

        $NextValue = $Values | Measure-Object -Sum | Select -ExpandProperty Sum
        $Script:Values = @($Values | Select-Object -Skip 1) + @($NextValue)

        $NextValue
    }.GetNewClosure()
}


Procedure.i FibonacciLike(k,n=2,p.s="",d.s=".")
Protected i,r
if k<0:ProcedureReturn 0:endif
if p.s
n=CountString(p.s,d.s)+1
for i=0 to n-1
if k=i:ProcedureReturn val(StringField(p.s,i+1,d.s)):endif
next
else
if k=0:ProcedureReturn 1:endif
if k=1:ProcedureReturn 1:endif
endif
for i=1 to n
r+FibonacciLike(k-i,n,p.s,d.s)
next
ProcedureReturn r
EndProcedure

; The fact that PureBasic supports default values for procedure parameters
; is very useful in a case such as this.
; Since:
; k=4
; Debug FibonacciLike(k)               ;good old Fibonacci

; Debug FibonacciLike(k,3)             ;here we specified n=3 [Tribonacci]
; Debug FibonacciLike(k,3,"1.1.2")     ;using the default delimiter "."
; Debug FibonacciLike(k,3,"1,1,2",",") ;using a different delimiter ","
; the last three all produce the same result.

; as do the following two for the Lucas series:
; Debug FibonacciLike(k,2,"2.1")     ;using the default delimiter "."
; Debug FibonacciLike(k,2,"2,1",",") ;using a different delimiter ","

m=10
t.s=lset("n",5)
for k=0 to m
  t.s+lset(str(k),5)
  next
Debug t.s
for n=2 to 10
  t.s=lset(str(n),5)
  for k=0 to m
    t.s+lset(str(FibonacciLike(k,n)),5)
    next
Debug t.s
next
Debug ""
p.s="2.1"
t.s=lset(p.s,5)
for k=0 to m
  t.s+lset(str(FibonacciLike(k,n,p.s)),5)
  next
Debug t.s
Debug ""


  [ 0 swap witheach + ]              is sum        (   [ --> n )

  [ tuck size -
    dup 0 < iff
      [ split drop ]
    else
      [ dip [ dup size negate swap ]
        times
          [ over split
            dup sum join join ]
        nip ] ]                      is n-step     ( n [ --> [ )

  [ ' [ 1 1 ] n-step ]               is fibonacci  (   n --> [ )

  [ ' [ 1 1 2 ] n-step ]             is tribonacci (   n --> [ )

  [ ' [ 1 1 2 4 ] n-step ]           is tetranacci (   n --> [ )

  [ ' [ 2 1 ] n-step ]               is lucas      (   n --> [ )

  ' [ fibonacci tribonacci tetranacci lucas ]
  witheach
    [ dup echo say ": " 10 swap do echo cr ]


#lang racket

;; fib-list : [Listof Nat] x Nat -> [Listof Nat]
;; Given a non-empty list of natural numbers, the length of the list
;; becomes the size of the step; return the first n numbers of the
;; sequence; assume n >= (length lon)
(define (fib-list lon n)
  (define len (length lon))
  (reverse (for/fold ([lon (reverse lon)]) ([_ (in-range (- n len))])
             (cons (apply + (take lon len)) lon))))

;; Show the series ...
(define (show-fibs name l)
  (printf "~a: " name)
  (for ([n (in-list (fib-list l 20))]) (printf "~a, " n))
  (printf "...\n"))

;; ... with initial 2-powers lists
(for ([n (in-range 2 11)])
  (show-fibs (format "~anacci" (case n [(2) 'fibo] [(3) 'tribo] [(4) 'tetra]
                                     [(5) 'penta] [(6) 'hexa] [(7) 'hepta]
                                     [(8) 'octo] [(9) 'nona] [(10) 'deca]))
             (cons 1 (build-list (sub1 n) (curry expt 2)))))
;; and with an initial (2 1)
(show-fibs "lucas" '(2 1))


/*REXX program  calculates and displays a   N-step   Fibonacci   sequence(s). */
parse arg FibName values               /*allows a Fibonacci name, starter vals*/
if FibName\=''  then do;  call nStepFib  FibName,values;    signal done;    end
                                       /* [↓]  no args specified, show a bunch*/
call  nStepFib  'Lucas'       ,   2 1
call  nStepFib  'fibonacci'   ,   1 1
call  nStepFib  'tribonacci'  ,   1 1 2
call  nStepFib  'tetranacci'  ,   1 1 2 4
call  nStepFib  'pentanacci'  ,   1 1 2 4 8
call  nStepFib  'hexanacci'   ,   1 1 2 4 8 16
call  nStepFib  'heptanacci'  ,   1 1 2 4 8 16 32
call  nStepFib  'octonacci'   ,   1 1 2 4 8 16 32 64
call  nStepFib  'nonanacci'   ,   1 1 2 4 8 16 32 64 128
call  nStepFib  'decanacci'   ,   1 1 2 4 8 16 32 64 128 256
call  nStepFib  'undecanacci' ,   1 1 2 4 8 16 32 64 128 256 512
call  nStepFib  'dodecanacci' ,   1 1 2 4 8 16 32 64 128 256 512 1024
call  nStepFib  '13th-order'  ,   1 1 2 4 8 16 32 64 128 256 512 1024 2048
done:  exit                            /*stick a fork in it,  we're all done. */
/*────────────────────────────────────────────────────────────────────────────*/
nStepFib:  procedure;  parse arg Fname,vals,m;    if m==''  then m=30;      L=
N=words(vals)
                             do pop=1  for N        /*use  N  initial values. */
                             @.pop=word(vals,pop)   /*populate initial numbers*/
                             end   /*pop*/
        do j=1  for m                               /*calculate M Fib numbers.*/
        if j>N  then do;  @.j=0                     /*initialize the sum to 0.*/
                                 do k=j-N  for N    /*sum the last  N numbers.*/
                                 @.[email protected].[email protected].k        /*add the  [N-j]th number.*/
                                 end   /*k*/
                     end
        L=L  @.j                                    /*append Fib number──►list*/
        end   /*j*/

say right(Fname,11)'[sum'right(N,3)    "terms]:"     strip(L)    '···'
return


# Project : Fibonacci n-step number sequences

f = list(12)

see "Fibonacci:" + nl
f2  = [1,1]
for nr2 = 1 to 10
    see "" + f2[1] + " "
    fibn(f2)
next
showarray(f2)
see " ..." + nl + nl

see "Tribonacci:" + nl
f3 = [1,1,2]
for nr3 = 1 to 9
    see "" + f3[1] + " "
    fibn(f3)
next
showarray(f3)
see " ..." + nl + nl

see "Tetranacci:" + nl
f4 = [1,1,2,4]
for nr4 = 1 to 8
    see "" + f4[1] + " "
    fibn(f4)
next
showarray(f4)
see " ..." + nl + nl

see "Lucas:" + nl
f5 = [2,1]
for nr5 = 1 to 10
    see "" + f5[1] + " "
    fibn(f5)
next
showarray(f5)
see " ..." + nl + nl

func fibn(fs)
     s = sum(fs)
     for i = 2 to len(fs)
         fs[i-1] = fs[i]
     next
     fs[i-1] = s
     return fs

func sum(arr)
     sm = 0
     for sn = 1 to len(arr)
         sm = sm + arr[sn]
     next
     return sm

func showarray(fn)
     svect = ""
     for p = 1 to len(fn)
         svect = svect + fn[p] + " "
     next
     see svect


def anynacci(start_sequence, count)
  n      = start_sequence.length    # Get the n-step for the type of fibonacci sequence
  result = start_sequence.dup       # Create a new result array with the values copied from the array that was passed by reference
  (count-n).times do                # Loop for the remaining results up to count
    result << result.last(n).sum    # Get the last n element from result and append its total to Array
  end
  result
end

naccis = { lucas:      [2,1],
           fibonacci:  [1,1],
           tribonacci: [1,1,2],
           tetranacci: [1,1,2,4],
           pentanacci: [1,1,2,4,8],
           hexanacci:  [1,1,2,4,8,16],
           heptanacci: [1,1,2,4,8,16,32],
           octonacci:  [1,1,2,4,8,16,32,64],
           nonanacci:  [1,1,2,4,8,16,32,64,128],
           decanacci:  [1,1,2,4,8,16,32,64,128,256] }

naccis.each {|name, seq| puts "%12s : %p" % [name, anynacci(seq, 15)]}


a = fib(" fibonacci ", "1,1")
a = fib("tribonacci ", "1,1,2")
a = fib("tetranacci ", "1,1,2,4")
a = fib(" pentanacc ", "1,1,2,4,8")
a = fib(" hexanacci ", "1,1,2,4,8,16")
a = fib("     lucas ", "2,1")

function fib(f$, s$)
dim f(20)
while word$(s$,b+1,",") <> ""
 b = b + 1
 f(b) = val(word$(s$,b,","))
wend
PRINT f$; "=>";
for i = b to 13 + b
  print " "; f(i-b+1); ",";
  for j = (i - b) + 1 to i
    f(i+1) = f(i+1) + f(j)
  next j
next i
print
end function


struct GenFibonacci {
    buf:    Vec<u64>,
    sum:    u64,
    idx:    usize,
}

impl Iterator for GenFibonacci {
    type Item = u64;
    fn next(&mut self) -> Option<u64> {
        let result = Some(self.sum);
        self.sum -= self.buf[self.idx];
        self.buf[self.idx] += self.sum;
        self.sum += self.buf[self.idx];
        self.idx = (self.idx + 1) % self.buf.len();
        result
    }
}

fn print(buf: Vec<u64>, len: usize) {
    let mut sum = 0;
    for &elt in buf.iter() { sum += elt; print!("\t{}", elt); }
    let iter = GenFibonacci { buf: buf, sum: sum, idx: 0 };
    for x in iter.take(len) {
        print!("\t{}", x);
    }
}

fn main() {
    print!("Fib2:");
    print(vec![1,1], 10 - 2);

    print!("\nFib3:");
    print(vec![1,1,2], 10 - 3);

    print!("\nFib4:");
    print(vec![1,1,2,4], 10 - 4);

    print!("\nLucas:");
    print(vec![2,1], 10 - 2);
}


  //we rely on implicit conversion from Int to BigInt.
  //BigInt is preferable since the numbers get very big, very fast.
  //(though for a small example of the first few numbers it's not needed)
  def fibStream(init: BigInt*): LazyList[BigInt] = {
    def inner(prev: Vector[BigInt]): LazyList[BigInt] = prev.head #:: inner(prev.tail :+ prev.sum)

    inner(init.toVector)
  }


(import (scheme base)
        (scheme write)
        (srfi 1))

;; uses n-step sequence formula to
;; continue lst until of length num
(define (n-fib lst num)
  (let ((n (length lst)))
    (do ((result (reverse lst)
                 (cons (fold + 0 (take result n))
                       result)))
      ((= num (length result)) (reverse result)))))

;; display examples
(do ((i 2 (+ 1 i)))
  ((> i 4) )
  (display (string-append "n = "
                          (number->string i)
                          ": "))
  (display (n-fib (cons 1 (list-tabulate (- i 1) (lambda (n) (expt 2 n))))
                  15))
  (newline))

(display "Lucas: ")
(display (n-fib '(2 1) 15))
(newline)


$ include "seed7_05.s7i";

const func array integer: bonacci (in array integer: start, in integer: arity, in integer: length) is func
  result
    var array integer: bonacciSequence is 0 times 0;
  local
    var integer: sum is 0;
    var integer: index is 0;
  begin
    bonacciSequence := start[.. length];
    while length(bonacciSequence) < length do
      sum := 0;
      for index range max(1, length(bonacciSequence) - arity + 1) to length(bonacciSequence) do
        sum +:= bonacciSequence[index];
      end for;
      bonacciSequence &:= [] (sum);
    end while;
  end func;

const proc: print (in string: name, in array integer: sequence) is func
  local
    var integer: index is 0;
  begin
    write((name <& ":") rpad 12);
    for index range 1 to pred(length(sequence)) do
      write(sequence[index] <& ", ");
    end for;
    writeln(sequence[length(sequence)]);
  end func;

const proc: main is func
  begin
    print("Fibonacci",  bonacci([] (1, 1), 2, 10));
    print("Tribonacci", bonacci([] (1, 1), 3, 10));
    print("Tetranacci", bonacci([] (1, 1), 4, 10));
    print("Lucas",      bonacci([] (2, 1), 2, 10));
  end func;


func fib(n, xs=[1], k=20) {
    loop {
        var len = xs.len
        len >= k && break
        xs << xs.ft(max(0, len - n)).sum
    }
    return xs
}

for i in (2..10) {
    say fib(i).join(' ')
}
say fib(2, [2, 1]).join(' ')


templates fibonacciNstep&{N:}
  templates next
    @: $(1);
    $(2..last)... -> @: $ + [email protected];
    [ $(2..last)..., [email protected] ] !
  end next

  @: $;
  1..$N -> #
  <>
    [email protected](1) !
    @: [email protected] -> next;
end fibonacciNstep

[1,1] -> fibonacciNstep&{N:10} -> '$; ' -> !OUT::write
'
' -> !OUT::write

[1,1,2] -> fibonacciNstep&{N:10} -> '$; ' -> !OUT::write
'
' -> !OUT::write

[1,1,2,4] -> fibonacciNstep&{N:10} -> '$; ' -> !OUT::write
'
' -> !OUT::write

[2,1] -> fibonacciNstep&{N:10} -> '$; ' -> !OUT::write
'
' -> !OUT::write


package require Tcl 8.6

proc fibber {args} {
    coroutine fib[incr ::fibs]=[join $args ","] apply {fn {
	set n [info coroutine]
	foreach f $fn {
	    if {![yield $n]} return
	    set n $f
	}
	while {[yield $n]} {
	    set fn [linsert [lreplace $fn 0 0] end [set n [+ {*}$fn]]]
	}
    } ::tcl::mathop} $args
}

proc print10 cr {
    for {set i 1} {$i <= 10} {incr i} {
	lappend out [$cr true]
    }
    puts \[[join [lappend out ...] ", "]\]
    $cr false
}
puts "FIBONACCI"
print10 [fibber 1 1]
puts "TRIBONACCI"
print10 [fibber 1 1 2]
puts "TETRANACCI"
print10 [fibber 1 1 2 4]
puts "LUCAS"
print10 [fibber 2 1]


Option Explicit

Sub Main()
Dim temp$, T() As Long, i&
    'Fibonacci:
    T = Fibonacci_Step(1, 15, 1)
    For i = LBound(T) To UBound(T)
        temp = temp & ", " & T(i)
    Next
    Debug.Print "Fibonacci: " & Mid(temp, 3)
    temp = ""

    'Tribonacci:
    T = Fibonacci_Step(1, 15, 2)
    For i = LBound(T) To UBound(T)
        temp = temp & ", " & T(i)
    Next
    Debug.Print "Tribonacci: " & Mid(temp, 3)
    temp = ""

    'Tetranacci:
    T = Fibonacci_Step(1, 15, 3)
    For i = LBound(T) To UBound(T)
        temp = temp & ", " & T(i)
    Next
    Debug.Print "Tetranacci: " & Mid(temp, 3)
    temp = ""

    'Lucas:
    T = Fibonacci_Step(1, 15, 1, 2)
    For i = LBound(T) To UBound(T)
        temp = temp & ", " & T(i)
    Next
    Debug.Print "Lucas: " & Mid(temp, 3)
    temp = ""
End Sub

Private Function Fibonacci_Step(First As Long, Count As Long, S As Long, Optional Second As Long) As Long()
Dim T() As Long, R() As Long, i As Long, Su As Long, C As Long

    If Second <> 0 Then S = 1
    ReDim T(1 - S To Count)
    For i = LBound(T) To 0
        T(i) = 0
    Next i
    T(1) = IIf(Second <> 0, Second, 1)
    T(2) = 1
    For i = 3 To Count
        Su = 0
        C = S + 1
        Do While C >= 0
            Su = Su + T(i - C)
            C = C - 1
        Loop
        T(i) = Su
    Next
    ReDim R(1 To Count)
    For i = 1 To Count
        R(i) = T(i)
    Next
    Fibonacci_Step = R
End Function


'function arguments:
'init - initial series of the sequence(e.g. "1,1")
'rep - how many times the sequence repeats - init
Function generate_seq(init,rep)
	token = Split(init,",")
	step_count = UBound(token)
	rep = rep - (UBound(token) + 1)
	out = init
	For i = 1 To rep
		sum = 0
		n = step_count
		Do While n >= 0
			sum = sum + token(UBound(token)-n)
			n = n - 1
		Loop
		'add the next number to the sequence
		ReDim Preserve token(UBound(token) + 1)
		token(UBound(token)) = sum
		out = out & "," & sum
	Next
	generate_seq = out
End Function

WScript.StdOut.Write "fibonacci: " & generate_seq("1,1",15)
WScript.StdOut.WriteLine
WScript.StdOut.Write "tribonacci: " & generate_seq("1,1,2",15)
WScript.StdOut.WriteLine
WScript.StdOut.Write "tetranacci: " & generate_seq("1,1,2,4",15)
WScript.StdOut.WriteLine
WScript.StdOut.Write "lucas: " & generate_seq("2,1",15)
WScript.StdOut.WriteLine


' Fibonacci n-step number sequences - VB.Net
Public Class FibonacciNstep

    Const nmax = 20

    Sub Main()
        Dim bonacci As String() = {"", "", "Fibo", "tribo", "tetra", "penta", "hexa"}
        Dim i As Integer
        'Fibonacci:
        For i = 2 To 6
            Debug.Print(bonacci(i) & "nacci: " & FibonacciN(i, nmax))
        Next i
        'Lucas:
        Debug.Print("Lucas: " & FibonacciN(2, nmax, 2))
    End Sub 'Main

    Private Function FibonacciN(iStep As Long, Count As Long, Optional First As Long = 0) As String
        Dim i, j As Integer, Sigma As Long, c As String
        Dim T(nmax) As Long
        T(1) = IIf(First = 0, 1, First)
        T(2) = 1
        For i = 3 To Count
            Sigma = 0
            For j = i - 1 To i - iStep Step -1
                If j > 0 Then
                    Sigma += T(j)
                End If
            Next j
            T(i) = Sigma
        Next i
        c = ""
        For i = 1 To nmax
            c &= ", " & T(i)
        Next i
        Return Mid(c, 3)
    End Function 'FibonacciN

End Class 'FibonacciNstep


fn fib_n(initial []int, num_terms int) []int {
    n := initial.len
    if n < 2 || num_terms < 0 {panic("Invalid argument(s).")}
    if num_terms <= n {return initial}
    mut fibs := []int{len:num_terms}
    for i in 0..n {
        fibs[i] = initial[i]
    }
    for i in n..num_terms {
        mut sum := 0
        for j in i-n..i {
            sum = sum + fibs[j]
        }
        fibs[i] = sum
    }
    return fibs
}

fn main(){
    names := [
        "fibonacci",  "tribonacci", "tetranacci", "pentanacci", "hexanacci",
        "heptanacci", "octonacci",  "nonanacci",  "decanacci"
    ]
    initial := [1, 1, 2, 4, 8, 16, 32, 64, 128, 256]
    println(" n  name         values")
    mut values := fib_n([2, 1], 15)
    print(" 2  ${'lucas':-10}")
    println(values.map('${it:4}').join(' '))
    for i in 0..names.len {
        values = fib_n(initial[0..i + 2], 15)
        print("${i+2:2}  ${names[i]:-10}")
        println(values.map('${it:4}').join(' '))
    }
}


import "/fmt" for Fmt

var fibN = Fn.new { |initial, numTerms|
    var n = initial.count
    if (n < 2 || numTerms < 0) Fiber.abort("Invalid argument(s).")
    if (numTerms <= n) return initial.toList
    var fibs = List.filled(numTerms, 0)
    for (i in 0...n) fibs[i] = initial[i]
    for (i in n...numTerms) {
        var sum = 0
        for (j in i-n...i) sum = sum + fibs[j]
        fibs[i] = sum
    }
    return fibs
}

var names = [
    "fibonacci",  "tribonacci", "tetranacci", "pentanacci", "hexanacci",
    "heptanacci", "octonacci",  "nonanacci",  "decanacci"
]
var initial = [1, 1, 2, 4, 8, 16, 32, 64, 128, 256]
System.print(" n  name         values")
var values = fibN.call([2, 1], 15)
Fmt.write("$2d  $-10s", 2, "lucas")
Fmt.aprint(values, 4, 0, "")
for (i in 0..8) {
    values = fibN.call(initial[0...i + 2], 15)
    Fmt.write("$2d  $-10s", i + 2, names[i])
    Fmt.aprint(values, 4, 0, "")
}


include c:\cxpl\codes;          \intrinsic 'code' declarations

proc Nacci(N, F0);              \Generate Fibonacci N-step sequence
int N,                          \step size
    F0;                         \array of first N values
int I, J;
def M = 10;                     \number of members in the sequence
int F(M);                       \Fibonacci sequence
[for I:= 0 to M-1 do            \for all the members of the sequence...
    [if I < N then F(I):= F0(I) \initialize sequence
    else [F(I):= 0;             \sum previous members to get member I
         for J:= 1 to N do F(I):= F(I) + F(I-J);
         ];
    IntOut(0, F(I)); ChOut(0, ^ );
    ];
CrLf(0);
];

[Text(0, " Fibonacci: ");  Nacci(2, [1, 1]);
 Text(0, "Tribonacci: ");  Nacci(3, [1, 1, 2]);
 Text(0, "Tetranacci: ");  Nacci(4, [1, 1, 2, 4]);
 Text(0, "     Lucas: ");  Nacci(2, [2, 1]);
]


sub nStepFibs$(seq$, limit)
    local iMax, sum, numb$(1), lim, i

    lim = token(seq$, numb$(), ",")
    redim numb$(limit)
    seq$ = ""
    iMax = lim - 1
    while(lim < limit)
        sum = 0
        for i = 0 to iMax : sum = sum + val(numb$(lim - i)) : next
        lim = lim + 1
        numb$(lim) = str$(sum)
    wend
    for i = 0 to lim : seq$ = seq$ + " " + numb$(i) : next
    return seq$
end sub

print "Fibonacci:", nStepFibs$("1,1", 10)
print "Tribonacci:", nStepFibs$("1,1,2", 10)
print "Tetranacci:", nStepFibs$("1,1,2,4", 10)
print "Lucas:", nStepFibs$("2,1", 10)


fcn fibN(ns){ fcn(ns){ ns.append(ns.sum()).pop(0) }.fp(vm.arglist.copy()); }


V FASTA =
|‘>Rosetta_Example_1
  THERECANBENOSPACE
  >Rosetta_Example_2
  THERECANBESEVERAL
  LINESBUTTHEYALLMUST
  BECONCATENATED’

F fasta_parse(infile_str)
   V key = ‘’
   V val = ‘’
   [(String, String)] r
   L(line) infile_str.split("\n")
      I line.starts_with(‘>’)
         I key != ‘’
            r [+]= (key, val)
         key = line[1..].split_py()[0]
         val = ‘’
      E I key != ‘’
         val ‘’= line
   I key != ‘’
      r [+]= (key, val)
   R r

print(fasta_parse(FASTA).map((key, val) -> ‘#.: #.’.format(key, val)).join("\n"))


PROC ReadFastaFile(CHAR ARRAY fname)
  CHAR ARRAY line(256)
  CHAR ARRAY tmp(256)
  BYTE newLine,dev=[1]

  newLine=0
  Close(dev)
  Open(dev,fname,4)
  WHILE Eof(dev)=0
  DO
    InputSD(dev,line)
    IF line(0)>0 AND line(1)='> THEN
      IF newLine THEN
        PutE()
      FI
      newLine=1
      SCopyS(tmp,line,2,line(0))
      Print(tmp) Print(": ")
    ELSE
      Print(line)
    FI
  OD
  Close(dev)
RETURN

PROC Main()
  CHAR ARRAY fname="H6:FASTA.TXT"

  ReadFastaFile(fname)
RETURN


with Ada.Text_IO; use Ada.Text_IO;

procedure Simple_FASTA is

   Current: Character;

begin
   Get(Current);
   if Current /= '>' then
      raise Constraint_Error with "'>' expected";
   end if;
   while not End_Of_File loop -- read name and string
      Put(Get_Line & ": "); -- read name and write directly to output
      Read_String:
      loop
	 exit Read_String when End_Of_File; -- end of input
	 Get(Current);
	 if Current = '>' then -- next name
	    New_Line;
	    exit Read_String;
	 else
	    Put(Current & Get_Line);
	    -- read part of string and write directly to output
	 end if;
      end loop Read_String;
   end loop;

end Simple_FASTA;


begin
    % reads FASTA format data from standard input and write the results to standard output %
    % only handles the ">" line start                                                      %
    string(256) line;
    % allow the program to continue after reaching end-of-file %
    ENDFILE := EXCEPTION( false, 1, 0, false, "EOF" );
    % handle the input %
    readcard( line );
    while not XCPNOTED(ENDFILE) do begin
        % strings are fixed length in Algol W - we need to find the line lengh with trailing spaces removed %
        integer len;
        len := 255;
        while len > 0 and line( len // 1 ) = " " do len := len - 1;
        if len > 0 then begin % non-empty line %
            integer pos;
            pos := 0;
            if line( 0 // 1 ) = ">" then begin % header line %
                write();
                pos := 1;
            end if_header_line ;
            for cPos := pos until len do writeon( line( cPos // 1 ) );
            if line( 0 // 1 ) = ">" then writeon( ": " )
        end if_non_empty_line ;
        readcard( line );
    end while_not_eof
end.


parseFasta: function [data][
    result: #[]
    current: ø
    loop split.lines data 'line [
        if? `>` = first line [
            current: slice line 1 (size line)-1
            set result current ""
        ]
        else ->
            set result current (get result current)++line
    ]
    return result
]

text: {
    >Rosetta_Example_1
    THERECANBENOSPACE
    >Rosetta_Example_2
    THERECANBESEVERAL
    LINESBUTTHEYALLMUST
    BECONCATENATED
}

inspect.muted parseFasta text


Data =
(
>Rosetta_Example_1
THERECANBENOSPACE
>Rosetta_Example_2
THERECANBESEVERAL
LINESBUTTHEYALLMUST
BECONCATENATED
)

Data := RegExReplace(RegExReplace(Data, ">\V+\K\v+", ": "), "\v+(?!>)")
Gui, add, Edit, w700,  % Data
Gui, show
return


# syntax: GAWK -f FASTA_FORMAT.AWK filename
# stop processing each file when an error is encountered
{   if (FNR == 1) {
      header_found = 0
      if ($0 !~ /^[;>]/) {
        error("record is not valid")
        nextfile
      }
    }
    if ($0 ~ /^;/) { next } # comment begins with a ";"
    if ($0 ~ /^>/) { # header
      if (header_found > 0) {
        printf("\n") # EOL for previous sequence
      }
      printf("%s: ",substr($0,2))
      header_found = 1
      next
    }
    if ($0 ~ /[ \t]/) { next } # ignore records with whitespace
    if ($0 ~ /\*$/) { # sequence may end with an "*"
      if (header_found > 0) {
        printf("%s\n",substr($0,1,length($0)-1))
        header_found = 0
        next
      }
      else {
        error("end of sequence found but header is missing")
        nextfile
      }
    }
    if (header_found > 0) {
      printf("%s",$0)
    }
    else {
      error("header not found")
      nextfile
    }
}
ENDFILE {
    if (header_found > 0) {
      printf("\n")
    }
}
END {
    exit (errors == 0) ? 0 : 1
}
function error(message) {
    printf("error: FILENAME=%s, FNR=%d, %s, %s\n",FILENAME,FNR,message,$0) >"con"
    errors++
    return
}


FUNCTION checkNoSpaces (s$)
    FOR i = 1 TO LEN(s$) - 1
        IF MID$(s$, i, 1) = CHR$(32) OR MID$(s$, i, 1) = CHR$(9) THEN checkNoSpaces = 0
    NEXT i
    checkNoSpaces = 1
END FUNCTION

OPEN "input.fasta" FOR INPUT AS #1

first = 1

DO WHILE NOT EOF(1)
    LINE INPUT #1, ln$
    IF LEFT$(ln$, 1) = ">" THEN
        IF NOT first THEN PRINT
        PRINT MID$(ln$, 2); ": ";
        IF first THEN first = 0
    ELSEIF first THEN
        PRINT : PRINT "Error : File does not begin with '>'"
        EXIT DO
    ELSE
        IF checkNoSpaces(ln$) THEN
            PRINT ln$;
        ELSE
            PRINT : PRINT "Error : Sequence contains space(s)"
            EXIT DO
        END IF
    END IF
LOOP
CLOSE #1


open 1, "input.fasta"

first = True

while not eof(1)
    ln = readline(1)
    if left(ln, 1) = ">"  then
        if not first then print
        print mid(ln, 2, length(ln)-2) & ": ";
        if first then first = False
    else
        if first then
            print "Error : File does not begin with '>'"
            exit while
        else
            if checkNoSpaces(ln) then
                print left(ln, length(ln)-2);
            else
                print "Error : Sequence contains space(s)"
                exit while
            end if
        end if
    end if
end while
close 1
end

function checkNoSpaces(s)
    for i = 1 to length(s) - 1
        if chr(mid(s,i,1)) = 32 or chr(mid(s,i,1)) = 9 then return False
    next i
    return True
end function


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

void main()
{
	FILE * fp;
	char * line = NULL;
	size_t len = 0;
	ssize_t read;

	fp = fopen("fasta.txt", "r");
	if (fp == NULL)
		exit(EXIT_FAILURE);

	int state = 0;
	while ((read = getline(&line, &len, fp)) != -1) {
		/* Delete trailing newline */
		if (line[read - 1] == '\n')
			line[read - 1] = 0;
		/* Handle comment lines*/
		if (line[0] == '>') {
			if (state == 1)
				printf("\n");
			printf("%s: ", line+1);
			state = 1;
		} else {
			/* Print everything else */
			printf("%s", line);
		}
	}
	printf("\n");

	fclose(fp);
	if (line)
		free(line);
	exit(EXIT_SUCCESS);
}


using System;
using System.Collections.Generic;
using System.IO;
using System.Text;

class Program
{
    public class FastaEntry
    {
        public string Name { get; set; }
        public StringBuilder Sequence { get; set; }
    }

    static IEnumerable<FastaEntry> ParseFasta(StreamReader fastaFile)
    {
        FastaEntry f = null;
        string line;
        while ((line = fastaFile.ReadLine()) != null)
        {
            // ignore comment lines
            if (line.StartsWith(";"))
                continue;

            if (line.StartsWith(">"))
            {
                if (f != null)
                    yield return f;
                f = new FastaEntry { Name = line.Substring(1), Sequence = new StringBuilder() };
            }
            else if (f != null)
                f.Sequence.Append(line);
        }
        yield return f;
    }

    static void Main(string[] args)
    {
        try
        {
            using (var fastaFile = new StreamReader("fasta.txt"))
            {
                foreach (FastaEntry f in ParseFasta(fastaFile))
                    Console.WriteLine("{0}: {1}", f.Name, f.Sequence);
            }
        }
        catch (FileNotFoundException e)
        {
            Console.WriteLine(e);
        }
        Console.ReadLine();
    }
}


#include <iostream>
#include <fstream>

int main( int argc, char **argv ){
    if( argc <= 1 ){
        std::cerr << "Usage: "<<argv[0]<<" [infile]" << std::endl;
        return -1;
    }

    std::ifstream input(argv[1]);
    if(!input.good()){
        std::cerr << "Error opening '"<<argv[1]<<"'. Bailing out." << std::endl;
        return -1;
    }

    std::string line, name, content;
    while( std::getline( input, line ).good() ){
        if( line.empty() || line[0] == '>' ){ // Identifier marker
            if( !name.empty() ){ // Print out what we read from the last entry
                std::cout << name << " : " << content << std::endl;
                name.clear();
            }
            if( !line.empty() ){
                name = line.substr(1);
            }
            content.clear();
        } else if( !name.empty() ){
            if( line.find(' ') != std::string::npos ){ // Invalid sequence--no spaces allowed
                name.clear();
                content.clear();
            } else {
                content += line;
            }
        }
    }
    if( !name.empty() ){ // Print out what we read from the last entry
        std::cout << name << " : " << content << std::endl;
    }

    return 0;
}


(defn fasta [pathname]
  (with-open [r (clojure.java.io/reader pathname)]
    (doseq [line (line-seq r)]
      (if (= (first line) \>)
          (print (format "%n%s: " (subs line 1)))
        (print line)))))


;; * The input file as a parameter
(defparameter *input* #p"fasta.txt"
              "The input file name.")

;; * Reading the data
(with-open-file (data *input*)
  (loop
     :for line = (read-line data nil nil)
     :while line
     ;; Check if we have a comment using a simple test instead of a RegEx
     :if (char= #\> (char line 0))
     :do (format t "~&~a: " (subseq line 1))
     :else
     :do (format t "~a" line)))


# create tmp fasta file in /tmp/
tmpfile = "/tmp/tmp"+Random.rand.to_s+".fasta"
File.write(tmpfile, ">Rosetta_Example_1
THERECANBENOSPACE
>Rosetta_Example_2
THERECANBESEVERAL
LINESBUTTHEYALLMUST
BECONCATENATED")

# read tmp fasta file and store to hash
ref = tmpfile
id = seq = ""
fasta = {} of String => String
File.each_line(ref) do |line|
  if line.starts_with?(">")
    fasta[id] = seq.sub(/\s/, "") if id != ""
    id = line.split(/\s/)[0].lstrip(">")
    seq = ""
  else
    seq += line
  end
end
fasta[id] = seq.sub(/\s/, "")

# show fasta component
fasta.each { |k,v| puts "#{k}: #{v}"}


USING: formatting io kernel sequences ;
IN: rosetta-code.fasta

: process-fasta-line ( str -- )
    dup ">" head? [ rest "\n%s: " printf ] [ write ] if ;

: main ( -- )
    readln rest "%s: " printf [ process-fasta-line ] each-line ;

MAIN: main


1024      constant  max-Line
char >    constant  marker

: read-lines        begin  pad max-line >r over r> swap
                           read-line throw
                    while  pad dup [email protected] marker =
                           if cr 1+ swap type ."  : "
                           else swap  type
                           then
                    repeat drop  ;

: Test              s" ./FASTA.txt" r/o open-file throw
                    read-lines
                    close-file throw
                    cr ;
Test


' FB 1.05.0 Win64

Function checkNoSpaces(s As String) As Boolean
  For i As UInteger = 0 To Len(s) - 1
    If s[i] = 32 OrElse s[i] = 9 Then Return False  '' check for spaces or tabs
  Next
  Return True
End Function

Open "input.fasta" For Input As # 1

Dim As String ln, seq
Dim first As Boolean = True

While Not Eof(1)
  Line Input #1, ln
  If Left(ln, 1) = ">"  Then
    If Not first Then Print
    Print Mid(ln, 2); ": ";
    If first Then first = False
  ElseIf first Then
    Print: Print "Error : File does not begin with '>'";
    Exit While
  Else
    If checkNoSpaces(ln) Then
      Print ln;
    Else
      Print : Print "Error : Sequence contains space(s)";
      Exit While
    End If
  End If
Wend

Close #1

Print : Print
Print "Press any key to quit"
Sleep


Public Sub Main()
Dim sList As String = File.Load("../FASTA")
Dim sTemp, sOutput As String

For Each sTemp In Split(sList, gb.NewLine)
  If sTemp Begins ">" Then
    If sOutput Then Print sOutput
    sOutput = Right(sTemp, -1) & ": "
  Else
    sOutput &= sTemp
  Endif
Next

Print sOutput

End


package main

import (
        "bufio"
        "fmt"
        "os"
)

func main() {
        f, err := os.Open("rc.fasta")
        if err != nil {
                fmt.Println(err)
                return
        }
        defer f.Close()
        s := bufio.NewScanner(f)
        headerFound := false
        for s.Scan() {
                line := s.Text()
                switch {
                case line == "":
                        continue
                case line[0] != '>':
                        if !headerFound {
                                fmt.Println("missing header")
                                return
                        }
                        fmt.Print(line)
                case headerFound:
                        fmt.Println()
                        fallthrough
                default:
                        fmt.Printf("%s: ", line[1:])
                        headerFound = true
                }
        }
        if headerFound {
                fmt.Println()
        }
        if err := s.Err(); err != nil {
                fmt.Println(err)
        }
}


import Data.List ( groupBy )

parseFasta :: FilePath -> IO ()
parseFasta fileName = do
  file <- readFile fileName
  let pairedFasta = readFasta $ lines file
  mapM_ (\(name, code) -> putStrLn $ name ++ ": " ++ code) pairedFasta

readFasta :: [String] -> [(String, String)]
readFasta = pair . map concat . groupBy (\x y -> notName x && notName y)
 where
  notName :: String -> Bool
  notName = (/=) '>' . head

  pair :: [String] -> [(String, String)]
  pair []           = []
  pair (x : y : xs) = (drop 1 x, y) : pair xs


require 'strings'  NB. not needed for J versions greater than 6.
parseFasta=: ((': ' ,~ LF&taketo) , (LF -.~ LF&takeafter));._1


import java.io.*;
import java.util.Scanner;

public class ReadFastaFile {

    public static void main(String[] args) throws FileNotFoundException {

        boolean first = true;

        try (Scanner sc = new Scanner(new File("test.fasta"))) {
            while (sc.hasNextLine()) {
                String line = sc.nextLine().trim();
                if (line.charAt(0) == '>') {
                    if (first)
                        first = false;
                    else
                        System.out.println();
                    System.out.printf("%s: ", line.substring(1));
                } else {
                    System.out.print(line);
                }
            }
        }
        System.out.println();
    }
}


const fs = require("fs");
const readline = require("readline");

const args = process.argv.slice(2);
if (!args.length) {
    console.error("must supply file name");
    process.exit(1);
}

const fname = args[0];

const readInterface = readline.createInterface({
    input: fs.createReadStream(fname),
    console: false,
});

let sep = "";
readInterface.on("line", (line) => {
    if (line.startsWith(">")) {
        process.stdout.write(sep);
        sep = "\n";
        process.stdout.write(line.substring(1) + ": ");
    } else {
        process.stdout.write(line);
    }
});

readInterface.on("close", () => process.stdout.write("\n"));


def fasta:
  foreach (inputs, ">") as $line
    # state: [accumulator, print ]
    ( [null, null];
      if $line[0:1] == ">" then [($line[1:] + ": "), .[0]]
      else [ (.[0] + $line), false]
      end;
      if .[1] then .[1] else empty end )
    ;

fasta


for line in eachline("data/fasta.txt")
    if startswith(line, '>')
        print(STDOUT, "\n$(line[2:end]): ")
    else
        print(STDOUT, "$line")
    end
end


// version 1.1.2

import java.util.Scanner
import java.io.File

fun checkNoSpaces(s: String) = ' ' !in s && '\t' !in s

fun main(args: Array<String>) {
    var first = true
    val sc = Scanner(File("input.fasta"))
    while (sc.hasNextLine()) {
        val line = sc.nextLine()
        if (line[0] == '>') {
            if (!first) println()
            print("${line.substring(1)}: ")
            if (first) first = false
        }
        else if (first) {
            println("Error : File does not begin with '>'")
            break
        }
        else if (checkNoSpaces(line))
            print(line)
        else {
            println("\nError : Sequence contains space(s)")
            break
        }
    }
    sc.close()
}


local file = io.open("input.txt","r")
local data = file:read("*a")
file:close()

local output = {}
local key = nil

-- iterate through lines
for line in data:gmatch("(.-)\r?\n") do
	if line:match("%s") then
		error("line contained space")
	elseif line:sub(1,1) == ">" then
		key = line:sub(2)
		-- if key already exists, append to the previous input
		output[key] = output[key] or ""
	elseif key ~= nil then
		output[key] = output[key] .. line
	end
end

-- print result
for k,v in pairs(output) do
	print(k..": "..v)
end


Module CheckIt {
      Class FASTA_MACHINE {
            Events "GetBuffer", "header", "DataLine", "Quit"
      Public:
            Module Run {
                  Const lineFeed$=chr$(13)+chr$(10)
                  Const WhiteSpace$=" "+chr$(9)+chrcode$(160)
                  Def long state=1, idstate=1
                  Def boolean Quit=False
                  Def Buf$, waste$, Packet$
            GetNextPacket:
                        Call Event "Quit", &Quit
                        If Quit then exit
                        Call Event "GetBuffer", &Packet$
                        Buf$+=Packet$
                        If len(Buf$)=0 Then exit
                        On State Goto GetStartIdentifier, GetIdentifier, GetStartData, GetData, GetStartIdentifier2
                        exit
            GetStartIdentifier:
                        waste$=rightpart$(Buf$, ">")
            GetStartIdentifier2:
                        If len(waste$)=0 Then waste$=rightpart$(Buf$, ";") : idstate=2
                        If len(waste$)=0 Then idstate=1 : Goto GetNextPacket ' we have to read more
                        buf$=waste$
                        state=2
            GetIdentifier:
                        If Len(Buf$)=len(lineFeed$) then {
                              if buf$<>lineFeed$ then Goto GetNextPacket
                              waste$=""
                        } Else {
                              if instr(buf$, lineFeed$)=0 then Goto GetNextPacket
                              waste$=rightpart$(Buf$, lineFeed$)
                          }
                        If idstate=2 Then {
                            idstate=1
                            \\ it's a comment, drop it
                            state=1
                            Goto GetNextPacket
                        } Else Call Event "header", filter$(leftpart$(Buf$,lineFeed$), WhiteSpace$)
                        Buf$=waste$
                        State=3
            GetStartData:
                        while left$(buf$, 2)=lineFeed$ {buf$=Mid$(buf$,3)}
                        waste$=Leftpart$(Buf$, lineFeed$)
                        If len(waste$)=0 Then  Goto GetNextPacket ' we have to read more
                        waste$=Filter$(waste$,WhiteSpace$)
                        Call Event "DataLine", leftpart$(Buf$,lineFeed$)
                        Buf$=Rightpart$(Buf$,lineFeed$)
                        state=4
            GetData:
                        while left$(buf$, 2)=lineFeed$ {buf$=Mid$(buf$,3)}
                        waste$=Leftpart$(Buf$, lineFeed$)
                        If len(waste$)=0 Then  Goto GetNextPacket ' we have to read more
                        If Left$(waste$,1)=";" Then wast$="": state=5 : Goto GetStartIdentifier2
                        If Left$(waste$,1)=">" Then state=1 : Goto GetStartIdentifier
                        waste$=Filter$(waste$,WhiteSpace$)
                        Call Event "DataLine", waste$
                        Buf$=Rightpart$(Buf$,lineFeed$)
                        Goto GetNextPacket
            }
      }
      Group WithEvents K=FASTA_MACHINE()
      Document Final$, Inp$

      \\ In documents, "="" used for append data. Final$="append this"
      Const NewLine$=chr$(13)+chr$(10)
      Const Center=2
      \\ Event's Functions
      Function K_GetBuffer (New &a$) {
            Input "IN:", a$
            inp$=a$+NewLine$
            while right$(a$, 1)="\" {
                  Input "IN:", b$
                  inp$=b$+NewLine$
                  if b$="" then b$="n"
                  a$+=b$
            }
            a$= replace$("\N","\n", a$)
            a$= replace$("\n",NewLine$, a$)
      }
      Function K_header (New a$) {
            iF Doc.Len(Final$)=0 then {
                  Final$=a$+": "
            } Else Final$=Newline$+a$+": "
      }
      Function K_DataLine (New a$) {
            Final$=a$
      }
      Function K_Quit (New &q) {
            q=keypress(1)
      }
      Cls , 0
      Report Center, "FASTA Format"
      Report "Simulate input channel in packets (\n for new line). Use empty input to exit after new line, or press left mouse button and Enter to quit. Use ; to write comments. Use > to open a title"
      Cls, row  ' scroll from current row
      K.Run
      Cls
      Report Center, "Input File"
      Report Inp$
      Report Center, "Output File"
      Report Final$
}
checkit


ImportString[">Rosetta_Example_1
 THERECANBENOSPACE
 >Rosetta_Example_2
 THERECANBESEVERAL
 LINESBUTTHEYALLMUST
 BECONCATENATED
 ", "FASTA"]


import strutils

let input = """>Rosetta_Example_1
    THERECANBENOSPACE
    >Rosetta_Example_2
    THERECANBESEVERAL
    LINESBUTTHEYALLMUST
    BECONCATENATED""".unindent

proc fasta*(input: string) =
    var row = ""
    for line in input.splitLines:
        if line.startsWith(">"):
            if row != "": echo row
            row = line[1..^1] & ": "
        else:
            row &= line.strip
    echo row

fasta(input)


class Fasta {
  function : Main(args : String[]) ~ Nil {
    if(args->Size() = 1) {
      is_line := false;
      tokens := System.Utility.Parser->Tokenize(System.IO.File.FileReader->ReadFile(args[0]))<String>;
      each(i : tokens) {
          token := tokens->Get(i);
          if(token->Get(0) = '>') {
            is_line := true;
            if(i <> 0) {
              "\n"->Print();
            };
          }
          else if(is_line) {
            "{$token}: "->Print();
            is_line := false;
          }
          else {
            token->Print();
          };
        };
      };
    };
  }
}


(* This program reads from the standard input and writes to standard output.
 * Examples of use:
 *    $ ocaml fasta.ml < fasta_file.txt
 *    $ ocaml fasta.ml < fasta_file.txt > my_result.txt
 *
 * The FASTA file is assumed to have a specific format, where the first line
 * contains a label in the form of '>blablabla', i.e. with a '>' as the first
 * character.
 *)

let labelstart = '>'

let is_label s = s.[0] = labelstart
let get_label s = String.sub s 1 (String.length s - 1)

let read_in channel = input_line channel |> String.trim

let print_fasta chan =
  let rec doloop currlabel line =
    if is_label line then begin
        if currlabel <> "" then print_newline ();
        let newlabel = get_label line in
        print_string (newlabel ^ ": ");
        doloop newlabel (read_in chan)
    end
    else begin
        print_string line;
        doloop currlabel (read_in chan)
    end
  in
  try
    match read_in chan with
    | line when is_label line -> doloop "" line
    | _ -> failwith "Badly formatted FASTA file?"
  with
    End_of_file -> print_newline ()

let () =
  print_fasta stdin


program FASTA_Format;
// FPC 3.0.2
var InF,
    OutF: Text;
    ch: char;
    First: Boolean=True;
    InDef: Boolean=False;

begin
  Assign(InF,'');
  Reset(InF);
  Assign(OutF,'');
  Rewrite(OutF);
  While Not Eof(InF) do
  begin
    Read(InF,ch);
    Case Ch of
      '>': begin
            if Not(First) then
              Write(OutF,#13#10)
            else
              First:=False;
            InDef:=true;
          end;
      #13: Begin
               if InDef then
               begin
                 InDef:=false;
                 Write(OutF,': ');
               end;
               Ch:=#0;
             end;
      #10: ch:=#0;
      else Write(OutF,Ch);
    end;
  end;
  Close(OutF);
  Close(InF);
end.


my $fasta_example = <<'END_FASTA_EXAMPLE';
>Rosetta_Example_1
THERECANBENOSPACE
>Rosetta_Example_2
THERECANBESEVERAL
LINESBUTTHEYALLMUST
BECONCATENATED
END_FASTA_EXAMPLE

my $num_newlines = 0;
while ( < $fasta_example > ) {
	if (/\A\>(.*)/) {
		print "\n" x $num_newlines, $1, ': ';
	}
	else {
		$num_newlines = 1;
		print;
	}
}