$ include "seed7_05.s7i";

const type: intHash is hash [integer] integer;

var intHash: qHash is intHash.value;

const func integer: q (in integer: n) is func
  result
    var integer: q is 1;
  begin
    if n in qHash then
      q := qHash[n];
    else
      if n > 2 then
        q := q(n - q(pred(n))) + q(n - q(n - 2));
      end if;
      qHash @:= [n] q;
    end if;
  end func;

const proc: main is func
  local
    var integer: n is 0;
    var integer: less_than_preceding is 0;
  begin
    writeln("q(n) for n = 1 .. 10:");
    for n range 1 to 10 do
      write(q(n) <& " ");
    end for;
    writeln;
    writeln("q(1000)=" <& q(1000));
    for n range 2 to 100000 do
      if q(n) < q(pred(n)) then
        incr(less_than_preceding);
      end if;
    end for;
    writeln("q(n) < q(n-1) for n = 2 .. 100000: " <& less_than_preceding);
  end func;


func Q(n) is cached {
    n <= 2 ? 1
           : Q(n - Q(n-1))+Q(n-Q(n-2))
}

say "First 10 terms: #{ {|n| Q(n) }.map(1..10) }"
say "Term 1000: #{Q(1000)}"
say "Terms less than preceding in first 100k: #{2..100000->count{|i|Q(i)<Q(i-1)}}"


print("""\
Usage: thingy [OPTIONS]
     -h                        Display this usage message
     -H hostname               Hostname to connect to
""")


#lang racket/base

(displayln #<<EOF
  Blah blah blah
    with indentation intact
    and "free" \punctuations\
EOF
)


my $color = 'green';
say qq :to 'END';
    some line
    color: $color
    another line
    END


'Buffy the Vampire Slayer' as sender
'Spike' as recipient

[
"Dear %(recipient)s,
"
"I wish you to leave Sunnydale and never return.
"
"Not Quite Love,
"%(sender)s
] "\n" join print


/*REXX program demonstrates a method to use  "here"  documents in REXX. */
parse arg doc .                        /*"here" name is case sensitive. */

     do j=1  for sourceline()
     if sourceline(j)\=='◄◄'doc  then iterate
           do !=j+1  to sourceline()  while sourceline(!)\=='◄◄.'
           say sourceline(!)
           end   /*!*/
     exit                              /*stick a fork in it, we're done.*/
     end         /*j*/

say doc '"here" document not found.'
exit                                   /*stick a fork in it, we're done.*/
/*──────────────────────────────────start of "here" docs──────────────────
◄◄rs-232
RS─232 Signals and Pinouts  ┌─────────────────────────────────────────────────┐
                            │13  12  11  10  9   8   7   6   5   4   3   2   1│
──►  Interface between data └┐ 25  24  23  22  21  20  19  18  17  16  15  14┌┘
terminal equipment (DTE/male)└───────────────────────────────────────────────┘
and data communication equipment
[DCE/female]  employing  serial   ┌───────────────────────────────────────────┐
binary  data  interchange.        │ 12◄─secondary carrier detect   [SCD]  DCE │
┌─────────────────────────────────┤ 13◄─secondary clear to send    [SCS]  DCE │
│ 1◄─protective ground  [PG, GND] │ 14◄─secondary transmitted data [STD]  DTE │
│ 2◄─transmitted data   [TD]  DTE │ 15◄─transmit clock             [TC]   DCE │
│ 3◄─received data      [RD]  DCE │ 16◄─secondary received data    [SRD]  DCE │
│ 4◄─request to send    [RTS] DTE │ 17◄─receiver clock             [RC]   DCE │
│ 5◄─clear to send      [CTS] DCE │ 18◄─unassigned                            │
│ 6◄─data set ready     [DSR] DCE │ 19◄─secondary request to send  [SRS]  DTE │
│ 7◄─signal ground      [SG]      │ 20◄─data terminal ready        [DTR]  DTE │
│      (common return)            │ 21◄─signal quality detector    [SQD]  DCE │
│ 8◄─carrier detect     [CD]  DCE │ 22◄─ring indicator             [RI]   DCE │
│ 9◄─positive voltage   [-]       │ 23◄─data rate select       [DRS]  DCE/DTE │
│10◄─negative voltage   [-]       │ 24◄─external clock             [XTC]  DTE │
│11◄─unassigned                   │ 25◄─unassigned                            │
└─────────────────────────────────┴───────────────────────────────────────────┘
◄◄.
◄◄can
        ┌──────┐
        │      │
        │      ├┐
        │      ├┘
        │      │
        │      │
        │      │
        │      │
        │      │                                         ┌─────┐
        └──┬┬──┘                                         │┌───┐│
           ││                                            ├┤   ├┤
           ││    ┌───────────────┐                       ││   ││
           ││   ┌┴──────────────┬┘                       └┤   ├┘
           │└───┤               │                         └───┘
           └────┤            ┌──┘
                │            │
                └──┐         │
                   │         │
                   │         │
                   │         │
                   └─────────┘
◄◄.
────────────────────────────────────end of "here" docs──────────────────*/


let n = 100000

var q = Array(repeating: 0, count: n)
q[0] = 1
q[1] = 1

for i in 2..<n {
    q[i] = q[i - q[i - 1]] + q[i - q[i - 2]]
}

print("First 10 elements of the sequence: \(q[0..<10])")
print("1000th element of the sequence: \(q[999])")

var count = 0
for i in 1..<n {
    if q[i] < q[i - 1] {
        count += 1
    }
}
print("Number of times a member of the sequence is less than the preceding term for terms up to and including the 100,000th term: \(count)")


templates q
  def outputFrom: $(1);
  def until: $(2);
  @: [1,1];
  1..$until -> #
  when <[email protected]::length~..> do
    ..|@: [email protected]($ - [email protected]($ - 1)) + [email protected]($ - [email protected]($ - 2));
    $ -> #
  when <$outputFrom..> do
    [email protected]($) !
end q

[1,10] -> q -> '$; ' -> !OUT::write
'
' -> !OUT::write

[1000,1000] -> q -> '$;
' -> !OUT::write

templates countDownSteps
  @: 0;
  def qs: $;
  2..$qs::length -> #
  [email protected] !
  when <?($qs($) <..~$qs($-1)>)> do @: [email protected] + 1;
end countDownSteps

[[1, 100000] -> q] -> countDownSteps -> 'Less than previous $; times' -> !OUT::write


package require Tcl 8.5

# Index 0 is not used, but putting it in makes the code a bit shorter
set tcl::mathfunc::Qcache {Q:-> 1 1}
proc tcl::mathfunc::Q {n} {
    variable Qcache
    if {$n >= [llength $Qcache]} {
	lappend Qcache [expr {Q($n - Q($n-1)) + Q($n - Q($n-2))}]
    }
    return [lindex $Qcache $n]
}

# Demonstration code
for {set i 1} {$i <= 10} {incr i} {
    puts "Q($i) == [expr {Q($i)}]"
}
# This runs very close to recursion limit...
puts "Q(1000) == [expr Q(1000)]"
# This code is OK, because the calculations are done step by step
set q [expr Q(1)]
for {set i 2} {$i <= 100000} {incr i} {
    incr count [expr {$q > [set q [expr {Q($i)}]]}]
}
puts "Q(i)<Q(i-1) for i \[2..100000\] is true $count times"


text ="
<<'FOO'
Now
   is
     the
       time
            for
               all
                  good mem
to come to the aid of their country."
see text + nl


address = <<END
1, High Street,
#{town_name},
West Midlands.
WM4 5HD.
END


text$ ="
<<'FOO'
Now
   is
     the
       time
            for
               all
                  good mem
to come to the aid of their country."
print text$


let x = r#"
    This is a "raw string literal," roughly equivalent to a heredoc.
"#;

let y = r##"
  This string contains a #.
"##;


object temp {
val MemoriesOfHolland=
  """Thinking of Holland
    |I see broad rivers
    |slowly chuntering
    |through endless lowlands,
    |rows of implausibly
    |airy poplars
    |standing like tall plumes
    |against the horizon;
    |and sunk in the unbounded
    |vastness of space
    |homesteads and boweries
    |dotted across the land,
    |copses, villages,
    |couchant towers,
    |churches and elm-trees,
    |bound in one great unity.
    |There the sky hangs low,
    |and steadily the sun
    |is smothered in a greyly
    |iridescent smirr,
    |and in every province
    |the voice of water
    |with its lapping disasters
    |is feared and hearkened.""".stripMargin
}


set script to {{SCRIPT
put "Script demonstrating block quotes"

set text to {{
"I wish it need not have happened in my time," said Frodo.
"So do I," said Gandalf, "and so do all who live to see such times. But that is not for them to decide. All we have to decide is what to do with the time that is given us."
}}

put the number of occurrences of "time" in text --> 3

SCRIPT}}

do script


main :=
"In SequenceL
strings are
multiline
by default.
'All' non-\"
characters are
valid for inclusion
in a string.";


db2 "select 'This is the first line.
This is the second line.
This is the third line.' from sysibm.sysdummy1"


Print "First 10 terms of Q = " ;
For i = 1 To 10 : Print FUNC(_q(i));" "; : Next : Print
Print "256th term = ";FUNC(_q(256))

End

_q Param(1)
  Local(2)

  If [email protected] < 3 Then Return (1)
  If [email protected] = 3 Then Return (2)

  @(0) = 1 : @(1) = 1 : @(2) = 2
  [email protected] = 0

  For [email protected] = 3 To [email protected]
    @([email protected]) = @([email protected] - @([email protected])) + @([email protected] - @([email protected]))
    If @([email protected]) < @([email protected]) Then [email protected] = [email protected] + 1
  Next

Return (@([email protected]))


Public Q(100000) As Long
Public Sub HofstadterQ()
    Dim n As Long, smaller As Long
    Q(1) = 1
    Q(2) = 1
    For n = 3 To 100000
        Q(n) = Q(n - Q(n - 1)) + Q(n - Q(n - 2))
        If Q(n) < Q(n - 1) Then smaller = smaller + 1
    Next n
    Debug.Print "First ten terms:"
    For i = 1 To 10
        Debug.Print Q(i);
    Next i
    Debug.print
    Debug.Print "The 1000th term is:"; Q(1000)
    Debug.Print "Number of times smaller:"; smaller
End Sub


Sub q_sequence(n)
	Dim Q()
	ReDim Q(n)
	Q(1)=1 : Q(2)=1 : Q(3)=2
	less_precede = 0
	For i = 4 To n
	 Q(i)=Q(i-Q(i-1))+Q(i-Q(i-2))
	 If Q(i) < Q(i-1) Then
	 	less_precede = less_precede + 1
	 End If
	Next
	WScript.StdOut.Write "First 10 terms of the sequence: "
	For j = 1 To 10
		If j < 10 Then
			WScript.StdOut.Write Q(j) & ", "
		Else
			WScript.StdOut.Write "and " & Q(j)
		End If
	Next
	WScript.StdOut.WriteLine
	WScript.StdOut.Write "1000th term of the sequence: " & Q(1000)
	WScript.StdOut.WriteLine
	WScript.StdOut.Write "Number of times the member of the sequence is less than its preceding term: " &_
		less_precede
End Sub

q_sequence(100000)


set hereDocExample {
In Tcl, the {curly brace} notation is strictly a here-document style notation
as it permits arbitrary content inside it *except* for an unbalanced brace.
That is typically not a problem as seen in reality, as almost all content that
might be placed in a here-doc is either brace-free or balanced.
The content of the braces is not interpreted at all;
no substitutions are performed on it.

The sole exception is that there is limited processing of backslashes;
a single backslash at the end of a line causes the end-of-line
plus all whitespace at the start of the next line
to be compressed to a single space.
}


#!/usr/bin/txr -f
@(maybe)
@(bind USER "Unknown User")
@(or)
@(bind MB "???")
@(end)
@(output)
Dear @USER

Your are over your disk quota by @MB megabytes.

The Computer
@(end)


#!/bin/sh
cat << ANARBITRARYTOKEN
The river was deep but I swam it, Janet.
The future is ours so let's plan it, Janet.
So please don't tell me to can it, Janet.
I've one thing to say and that's ...
Dammit. Janet, I love you.
ANARBITRARYTOKEN


hd =

-[
The text enclosed within the so called dash-brackets shown above
and below will be interpreted as a list of character strings. It
can contain anything except uninterpreted dash-brackets, and can
be used in any declaration or expression. The dash-brackets don't
have to be on a line by themselves.
]-

example =

-[Some additional facilities allow here-documents to be nested and
combined. Writing something like -[ hd ]- within a nested pair of
dash-brackets will cause the text declared above (having the
identifer hd) to be inserted at that point. The enclosed item can
be any expression that evaluates to a list of character strings.
We could therefore "escape" a literal dash-bracket within a
here-document by writing -[ <'-['> ]-. Dash-brackets can be nested
to any depth, alternating between literal text and compiled code
on each level.]-

template "x" =

-[A further use of this notation involves defining a text-valued
function. The output of this function will be this text, with
the argument inserted here -["x"]- and again here -["x"]-. The
argument type should be a list of character strings.]-

formletter ("x","y") =

-[Other calling conventions are possible. The left argument
comes out here -["x"]- and the right one here -["y"]-.]-

designpattern =

-[A point-free style of function declaration is also supported.
The argument comes out here -[. ~& ]-, after being fed through
the function appearing within the nested dash-brackets (in this
case the identity function). This usage is indicated by a period
after the left inner dash-bracket. Nesting is also allowed in
point free dash-bracket function specifications.]-

abstractionastronaut =

-[Higher order functions to any level are specified by piling on
the periods like this -[.. ~&]-. This one is a second order function
that needs to be applied to another function in order to get a
first order function such as the previous three examples.]-


'Purpose: Converts TXT files into VBS code with a function that returns a text string with the contents of the TXT file
'         The TXT file can even be another VBS file.

'History:
'   1.0 8may2009    Initial release
'
'
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2

set WshShell = CreateObject("WSCript.shell")

'File browse dialog box
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "All Files|*.*"
objDialog.InitialDir = WshShell.CurrentDirectory
intResult = objDialog.ShowOpen

If intResult = 0 Then
    WshShell.Popup "No file selected.", 2, " ", 64
    Wscript.Quit
Else
    strFileNameIN = objDialog.FileName
End If

strFileNameOUT= strFileNameIN & "_CONVERTED.Vbs"

'Check if strFileNameOUT exists already
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFileNameOUT) then  'does the file EXIST?
'   WScript.Echo "found"
    OVRWT=MSGBOX(strFileNameOUT & " exists already"&vbCRLF&"Overwrite?",vbYesNoCancel,"Overwrite?")
    if OVRWT = 6 then
        'proceed
        objFSO.DeleteFile(strFileNameOUT)
    else
        WshShell.Popup "Exiting as requested.", 1, " ", 64
        Wscript.Quit
    End If
Else
'   WScript.Echo "not found" 'strFileNameOUT does NOT exists already

END if

strBaseName=objFSO.GetBaseName(strFileNameIN)

'open strFileNameANSI file, and put entire file into a variable ****SIZE LIMIT ??*****
Set objFile = objFSO.OpenTextFile(strFileNameIN, ForReading)
strText = objFile.ReadAll
objFile.Close

'Start converting

'Convert " to ""
strOldText = Chr(34)
strNewText = Chr(34)&Chr(34)
strText = Replace(strText, strOldText, strNewText)

'Add objTXTFile.writeline ("
strOldText = VBCRLF
strNewText = """)  &vbCrLf"&VBCRLF&"    strText=strText& ("""
strText = Replace(strText, strOldText, strNewText)
'Converting done

strFileName=objFSO.GetFileName(strFileNameIN)

'Write to file
Set objFile = objFSO.OpenTextFile(strFileNameOUT, ForAppending, True)
objFile.WriteLine "'this Function will return a string containing the contents of the file called "&strFileName
objFile.WriteLine "msgbox "&strBaseName &"()"
objFile.WriteLine vbCrLf
objFile.WriteLine "Function "&strBaseName&"()"
objFile.WriteLine " 'returns a string containing the contents of the file called "&strFileName
objFile.WriteLine " Dim strText"
objFile.WriteLine " strText= ("""&strText&""") &vbCrLf"
objFile.WriteLine " "&strBaseName&"=strText"
objFile.WriteLine "End Function"
objFile.Close

WshShell.Popup "created " & strFileNameOUT, 3, "Completed", 64


fn main() {
    m := '    leading spaces

and blank lines'

    println(m)
}


var a = 42
var b = """
This is a 'raw' string with the following properties:
  - indention is preserved,
  - an escape sequence such as a quotation mark "\\" is interpreted literally, and
  - interpolation such as %(a) is also interpreted literally.
`Have fun!`
"""
System.print(b)


code Text=12;
Text(0, "   ^"Heredocs^" are pretty much automatic. Multiple lines and
whitespace, such as indentations, are output exactly as written. Quote
marks (^") and any carets (^^) within the string must be escaped.")


LOCAL p As Integer, i As Integer
CLEAR
p = 0
? "Hofstadter Q Sequence"
? "First 10 terms:"
FOR i = 1 TO 10
	?? Q(i, @p)
ENDFOR
? "1000th term:", Q(1000, @p)
? "100000th term:", q(100000, @p)
? "Number of terms less than the preceding term:", p

FUNCTION Q(n As Integer, k As Integer) As Integer
LOCAL i As Integer
LOCAL ARRAY aq[n]
aq[1] = 1
IF n > 1
    aq[2] = 1
ENDIF
k = 0
FOR i = 3 TO n
    aq[i] = aq[i - aq[i-1]] + aq[i-aq[i-2]]
    IF aq(i) < aq(i-1)
    	k = k + 1
    ENDIF
ENDFOR
RETURN aq[n]
ENDFUNC


var N = 1e5
var q = List.filled(N + 1, 0)
q[1] = 1
q[2] = 1
for (n in 3..N) q[n] = q[n - q[n-1]] + q[n - q[n-2]]

System.print("The first ten terms of the Hofstadter Q sequence are:")
System.print(q[1..10])
System.print("\nThe thousandth term is %(q[1000]).")
var flips = 0
for (n in 2..N) {
    if (q[n] < q[n-1]) flips = flips + 1
}
System.print("\nThere are %(flips) flips in the first %(N) terms.")


<?xml version="1.0" encoding="UTF-8"?>
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
<xsl:output method="text"/>

<xsl:template match="/">
<![CDATA[

This text is in a CDATA section. In here, it's okay to include <, >, &, ", and '
without any special treatment.

The section is terminated by a three-character sequence consisting of two right
brackets ("]]") followed by a greater-than (">"). If this sequence appears in
your text, a workaround is to drop out of the CDATA section, output part of the
terminator, then start a new CDATA section and output the rest. Let's do this
now:

    ]]>]]<![CDATA[>

Newlines and spacing are retained as well, as long as they're evaluated in a
context that bothers preserving them. Whether or not the spaces before and after
the CDATA section are also preserved may be application-dependent.

]]>
</xsl:template>
</xsl:stylesheet>


text1$ = "Esta es la primera linea.
Esta es la segunda linea.
Esta \"linea\" contiene comillas.\n"

text2$ = "Blast it James! I'm a magician,
not a doctor!
   --- L. McCoy\n"

print text1$
print text2$
end


x:=
#<<<
"#<<< starts a block of lines that are concatenated verbatim
and fed into the parser as one line. #<<< ends the block.
Both #<<< tokens must start the line that is otherwise ignored

Note that is isn't a string, but arbitrary source " + 1 + 23;
#<<<
x.println();


10 PRINT "First 10 terms of Q = "
20 FOR i=1 TO 10: GO SUB 1000: PRINT s;" ";: NEXT i: PRINT
30 LET i=1000
40 PRINT "1000th term = ";: GO SUB 1000: PRINT s
50 PRINT "Term is less than preceding term ";c;" times"
100 STOP
1000 REM Qsequence subroutine
1010 IF i<3 THEN LET s=1: RETURN
1020 IF i=3 THEN LET s=2: RETURN
1030 DIM q(i)
1040 LET q(1)=1: LET q(2)=1: LET q(3)=2
1050 LET c=0
1060 FOR j=3 TO i
1070 LET q(j)=q(j-q(j-1))+q(j-q(j-2))
1080 IF q(j)<q(j-1) THEN LET c=c+1
1090 NEXT j
1100 LET s=q(i)
1110 RETURN


V cR = [1]
V cS = [2]

F extend_RS()
   V x = :cR[:cR.len-1] + :cS[:cR.len-1]
   :cR [+]= (x)
   :cS [+]= :cS.last+1 .< x
   :cS [+]= (x + 1)

F ff_R(n)
   assert(n > 0)
   L n > :cR.len
      extend_RS()
   R :cR[n - 1]

F ff_S(n)
   assert(n > 0)
   L n > :cS.len
      extend_RS()
   R :cS[n - 1]

print((1..10).map(i -> ff_R(i)))

V arr = [0] * 1001
L(i) (40.<0).step(-1)
   arr[ff_R(i)]++
L(i) (960.<0).step(-1)
   arr[ff_S(i)]++

I all(arr[1..1000].map(a -> a == 1))
   print(‘All Integers 1..1000 found OK’)
E
   print(‘All Integers 1..1000 NOT found only once: ERROR’)


package Hofstadter_Figure_Figure is

   function FFR(P: Positive) return Positive;

   function FFS(P: Positive) return Positive;

end Hofstadter_Figure_Figure;


:Class HFF
    :Field Private Shared RBuf←,1
    ∇r←ffr n
        :Access Public Shared
        r←n⊃RBuf←(⊢,⊃∘⌽+≢⊃(⍳1+⌈/)~⊢)⍣(0⌈n-≢RBuf)⊢RBuf
    ∇
    ∇s←ffs n;S
        :Access Public Shared
        :Repeat
            S←((⍳1+⌈/)~⊢)RBuf
            :If n≤≢S ⋄ :Leave ⋄ :EndIf
            S←ffr 1+≢RBuf
        :EndRepeat
        s←n⊃S
    ∇
    ∇Task;th
        :Access Public Shared
        ⎕←'R(1 .. 10):', ffr¨⍳10
        :If (⍳1000) ∧.∊ ⊂th←(ffr¨⍳40) ∪ (ffs¨⍳960)
            ⎕←'1..1000 ∊ (ffr 1..40) ∪ (ffs 1..960)'
        :Else
            ⎕←'Missing values: ', (⍳1000)~th
        :EndIf
    ∇
:EndClass


R(n){
	if n=1
		return 1
	return R(n-1) + S(n-1)
}

S(n){
	static ObjR:=[]
	if n=1
		return 2
	ObjS:=[]
	loop, % n
		ObjR[R(A_Index)] := true
	loop, % n-1
		ObjS[S(A_Index)] := true
	Loop
		if !(ObjR[A_Index]||ObjS[A_Index])
			return A_index
}


# Hofstadter Figure-Figure sequences
#
#    R(1) = 1; S(1) = 2;
#    R(n) = R(n-1) + S(n-1), n > 1
#    S(n) is the values not in R(n)

BEGIN {

    # start with the first two values of R and S to simplify finding S[n]:
    R[ 1 ] = 1;
    R[ 2 ] = 3;
    S[ 1 ] = 2;
    S[ 2 ] = 4;
    # maximum n we currently have of R and S
    rMax   = 2;
    sMax   = 2;

    # calculate and show the first 10 values of R:
    printf( "R[1..10]:" );
    for( n = 1; n < 11; n ++ )
    {
        printf( " %d", ffr( n ) );
    }
    printf( "\n" );
    # check that R[1..40] and S[1..960] contain the numbers 1..1000 once each
    # add the values of R[ 1..40 ] to the set V
    for( n = 1; n <= 40; n ++ )
    {
        V[ ffr( n ) ] ++;
    }
    # add the values of S[ 1..960 ] to the set V
    for( n = 1; n <= 960; n ++ )
    {
        V[ ffs( n ) ] ++;
    }
    # check all numbers are present and not duplicated
    ok = 1;
    for( n = 1; n <= 1000; n ++ )
    {
        if( ! ( n in V ) )
        {
            printf( "%d not present in R[1..40], S[1..960]\n", n );
            ok = 0;
        }
        else if( V[ n ] != 1 )
        {
            printf( "%d occurs %d times in R[1..40], S[1..960]\n", n, V[ n ] );
            ok = 0;
        }
    }
    if( ok )
    {
        printf( "R[1..40] and S[1..960] uniquely contain all 1..1000\n" );
    }

} # BEGIN

function ffr( n )
{
    # calculate R[n]
    if( ! ( n in R ) )
    {
        # we haven't calculated R[ n ] yet
        R[ n ]  = ffs( n - 1 );
        R[ n ] += ffr( n - 1 );
    }
return R[ n ];
} # ffr

function ffs( n )
{
    # calculate S[n]
    if( ! ( n in S ) )
    {
        # starting at the highest known R, calculate the next one and fill in the S values
        # continuing until we have enough S values
        do
        {
            R[ rMax + 1 ] = R[ rMax ] + S[ rMax ];
            for( sValue = R[ rMax ] + 1; sValue < R[ rMax + 1 ]; sValue ++ )
            {
                S[ sMax ++ ] = sValue;
            }
            rMax ++;
        }
        while( sMax < n );
    }
return S[ n ];
} # ffs


      PRINT "First 10 values of R:"
      FOR i% = 1 TO 10 : PRINT ;FNffr(i%) " "; : NEXT : PRINT
      PRINT "First 10 values of S:"
      FOR i% = 1 TO 10 : PRINT ;FNffs(i%) " "; : NEXT : PRINT
      PRINT "Checking for first 1000 integers:"
      r% = 1 : s% = 1
      ffr% = FNffr(r%)
      ffs% = FNffs(s%)
      FOR wanted% = 1 TO 1000
        CASE TRUE OF
          WHEN wanted% = ffr% : r% += 1 : ffr% = FNffr(r%)
          WHEN wanted% = ffs% : s% += 1 : ffs% = FNffs(s%)
          OTHERWISE: EXIT FOR
        ENDCASE
      NEXT
      IF r% = 41 AND s% = 961 PRINT "Test passed" ELSE PRINT "Test failed"
      END

      DEF FNffr(N%)
      LOCAL I%, J%, R%, S%, V%
      DIM V% LOCAL 2*N%+1
      V%?1 = 1
      IF N% = 1 THEN = 1
      R% = 1
      S% = 2
      FOR I% = 2 TO N%
        FOR J% = S% TO 2*N%
          IF V%?J% = 0 EXIT FOR
        NEXT
        V%?J% = 1
        S% = J%
        R% += S%
        IF R% <= 2*N% V%?R% = 1
      NEXT I%
      = R%

      DEF FNffs(N%)
      LOCAL I%, J%, R%, S%, V%
      DIM V% LOCAL 2*N%+1
      V%?1 = 1
      IF N% = 1 THEN = 2
      R% = 1
      S% = 2
      FOR I% = 1 TO N%
        FOR J% = S% TO 2*N%
          IF V%?J% = 0 EXIT FOR
        NEXT
        V%?J% = 1
        S% = J%
        R% += S%
        IF R% <= 2*N% V%?R% = 1
      NEXT I%
      = S%


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

// simple extensible array stuff
typedef unsigned long long xint;

typedef struct {
	size_t len, alloc;
	xint *buf;
} xarray;

xarray rs, ss;

void setsize(xarray *a, size_t size)
{
	size_t n = a->alloc;
	if (!n) n = 1;

	while (n < size) n <<= 1;
	if (a->alloc < n) {
		a->buf = realloc(a->buf, sizeof(xint) * n);
		if (!a->buf) abort();
		a->alloc = n;
	}
}

void push(xarray *a, xint v)
{
	while (a->alloc <= a->len)
		setsize(a, a->alloc * 2);

	a->buf[a->len++] = v;
}

// sequence stuff
void RS_append(void);

xint R(int n)
{
	while (n > rs.len) RS_append();
	return rs.buf[n - 1];
}

xint S(int n)
{
	while (n > ss.len) RS_append();
	return ss.buf[n - 1];
}

void RS_append()
{
	int n = rs.len;
	xint r = R(n) + S(n);
	xint s = S(ss.len);

	push(&rs, r);
	while (++s < r) push(&ss, s);
	push(&ss, r + 1); // pesky 3
}

int main(void)
{
	push(&rs, 1);
	push(&ss, 2);

	int i;
	printf("R(1 .. 10):");
	for (i = 1; i <= 10; i++)
		printf(" %llu", R(i));

	char seen[1001] = { 0 };
	for (i = 1; i <=  40; i++) seen[ R(i) ] = 1;
	for (i = 1; i <= 960; i++) seen[ S(i) ] = 1;
	for (i = 1; i <= 1000 && seen[i]; i++);

	if (i <= 1000) {
		fprintf(stderr, "%d not seen\n", i);
		abort();
	}

	puts("\nfirst 1000 ok");
	return 0;
}


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

namespace HofstadterFigureFigure
{
	class HofstadterFigureFigure
	{
		readonly List<int> _r = new List<int>() {1};
		readonly List<int> _s = new List<int>();

		public IEnumerable<int> R()
		{
			int iR = 0;
			while (true)
			{
				if (iR >= _r.Count)
				{
					Advance();
				}
				yield return _r[iR++];
			}
		}

		public IEnumerable<int> S()
		{
			int iS = 0;
			while (true)
			{
				if (iS >= _s.Count)
				{
					Advance();
				}
				yield return _s[iS++];
			}
		}

		private void Advance()
		{
			int rCount = _r.Count;
			int oldR = _r[rCount - 1];
			int sVal;

			// Take care of first two cases specially since S won't be larger than R at that point
			switch (rCount)
			{
				case 1:
					sVal = 2;
					break;
				case 2:
					sVal = 4;
					break;
				default:
					sVal = _s[rCount - 1];
					break;
			}
			_r.Add(_r[rCount - 1] + sVal);
			int newR = _r[rCount];
			for (int iS = oldR + 1; iS < newR; iS++)
			{
				_s.Add(iS);
			}
		}
	}

	class Program
	{
		static void Main()
		{
			var hff = new HofstadterFigureFigure();
			var rs = hff.R();
			var arr = rs.Take(40).ToList();

			foreach(var v in arr.Take(10))
			{
				Console.WriteLine("{0}", v);
			}

			var hs = new HashSet<int>(arr);
			hs.UnionWith(hff.S().Take(960));
			Console.WriteLine(hs.Count == 1000 ? "Verified" : "Oops!  Something's wrong!");
		}
	}
}


#include <iomanip>
#include <iostream>
#include <set>
#include <vector>

using namespace std;

unsigned hofstadter(unsigned rlistSize, unsigned slistSize)
{
    auto n = rlistSize > slistSize ? rlistSize : slistSize;
    auto rlist = new vector<unsigned> { 1, 3, 7 };
    auto slist = new vector<unsigned> { 2, 4, 5, 6 };
    auto list = rlistSize > 0 ? rlist : slist;
    auto target_size = rlistSize > 0 ? rlistSize : slistSize;

    while (list->size() > target_size) list->pop_back();

    while (list->size() < target_size)
    {
        auto lastIndex = rlist->size() - 1;
        auto lastr = (*rlist)[lastIndex];
        auto r = lastr + (*slist)[lastIndex];
        rlist->push_back(r);
        for (auto s = lastr + 1; s < r && list->size() < target_size;)
            slist->push_back(s++);
    }

    auto v = (*list)[n - 1];
    delete rlist;
    delete slist;
    return v;
}

ostream& operator<<(ostream& os, const set<unsigned>& s)
{
    cout << '(' << s.size() << "):";
    auto i = 0;
    for (auto c = s.begin(); c != s.end();)
    {
        if (i++ % 20 == 0) os << endl;
        os << setw(5) << *c++;
    }
    return os;
}

int main(int argc, const char* argv[])
{
    const auto v1 = atoi(argv[1]);
    const auto v2 = atoi(argv[2]);
    set<unsigned> r, s;
    for (auto n = 1; n <= v2; n++)
    {
        if (n <= v1)
            r.insert(hofstadter(n, 0));
        s.insert(hofstadter(0, n));
    }
    cout << "R" << r << endl;
    cout << "S" << s << endl;

    int m = max(*r.rbegin(), *s.rbegin());
    for (auto n = 1; n <= m; n++)
        if (r.count(n) == s.count(n))
            clog << "integer " << n << " either in both or neither set" << endl;

    return 0;
}


figfig = cluster is ffr, ffs
    rep = null
    ai = array[int]
    own R: ai := ai$[1]
    own S: ai := ai$[2]

    % Extend R and S until R(n) is known
    extend = proc (n: int)
        while n > ai$high(R) do
            next: int := ai$top(R) + S[ai$high(R)]
            ai$addh(R, next)
            while ai$top(S) < next-1 do
                ai$addh(S, ai$top(S)+1)
            end
            ai$addh(S, next+1)
        end
    end extend

    ffr = proc (n: int) returns (int)
        extend(n)
        return(R[n])
    end ffr

    ffs = proc (n: int) returns (int)
        while n > ai$high(S) do
            extend(ai$high(R) + 1)
        end
        return(S[n])
    end ffs
end figfig

start_up = proc ()
    ai = array[int]
    po: stream := stream$primary_output()

    % Print R[1..10]
    stream$puts(po, "R[1..10] =")
    for i: int in int$from_to(1,10) do
        stream$puts(po, " " || int$unparse(figfig$ffr(i)))
    end
    stream$putl(po, "")

    % Count the occurrences of 1..1000 in R[1..40] and S[1..960]
    occur: ai := ai$fill(1, 1000, 0)
    for i: int in int$from_to(1, 40) do
        occur[figfig$ffr(i)] := occur[figfig$ffr(i)] + 1
    end
    for i: int in int$from_to(1, 960) do
        occur[figfig$ffs(i)] := occur[figfig$ffs(i)] + 1
    end

    % See if they all occur exactly once
    begin
        for i: int in int$from_to(1, 1000) do
            if occur[i] ~= 1 then exit wrong(i) end
        end
        stream$putl(po,
            "All numbers 1..1000 occur exactly once in R[1..40] U S[1..960].")
    end except when wrong(i: int):
        stream$putl(po, "Error: " ||
            int$unparse(i) || " occurs " || int$unparse(occur[i]) || " times.")
    end
end start_up


R = [ null, 1 ]
S = [ null, 2 ]

extend_sequences = (n) ->
  current = Math.max(R[R.length - 1], S[S.length - 1])
  i = undefined
  while R.length <= n or S.length <= n
    i = Math.min(R.length, S.length) - 1
    current += 1
    if current == R[i] + S[i]
      R.push current
    else
      S.push current

ff = (X, n) ->
    extend_sequences n
    X[n]

console.log 'R(' + i + ') = ' + ff(R, i) for i in [1..10]
int_array = ([1..40].map (i) -> ff(R, i)).concat [1..960].map (i) -> ff(S, i)
int_array.sort (a, b) -> a - b

for i in [1..1000]
  if int_array[i - 1] != i
    throw 'Something\'s wrong!'
console.log '1000 integer check ok.'


;;; equally doable with a list
(flet ((seq (i) (make-array 1 :element-type 'integer
			      :initial-element i
			      :fill-pointer 1
			      :adjustable t)))
  (let ((rr (seq 1)) (ss (seq 2)))
    (labels ((extend-r ()
		       (let* ((l (1- (length rr)))
			      (r (+ (aref rr l) (aref ss l)))
			      (s (elt ss (1- (length ss)))))
			 (vector-push-extend r rr)
			 (loop while (<= s r) do
			       (if (/= (incf s) r)
				 (vector-push-extend s ss))))))
      (defun seq-r (n)
	(loop while (> n (length rr)) do (extend-r))
	(elt rr (1- n)))

      (defun seq-s (n)
	(loop while (> n (length ss)) do (extend-r))
	(elt ss (1- n))))))

(defun take (f n)
  (loop for x from 1 to n collect (funcall f x)))

(format t "First of R: ~a~%" (take #'seq-r 10))

(mapl (lambda (l) (if (and (cdr l)
			   (/= (1+ (car l)) (cadr l)))
		    (error "not in sequence")))
      (sort (append (take #'seq-r 40)
		    (take #'seq-s 960))
	    #'<))
(princ "Ok")


include "cowgol.coh";
include "strings.coh";
include "malloc.coh";

# An uint16 is big enough to deal with the figures from the task,
# but it is good practice to allow it to be easily redefined.
typedef N is uint16;

# There is no extensible vector type included in the standard library,
# so it is necessary to define one.
record VecR is
    len: intptr;
    alloc: intptr;
    data: [N];
end record;

typedef Vec is [VecR];

sub NewVec(): (v: Vec) is
    v := Alloc(@bytesof VecR) as Vec;
    MemZero(v as [uint8], @bytesof VecR);
    v.alloc := 256;
    v.data := Alloc(@bytesof N * 256) as [N];
    MemZero(v.data as [uint8], @bytesof N * 256);
end sub;

sub VecGet(v: Vec, i: intptr): (r: N) is
    if i >= v.len then
        print("index error\n");
        ExitWithError();
    end if;
    r := [v.data + i * @bytesof N];
end sub;

sub VecSet(v: Vec, i: intptr, n: N) is
    if i >= v.alloc then
        var newsize := v.alloc;
        while i >= newsize loop
            newsize := newsize + 256;
        end loop;
        var newbytes := newsize * @bytesof N;
        var oldbytes := v.alloc * @bytesof N;
        var newdata := Alloc(newbytes) as [N];
        MemCopy(v.data as [uint8], oldbytes, newdata as [uint8]);
        MemZero(newdata as [uint8] + oldbytes, newbytes - oldbytes);
        Free(v.data as [uint8]);
        v.data := newdata;
        v.alloc := newsize;
    end if;
    [v.data + i * @bytesof N] := n;
    if i >= v.len then
        v.len := i+1;
    end if;
end sub;

sub Last(v: Vec): (r: N) is r := VecGet(v, v.len-1); end sub;
sub Append(v: Vec, n: N) is VecSet(v, v.len, n); end sub;

# We also need to define a flag array, to avoid taking up 1K of memory
# for a thousand bit flags.
sub GetFlag(bitarr: [uint8], n: intptr): (s: uint8) is
    s := ([bitarr + (n >> 3)] >> (n as uint8 & 7)) & 1;
end sub;
sub SetFlag(bitarr: [uint8], n: intptr) is
    var p := bitarr + (n >> 3);
    var f: uint8 := 1;
    [p] := [p] | (f << (n as uint8 & 7));
end sub;

# Define and initialize vectors holding the R and S sequences
var R := NewVec(); Append(R, 1);
var S := NewVec(); Append(S, 2);

# Extend the sequences until R(n) is known.
sub Extend(n: intptr) is
    while n > R.len loop
        var newR := Last(R) + VecGet(S, R.len-1);
        Append(R, newR);
        while Last(S) < newR - 1 loop
            Append(S, Last(S) + 1);
        end loop;
        Append(S, newR + 1);
    end loop;
end sub;

# Get R
sub ffr(n: intptr): (r: N) is
    Extend(n);
    r := VecGet(R, n-1);
end sub;

# Get S
sub ffs(n: intptr): (s: N) is
    while n > S.len loop
        Extend(R.len + 1);
    end loop;
    s := VecGet(S, n-1);
end sub;

# Print the first 10 values of R.
print("R(1 .. 10): ");
var n: intptr := 1;
while n <= 10 loop
    print_i32(ffr(n) as uint32);
    print_char(' ');
    n := n + 1;
end loop;
print_nl();

print("Checking that (1 .. 1000) are in R(1 .. 40) U S(1 .. 960)...\n");
# Reserve 1000 bits to use as flags, and set them all to zero
var flags: uint8[1000 / 8];
MemZero(&flags[0], @bytesof flags);

# Set the flags corresponding to FFR(1 .. 40) and FFS(1 .. 960)
n := 1;
while n <= 40 loop
    SetFlag(&flags[0], (ffr(n)-1) as intptr);
    n := n + 1;
end loop;

n := 1;
while n <= 960 loop
    SetFlag(&flags[0], (ffs(n)-1) as intptr);
    n := n + 1;
end loop;

# Check all flags
var ok: uint8 := 1;
n := 1;
while n <= 1000 loop
    if GetFlag(&flags[0], (n-1) as intptr) == 0 then
        print_i32(n as uint32);
        print(" not found!\n");
        ok := 0;
    end if;
    n := n + 1;
end loop;

if ok != 0 then
    print("All numbers 1 .. 1000 found!\n");
end if;


int delegate(in int) nothrow ffr, ffs;

nothrow static this() {
    auto r = [0, 1], s = [0, 2];

    ffr = (in int n) nothrow {
        while (r.length <= n) {
            immutable int nrk = r.length - 1;
            immutable int rNext = r[nrk] + s[nrk];
            r ~= rNext;
            foreach (immutable sn; r[nrk] + 2 .. rNext)
                s ~= sn;
            s ~= rNext + 1;
        }
        return r[n];
    };

    ffs = (in int n) nothrow {
        while (s.length <= n)
            ffr(r.length);
        return s[n];
    };
}

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

    iota(1, 11).map!ffr.writeln;
    auto t = iota(1, 41).map!ffr.chain(iota(1, 961).map!ffs);
    t.array.sort().equal(iota(1, 1001)).writeln;
}


(define (FFR n)
	(+ (FFR (1- n)) (FFS (1- n))))

(define (FFS n)
	(define next (1+ (FFS (1- n))))
	(for ((k (in-naturals next)))
		  #:break (not (vector-search* k (cache 'FFR))) => k
		  ))

(remember 'FFR #(0 1)) ;; init cache
(remember 'FFS #(0 2))


// Populate R and S with values of Hofstadter Figure Figure sequence. Nigel Galloway: August 28th., 2020
let fF q=let R,S=Array.zeroCreate<int>q,Array.zeroCreate<int>q
         R.[0]<-1;S.[0]<-2
         let rec fN n g=match n=q with true->(R,S)
                                      |_->R.[n]<-R.[n-1]+S.[n-1]
                                          match S.[n-1]+1 with i when i<>R.[g]->S.[n]<-i; fN (n+1) g
                                                              |i->S.[n]<-i+1; fN (n+1) (g+1)
         fN 1 1


SYMBOL: S  V{ 2 } S set
SYMBOL: R  V{ 1 } R set

: next ( s r -- news newr )
2dup [ last ] [email protected] + suffix
dup [
  [ dup last 1 + dup ] dip member? [ 1 + ] when suffix
] dip ;

: inc-SR ( n -- )
dup 0 <=
[ drop ]
[ [ S get R get ] dip  [ next ] times  R set S set ]
if ;

: ffs ( n -- S(n) )
dup S get length - inc-SR
1 - S get nth ;
: ffr ( n -- R(n) )
dup R get length - inc-SR
1 - R get nth ;


function ffr( n as integer ) as integer
    if n = 1 then return 1
    dim as integer i, j, r=1, s=1, v(1 to 2*n+1)
    v(1) = 1
    for i = 2 to n
        for j = s to 2*n
            if v(j) = 0 then exit for
        next j
        v(j) = 1
        s = j
        r += s
        if r <= 2*n then v(r) = 1
    next i
    return r
end function

function ffs( n as integer ) as integer
    if n = 1 then return 2
    dim as integer i, j, r=1, s=2, v(1 to 2*n+1)
    for i = 1 to n
        for j = s to 2*n
            if v(j) = 0 then exit for
        next j
        v(j) = 1
        s = j
        r += s
        if r <= 2*n then v(r) = 1
    next i
    return s
end function

dim as integer i
print " R"," S"
print
for i = 1 to 10
    print ffr(i), ffs(i)
next i

dim as boolean found(1 to 1000), failed
for i = 1 to 40
    found(ffr(i)) = true
next i
for i = 1 to 960
    found(ffs(i)) = true
next i
for i = 1 to 1000
    if found(i) = false then failed = true
next i

if failed then print "Oh no!" else print "All integers from 1 to 1000 accounted for"


package main

import "fmt"

var ffr, ffs func(int) int

// The point of the init function is to encapsulate r and s.  If you are
// not concerned about that or do not want that, r and s can be variables at
// package level and ffr and ffs can be ordinary functions at package level.
func init() {
    // task 1, 2
    r := []int{0, 1}
    s := []int{0, 2}

    ffr = func(n int) int {
        for len(r) <= n {
            nrk := len(r) - 1       // last n for which r(n) is known
            rNxt := r[nrk] + s[nrk] // next value of r:  r(nrk+1)
            r = append(r, rNxt)     // extend sequence r by one element
            for sn := r[nrk] + 2; sn < rNxt; sn++ {
                s = append(s, sn)   // extend sequence s up to rNext
            }
            s = append(s, rNxt+1)   // extend sequence s one past rNext
        }
        return r[n]
    }

    ffs = func(n int) int {
        for len(s) <= n {
            ffr(len(r))
        }
        return s[n]
    }
}

func main() {
    // task 3
    for n := 1; n <= 10; n++ {
        fmt.Printf("r(%d): %d\n", n, ffr(n))
    }
    // task 4
    var found [1001]int
    for n := 1; n <= 40; n++ {
        found[ffr(n)]++
    }
    for n := 1; n <= 960; n++ {
        found[ffs(n)]++
    }
    for i := 1; i <= 1000; i++ {
        if found[i] != 1 {
            fmt.Println("task 4: FAIL")
            return
        }
    }
    fmt.Println("task 4: PASS")
}


import Data.List (delete, sort)

-- Functions by Reinhard Zumkeller
ffr :: Int -> Int
ffr n = rl !! (n - 1)
  where
    rl = 1 : fig 1 [2 ..]
    fig n (x:xs) = n_ : fig n_ (delete n_ xs)
      where
        n_ = n + x

ffs :: Int -> Int
ffs n = rl !! n
  where
    rl = 2 : figDiff 1 [2 ..]
    figDiff n (x:xs) = x : figDiff n_ (delete n_ xs)
      where
        n_ = n + x

main :: IO ()
main = do
  print $ ffr <$> [1 .. 10]
  let i1000 = sort (fmap ffr [1 .. 40] ++ fmap ffs [1 .. 960])
  print (i1000 == [1 .. 1000])


link printf,ximage

procedure main()
   printf("Hofstader ff sequences R(n:= 1 to %d)\n",N := 10)
   every printf("R(%d)=%d\n",n := 1 to N,ffr(n))

   L := list(N := 1000,0)
   zero := dup := oob := 0
   every n := 1 to (RN := 40) do
      if not L[ffr(n)] +:= 1 then    # count R occurrence
         oob +:= 1                   # count out of bounds

   every n := 1 to (N-RN) do
      if not L[ffs(n)] +:= 1 then    # count S occurrence
         oob +:= 1                   # count out of bounds

   every zero +:= (!L = 0)           # count zeros / misses
   every dup  +:= (!L > 1)           # count > 1's / duplicates

   printf("Results of R(1 to %d) and S(1 to %d) coverage is ",RN,(N-RN))
   if oob+zero+dup=0 then
      printf("complete.\n")
   else
      printf("flawed\noob=%i,zero=%i,dup=%i\nL:\n%s\nR:\n%s\nS:\n%s\n",
             oob,zero,dup,ximage(L),ximage(ffr(ffr)),ximage(ffs(ffs)))
end

procedure ffr(n)
static R,S
initial {
   R := [1]
   S := ffs(ffs)               # get access to S in ffs
   }

   if n === ffr then return R  # secret handshake to avoid globals :)

   if integer(n) > 0 then
      return R[n] | put(R,ffr(n-1) + ffs(n-1))[n]
end

procedure ffs(n)
static R,S
initial {
   S := [2]
   R := ffr(ffr)               # get access to R in ffr
   }

   if n === ffs then return S  # secret handshake to avoid globals :)

   if integer(n) > 0 then {
      if S[n] then return S[n]
      else {
         t := S[*S]
         until *S = n do
            if (t +:= 1) = !R then next # could be optimized with more code
            else return put(S,t)[*S]    # extend S
         }
   }
end


import java.util.*;

class Hofstadter
{
  private static List<Integer> getSequence(int rlistSize, int slistSize)
  {
    List<Integer> rlist = new ArrayList<Integer>();
    List<Integer> slist = new ArrayList<Integer>();
    Collections.addAll(rlist, 1, 3, 7);
    Collections.addAll(slist, 2, 4, 5, 6);
    List<Integer> list = (rlistSize > 0) ? rlist : slist;
    int targetSize = (rlistSize > 0) ? rlistSize : slistSize;
    while (list.size() > targetSize)
      list.remove(list.size() - 1);
    while (list.size() < targetSize)
    {
      int lastIndex = rlist.size() - 1;
      int lastr = rlist.get(lastIndex).intValue();
      int r = lastr + slist.get(lastIndex).intValue();
      rlist.add(Integer.valueOf(r));
      for (int s = lastr + 1; (s < r) && (list.size() < targetSize); s++)
        slist.add(Integer.valueOf(s));
    }
    return list;
  }

  public static int ffr(int n)
  {  return getSequence(n, 0).get(n - 1).intValue();  }

  public static int ffs(int n)
  {  return getSequence(0, n).get(n - 1).intValue();  }

  public static void main(String[] args)
  {
    System.out.print("R():");
    for (int n = 1; n <= 10; n++)
      System.out.print(" " + ffr(n));
    System.out.println();

    Set<Integer> first40R = new HashSet<Integer>();
    for (int n = 1; n <= 40; n++)
      first40R.add(Integer.valueOf(ffr(n)));

    Set<Integer> first960S = new HashSet<Integer>();
    for (int n = 1; n <= 960; n++)
      first960S.add(Integer.valueOf(ffs(n)));

    for (int i = 1; i <= 1000; i++)
    {
      Integer n = Integer.valueOf(i);
      if (first40R.contains(n) == first960S.contains(n))
        System.out.println("Integer " + i + " either in both or neither set");
    }
    System.out.println("Done");
  }
}


var R = [null, 1];
var S = [null, 2];

var extend_sequences = function (n) {
	var current = Math.max(R[R.length-1],S[S.length-1]);
	var i;
	while (R.length <= n || S.length <= n) {
		i = Math.min(R.length, S.length) - 1;
		current += 1;
		if (current === R[i] + S[i]) {
			R.push(current);
		} else {
			S.push(current);
		}
	}
}

var ffr = function(n) {
	extend_sequences(n);
	return R[n];
};

var ffs = function(n) {
	extend_sequences(n);
	return S[n];
};

for (var i = 1; i <=10; i += 1) {
   console.log('R('+ i +') = ' + ffr(i));
}

var int_array = [];

for (var i = 1; i <= 40; i += 1) {
	int_array.push(ffr(i));
}
for (var i = 1; i <= 960; i += 1) {
	int_array.push(ffs(i));
}

int_array.sort(function(a,b){return a-b;});

for (var i = 1; i <= 1000; i += 1) {
	if (int_array[i-1] !== i) {
		throw "Something's wrong!"
	} else { console.log("1000 integer check ok."); }
}


def init: {r: [0, 1], s: [0, 2] };

# input: {r,s}
# output: {r,s,emit} where .emit is either null or the next R and where either .r or .s on output has been extended.
# .emit is provided in case an unbounded stream of R values is desired.
def extend_ff:
  (.r|length) as $rn
  | if .s[$rn - 1]
    then .emit = .r[$rn - 1] + .s[$rn - 1]
    | .r[$rn] = .emit
    | reduce range( [.r[$rn-1], .s[-1]] | max + 1; .r[$rn] ) as $i (.; .s += [$i] )
    else .emit = null
    | .s += [.r[$rn - 1] + 1]
    end;

def ffr($n):
  first(init | while(true; extend_ff) | select(.r[$n])).r[$n] ;

def ffs($n):
  first(init | while(true; extend_ff) | select(.s[$n])).s[$n] ;

def task1($n):
  "The first \($n) values of R are:",
  (init | until( .r | length > $n; extend_ff) | .r[1:]) ;

def task2:
  "The result of checking that the first 40 values of R and the first 960 of S together cover the interval [1,1000] is:",
  ( init | until( (.r|length) > 40 and (.s|length) > 960; extend_ff)
   | (.r[1:41] + .s[1:961] | sort) == [range(1;1001)] ) ;

task1(10), task2


type FigureFigure{T<:Integer}
    r::Array{T,1}
    rnmax::T
    snmax::T
    snext::T
end

function grow!{T<:Integer}(ff::FigureFigure{T}, rnmax::T=100)
    ff.rnmax < rnmax || return nothing
    append!(ff.r, zeros(T, (rnmax-ff.rnmax)))
    snext = ff.snext
    for i in (ff.rnmax+1):rnmax
        ff.r[i] = ff.r[i-1] + snext
        snext += 1
        while snext in ff.r
            snext += 1
        end
    end
    ff.rnmax = rnmax
    ff.snmax = ff.r[end] - rnmax
    ff.snext = snext
    return nothing
end

function FigureFigure{T<:Integer}(rnmax::T=10)
    ff = FigureFigure([1], 1, 0, 2)
    grow!(ff, rnmax)
    return ff
end

function FigureFigure{T<:Integer}(rnmax::T, snmax::T)
    ff = FigureFigure(rnmax)
    while ff.snmax < snmax
        grow!(ff, 2ff.rnmax)
    end
    return ff
end

function make_ffr{T<:Integer}(nmax::T=10)
    ff = FigureFigure(nmax)
    function ffr{T<:Integer}(n::T)
        if n > ff.rnmax
            grow!(ff, 2n)
        end
        ff.r[n]
    end
end

function make_ffs{T<:Integer}(nmax::T=100)
    ff = FigureFigure(13, nmax)
    function ffs{T<:Integer}(n::T)
        while ff.snmax < n
            grow!(ff, 2ff.rnmax)
        end
        s = n
        for r in ff.r
            r <= s || return s
            s += 1
        end
    end
end


fun ffr(n: Int) = get(n, 0)[n - 1]

fun ffs(n: Int) = get(0, n)[n - 1]

internal fun get(rSize: Int, sSize: Int): List<Int> {
    val rlist = arrayListOf(1, 3, 7)
    val slist = arrayListOf(2, 4, 5, 6)
    val list = if (rSize > 0) rlist else slist
    val targetSize = if (rSize > 0) rSize else sSize

    while (list.size > targetSize)
        list.removeAt(list.size - 1)
    while (list.size < targetSize) {
        val lastIndex = rlist.lastIndex
        val lastr = rlist[lastIndex]
        val r = lastr + slist[lastIndex]
        rlist += r
        var s = lastr + 1
        while (s < r && list.size < targetSize)
            slist += s++
    }
    return list
}

fun main(args: Array<String>) {
    print("R():")
    (1..10).forEach { print(" " + ffr(it)) }
    println()

    val first40R = (1..40).map { ffr(it) }
    val first960S = (1..960).map { ffs(it) }
    val indices = (1..1000).filter  { it in first40R == it in first960S }
    indices.forEach { println("Integer $it either in both or neither set") }
    println("Done")
}


   The instructions call for two functions.
   Because S[n] is generated while computing R[n], one would normally avoid redundancy by combining
   R and S into a single function that returns both sequences.


  function [R,S] = ffr_ffs(N)
    t = [1,0];
    T = 1;
    n = 1;
    %while T<=1000,
    while n<=N,
        R = find(t,n);
        S = find(~t,n);
        T = R(n)+S(n);

        % pre-allocate memory, this improves performance
	if T > length(t), t = [t,zeros(size(t))]; end;

        t(T) = 1;
        n = n + 1;
    end;
    if nargout>0,
      r = max(R);
      s = max(S);
    else
      printf('Sequence R:\n'); disp(R);
      printf('Sequence S:\n'); disp(S);
    end;
  end;


var cr = @[1]
var cs = @[2]

proc extendRS =
  let x = cr[cr.high] + cs[cr.high]
  cr.add x
  for y in cs[cs.high] + 1 ..< x: cs.add y
  cs.add x + 1

proc ffr(n: int): int =
  assert n > 0
  while n > cr.len: extendRS()
  cr[n - 1]

proc ffs(n: int): int =
  assert n > 0
  while n > cs.len: extendRS()
  cs[n - 1]

for i in 1..10: stdout.write ffr i," "
echo ""

var bin: array[1..1000, int]
for i in 1..40: inc bin[ffr i]
for i in 1..960: inc bin[ffs i]
var all = true
for x in bin:
  if x != 1:
    all = false
    break

if all: echo "All Integers 1..1000 found OK"
else: echo "All Integers 1..1000 NOT found only once: ERROR"


tvar: R
ListBuffer new 1 over add R put

tvar: S
ListBuffer new 2 over add S put

: buildnext
| r s current i |
   R at ->r
   S at ->s
   r last  r size s at  + dup ->current  r add
   s last 1+  current 1-  for: i [ i s add ]
   current 1+ s add ;

: ffr(n)
   while ( R at size n < ) [ buildnext ]
   n R at at ;

: ffs(n)
   while ( S at size n < ) [ buildnext ]
   n S at at ;


#!perl
use strict;
use warnings;

my @r = ( undef, 1 );
my @s = ( undef, 2 );

sub ffsr {
  my $n = shift;
  while( $#r < $n ) {
    push @r, $s[$#r]+$r[-1];
    push @s, grep { $s[-1]<$_ } $s[-1]+1..$r[-1]-1, $r[-1]+1;
  }
  return $n;
}

sub ffr { $r[ffsr shift] }
sub ffs { $s[ffsr shift] }

printf "  i: R(i) S(i)\n";
printf "==============\n";
printf "%3d:  %3d  %3d\n", $_, ffr($_), ffs($_) for 1..10;
printf "\nR(40)=%3d S(960)=%3d R(41)=%3d\n", ffr(40), ffs(960), ffr(41);

my %seen;
$seen{ffr($_)}++ for 1 .. 40;
$seen{ffs($_)}++ for 1 .. 960;
if( 1000 == keys %seen and grep $seen{$_}, 1 .. 1000 ) {
	print "All occured exactly once.\n";
} else {
	my @missed = grep !$seen{$_}, 1 .. 1000;
	my @dupped = sort { $a <=> $b} grep $seen{$_}>1, keys %seen;
	print "These were missed: @missed\n";
	print "These were duplicated: @dupped\n";
}


with javascript_semantics
sequence F = {1,3,7},
         S = {2,4,5,6}
integer fmax = 3 -- (ie F[3], ==7, already in S)

forward function ffs(integer n)

function ffr(integer n)
    integer l = length(F)
    while n>l do
        F &= F[l]+ffs(l)
        l += 1
    end while
    return F[n]
end function

function ffs(integer n)
    while n>length(S) do
        fmax += 1
        if fmax>length(F) then {} = ffr(fmax) end if
        S &= tagset(lim:=F[fmax]-1,start:=F[fmax-1]+1)
        -- ie/eg if fmax was 3, then F[2..3] being {3,7}
        --       ==> tagset(lim:=6,start:=4), ie {4,5,6}.
    end while
    return S[n]
end function

{} = ffr(10)    -- (or collect one by one)
printf(1,"The first ten values of R: %v\n",{F[1..10]})
{} = ffr(40)    -- (not actually needed)
{} = ffs(960)
if sort(F[1..40]&S[1..960])=tagset(1000) then
    puts(1,"test passed\n")
else
    puts(1,"some error!\n")
end if


(setq *RNext 2)

(de ffr (N)
   (cache '(NIL) N
      (if (= 1 N)
         1
         (+ (ffr (dec N)) (ffs (dec N))) ) ) )

(de ffs (N)
   (cache '(NIL) N
      (if (= 1 N)
         2
         (let S (inc (ffs (dec N)))
            (when (= S (ffr *RNext))
               (inc 'S)
               (inc '*RNext) )
            S ) ) ) )


ffr: procedure (n) returns (fixed binary(31));
   declare n fixed binary (31);
   declare v(2*n+1) bit(1);
   declare (i, j) fixed binary (31);
   declare (r, s) fixed binary (31);

   v = '0'b;
   v(1) = '1'b;

   if n = 1 then return (1);

   r = 1;
   do i = 2 to n;
      do j = 2 to 2*n;
         if v(j) = '0'b then leave;
      end;
      v(j) = '1'b;
      s = j;
      r = r + s;
      if r <= 2*n then v(r) = '1'b;
   end;
   return (r);
end ffr;


:- use_module(library(chr)).

:- chr_constraint ffr/2, ffs/2, hofstadter/1,hofstadter/2.
:- chr_option(debug, off).
:- chr_option(optimize, full).

% to remove duplicates
ffr(N, R1) \ ffr(N, R2) <=> R1 = R2 | true.
ffs(N, R1) \ ffs(N, R2) <=> R1 = R2 | true.

% compute ffr
ffr(N, R), ffr(N1, R1), ffs(N1,S1) ==>
         N > 1, N1 is N - 1 |
	 R is R1 + S1.

% compute ffs
ffs(N, S), ffs(N1,S1) ==>
         N > 1, N1 is N - 1 |
	 V is S1 + 1,
	 (   find_chr_constraint(ffr(_, V)) ->  S is V+1; S = V).

% init
hofstadter(N) ==>  ffr(1,1), ffs(1,2).
% loop
hofstadter(N), ffr(N1, _R), ffs(N1, _S) ==> N1 < N, N2 is N1 +1 |  ffr(N2,_), ffs(N2,_).


def ffr(n):
    if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1")
    try:
        return ffr.r[n]
    except IndexError:
        r, s = ffr.r, ffs.s
        ffr_n_1 = ffr(n-1)
        lastr = r[-1]
        # extend s up to, and one past, last r
        s += list(range(s[-1] + 1, lastr))
        if s[-1] < lastr: s += [lastr + 1]
        # access s[n-1] temporarily extending s if necessary
        len_s = len(s)
        ffs_n_1 = s[n-1] if len_s > n else (n - len_s) + s[-1]
        ans = ffr_n_1 + ffs_n_1
        r.append(ans)
        return ans
ffr.r = [None, 1]

def ffs(n):
    if n < 1 or type(n) != int: raise ValueError("n must be an int >= 1")
    try:
        return ffs.s[n]
    except IndexError:
        r, s = ffr.r, ffs.s
        for i in range(len(r), n+2):
            ffr(i)
            if len(s) > n:
                return s[n]
        raise Exception("Whoops!")
ffs.s = [None, 2]

if __name__ == '__main__':
    first10 = [ffr(i) for i in range(1,11)]
    assert first10 == [1, 3, 7, 12, 18, 26, 35, 45, 56, 69], "ffr() value error(s)"
    print("ffr(n) for n = [1..10] is", first10)
    #
    bin = [None] + [0]*1000
    for i in range(40, 0, -1):
        bin[ffr(i)] += 1
    for i in range(960, 0, -1):
        bin[ffs(i)] += 1
    if all(b == 1 for b in bin[1:1000]):
        print("All Integers 1..1000 found OK")
    else:
        print("All Integers 1..1000 NOT found only once: ERROR")


rValues <- 1
sValues <- 2
ffr <- function(n)
{
  if(!is.na(rValues[n])) rValues[n] else (rValues[n] <<- ffr(n-1) + ffs(n-1))
}

#In theory, generating S requires computing ALL values not in R.
#That would be infinitely many values.
#However, to generate S(n) we only need to observe that its value cannot exceed R(n)+1.
ffs <- function(n)
{
  if(!is.na(sValues[n])) sValues[n] else (sValues[n] <<- setdiff(seq_len(1 + ffr(n)), rValues)[n])
}

#Task 1
invisible(ffr(10))
print(rValues)

#Task 2
#If we try to call ffs(960) directly, R will complain about the stack being too big.
#Calling ffs(500) first solves this problem.
invisible(ffs(500))
invisible(ffs(960))
#In R, "the first 40 values of ffr plus the first 960 values of ffs" can easily be misread.
#rValues[1:40]+sValues[1:960] is valid R code. It will duplicate the first 40 rValues 23
#times, append them to the original, and add that vector to the first 960 sValues.
This gives an output of length 960, which clearly cannot contain 1000 different values.
#Presumably, the task wants us to append rValues[1:40] and sValues[1:960].
print(table(c(rValues[1:40], sValues[1:960])))


#lang racket/base

(define r-cache (make-hash '((1 . 1) (2 . 3) (3 . 7))))
(define s-cache (make-hash '((1 . 2) (2 . 4) (3 . 5) (4 . 6))))

(define (extend-r-s!)
  (define r-count (hash-count r-cache))
  (define s-count (hash-count s-cache))
  (define last-r (ffr r-count))
  (define new-r (+ (ffr r-count) (ffs r-count)))
  (hash-set! r-cache (add1 r-count) new-r)
  (define offset (- s-count last-r))
  (for ([val (in-range (add1 last-r) new-r)])
    (hash-set! s-cache (+ val offset) val)))


/*REXX program  calculates and verifies  the  Hofstadter Figure─Figure sequences.       */
parse arg x top bot .                            /*obtain optional arguments from the CL*/
if   x=='' |   x==","  then   x=  10             /*Not specified?  Then use the default.*/
if top=='' | top==","  then top=1000             /* "      "         "   "   "      "   */
if bot=='' | bot==","  then bot=  40             /* "      "         "   "   "      "   */
low=1;         if x<0  then low=abs(x)           /*only display a  single   │X│  value? */
r.=0;  r.1=1;  rr.=r.;  rr.1=1;   s.=r.;  s.1=2  /*initialize the  R, RR, and S  arrays.*/
errs=0                                           /*the number of errors found  (so far).*/
             do i=low  to abs(x)                 /*display the 1st  X  values of  R & S.*/
             say right('R('i") =",20) right(FFR(i),7) right('S('i") =",20) right(FFS(i),7)
             end   /*i*/
                                                 /* [↑]  list the 1st X Fig─Fig numbers.*/
if x<1  then exit                                /*if X isn't positive, then we're done.*/
$.=0                                             /*initialize the memoization ($) array.*/
             do m=1  for  bot;  r=FFR(m);  $.r=1 /*calculate the first forty  R  values.*/
             end   /*m*/                         /* [↑]  ($.)  is used for memoization. */
                                                 /* [↓]  check for duplicate #s in R & S*/
             do n=1  for top-bot;     s=FFS(n)   /*calculate the value of  FFS(n).      */
             if $.s  then call ser 'duplicate number in R and S lists:' s;   $.s=1
             end   /*n*/                         /* [↑]  calculate the 1st 960 S values.*/
                                                 /* [↓]  check for missing values in R│S*/
             do v=1  for top;  if \$.v  then  call ser     'missing R │ S:'    v
             end   /*v*/                         /* [↑]  are all 1≤ numbers ≤1k present?*/
say
if errs==0  then say 'verification completed for all numbers from  1 ──►' top "  [inclusive]."
            else say 'verification failed with'      errs      "errors."
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
FFR: procedure expose r. rr. s.; parse arg n     /*obtain the number from the arguments.*/
     if r.n\==0  then return r.n                 /*R.n  defined?  Then return the value.*/
     _=FFR(n-1) + FFS(n-1)                       /*calculate the  FFR  and  FFS  values.*/
     r.n=_;       rr._=1;        return _        /*assign the value to R & RR;   return.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
FFS: procedure expose r. s. rr.; parse arg n     /*search for not null  R or S  number. */
     if s.n==0  then do k=1  for n               /* [↓]  1st  IF  is a  SHORT CIRCUIT.  */
                     if s.k\==0  then if r.k\==0  then iterate       /*are both defined?*/
                     call FFR k                  /*define  R.k  via the  FFR  subroutine*/
                     km=k-1;     _=s.km+1        /*calc. the next  S  number,  possibly.*/
                     _=_+rr._;   s.k=_           /*define an element of  the  S  array. */
                     end   /*k*/
     return s.n                                  /*return   S.n   value to the invoker. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
ser: errs=errs+1;    say  '***error***'  arg(1);                  return


# Project : Hofstadter Figure-Figure sequences

hofr = list(20)
hofr[1] = 1
hofs = []
add(hofs,2)
for n = 1 to 10
      hofr[n+1] = hofr[n] + hofs[n]
      if n = 1
         add(hofs,4)
      else
         for p = hofr[n] + 1 to hofr[n+1] - 1
               if p != hofs[n]
                  add(hofs,p)
               ok
         next
      ok
next
see "First 10 values of R:" + nl
showarray(hofr)
see "First 10 values of S:" + nl
showarray(hofs)

func showarray(vect)
         svect = ""
        for n = 1 to 10
              svect = svect + vect[n] + " "
        next
        svect = left(svect, len(svect) - 1)
        see svect + nl


$r = [nil, 1]
$s = [nil, 2]

def buildSeq(n)
  current = [ $r[-1], $s[-1] ].max
  while $r.length <= n || $s.length <= n
    idx = [ $r.length, $s.length ].min - 1
    current += 1
    if current == $r[idx] + $s[idx]
      $r << current
    else
      $s << current
    end
  end
end

def ffr(n)
  buildSeq(n)
  $r[n]
end

def ffs(n)
  buildSeq(n)
  $s[n]
end

require 'set'
require 'test/unit'

class TestHofstadterFigureFigure < Test::Unit::TestCase
  def test_first_ten_R_values
    r10 = 1.upto(10).map {|n| ffr(n)}
    assert_equal(r10, [1, 3, 7, 12, 18, 26, 35, 45, 56, 69])
  end

  def test_40_R_and_960_S_are_1_to_1000
    rs_values = Set.new
    rs_values.merge( 1.upto(40).collect  {|n| ffr(n)} )
    rs_values.merge( 1.upto(960).collect {|n| ffs(n)} )
    assert_equal(rs_values, Set.new( 1..1000 ))
  end
end


use std::collections::HashMap;

struct Hffs {
    sequence_r: HashMap<usize, usize>,
    sequence_s: HashMap<usize, usize>,
}

impl Hffs {
    fn new() -> Hffs {
        Hffs {
            sequence_r: HashMap::new(),
            sequence_s: HashMap::new(),
        }
    }
    fn ffr(&mut self, n: usize) -> usize {
        // first try the cache
        let new_r = if let Some(result) = self.sequence_r.get(&n) {
            *result
        } else if n == 0 {
            1
        } else {
            // call recursively
            self.ffr(n - 1) + self.ffs(n - 1)
        };

        // insert into the cache and return value
        *self.sequence_r.entry(n).or_insert(new_r)
    }

    fn ffs(&mut self, n: usize) -> usize {
        // first try the cache
        let new_s = if let Some(result) = self.sequence_s.get(&n) {
            *result
        } else if n == 0 {
            2
        } else {
            let lower = self.ffs(n - 1) + 1_usize;
            let upper = self.ffr(n) + 1_usize;
            let mut min_s: usize = 0;
            // find next available S
            for i in lower..=upper {
                if !self.sequence_r.values().any(|&val| val == i) {
                    min_s = i;
                    break;
                }
            }
            min_s
        };

        // insert into the cache and return value
        *self.sequence_s.entry(n).or_insert(new_s)
    }
}

impl Default for Hffs {
    fn default() -> Self {
        Self::new()
    }
}
fn main() {
    let mut hof = Hffs::new();

    for i in 0..10 {
        println!("H:{} -> R: {}, S: {}", i, hof.ffr(i), hof.ffs(i));
    }

    let r40 = (0..40).map(|i| hof.ffr(i)).collect::<Vec<_>>();
    let mut s960 = (0..960).map(|i| hof.ffs(i)).collect::<Vec<_>>();

    s960.extend(&r40);
    s960.sort_unstable();
    let f1000 = (1_usize..=1000).collect::<Vec<_>>();

    assert_eq!(f1000, s960, "Does NOT match");
}


object HofstadterFigFigSeq extends App {
  import scala.collection.mutable.ListBuffer

  val r = ListBuffer(0, 1)
  val s = ListBuffer(0, 2)

  def ffr(n: Int): Int = {
    val ffri: Int => Unit = i => {
      val nrk = r.size - 1
      val rNext = r(nrk)+s(nrk)
      r += rNext
      (r(nrk)+2 to rNext-1).foreach{s += _}
      s += rNext+1
    }

    (r.size to n).foreach(ffri(_))
    r(n)
  }

  def ffs(n:Int): Int = {
    while (s.size <= n) ffr(r.size)
    s(n)
  }

  (1 to 10).map(i=>(i,ffr(i))).foreach(t=>println("r("+t._1+"): "+t._2))
  println((1 to 1000).toList.filterNot(((1 to 40).map(ffr(_))++(1 to 960).map(ffs(_))).contains)==List())
}


var r = [nil, 1]
var s = [nil, 2]

func ffsr(n) {
  while(r.end < n) {
    r << s[r.end]+r[-1]
    s << [(s[-1]+1 .. r[-1]-1)..., r[-1]+1].grep{ s[-1] < _ }...
  }
  return n
}

func ffr(n) { r[ffsr(n)] }
func ffs(n) { s[ffsr(n)] }

printf("  i: R(i) S(i)\n")
printf("==============\n")
{ |i|
    printf("%3d:  %3d  %3d\n", i, ffr(i), ffs(i))
} << 1..10
printf("\nR(40)=%3d S(960)=%3d R(41)=%3d\n", ffr(40), ffs(960), ffr(41))

var seen = Hash()

{|i| seen{ffr(i)} := 0 ++ } << 1..40
{|i| seen{ffs(i)} := 0 ++ } << 1..960

if (seen.count {|k,v| (k.to_i >= 1) && (k.to_i <= 1000) && (v == 1) } == 1000) {
    say "All occured exactly once."
}
else {
    var missed = { !seen.has_key(_) }.grep(1..1000)
    var dupped = seen.grep { |_, v| v > 1 }.keys.sort
    say "These were missed: #{missed}"
    say "These were duplicated: #{dupped}"
}


package require Tcl 8.5
package require struct::set

# Core sequence generator engine; stores in $R and $S globals
set R {R:-> 1}
set S {S:-> 2}
proc buildSeq {n} {
    global R S
    set ctr [expr {max([lindex $R end],[lindex $S end])}]
    while {[llength $R] <= $n || [llength $S] <= $n} {
	set idx [expr {min([llength $R],[llength $S]) - 1}]
	if {[incr ctr] == [lindex $R $idx]+[lindex $S $idx]} {
	    lappend R $ctr
	} else {
	    lappend S $ctr
	}
    }
}

# Accessor procedures
proc ffr {n} {
    buildSeq $n
    lindex $::R $n
}
proc ffs {n} {
    buildSeq $n
    lindex $::S $n
}

# Show some things about the sequence
for {set i 1} {$i <= 10} {incr i} {
    puts "R($i) = [ffr $i]"
}
puts "Considering {1..1000} vs {R(i)|i\u2208\[1,40\]}\u222a{S(i)|i\u2208\[1,960\]}"
for {set i 1} {$i <= 1000} {incr i} {lappend numsInSeq $i}
for {set i 1} {$i <= 40} {incr i} {
    lappend numsRS [ffr $i]
}
for {set i 1} {$i <= 960} {incr i} {
    lappend numsRS [ffs $i]
}
puts "set sizes: [struct::set size $numsInSeq] vs [struct::set size $numsRS]"
puts "set equality: [expr {[struct::set equal $numsInSeq $numsRS]?{yes}:{no}}]"


Proc _SetBitR(1)                       ' Set the first R value
Proc _SetBitS(2)                       ' Set the first S value

Print "Creating bitmap, wait.."        ' Create the bitmap
Proc _MakeBitMap
Print

Print "R(1 .. 10):";                   ' Print first 10 R-values

For x = 1 To 10
  Print " ";FUNC(_Rx(x));
Next

Print : Print "S(1 .. 10):";           ' Print first 10 S-values

For x = 1 To 10
  Print " ";FUNC(_Sx(x));
Next

Print : Print                          ' Terminate and skip line

For x = 0 To (1000/31)                 ' Check the first 1000 values
  Print "Checking ";(x*31)+1;" to ";(x*31)+31;":\t";
  If XOR(@(x), @(x+64)) = 2147483647 Then
     Print "OK"                        ' XOR R() and S() ranges
  Else                                 ' should deliver MAX-N
     Print "Fail!"                     ' or we did have an error
  EndIf
Next

For x = 1 to 40                        ' Prove there are only 40 R(x) values
  If FUNC(_Rx(x)) > 1000 Then Print "R(";x;") value greater than 1000"
Next                                   ' below 1000

If FUNC(_Rx(x)) < 1001 Then Print "R(";x;") value also below 1000"
End

_MakeBitMap                            ' Create the bitmap
  Local (4)

  [email protected] = 1                               ' Previous R(x) level
  [email protected] = 1                               ' Previous R(x) value

  Do Until [email protected] > (1000/31)*32           ' Fill up an entire array element
                                       ' calculate R(x+1) level
    [email protected] = FUNC(_Rx([email protected])) + FUNC(_Sx([email protected]))
    Proc _SetBitR ([email protected])                 ' Set R(x+1) in the bitmap

    For [email protected] = [email protected] + 1 To [email protected] - 1          ' Set all intermediate S() values
      Proc _SetBitS ([email protected])               ' between R(x) and R(x+1)
    Next

    Proc _SetBitS ([email protected]+1)               ' Number after R(x) is always S()
    [email protected] = [email protected]                            ' R(x+1) now becomes R(x)
    [email protected] = [email protected] + 1                        ' Increment level
  Loop                                 ' Now do it again
Return

_Rx Param(1)                           ' Return value R(x)
  Local(2)

  [email protected] = 0                               ' No value found so far

  For [email protected] = 1 To (64*31)-1              ' Check the entire bitmap
    If (FUNC(_GetBitR([email protected]))) Then [email protected] = [email protected] + 1
    Until [email protected] = [email protected]                      ' If a value found, increment counter
  Next                                 ' Until the required level is reached
Return ([email protected])                            ' Return position in bitmap

_Sx Param(1)                           ' Return value S(x)
  Local(2)

  [email protected] = 0                               ' No value found so far

  For [email protected] = 1 To (64*31)-1              ' Check the entire bitmap
    If (FUNC(_GetBitS([email protected]))) Then [email protected] = [email protected] + 1
    Until [email protected] = [email protected]                      ' If a value found, increment counter
  Next                                 ' Until the required level is reached
Return ([email protected])                            ' Return position in bitmap

_SetBitR Param(1)                      ' Set bit n-1 in R-bitmap
  [email protected] = [email protected] - 1
  @([email protected]/31) = OR(@([email protected]/31), SHL(1,[email protected]%31))
Return

_GetBitR Param(1)                      ' Return bit n-1 in R-bitmap
  [email protected] = [email protected] - 1
Return (AND(@([email protected]/31), SHL(1,[email protected]%31))#0)

_SetBitS Param(1)                      ' Set bit n-1 in S-bitmap
  [email protected] = [email protected] - 1
  @([email protected]/31) = OR(@([email protected]/31), SHL(1,[email protected]%31))
Return

_GetBitS Param(1)                      ' Return bit n-1 in S-bitmap
  [email protected] = [email protected] - 1
Return (AND(@([email protected]/31), SHL(1,[email protected]%31))#0)


Private Function ffr(n As Long) As Long
    Dim R As New Collection
    Dim S As New Collection
    R.Add 1
    S.Add 2
    'return R(n)
    For i = 2 To n
        R.Add R(i - 1) + S(i - 1)
        For j = S(S.Count) + 1 To R(i) - 1
            S.Add j
        Next j
        For j = R(i) + 1 To R(i) + S(i - 1)
            S.Add j
        Next j
    Next i
    ffr = R(n)
    Set R = Nothing
    Set S = Nothing
End Function
Private Function ffs(n As Long) As Long
    Dim R As New Collection
    Dim S As New Collection
    R.Add 1
    S.Add 2
    'return S(n)
    For i = 2 To n
        R.Add R(i - 1) + S(i - 1)
        For j = S(S.Count) + 1 To R(i) - 1
            S.Add j
        Next j
        For j = R(i) + 1 To R(i) + S(i - 1)
            S.Add j
        Next j
        If S.Count >= n Then Exit For
    Next i
    ffs = S(n)
    Set R = Nothing
    Set S = Nothing
End Function
Public Sub main()
    Dim i As Long
    Debug.Print "The first ten values of R are:"
    For i = 1 To 10
        Debug.Print ffr(i);
    Next i
    Debug.Print
    Dim x As New Collection
    For i = 1 To 1000
        x.Add i, CStr(i)
    Next i
    For i = 1 To 40
        x.Remove CStr(ffr(i))
    Next i
    For i = 1 To 960
        x.Remove CStr(ffs(i))
    Next i
    Debug.Print "The first 40 values of ffr plus the first 960 values of ffs "
    Debug.Print "include all the integers from 1 to 1000 exactly once is "; Format(x.Count = 0)
End Sub


'Initialize the r and the s arrays.
Set r = CreateObject("System.Collections.ArrayList")
Set s = CreateObject("System.Collections.ArrayList")

'Set initial values of r.
r.Add ""  : r.Add 1

'Set initial values of s.
s.Add "" : s.Add 2

'Populate the r and the s arrays.
For i = 2 To 1000
	ffr(i)
	ffs(i)
Next

'r function
Function ffr(n)
	r.Add r(n-1)+s(n-1)
End Function

's function
Function ffs(n)
	'index is the value of the last element of the s array.
	index = s(n-1)+1
	Do
                'Add to s if the current index is not in the r array.
		If r.IndexOf(index,0) = -1 Then
			s.Add index
			Exit Do
		Else
			index = index + 1
		End If
	Loop
End Function

'Display the first 10 values of r.
WScript.StdOut.Write "First 10 Values of R:"
WScript.StdOut.WriteLine
For j = 1 To 10
	If j = 10 Then
		WScript.StdOut.Write "and " & r(j)
	Else
		WScript.StdOut.Write r(j) & ", "
	End If
Next
WScript.StdOut.WriteBlankLines(2)

'Show that the first 40 values of r plus the first 960 values of s include all the integers from 1 to 1000 exactly once.
'The idea here is to create another array(integer) with 1000 elements valuing from 1 to 1000. Go through the first 40 values
'of the r array and remove the corresponding element in the integer array.  Do the same thing with the first 960 values of
'the s array.  If the resultant count of the integer array is 0 then it is a pass.
Set integers = CreateObject("System.Collections.ArrayList")
For k = 1 To 1000
	integers.Add k
Next
For l = 1 To 960
	If l <= 40 Then
		integers.Remove(r(l))
	End If
	integers.Remove(s(l))
Next
WScript.StdOut.Write "Test for the first 1000 integers: "
If integers.Count = 0 Then
	WScript.StdOut.Write "Passed!!!"
	WScript.StdOut.WriteLine
Else
	WScript.StdOut.Write "Miserably Failed!!!"
	WScript.StdOut.WriteLine
End If


var r = [0, 1]
var s = [0, 2]

var ffr = Fn.new { |n|
    while (r.count <= n) {
        var nrk = r.count - 1         // last n for which r[n] is known
        var rNxt = r[nrk] + s[nrk]    // r[nrk+1]
        r.add(rNxt)                   // extend r by one element
        for (sn in r[nrk]+2...rNxt) {
            s.add(sn)                 // extend sequence s up to rNxt
        }
        s.add(rNxt + 1)               // extend sequence s one past rNxt
    }
    return r[n]
}

var ffs = Fn.new { |n|
    while (s.count <= n) ffr.call(r.count)
    return s[n]
}

System.print("The first 10 values of R are:")
for (i in 1..10) System.write(" %(ffr.call(i))")
System.print()
var present = List.filled(1001, false)
for (i in 1..40)  present[ffr.call(i)] = true
for (i in 1..960) present[ffs.call(i)] = true
var allPresent = present.skip(1).all { |i| i == true }
System.print("\nThe first 40 values of ffr plus the first 960 values of ffs")
System.print("includes all integers from 1 to 1000 exactly once is %(allPresent).")


fcn genRS(reset=False){ //-->(n,R,S)
  var n=0, Rs=L(0,1), S=2;
  if(True==reset){ n=0; Rs=L(0,1); S=2; return(); }

  if (n==0) return(n=1,1,2);
  R:=Rs[-1] + S; Rs.append(R);
  foreach s in ([S+1..]){
     if(not Rs.holds(s)) { S=s; break; } // trimming Rs doesn't save space
  }
  return(n+=1,R,S);
}
fcn ffrs(n) { genRS(True); do(n){ n=genRS() } n[1,2] }  //-->( R(n),S(n) )


.equ STDERR, 2
.equ SVC_WRITE, 64
.equ SVC_EXIT, 93

.text
.global _start

_start:
	stp x29, x30, [sp, -16]!
	mov x0, #STDERR
	ldr x1, =msg
	mov x2, 15
	mov x8, #SVC_WRITE
	mov x29, sp
	svc #0 // write(stderr, msg, 15);
	ldp x29, x30, [sp], 16
	mov x0, #0
	mov x8, #SVC_EXIT
	svc #0 // exit(0);

msg:	.ascii "Goodbye World!\n"


with Ada.Text_IO;  use Ada.Text_IO;

procedure Goodbye_World is
begin
   Put_Line (Standard_Error, "Goodbye, World!");
end Goodbye_World;


io.write( io.stderr, "Goodbye, World!\n" )


main:(
  put(stand error, ("Goodbye, World!", new line))
)


/* ARM assembly Raspberry PI  */
/*  program hellowordLP.s   */
.data
szMessage: .asciz "Goodbye world. \n "       @ error message
.equ LGMESSAGE, . -  szMessage  @ compute length of message

.text
.global main
main:
    mov r0, #2                  @ output error linux
    ldr r1, iAdrMessage         @ adresse of message
    mov r2, #LGMESSAGE          @ sizeof(message)
    mov r7, #4                  @ select system call 'write'
    swi #0                      @ perform the system call

    mov r0, #0                  @ return code
    mov r7, #1                  @ request to exit program
    swi #0                       @ perform the system call
iAdrMessage: .int szMessage


implement main0 () = fprint (stderr_ref, "Goodbye, World!\n")


; c:\>  autohotkey.exe stderr.ahk 2> error.txt
FileAppend, Goodbye`, World!, stderr   ; requires AutoHotkey_N


ConsoleWriteError("Goodbye, World!" & @CRLF)


BEGIN {
  print "Goodbye, World!"| "cat 1>&2"
}


ON ERROR GOTO ManejoErrores
ERROR 99
END

ManejoErrores:
  PRINT "Googbye World!"
  RESUME


      STD_ERROR_HANDLE = -12
      SYS "GetStdHandle", STD_ERROR_HANDLE TO @hfile%(1)
      PRINT #13, "Goodbye, World!"
      QUIT


import io
io.stderr.write('Goodbye, World!')


#include <stdio.h>

int main()
{
	fprintf(stderr, "Goodbye, ");
	fputs("World!\n", stderr);

	return 0;
}


static class StdErr
{
    static void Main(string[] args)
    {
        Console.Error.WriteLine("Goodbye, World!");
    }
}


#include <iostream>

int main() {
  std::cerr << "Goodbye, World!\n";
}


(binding [*out* *err*]
  (println "Goodbye, world!"))


start_up = proc ()
    stream$putl(stream$error_output(), "Goodbye, World!")
end start_up


	program-id. ehello.
	procedure division.
		display "Goodbye, world!"  upon syserr.
		stop run.


(format *error-output* "Goodbye, world!~%")


import std.stdio;

void main () {
    stderr.writeln("Goodbye, World!");
}


import 'dart:io';

void main() {
  stderr.writeln('Goodbye, World!');
}


program Project1;

{$APPTYPE CONSOLE}

begin
  WriteLn(ErrOutput, 'Goodbye, World!');
end.


puts(2,"Goodbye, world!\n") -- 2 means output to 'standard error'


error-stream get [ "Goodbye, World! bbl, crashing" print flush ] with-output-stream*


class Main
{
  public static Void main ()
  {
    Env.cur.err.printLine ("Goodbye, World!")
  }
}


outfile-id
  stderr to outfile-id
  ." Goodbye, World!" cr
to outfile-id


program StdErr
  ! Fortran 2003
  use iso_fortran_env

  ! in case there's no module iso_fortran_env ...
  !integer, parameter :: ERROR_UNIT = 0

  write (ERROR_UNIT, *) "Goodbye, World!"
end program StdErr


' FB 1.05.0 Win64

Open Err As #1
Print #1, "Goodbye World!"
Close #1
Sleep


[indent=4]
/*
  Hello, to Standard error, in Genie
  valac helloStderr.gs
*/

init
    stderr.printf("%s\n", "Goodbye, World!")


package main
func main() { println("Goodbye, World!") }


import System.IO
main = hPutStrLn stderr "Goodbye, World!"


#! /bin/sh
exec huginn --no-argv -E "${0}" "${@}"
#! huginn

import OperatingSystem as os;

main() {
	os.stderr().write( "Goodbye, World!\n" );
	return ( 0 );
}


procedure main()
  write(&errout, "Goodbye World" )
end


stderr =: 1!:2&4
stderr 'Goodbye, World!'


public class Err{
   public static void main(String[] args){
      System.err.println("Goodbye, World!");
   }
}


jq -n —-arg s 'Goodbye, World!' '$s | stderr | empty'


fun main(args: Array<String>) {
    System.err.println("Goodbye, World!")
}


define stderr(s::string) => {
    file_stderr->writeBytes(#s->asBytes)
}

stderr('Goodbye, World!')


-- print to standard error
stdErr("Goodbye, World!", TRUE)

-- print to the Windows debug console (shown in realtime e.g. in Systernal's DebugView)
dbgPrint("Goodbye, World!")


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

; Additional comments have been inserted, as well as changes made from the output produced by clang such as putting more meaningful labels for the jumps

%struct._iobuf = type { i8* }

$"message" = comdat any
@"message" = linkonce_odr unnamed_addr constant [17 x i8] c"Goodbye, world!\0A\00", comdat, align 1

;-- For discovering stderr (io pipe 2)
declare %struct._iobuf* @__acrt_iob_func(i32)

;--- The declaration for the external C fprintf function.
declare i32 @fprintf(%struct._iobuf*, i8*, ...)

define i32 @main() {
;-- load stderr
  %1 = call %struct._iobuf* @__acrt_iob_func(i32 2)
;-- print the message to stderr with fprintf
  %2 = call i32 (%struct._iobuf*, i8*, ...) @fprintf(%struct._iobuf* %1, i8* getelementptr inbounds ([17 x i8], [17 x i8]* @"message", i32 0, i32 0))
;-- exit
  ret i32 0
}


:- object(error_message).

    % the initialization/1 directive argument is automatically executed
    % when the object is compiled and loaded into memory:
    :- initialization(write(user_error, 'Goodbye, World!\n')).

:- end_object.


{{extern "manool.org.18/std/0.3/all"} in Err.WriteLine["Goodbye, World!"]}


:- module hello_error.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.

main(!IO) :-
    io.stderr_stream(Stderr, !IO),
    io.write_string(Stderr, "Goodbye, World!\n", !IO).


errmessage "Error";
message "...going on..."; % if the user decides to go on and not to stop
                          % the program because of the error.


MODULE HelloErr;
IMPORT StdError;

BEGIN
  StdError.WriteString('Goodbye, World!');
  StdError.WriteLn
END HelloErr.


MODULE Stderr EXPORTS Main;

IMPORT Wr, Stdio;

BEGIN
  Wr.PutText(Stdio.stderr, "Goodbye, World!\n");
END Stderr.


/**
  Hello world, to standard error, in Neko
  Tectonics:
    nekoc hello-stderr.neko
    neko hello-stderr
*/

/* Assume stderr is already open, just need write */
var file_write = $loader.loadprim("[email protected]_write", 4);

/* Load (and execute) the file_stderr primitive */
var stderr = $loader.loadprim("[email protected]_stderr", 0)();

file_write(stderr, "Goodbye, World!\n", 0, 16);


/* NetRexx */

options replace format comments java crossref savelog symbols binary

System.err.println("Goodbye, World!")


MODULE HelloErr;
IMPORT Err;
BEGIN
	Err.String("Goodbye, World!");Err.Ln
END HelloErr.


#import <Foundation/Foundation.h>

int main()
{
   fprintf(stderr, "Goodbye, World!\n");
   fputs("Goodbye, World!\n", stderr);
   NSLog(@"Goodbye, World!");
   return 0;
}


prerr_endline "Goodbye, World!";    (* this is how you print a string with newline to stderr *)
Printf.eprintf "Goodbye, World!\n"; (* this is how you would use printf with stderr *)


functor
import Application System
define
   {System.showError "Goodbye, World!"}
   {Application.exit 0}
end


program byeworld;

begin
  writeln(StdErr, 'Goodbye, World!');
end.


(%stderr) (w) file dup
(Goodbye, World!
) writestring
closefile


import sys

print >> sys.stderr, "Goodbye, World!"


class HelloWorld
	**Prints "Goodbye, World!" to standard error**

	on start

		print to Console.error made !, "Goodbye, World!"


call lineout 'STDERR', "Goodbye, World!"


html "<script>
window.open('','error_msg','');
document.write('Goodbye, World!');
</script>""


fn main() {
    eprintln!("Hello, {}!", "world");
}


() = fputs("Goodbye, World!\n", stderr);


class MAIN is
  main is
    #ERR + "Hello World!\n";
  end;
end;


#n
1 {
	s/.*/Goodbye, World!/w /dev/stderr
}


$ include "seed7_05.s7i";

const proc: main is func
  begin
    writeln(STD_ERR, "Goodbye, World!");
  end func;


inform: 'Goodbye, World!' &target: DebugConsole.


        terminal = "Error"
        output = "Normal text"
end


TextIO.output (TextIO.stdErr, "Goodbye, World!\n")


import Foundation

let out = NSOutputStream(toFileAtPath: "/dev/stderr", append: true)
let err = "Goodbye, World!".dataUsingEncoding(NSUTF8StringEncoding, allowLossyConversion: false)
out?.open()
let success = out?.write(UnsafePointer<UInt8>(err!.bytes), maxLength: err!.length)
out?.close()

if let bytes = success {
    println("\nWrote \(bytes) bytes")
}


$$ MODE TUSCRIPT
PRINT/ERROR "hello world"
text="goodbye world"
PRINT/ERROR text


Sub StandardError()
    Debug.Print "Goodbye World!"
End Sub


Module Module1

    Sub Main()
        Console.Error.WriteLine("Goodbye, World!")
    End Sub

End Module


section .data
msg     db      'Goodbye, World!', 0AH
len     equ     $-msg

section .text
global  _start
_start: mov     edx, len
        mov     ecx, msg
        mov     ebx, 2
        mov     eax, 4
        int     80h

        mov     ebx, 1
        mov     eax, 1
        int     80h


(DISPLAY "Goodbye, World!" *ERROR-OUTPUT*)


code Text=12;
Text(2, "Goodbye, World!")


const std = @import("std");
pub fn main() !void {
    try std.io.getStdErr().writer().writeAll("Goodbye, World!\n");
    // debug messages are also printed to stderr
    //std.debug.print("Goodbye, World!\n");
}


PrintString:
;input: A0 = source address
;outputs to screen.
MOVE.B (A0)+,D0
BEQ Terminated
JSR PrintChar
BRA PrintString
Terminated:
; If this routine did in fact put a new line by default, it would do so here with the following:
; MOVE.B #13,D0  ;13 is ascii for Carriage Return (moves cursor back to beginning of row).
; JSR PrintChar
; MOVE.B #10,D0  ;10 is ascii for Line Feed (moves cursor down one line).
; JSR PrintChar
RTS

myString:
DC.B "Goodbye, World!",0
EVEN


PROC Main()
  Print("Goodbye, World!")
RETURN


with Ada.Text_IO;

procedure Goodbye_World is
begin
   Ada.Text_IO.Put("Goodbye, World!");
end Goodbye_World;


implement main0 () = print "Goodbye, World!"


DllCall("AllocConsole")
FileAppend, Goodbye`, World!, CONOUT$ ; No newline outputted
MsgBox


main()
{
    putstr("Goodbye, World!");
    return(0);
}


10 REM The trailing semicolon prevents a newline
20 PRINT "Goodbye, World!";


<nul set/p"=Goodbye, World!"
<nul set/p=Goodbye, World!


      REM BBC BASIC accepts the standard trailing semicolon:
      PRINT "Goodbye World!";

      REM One could also output the characters individually:
      GW$ = "Goodbye World!"
      FOR i% = 1 TO LEN(GW$)
        VDU ASCMID$(GW$, i%)
      NEXT


10 print "Goodbye, w";
20 print "orld!";


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

int main(int argc, char *argv[]) {
  (void) printf("Goodbye, World!");    /* No automatic newline */
  return EXIT_SUCCESS;
}


using System;

class Program
{
    static void Main(string[] args)
    {
        //Using Console.WriteLine() will append a newline
        Console.WriteLine("Goodbye, World!");

        //Using Console.Write() will not append a newline
        Console.Write("Goodbye, World!");
    }
}


#include <iostream>

int main() {
  std::cout << "Goodbye, World!";
  return 0;
}


IDENTIFICATION DIVISION.
PROGRAM-ID. GOODBYE-WORLD.

PROCEDURE DIVISION.
DISPLAY 'Goodbye, World!'
    WITH NO ADVANCING
END-DISPLAY
.
STOP RUN.


'In a window

DEF Win:WINDOW
DEF Close:CHAR
DEF ScreenSizeX,ScreenSizeY:INT

GETSCREENSIZE(ScreenSizeX,ScreenSizeY)

WINDOW Win,0,0,ScreenSizeX,ScreenSizeY,0,0,"Goodbye program",MainHandler

PRINT Win,"Goodbye, World!"
'Prints in the upper left corner of the window (position 0,0).
PRINT"Win," I ride off into the sunset."

'There does not appear to be a means of starting a new line when printing in a window, other than by using the MOVE command.
'Therefore, both sentences here will print on the same line, i.e., in the same vertical position.

WAITUNTIL Close=1

CLOSEWINDOW Win

END

SUB MainHandler

    IF @[email protected] THEN Close=1

RETURN

'In the console

OPENCONSOLE

'Insert a trailing comma.
PRINT"Goodbye, World!",
PRINT" I ride off into the sunset."

PRINT:PRINT"Press any key to end."

DO:UNTIL INKEY$<>""

CLOSECONSOLE

'Since this a Cbasic console program.
END


import std.stdio;

void main() {
    write("Goodbye, World!");
}


program Project1;

{$APPTYPE CONSOLE}

begin
  Write('Goodbye, World!');
end.


print("Goodbye, World!", terminator: "")


(begin
    (write "GoodBye, World")
    (write "Next on same line"))


public program()
{
    //print will not append a newline
    console.write("Goodbye, World!")
}


-- In Euphoria puts() does not insert a newline character after outputting a string
puts(1,"Goodbye, world!")


// A program that will run in the interpreter (fsi.exe)
printf "Goodbye, World!";;

// A compiled program
[<EntryPoint>]
let main args =
    printf "Goodbye, World!"
    0


class Main {
  Void main() {
    echo("Goodbye, World!")
  }
}


\ The Forth word ." does not insert a newline character after outputting a string
." Goodbye, World!"


program bye
  write (*,'(a)',advance='no') 'Goodbye, World!'
end program bye


' FB 1.05.0 Win64

Print "Goodbye, World!";  '' the trailing semi-colon suppresses the new line
Sleep


Public Sub Main()

Print "Goodbye, "; 'The semicolon stops the newline being added
Print "World!"

End


[indent=4]
/*
  Hello, with no newline, in Genie
  valac helloNoNewline.gs
*/

init
    stdout.printf("%s", "Goodbye, World!")


package main

import "fmt"

func main() { fmt.Print("Goodbye, World!") }


?? "Goodbye, world"
or
QQout( "Goodbye, world" )


#! /bin/sh
exec huginn --no-argv -E "${0}" "${@}"
#! huginn

main() {
	print( "Goodbye, World!" );
	return ( 0 );
}


procedure main()
   writes("Goodbye, World!")
end


'In a window

DEF Win:WINDOW
DEF Close:CHAR
DEF ScreenSizeX,ScreenSizeY:UINT

GETSCREENSIZE(ScreenSizeX,ScreenSizeY)

OPENWINDOW Win,0,0,ScreenSizeX,ScreenSizeY,NULL,NULL,"Goodbye program",&MainHandler

PRINT Win,"Goodbye, World!"
'Prints in upper left corner of the window (position 0,0).
PRINT Win," You won't have this program to kick around anymore."

'There does not appear to be a means of starting a new line when printing in a window, other than by using the MOVE command.
'Therefore, both sentences here will print on the same line, i.e., in the same vertical position.

WAITUNTIL Close=1

CLOSEWINDOW Win

END

SUB MainHandler

    IF @[email protected] THEN Close=1

RETURN
ENDSUB

'In the console

OPENCONSOLE

'by inserting a trailing comma.
PRINT"Goodbye, World!",
PRINT" You won't have this program to kick around anymore."

PRINT:PRINT

'A press any key to continue message is automatic in a program compiled as console only.
'I presume the compiler adds the code.
CLOSECONSOLE

'Since this an IWBASIC console program.
END


   'Goodbye, World!' 1!:3 <'/proc/self/fd/1'
Goodbye, World!


class Main {
  function void main () {
    do Output.printString("Goodbye, World!");und
    return;
  }
}


public class HelloWorld
{
 public static void main(String[] args)
 {
  System.out.print("Goodbye, World!");
 }
}


$ jq -n -j '"Goodbye, World!"'
Goodbye, World!$


fun main(args: Array<String>) = print("Goodbye, World!")


implement HelloWorld;

include "sys.m"; sys: Sys;
include "draw.m";

HelloWorld: module {
	init: fn(nil: ref Draw->Context, nil: list of string);
};

init(nil: ref Draw->Context, nil: list of string)
{
	sys = load Sys Sys->PATH;
	sys->print("Goodbye, World!"); # No automatic newline.
}


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

$"OUTPUT_STR" = comdat any
@"OUTPUT_STR" = linkonce_odr unnamed_addr constant [16 x i8] c"Goodbye, World!\00", comdat, align 1

;--- The declaration for the external C printf function.
declare i32 @printf(i8*, ...)

define i32 @main() {
    %1 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([16 x i8], [16 x i8]* @"OUTPUT_STR", i32 0, i32 0))
    ret i32 0
}


:- object(error_message).

    % the initialization/1 directive argument is automatically executed
    % when the object is compiled loaded into memory:
    :- initialization(write('Goodbye, World!')).

:- end_object.


{{extern "manool.org.18/std/0.3/all"} in Out.Write["Goodbye, World!"]}


MODULE HelloWorld;
FROM Terminal IMPORT WriteString,ReadChar;

BEGIN
    WriteString("Goodbye, World!");
    ReadChar
END HelloWorld.


/**
 hellonnl.neko
 Tectonics:
   nekoc hellonnl.neko
   neko hellonnl

   -or-

   nekoc hellonnl.neko
   nekotools boot hellonnl.n
   ./hellonnl
*/

$print("Goodbye, World!");


using System.Console;

module Hello
{
    // as with C#, Write() does not append a newline
    Write("Goodbye, world!");

    // equivalently
    Write("Goodbye, ");
    Write("world!");
}


/* NetRexx */
options replace format comments java crossref symbols binary

say 'Goodbye, World!\-'


MODULE HelloWorld;
IMPORT Out;
BEGIN
  Out.String("Goodbye, world!")
END HelloWorld.


bundle Default {
  class SayGoodbye {
    function : Main(args : String[]) ~ Nil {
      "Goodbye, World!"->Print();
    }
  }
}


main: func {
  "Goodbye, World!" print()
}


namespace HelloWorld;

interface

type
  HelloWorld = class
  public
    class method Main;
  end;

implementation

class method HelloWorld.Main;
begin
  Console.Write('Farewell, ');
  Console.Write('cruel ');
  Console.WriteLine('world!');
end;

end.


rem insert a trailing semicolon.
print "Goodbye, World!";
print " Nice having known you."


program NewLineOmission(output);

begin
  write('Goodbye, World!');
end.


print "Goodbye World!"    # Newlines do not occur unless we embed them
end


print "Goodbye, World!";    # A newline does not occur automatically


module helloworld_noln;
extern printf;

@Integer main [
    printf("Goodbye, World!");
    return 0;
]


To run:
Start up.
Write "Goodbye, world!" on the console without advancing.
Wait for the escape key.
Shut down.


Write-Host -NoNewLine "Goodbye, "
Write-Host -NoNewLine "World!"


print("Goodbye, World!");    /* No automatic newline */


OpenConsole()
Print("Goodbye, World!")
Input() ;wait for enter key to be pressed


import sys
sys.stdout.write("Goodbye, World!")


class HelloWorld
	**Prints "Goodbye, World!" without a new line**

	on start

		print "Goodbye, World!" without new line


#lang racket
(display "Goodbye, World!")


print "Goodbye, World!";
printf "%s", "Goodbye, World!";


/*REXX pgm displays a   "Goodbye, World!"   without a trailing newline. */

call charout ,'Goodbye, World!'


fn main () {
    print!("Goodbye, World!");
}


$ include "seed7_05.s7i";

const proc: main is func
  begin
    write("Goodbye, World!");
  end func;


print("Goodbye, World!", terminator: "")


$$ MODE TUSCRIPT
PRINT "Goodbye, World!"


$ txr -e '(put-string "Goodbye, world!")'
Goodbye, world!$


printf "Goodbye, World!"          # This works. There is no newline.
printf %s "-hyphens and % signs"  # Use %s with arbitrary strings.


module main;
  initial
    begin
      $write("Goodbye, World!");
      $finish ;
    end
endmodule


Module Module1

    Sub Main()
        Console.Write("Goodbye, World!")
    End Sub

End Module


@ @[email protected]=#!/usr/bin/a68g [email protected]>@\BEGIN print("Hello World") END


code Text=12;
Text(0, "Goodbye, World!")


print("Goodbye, World!");
Console.write("Goodbye, World!");


const std = @import("std");

pub fn main() !void {
    try std.io.getStdOut().writer().writeAll("Hello world!");
}


10 REM The trailing semicolon prevents a newline
20 PRINT "Goodbye, World!";


V lp = File(‘/dev/lp0’, ‘w’)
lp.write("Hello World!\n")
lp.close()


HELLO    CSECT
         PRINT NOGEN
         BALR  12,0
         USING *,12
         OPEN  LNPRNTR
         LA    6,HW
         PUT   LNPRNTR
         CLOSE LNPRNTR
         EOJ
LNPRNTR  DTFPR DEVADDR=SYSLST,IOAREA1=L1
L1       DS    0CL133
HW       DC    C'Hello World!'
         END HELLO


Proc Main()
 Open(1,"P:",8,0)
 PrintDE(1,"HELLO WORLD!")
 Close(1)
Return


with Ada.Text_IO; use Ada.Text_IO;

procedure Print_Line is
   Printer : File_Type;
begin
   begin
      Open (Printer, Mode => Out_File, Name => "/dev/lp0");
   exception
      when others =>
         Put_Line ("Unable to open printer.");
         return;
   end;

   Set_Output (Printer);
   Put_Line ("Hello World!");
   Close (Printer);
end Print_Line;


BEGIN
   STRING printer name = "/dev/lp0";
   FILE line printer;
   IF open (line printer, printer name, stand out channel) = 0 THEN
      put (line printer, ("Hello world", newline));
      close (line printer)
   ELSE
      put (stand error, ("Can't contact line printer on ", printer name, newline));
      put (stand error, ("Trying to use lpr(1)", newline));
      PIPE printer pipe = execve child pipe ("lpr", "", "");
      IF pid OF printer pipe < 0 THEN
	 put (stand error, ("Oh dear, that didn't seem to work either.  Giving up.", newline));
	 stop
      FI;
      put (write OF printer pipe, ("Hello world", newline));
      close (read OF printer pipe);
      close (write OF printer pipe)
   FI
END


Fileappend, Hello World!, print.txt
Run, print "print.txt"


BEGIN { print("Hello World!") >"/dev/lp0" }


#include <stdio.h>

int main()
{
   FILE *lp;
   lp = fopen("/dev/lp0","w");
   fprintf(lp,"Hello world!\n");
   fclose(lp);
   return 0;
}


[StructLayout(LayoutKind.Sequential, CharSet = CharSet.Ansi)]
public class DOCINFOA
{
    [MarshalAs(UnmanagedType.LPStr)]
    public string pDocName;
    [MarshalAs(UnmanagedType.LPStr)]
    public string pOutputFile;
    [MarshalAs(UnmanagedType.LPStr)]
    public string pDataType;
}

[DllImport("winspool.Drv", EntryPoint = "OpenPrinterA", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool OpenPrinter([MarshalAs(UnmanagedType.LPStr)] string szPrinter, out IntPtr hPrinter, IntPtr pd);

[DllImport("winspool.Drv", EntryPoint = "StartDocPrinterA", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool StartDocPrinter(IntPtr hPrinter, int level, [In, MarshalAs(UnmanagedType.LPStruct)] DOCINFOA di);

[DllImport("winspool.Drv", EntryPoint = "StartPagePrinter", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool StartPagePrinter(IntPtr hPrinter);

[DllImport("winspool.Drv", EntryPoint = "EndPagePrinter", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool EndPagePrinter(IntPtr hPrinter);

[DllImport("winspool.Drv", EntryPoint = "EndDocPrinter", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool EndDocPrinter(IntPtr hPrinter);

[DllImport("winspool.Drv", EntryPoint = "ClosePrinter", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool ClosePrinter(IntPtr hPrinter);

[DllImport("winspool.Drv", EntryPoint = "WritePrinter", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern bool WritePrinter(IntPtr hPrinter, IntPtr pBytes, Int32 dwCount, out Int32 dwWritten);

public void HelloWorld()
{
    IntPtr hPrinter;
    bool openSuccessful = OpenPrinter("My Printer", out hPrinter, IntPtr.Zero);
    if (openSuccessful)
    {
        DOCINFOA docInfo = new DOCINFOA();
        docInfo.pDocName = "Hello World Example";
        docInfo.pOutputFile = null;
        docInfo.pDataType = "RAW";

        if (StartDocPrinter(hPrinter, 1, docInfo))
        {
            StartPagePrinter(hPrinter);

            const string helloWorld = "Hello World!";
            IntPtr buf = Marshal.StringToCoTaskMemAnsi(helloWorld);

            int bytesWritten;
            WritePrinter(hPrinter, buf, helloWorld.Length, out bytesWritten);

            Marshal.FreeCoTaskMem(buf);
        }
        if (EndPagePrinter(hPrinter))
            if (EndDocPrinter(hPrinter))
                ClosePrinter(hPrinter);
    }
}


#include <iostream>
#include <fstream>

int main(){
  std::ofstream lprFile;
  lprFile.open( "/dev/lp0" );
  lprFile << "Hello World!\n";
  lprFile.close();
  return 0;
}


SET PRINT ON
SET CONSOLE OFF
? "Hello World!"
SET PRINT OFF
SET CONSOLE ON


(ns rosetta-code.line-printer
  (:import java.io.FileWriter))

(defn -main [& args]
  (with-open [wr (new FileWriter "/dev/lp0")]
    (.write wr "Hello, World!")))


IDENTIFICATION DIVISION.
PROGRAM-ID. GOODBYE-WORLD-PRINTER.

PROCEDURE DIVISION.
DISPLAY 'Hello World!'
	UPON PRINTER
END-DISPLAY.
STOP RUN.


10 rem rosetta code - "Hello World" on line printer
20 open 7,4 : rem open <logical file number>, <device number>
30 print#7,"hello world!" : rem print line as shown to logical file number
40 close 7 : rem close the file number


(defun main ()
  (with-open-file (stream "/dev/lp0"
    :direction :output
    :if-exists :append)
    (format stream "Hello World~%")))
(main)


import std.stdio;

void main()
{
    auto lp = File("/dev/lp0", "w");
    lp.writeln("Hello World!");
}


program Project1;

{$APPTYPE CONSOLE}

uses Printers;

var
  lPrinterAsTextFile: TextFile;
begin
  AssignPrn(lPrinterAsTextFile);
  Rewrite(lPrinterAsTextFile);
  Writeln(lPrinterAsTextFile, 'Hello World!');
  CloseFile(lPrinterAsTextFile);
end.


select "files"

f2 = fopen("E:\my.txt", "w")
f = "my data"
writeText(f2,f)
flush(f2)
fclose(f2)