Hello world/Newline omission

Pete: Add trivial Limbo example.


{{task|Basic language learning}}

Some languages automatically insert a newline after outputting a string, unless measures are taken to prevent its output. The purpose of this task is to output the string "Goodbye, World!" without a trailing newline.

'''See also'''
* [[Hello world/Graphical]]
* [[Hello world/Line Printer]]
* [[Hello world/Standard error]]
* [[Hello world/Text]]

=={{header|ACL2}}==
(cw "Goodbye, World!")

=={{header|Ada}}==

with Ada.Text_IO;

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


=={{header|ATS}}==
implement main () = print "Goodbye, World!"

=={{header|AutoHotkey}}==
DllCall("AllocConsole")
FileAppend, Goodbye`, World!, CONOUT$ ; No newline outputted
MsgBox

=={{header|AWK}}==

BEGIN { printf("Goodbye, World!") }

=={{header|BASIC}}==
10 REM The trailing semicolon prevents a newline
20 PRINT "Goodbye, World!";


=={{header|BASIC256}}==
Output all on a single line.
print "Goodbye,";
print " ";
print "World!";


=={{header|Batch File}}==
'''Under normal circumstances, when delayed expansion is disabled'''

The quoted form guarantees there are no hidden trailing spaces after World!


'''If delayed expansion is enabled, then the ! must be escaped'''

Escape once if quoted form, twice if unquoted.
setlocal enableDelayedExpansion


=={{header|BBC BASIC}}==
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


=={{header|Bracmat}}==

put$"Goodbye, World!"

=={{header|C}}==
In C, we do not get a newline unless we embed one:
#include

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


However ISO C leaves it up to implementations to define whether or not the last line of a text stream requires a new-line. This means that the C can be targetted to environments where this task is impossible to implement, at least with a direct text stream manipulation like this.

=={{header|C++}}==
In C++, using iostreams, portable newlines come from std::endl. Non-portable newlines may come from using constructs like \n, \r or \r\n. If we don't use any of these, we won't get a newline.
#include

int main(int argc, char *argv[]) {
std::cout << "Goodbye, World!";
}


=={{header|C sharp|C#}}==
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!");
}
}


=={{header|Clipper}}==
?? "Goodbye, World!"

=={{header|Clojure}}==
(print "Goodbye, World!")

=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. GOODBYE-WORLD.

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


=={{header|Common Lisp}}==
(princ "Goodbye, World!")
=={{header|Creative Basic}}==

'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 @CLASS=@IDCLOSEWINDOW 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


=={{header|D}}==
{{works with|D|2.0}}
import std.stdio;

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

=={{header|Déjà Vu}}==
print\ "Goodbye, World!"

=={{header|Delphi}}==
program Project1;

{$APPTYPE CONSOLE}

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


=={{header|Dylan.NET}}==
{{works with|Mono|2.6.7}}
{{works with|Mono|2.10.x}}
{{works with|.NET|3.5}}
{{works with|.NET|4.0}}
One Line version:
Console::Write("Goodbye, World!")
Goodbye World Program:

//compile using the new dylan.NET v, 11.3.1.3 or later
//use mono to run the compiler
#refstdasm mscorlib.dll

import System

assembly gdbyeex exe
ver 1.1.0.0

class public auto ansi Module1

method public static void main()
Console::Write("Goodbye, World!")
end method

end class


=={{header|DWScript}}==
Print('Goodbye, World!');

=={{header|Erlang}}==
In erlang a newline must be specified in the format string.
io:format("Goodbye, world!").

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


=={{header|Factor}}==
USE: io
"Goodbye, World!" write


=={{header|Fantom}}==


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


=={{header|Frink}}==
print["Goodbye, World!"]

=={{header|Forth}}==
\ The Forth word ." does not insert a newline character after outputting a string
." Goodbye, World!"


=={{header|Fortran}}==
program bye
write (*,'(a)',advance='no') 'Goodbye, World!'
end program bye


=={{header|F Sharp|F#}}==

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

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


=={{header|gecho}}==
{{incorrect|gecho|output isn't consistent with the task's requirements: wording, capitalization of the 2nd word.}}
'Hello, <> 'world! print

=={{header|GML}}==
show_message("Goodbye, World!")

=={{header|Go}}==
package main

import "fmt"

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


=={{header|GUISS}}==
In Graphical User Interface Support Script, we specify a newline, if we want one. The following will not produce a newline:
Start,Programs,Accessories,Notepad,Type:Goodbye World[pling]

=={{header|Groovy}}==

print "Goodbye, world"

=={{header|Harbour}}==
?? "Goodbye, world"

=={{header|Haskell}}==

main = putStr "Goodbye, world"

=={{header|Icon}} and {{header|Unicon}}==
Native output in Icon and Unicon is performed via the ''write'' and ''writes'' procedures. The ''write'' procedure terminates each line with both a return and newline (for consistency across platforms). The ''writes'' procedure omits this. Additionally, the programming library has a series of ''printf'' procedures as well.
procedure main()
writes("Goodbye, World!")
end


== {{header|Io}}==

write("Goodbye, World!")

=={{header|IWBASIC}}==

'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 @MESSAGE=@IDCLOSEWINDOW 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


=={{header|J}}==

'''Solution''':prompt from the misc package.
'''Example''': load'misc'
prompt 'hello world'
hello world

'''Notes''': J programs are normally run from a REPL, or session manager, which comes in several flavors. The traditional commandline-based terminal (jconsole), one of several desktop applications (jqt for the current version of J, jgtk and jwd for older but still supported versions), a web-based frontend (jhs), and various mobile apps (J for iOS, Android).

The specific session manager being used changes the context and therefore answer to this task. For example, when using J from a browser (including mobile browsers) newlines are omitted by default. Further, J provides strong tools for coalescing results and manipulating them prior to output, so newline elimination would typically happen before output rather than after.

With that said, prompt handles the most common cases (using binary output for jconsole, so no newline is appended; adjusting the REPL prompt in the desktop apps to to elide the newline which is normally included by default, etc).

For truly automated processes, you'd almost always want this kind of functionality (omitting the newline when printing) in a file- or stream-oriented application. For those cases, the simple text 1!:3 file will append the text to the referenced file verbatim, without inserting any extra newlines.

So, if a J programmer were asked to solve this task, the right approach would be to ask why that is needed, and then craft a solution appropriate to that situation.

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


=={{header|Julia}}==
Julia provides a println function which appends a newline, and a print function which doesn't:
print("Goodbye, World!")

=={{header|Lasso}}==
Lasso provides a stdoutnl method that prints a trailing newline, and a stdout method that does not:
stdout("Goodbye, World!")

=={{header|LFE}}==

(: io format '"Hello, planetary orb!")


=={{header|Liberty BASIC}}==
A trailing semicolon prevents a newline
print "Goodbye, World!";


=={{header|Limbo}}==

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("Hello, World!");
}



=={{header|Logtalk}}==
No action is necessary to avoid an unwanted newline.

:- 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.


=={{header|Lua}}==
io.write("Goodbye, World!")

=={{header|m4}}==

(Quoted) text is issued verbatim, "dnl" suppresses all input until and including the next newline. Simply creating an input without a trailing newline would of course accomplish the same task.

`Goodbye, World!'dnl

=={{header|Maple}}==

printf( "Goodbye, World!" );


=={{header|Mathematica}}==

NotebookWrite[EvaluationNotebook[], "Goodbye, World!"]


=={{header|MATLAB}} / {{header|Octave}}==
fprintf('Goodbye, World!');

=={{header|mIRC Scripting Language}}==
echo -ag Goodbye, World!

=={{header|ML/I}}==
===Simple solution===
In ML/I, if there isn't a newline in the input, there won't be one in the output; so a simple solution is this (although it's hard to see that there isn't a newline).
Goodbye, World!
===More sophisticated solution===
To make it clearer, we can define an ML/I ''skip'' to delete itself and an immediately following newline.
MCSKIP " WITH " NL
Goodbye, World!""


=={{header|Nemerle}}==

using System.Console;

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

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


=={{header|NetRexx}}==
/* NetRexx */
options replace format comments java crossref symbols binary

say 'Goodbye, World!\-'


=={{header|NewLISP}}==
(print "Goodbye, World!")

=={{header|Objeck}}==


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


=={{header|OCaml}}==

In OCaml, the function [http://caml.inria.fr/pub/docs/manual-ocaml/libref/Pervasives.html#VALprint_endline print_endline] prints a string followed by a newline character on the standard output and flush the standard output. And the function [http://caml.inria.fr/pub/docs/manual-ocaml/libref/Pervasives.html#VALprint_string print_string] just prints a string with nothing additional.

print_string "Goodbye, World!"

=={{header|Oxygene}}==
{{incorrect|Oxygene|output isn't consistent with the task's requirements: wording, capitalization.}}


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.


>HelloWorld.exe
Farewell, cruel world!


=={{header|Panoramic}}==

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


=={{header|PARI/GP}}==
print1("Goodbye, World!")

=={{header|PASM}}==

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


=={{header|Pascal}}==
program NewLineOmission(output);

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

Output:
% ./NewLineOmission 
Goodbye, World!%


=={{header|Perl}}==
print "Goodbye, World!"; # A newline does not occur automatically

=={{header|Perl 6}}==
A newline is not added automatically to print or printf
print "Goodbye, World!";
printf "%s", "Goodbye, World!";


=={{header|PHL}}==
Printf doesn't add newline automatically.

module helloworld_noln;
extern printf;

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


=={{header|PicoLisp}}==
(prin "Goodbye, world")

=={{header|PL/I}}==

put ('Goodbye, World!');


=={{header|PureBasic}}==
OpenConsole()
Print("Goodbye, World!")
Input() ;wait for enter key to be pressed


=={{header|Python}}==
import sys
sys.stdout.write("Goodbye, World!")


{{works with|Python|3.x}}
print("Goodbye, World!", end="")

=={{header|Racket}}==
#lang racket
(display "Goodbye, World!")


=={{header|Retro}}==
"Goodbye, World!" puts

=={{header|REXX}}==
It should be noted that upon a REXX program completion, any text left pending without a C/R (or newline) is followed by a

blank line so as to not leave the state of the terminal with malformed "text lines" (which can be followed by other text

(lines) from a calling program(s), or the operating system (shell) which is usually some sort of a "prompt" text string.
/*REXX pgm displays a "Goodbye, World!" without a trailing newline. */

call charout ,'Goodbye, World!'


=={{header|Ruby}}==
print "Goodbye, World!"

=={{header|Salmon}}==
print("Goodbye, World!");

=={{header|Scala}}==
[[Category:Scala Implementations]]
{{libheader|scala}}
===Ad hoc REPL solution===
Ad hoc solution as [http://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop REPL] script. Type this in a REPL session:
print("Goodbye, World!")
=={{header|Scheme}}==
(display "Goodbye, World!")

=={{header|Seed7}}==
$ include "seed7_05.s7i";

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


=={{header|Standard ML}}==
print "Goodbye, World!"

=={{header|Tcl}}==
puts -nonewline "Goodbye, World!"

=={{header|TUSCRIPT}}==

$$ MODE TUSCRIPT
PRINT "Goodbye, World!"

Output:

Goodbye, World!


=={{header|TXR}}==
{{incorrect|TXR|output isn't consistent with the task's requirements: wording, capitalization.}}
Possible using access to standard output stream via TXR Lisp:
$txr -c '@(do (format t "Hello, world!"))'
Hello, world!$


=={{header|UNIX Shell}}==
The ''echo'' command is not portable, and echo -n is not guaranteed to prevent a newline from occuring. With the original [[Bourne Shell]], echo -n "Goodbye, World!" prints -n Goodbye, World! with a newline. So use a ''printf'' instead.

{{works with|Bourne Shell}}

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


Unfortunately, older systems where you have to rely on vanilla Bourne shell may not have a ''printf'' command, either. It's possible that there is no command available to complete the task, but only on very old systems. For the rest, one of these two should work:

echo -n 'Goodbye, World!'
or
echo 'Goodbye, World!\c'

The ''print'' command, from the [[Korn Shell]], would work well, but most shells have no ''print'' command. (With [[pdksh]], ''print'' is slightly faster than ''printf'' because ''print'' runs a built-in command, but ''printf'' forks an external command. With [[ksh93]] and [[zsh]], ''print'' and ''printf'' are both built-in commands.)

{{works with|ksh93}}
{{works with|pdksh}}
{{works with|zsh}}

print -n "Goodbye, World!"
print -nr -- "-hyphens and \backslashes"


==={{header|C Shell}}===
C Shell does support echo -n and omits the newline.

echo -n "Goodbye, World!"
echo -n "-hyphens and \backslashes"


=={{header|Web 68}}==
{{incorrect|Web 68|output isn't consistent with the task's requirements: wording, punctuation.}}
Use the command 'tang -V hello.w68', then 'chmod +x hello.a68', then './hello.a68'

@ @a@=#!/usr/bin/a68g -nowarn@>@\BEGIN print("Hello World") END

=={{header|XPL0}}==
code Text=12;
Text(0, "Goodbye, World!")


=={{header|ZX Spectrum Basic}}==
10 REM The trailing semicolon prevents a newline
20 PRINT "Goodbye, World!";

{{omit from|PHP|lack of special newline command}}

User:Pete

Pete: I'm new here.


Signed up to add (time permitting) some examples in Limbo. It's a pretty great language!

Blog: http://debu.gs/

Company: http://reverso.be/

Hello world/Newline omission

Pete: /* {{header|Limbo}} */ Apparently it's "Good-bye" here. Sorry!


{{task|Basic language learning}}

Some languages automatically insert a newline after outputting a string, unless measures are taken to prevent its output. The purpose of this task is to output the string "Goodbye, World!" without a trailing newline.

'''See also'''
* [[Hello world/Graphical]]
* [[Hello world/Line Printer]]
* [[Hello world/Standard error]]
* [[Hello world/Text]]

=={{header|ACL2}}==
(cw "Goodbye, World!")

=={{header|Ada}}==

with Ada.Text_IO;

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


=={{header|ATS}}==
implement main () = print "Goodbye, World!"

=={{header|AutoHotkey}}==
DllCall("AllocConsole")
FileAppend, Goodbye`, World!, CONOUT$ ; No newline outputted
MsgBox

=={{header|AWK}}==

BEGIN { printf("Goodbye, World!") }

=={{header|BASIC}}==
10 REM The trailing semicolon prevents a newline
20 PRINT "Goodbye, World!";


=={{header|BASIC256}}==
Output all on a single line.
print "Goodbye,";
print " ";
print "World!";


=={{header|Batch File}}==
'''Under normal circumstances, when delayed expansion is disabled'''

The quoted form guarantees there are no hidden trailing spaces after World!


'''If delayed expansion is enabled, then the ! must be escaped'''

Escape once if quoted form, twice if unquoted.
setlocal enableDelayedExpansion


=={{header|BBC BASIC}}==
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


=={{header|Bracmat}}==

put$"Goodbye, World!"

=={{header|C}}==
In C, we do not get a newline unless we embed one:
#include

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


However ISO C leaves it up to implementations to define whether or not the last line of a text stream requires a new-line. This means that the C can be targetted to environments where this task is impossible to implement, at least with a direct text stream manipulation like this.

=={{header|C++}}==
In C++, using iostreams, portable newlines come from std::endl. Non-portable newlines may come from using constructs like \n, \r or \r\n. If we don't use any of these, we won't get a newline.
#include

int main(int argc, char *argv[]) {
std::cout << "Goodbye, World!";
}


=={{header|C sharp|C#}}==
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!");
}
}


=={{header|Clipper}}==
?? "Goodbye, World!"

=={{header|Clojure}}==
(print "Goodbye, World!")

=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. GOODBYE-WORLD.

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


=={{header|Common Lisp}}==
(princ "Goodbye, World!")
=={{header|Creative Basic}}==

'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 @CLASS=@IDCLOSEWINDOW 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


=={{header|D}}==
{{works with|D|2.0}}
import std.stdio;

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

=={{header|Déjà Vu}}==
print\ "Goodbye, World!"

=={{header|Delphi}}==
program Project1;

{$APPTYPE CONSOLE}

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


=={{header|Dylan.NET}}==
{{works with|Mono|2.6.7}}
{{works with|Mono|2.10.x}}
{{works with|.NET|3.5}}
{{works with|.NET|4.0}}
One Line version:
Console::Write("Goodbye, World!")
Goodbye World Program:

//compile using the new dylan.NET v, 11.3.1.3 or later
//use mono to run the compiler
#refstdasm mscorlib.dll

import System

assembly gdbyeex exe
ver 1.1.0.0

class public auto ansi Module1

method public static void main()
Console::Write("Goodbye, World!")
end method

end class


=={{header|DWScript}}==
Print('Goodbye, World!');

=={{header|Erlang}}==
In erlang a newline must be specified in the format string.
io:format("Goodbye, world!").

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


=={{header|Factor}}==
USE: io
"Goodbye, World!" write


=={{header|Fantom}}==


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


=={{header|Frink}}==
print["Goodbye, World!"]

=={{header|Forth}}==
\ The Forth word ." does not insert a newline character after outputting a string
." Goodbye, World!"


=={{header|Fortran}}==
program bye
write (*,'(a)',advance='no') 'Goodbye, World!'
end program bye


=={{header|F Sharp|F#}}==

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

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


=={{header|gecho}}==
{{incorrect|gecho|output isn't consistent with the task's requirements: wording, capitalization of the 2nd word.}}
'Hello, <> 'world! print

=={{header|GML}}==
show_message("Goodbye, World!")

=={{header|Go}}==
package main

import "fmt"

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


=={{header|GUISS}}==
In Graphical User Interface Support Script, we specify a newline, if we want one. The following will not produce a newline:
Start,Programs,Accessories,Notepad,Type:Goodbye World[pling]

=={{header|Groovy}}==

print "Goodbye, world"

=={{header|Harbour}}==
?? "Goodbye, world"

=={{header|Haskell}}==

main = putStr "Goodbye, world"

=={{header|Icon}} and {{header|Unicon}}==
Native output in Icon and Unicon is performed via the ''write'' and ''writes'' procedures. The ''write'' procedure terminates each line with both a return and newline (for consistency across platforms). The ''writes'' procedure omits this. Additionally, the programming library has a series of ''printf'' procedures as well.
procedure main()
writes("Goodbye, World!")
end


== {{header|Io}}==

write("Goodbye, World!")

=={{header|IWBASIC}}==

'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 @MESSAGE=@IDCLOSEWINDOW 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


=={{header|J}}==

'''Solution''':prompt from the misc package.
'''Example''': load'misc'
prompt 'hello world'
hello world

'''Notes''': J programs are normally run from a REPL, or session manager, which comes in several flavors. The traditional commandline-based terminal (jconsole), one of several desktop applications (jqt for the current version of J, jgtk and jwd for older but still supported versions), a web-based frontend (jhs), and various mobile apps (J for iOS, Android).

The specific session manager being used changes the context and therefore answer to this task. For example, when using J from a browser (including mobile browsers) newlines are omitted by default. Further, J provides strong tools for coalescing results and manipulating them prior to output, so newline elimination would typically happen before output rather than after.

With that said, prompt handles the most common cases (using binary output for jconsole, so no newline is appended; adjusting the REPL prompt in the desktop apps to to elide the newline which is normally included by default, etc).

For truly automated processes, you'd almost always want this kind of functionality (omitting the newline when printing) in a file- or stream-oriented application. For those cases, the simple text 1!:3 file will append the text to the referenced file verbatim, without inserting any extra newlines.

So, if a J programmer were asked to solve this task, the right approach would be to ask why that is needed, and then craft a solution appropriate to that situation.

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


=={{header|Julia}}==
Julia provides a println function which appends a newline, and a print function which doesn't:
print("Goodbye, World!")

=={{header|Lasso}}==
Lasso provides a stdoutnl method that prints a trailing newline, and a stdout method that does not:
stdout("Goodbye, World!")

=={{header|LFE}}==

(: io format '"Hello, planetary orb!")


=={{header|Liberty BASIC}}==
A trailing semicolon prevents a newline
print "Goodbye, World!";


=={{header|Limbo}}==

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.
}


=={{header|Logtalk}}==
No action is necessary to avoid an unwanted newline.

:- 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.


=={{header|Lua}}==
io.write("Goodbye, World!")

=={{header|m4}}==

(Quoted) text is issued verbatim, "dnl" suppresses all input until and including the next newline. Simply creating an input without a trailing newline would of course accomplish the same task.

`Goodbye, World!'dnl

=={{header|Maple}}==

printf( "Goodbye, World!" );


=={{header|Mathematica}}==

NotebookWrite[EvaluationNotebook[], "Goodbye, World!"]


=={{header|MATLAB}} / {{header|Octave}}==
fprintf('Goodbye, World!');

=={{header|mIRC Scripting Language}}==
echo -ag Goodbye, World!

=={{header|ML/I}}==
===Simple solution===
In ML/I, if there isn't a newline in the input, there won't be one in the output; so a simple solution is this (although it's hard to see that there isn't a newline).
Goodbye, World!
===More sophisticated solution===
To make it clearer, we can define an ML/I ''skip'' to delete itself and an immediately following newline.
MCSKIP " WITH " NL
Goodbye, World!""


=={{header|Nemerle}}==

using System.Console;

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

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


=={{header|NetRexx}}==
/* NetRexx */
options replace format comments java crossref symbols binary

say 'Goodbye, World!\-'


=={{header|NewLISP}}==
(print "Goodbye, World!")

=={{header|Objeck}}==


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


=={{header|OCaml}}==

In OCaml, the function [http://caml.inria.fr/pub/docs/manual-ocaml/libref/Pervasives.html#VALprint_endline print_endline] prints a string followed by a newline character on the standard output and flush the standard output. And the function [http://caml.inria.fr/pub/docs/manual-ocaml/libref/Pervasives.html#VALprint_string print_string] just prints a string with nothing additional.

print_string "Goodbye, World!"

=={{header|Oxygene}}==
{{incorrect|Oxygene|output isn't consistent with the task's requirements: wording, capitalization.}}


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.


>HelloWorld.exe
Farewell, cruel world!


=={{header|Panoramic}}==

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


=={{header|PARI/GP}}==
print1("Goodbye, World!")

=={{header|PASM}}==

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


=={{header|Pascal}}==
program NewLineOmission(output);

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

Output:
% ./NewLineOmission 
Goodbye, World!%


=={{header|Perl}}==
print "Goodbye, World!"; # A newline does not occur automatically

=={{header|Perl 6}}==
A newline is not added automatically to print or printf
print "Goodbye, World!";
printf "%s", "Goodbye, World!";


=={{header|PHL}}==
Printf doesn't add newline automatically.

module helloworld_noln;
extern printf;

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


=={{header|PicoLisp}}==
(prin "Goodbye, world")

=={{header|PL/I}}==

put ('Goodbye, World!');


=={{header|PureBasic}}==
OpenConsole()
Print("Goodbye, World!")
Input() ;wait for enter key to be pressed


=={{header|Python}}==
import sys
sys.stdout.write("Goodbye, World!")


{{works with|Python|3.x}}
print("Goodbye, World!", end="")

=={{header|Racket}}==
#lang racket
(display "Goodbye, World!")


=={{header|Retro}}==
"Goodbye, World!" puts

=={{header|REXX}}==
It should be noted that upon a REXX program completion, any text left pending without a C/R (or newline) is followed by a

blank line so as to not leave the state of the terminal with malformed "text lines" (which can be followed by other text

(lines) from a calling program(s), or the operating system (shell) which is usually some sort of a "prompt" text string.
/*REXX pgm displays a "Goodbye, World!" without a trailing newline. */

call charout ,'Goodbye, World!'


=={{header|Ruby}}==
print "Goodbye, World!"

=={{header|Salmon}}==
print("Goodbye, World!");

=={{header|Scala}}==
[[Category:Scala Implementations]]
{{libheader|scala}}
===Ad hoc REPL solution===
Ad hoc solution as [http://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop REPL] script. Type this in a REPL session:
print("Goodbye, World!")
=={{header|Scheme}}==
(display "Goodbye, World!")

=={{header|Seed7}}==
$ include "seed7_05.s7i";

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


=={{header|Standard ML}}==
print "Goodbye, World!"

=={{header|Tcl}}==
puts -nonewline "Goodbye, World!"

=={{header|TUSCRIPT}}==

$$ MODE TUSCRIPT
PRINT "Goodbye, World!"

Output:

Goodbye, World!


=={{header|TXR}}==
{{incorrect|TXR|output isn't consistent with the task's requirements: wording, capitalization.}}
Possible using access to standard output stream via TXR Lisp:
$txr -c '@(do (format t "Hello, world!"))'
Hello, world!$


=={{header|UNIX Shell}}==
The ''echo'' command is not portable, and echo -n is not guaranteed to prevent a newline from occuring. With the original [[Bourne Shell]], echo -n "Goodbye, World!" prints -n Goodbye, World! with a newline. So use a ''printf'' instead.

{{works with|Bourne Shell}}

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


Unfortunately, older systems where you have to rely on vanilla Bourne shell may not have a ''printf'' command, either. It's possible that there is no command available to complete the task, but only on very old systems. For the rest, one of these two should work:

echo -n 'Goodbye, World!'
or
echo 'Goodbye, World!\c'

The ''print'' command, from the [[Korn Shell]], would work well, but most shells have no ''print'' command. (With [[pdksh]], ''print'' is slightly faster than ''printf'' because ''print'' runs a built-in command, but ''printf'' forks an external command. With [[ksh93]] and [[zsh]], ''print'' and ''printf'' are both built-in commands.)

{{works with|ksh93}}
{{works with|pdksh}}
{{works with|zsh}}

print -n "Goodbye, World!"
print -nr -- "-hyphens and \backslashes"


==={{header|C Shell}}===
C Shell does support echo -n and omits the newline.

echo -n "Goodbye, World!"
echo -n "-hyphens and \backslashes"


=={{header|Web 68}}==
{{incorrect|Web 68|output isn't consistent with the task's requirements: wording, punctuation.}}
Use the command 'tang -V hello.w68', then 'chmod +x hello.a68', then './hello.a68'

@ @a@=#!/usr/bin/a68g -nowarn@>@\BEGIN print("Hello World") END

=={{header|XPL0}}==
code Text=12;
Text(0, "Goodbye, World!")


=={{header|ZX Spectrum Basic}}==
10 REM The trailing semicolon prevents a newline
20 PRINT "Goodbye, World!";

{{omit from|PHP|lack of special newline command}}

Show the epoch

Pete: Add a Limbo example.


{{task}}Choose popular date libraries used by your language and show the [[wp:Epoch_(reference_date)#Computing|epoch]] those libraries use. A demonstration is preferable (e.g. setting the internal representation of the date to 0 ms/ns/etc., or another way that will still show the epoch even if it is changed behind the scenes by the implementers), but text from (with links to) documentation is also acceptable where a demonstration is impossible/impractical. For consistency's sake, show the date in UTC time where possible.

See also: [[Date format]]

=={{header|Ada}}==
In Ada, time is a private type and is implementation defined, for instance, on 64 bit GNAT, time is represented internally as nanoseconds relative to Jan 1, 2150.

However, conversion from unix epoch seconds is also supported and shown below.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Formatting; use Ada.Calendar.Formatting;
with Ada.Calendar.Conversions; use Ada.Calendar.Conversions;
procedure ShowEpoch is
etime : Time := To_Ada_Time (0);
begin
Put_Line (Image (Date => etime));
end ShowEpoch;

{{out}}
1970-01-01 00:00:00


=={{header|AWK}}==

# syntax: GAWK -f SHOW_THE_EPOCH.AWK
# requires GNU Awk 4.0.1 or later
BEGIN {
print(strftime("%Y-%m-%d %H:%M:%S",0,1))
exit(0)
}

output:



1970-01-01 00:00:00


=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
INSTALL @lib$+"DATELIB"
PRINT FN_date$(0, "dd-MMM-yyyy")

'''Output:'''

17-Nov-1858


=={{header|C}}==
#include
#include

int main() {
time_t t = 0;
printf("%s", asctime(gmtime(&t)));
return 0;
}

{{out}}
Thu Jan  1 00:00:00 1970

=== Windows ===
FileTime, from the Win32 API, uses a different epoch.
{{libheader|Win32}}
#include
#include
#include

int
main()
{
FILETIME ft = {dwLowDateTime: 0, dwHighDateTime: 0}; /* Epoch */
SYSTEMTIME st;
wchar_t date[80], time[80];

/*
* Convert FILETIME (which counts 100-nanosecond intervals since
* the epoch) to SYSTEMTIME (which has year, month, and so on).
*
* The time is in UTC, because we never call
* SystemTimeToTzSpecificLocalTime() to convert it to local time.
*/
FileTimeToSystemTime(&ft, &st);

/*
* Format SYSTEMTIME as a string.
*/
if (GetDateFormatW(LOCALE_USER_DEFAULT, DATE_LONGDATE, &st, NULL,
date, sizeof date / sizeof date[0]) == 0 ||
GetTimeFormatW(LOCALE_USER_DEFAULT, 0, &st, NULL,
time, sizeof time / sizeof time[0]) == 0) {
fwprintf(stderr, L"Error!\n");
return 1;
}

wprintf(L"FileTime epoch is %ls, at %ls (UTC).\n", date, time);
return 0;
}

{{out}}
FileTime epoch is Monday, January 01, 1601, at 12:00:00 AM (UTC).


=={{header|C sharp|C#}}==
using System;

class Program
{
static void Main()
{
Console.WriteLine(new DateTime());
}
}

{{out}}
1-1-0001 0:00:00


=={{header|C++}}==
{{works with|C++11}}
{{works with|gcc|4.5.3}}
Doesn't work with MSVC 10 SP1
#include
#include
#include
int main()
{
std::chrono::system_clock::time_point epoch;
std::time_t t = std::chrono::system_clock::to_time_t(epoch);
std::cout << std::asctime(std::gmtime(&t)) << '\n';
return 0;
}

{{out}}
Thu Jan  1 00:00:00 1970

{{libheader|boost}}
#include
#include
int main()
{
std::cout << boost::posix_time::ptime( boost::posix_time::min_date_time ) << '\n';
return 0;
}

{{out}}
1400-Jan-01 00:00:00


=={{header|Clojure}}==
(println (java.util.Date. 0))
Output (since Clojure 1.5)
#inst "1970-01-01T00:00:00.000-00:00"

=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. epoch.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 epoch-date.
03 year PIC 9(4).
03 month PIC 99.
03 dday PIC 99.

PROCEDURE DIVISION.
MOVE FUNCTION DATE-OF-INTEGER(1) TO epoch-date

DISPLAY year "-" month "-" dday

GOBACK
.


{{out}}
1601-01-01


=={{header|Common Lisp}}==
(multiple-value-bind (second minute hour day month year) (decode-universal-time 0 0)
(format t "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day hour minute second))

{{out}}
1900-01-01 00:00:00


=={{header|D}}==
The Date struct of the standard library module "std.datetime" represents a date in the Proleptic Gregorian Calendar ranging from 32,768 B.C. to 32,767 A.D.

=={{header|Dart}}==
main() {
print(new Date.fromEpoch(0,new TimeZone.utc()));
}

{{out}}
1970-01-01 00:00:00.000Z


=={{header|Delphi}}==
program ShowEpoch;

{$APPTYPE CONSOLE}

uses SysUtils;

begin
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', 0));
end.

{{out}}
1899-12-30 00:00:00.000


=={{header|Erlang}}==
Erlang uses 2 3-tuples for time and date manipulation. It is possible to get the current values from the operating system. It is also possible to transform these values to/from gregorian seconds. Those are seconds since the date and time interpreted with the Gregorian calendar extended back to year 0. Perhaps the epoch is the date and time at gregorian seconds 0?


2> calendar:universal_time().
{{2013,9,13},{8,3,16}}
3> calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
63546278932
4> calendar:gregorian_seconds_to_datetime(63546278932).
{{2013,9,13},{8,8,52}}
11> calendar:gregorian_seconds_to_datetime(0).
{{0,1,1},{0,0,0}}



=={{header|F_Sharp|F#}}==
printfn "%s" ((new System.DateTime()).ToString("u"))
{{out}}
0001-01-01 00:00:00Z


=={{header|Factor}}==

IN: USE: calendar calendar.format
IN: 0 micros>timestamp timestamp>ymdhms .
"1970-01-01 00:00:00"


=={{header|Forth}}==
{{works with|4tH|3.61.3}}
include lib/longjday.4th
0 posix>jday .longjday cr

{{out}}

Thursday, January 1, 1970


=={{header|Go}}==
package main
import ("fmt"; "time")

func main() {
fmt.Println(time.Time{})
}

{{out}}
This is UNIX format. The 1 on the end is the full year, not two or four digit year.

Mon Jan 1 00:00:00 +0000 UTC 1


=={{header|Groovy}}==
Groovy uses the UNIX epoch.
def date = new Date(0)
def format = new java.text.SimpleDateFormat('yyyy-MM-dd\'T\'HH:mm:ss.SSSZ')
format.timeZone = TimeZone.getTimeZone('UTC')
println (format.format(date))

{{out}}
1970-01-01T00:00:00.000+0000


=={{header|Haskell}}==
===Old time library===
The ClockTime type is abstract in Haskell 98, but is defined in GHC.
{{works with|GHC}}
import System.Time

main = putStrLn $ calendarTimeToString $ toUTCTime $ TOD 0 0

{{out}}
Thu Jan  1 00:00:00 UTC 1970

===New time library===
{{works with|GHC}}
import Data.Time

main = print $ UTCTime (ModifiedJulianDay 0) 0

{{out}}
1858-11-17 00:00:00 UTC


=={{header|Icon}} and {{header|Unicon}}==
Date and Time can be accessed via a number of keywords and functions
* The following are available in both Icon and Unicon
** &clock, &date, &dateline, and &time deal with current times and dates
* The following are specific to Unicon
** &now provides the number of seconds since the epoch, Jan 1, 1970 00:00:00
** ctime(integer) takes the number of seconds since the epoch and returns the date and time as a string in the local timezone
** gtime(integer) takes the number of seconds since the epoch and returns the date and time as a string in UTC
** gettimeofday() returns a record with the current time since the epoch in seconds and microseconds
{{libheader|Icon Programming Library}}
* [http://www.cs.arizona.edu/icon/library/src/procs/datetime.icn datetime routines] use a global variable 'DateBaseYear' which defaults to Jan 1, 1970 00:00:00 but can be set if desired.
* The example below uses only a couple of the datetime procedures
link printf,datetime

procedure main()
# Unicon
now := gettimeofday().sec
if now = &now then printf("&now and gettimeofday().sec are equal\n")
printf("Now (UTC) %s, (local) %s\n",gtime(now),ctime(now))
printf("Epoch %s\n",gtime(0))
# Icon and Unicon
now := DateToSec(&date) + ClockToSec(&clock)
printf("Now is also %s and %s\n",SecToDate(now),SecToDateLine(now))
end

{{out|Sample Output}}
&now and gettimeofday().sec are equal
Now (UTC) Tue Aug 09 10:43:23 2011, (local) Tue Aug 09 06:43:23 2011
Epoch Thu Jan 01 00:00:00 1970
Now is also 2011/08/09 and Tuesday, August 9, 2011 6:43 am


=={{header|J}}==
J does not have an epoch. J's native representation of date and time is a six element list: year, month, day, hour, minute, second. For example:
6!:0''
2011 8 8 20 25 44.725

(August 8, 2011, 8:25:44 pm)

That said, the 'dates' library does have an epoch:
require'dates'
todate 0
1800 1 1


=={{header|Java}}==
DateFormat is needed to set the timezone. Printing date alone would show this date in the timezone/locale of the machine that the program is running on. The epoch used in java.util.Date (as well as java.sql.Date, which can be subbed into this example) is actually in GMT, but there isn't a significant difference between that and UTC for lots of applications ([http://download.oracle.com/javase/7/docs/api/java/util/Date.html#getTime() documentation for java.util.Date]).
import java.text.DateFormat;
import java.util.Date;
import java.util.TimeZone;

public class DateTest{
public static void main(String[] args) {
Date date = new Date(0);
DateFormat format = DateFormat.getDateTimeInstance();
format.setTimeZone(TimeZone.getTimeZone("UTC"));
System.out.println(format.format(date));
}
}

{{out}}
Jan 1, 1970 12:00:00 AM

On my PC I see
01.01.1970 00:00:00


=={{header|JavaScript}}==
document.write(new Date(0).toUTCString());
{{out}}
Thu, 01 Jan 1970 00:00:00 GMT




=={{header|Lasso}}==
date(0.00)
date(0)


{{out}}
1969-12-31 19:00:00
1969-12-31 19:00:00


=={{header|Limbo}}==
implement Epoch;

include "sys.m"; sys: Sys;
include "draw.m";
include "daytime.m"; daytime: Daytime;
Tm: import daytime;

Epoch: 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;
daytime = load Daytime Daytime->PATH;
sys->print("%s\n", daytime->text(daytime->gmt(0)));
}


{{out}}
Thu Jan 01 00:00:00 GMT 1970


=={{header|Mathematica}}==
DateString[0]
->Mon 1 Jan 1900 00:00:00

=={{header|MATLAB}} / {{header|Octave}}==
Matlab and Octave store date/time number in a floating point number counting the days.
d = [0,1,2,3.5,-3.5,1000*365,1000*366,now+[-1,0,1]];
for k=1:length(d)
printf('day %f\t%s\n',d(k),datestr(d(k),0))
disp(datevec(d(k)))
end;

{{out}}
day 0.000000	31-Dec--001 00:00:00
-1 12 31 0 0 0
day 1.000000 01-Jan-0000 00:00:00
0 1 1 0 0 0
day 2.000000 02-Jan-0000 00:00:00
0 1 2 0 0 0
day 3.500000 03-Jan-0000 12:00:00
0 1 3 12 0 0
day -3.500000 27-Dec--001 12:00:00
-1 12 27 12 0 0
day 365000.000000 02-May-0999 00:00:00
999 5 2 0 0 0
day 366000.000000 27-Jan-1002 00:00:00
1002 1 27 0 0 0
day 734908.972013 09-Feb-2012 23:19:41
2012.0000 2.0000 9.0000 23.0000 19.0000 41.9633
day 734909.972013 10-Feb-2012 23:19:41
2012.0000 2.0000 10.0000 23.0000 19.0000 41.9633
day 734910.972013 11-Feb-2012 23:19:41
2012.0000 2.0000 11.0000 23.0000 19.0000 41.9633


=={{header|Maxima}}==
timedate(0);
"1900-01-01 10:00:00+10:00"


=={{header|NetRexx}}==
{{trans|Java}}
/* NetRexx */
options replace format comments java crossref symbols nobinary

import java.text.DateFormat

edate = Date(0)
zulu = DateFormat.getDateTimeInstance()
zulu.setTimeZone(TimeZone.getTimeZone('UTC'))
say zulu.format(edate)
return

'''Output:'''

Jan 1, 1970 12:00:00 AM


=={{header|NewLISP}}==
(date 0)
->"Thu Jan 01 01:00:00 1970"


=={{header|Objective-C}}==
#import

int main(int argc, const char *argv[]) {
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];

NSDate *t = [NSDate dateWithTimeIntervalSinceReferenceDate:0];
NSDateFormatter *dateFormatter = [[[NSDateFormatter alloc] init] autorelease];
[dateFormatter setTimeZone:[NSTimeZone timeZoneWithName:@"UTC"]];
[dateFormatter setDateFormat:@"yyyy-MM-dd HH:mm:ss ZZ"];
NSLog(@"%@", [dateFormatter stringFromDate:t]);

[pool release];
return 0;
}

{{out|Log}}
2001-01-01 00:00:00 +0000


=={{header|OCaml}}==
open Unix

let months = [| "January"; "February"; "March"; "April"; "May"; "June";
"July"; "August"; "September"; "October"; "November"; "December" |]

let () =
let t = Unix.gmtime 0.0 in
Printf.printf "%s %d, %d\n" months.(t.tm_mon) t.tm_mday (1900 + t.tm_year)

{{out|Execution}}
$ ocaml unix.cma epoch.ml
January 1, 1970


=={{header|Pascal}}==
This works with [[Free_Pascal| Free Pascal]]:
Program ShowEpoch;

uses
SysUtils;

begin
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Now));
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', 0));
end.

{{out}}

:> ./SelfDescribingNumber
2011-12-13 00:57:41.378
1899-12-30 00:00:00.000


=={{header|Perl}}==
print scalar gmtime 0, "\n";
{{out}}
Thu Jan  1 00:00:00 1970


=={{header|Perl 6}}==
say DateTime.new(0)
{{out}}

1970-01-01T00:00:00Z


=={{header|PHP}}==
echo gmdate('r', 0), "\n";
?>

{{out}}
Thu, 01 Jan 1970 00:00:00 +0000


=={{header|PicoLisp}}==
The 'date' function in PicoLisp returns a day number, starting first of March of the year zero. Calculated according to the gregorian calendar (despite that that calendar wasn't used in 0 AD yet).
: (date 1)
-> (0 3 1) # Year zero, March 1st


=={{header|PL/I}}==
*process source attributes xref;
epoch: Proc Options(main);
/*********************************************************************
* 20.08.2013 Walter Pachl shows that PL/I uses 15 Oct 1582 as epoch
* DAYS returns a FIXED BINARY(31,0) value which is the number of days
* (in Lilian format) corresponding to the date d.
*********************************************************************/
Dcl d Char(17);
Put Edit(datetime(),days(datetime()))
(Skip,a,f(15));
d='15821015000000000';
Put Edit(d ,days(d))
(Skip,a,f(15));
d='15821014000000000';
Put Edit(d ,days(d))
(Skip,a,f(15));
End;

Result:

20130820072642956 157365
15821015000000000 1
15821014000000000
IBM0512I ONCODE=2112 X in SECS(X,Y) or DAYS(X,Y) was outside the
supported range.
At offset +00000283 in procedure with entry EPOCH


=={{header|PowerShell}}==
PowerShell uses .NET's DateTime structure and an integer can simply be casted appropriately:
[datetime] 0
{{out}}
Monday, January 01, 0001 12:00:00 AM


=={{header|PureBasic}}==
If OpenConsole()
PrintN(FormatDate("Y = %yyyy M = %mm D = %dd, %hh:%ii:%ss", 0))

Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf

{{out}}
Y = 1970  M = 01  D = 01, 00:00:00


=={{header|Python}}==
>>> import time
>>> time.asctime(time.gmtime(0))
'Thu Jan 1 00:00:00 1970'
>>>


=={{header|R}}==
> epoch <- 0
> class(epoch) <- class(Sys.time())
> format(epoch, "%Y-%m-%d %H:%M:%S %Z")
[1] "1970-01-01 00:00:00 UTC"


=={{header|Racket}}==

#lang racket
(require racket/date)
(date->string (seconds->date 0 #f))


Output:

"Thursday, January 1st, 1970"


=={{header|REXX}}==
The epoch for the REXX language built-in function DATE is January 1st, year 1.
/*REXX program shows the # of days since the epoch for the DATE function*/

say ' today is' date() /*today's is format: mm MON YYYY */

days=date('Basedate') /*only 1st char of option is used*/
say right(days,35) "days since the REXX base date of January 1st, year 1"

say 'and today is:' date(,days,'B') /*this should be today (still). */

/*──────── The above statement is only valid for the newer REXXes,*/
/*──────── older versions don't support the 2nd and 3rd arguments.*/

'''output'''

today is 3 Aug 2012
734717 days since the REXX base date of January 1st, year 1
and today is: 3 Aug 2012


=={{header|Ruby}}==
irb(main):001:0> Time.at(0).utc
=> 1970-01-01 00:00:00 UTC

=={{header|Run BASIC}}==
eDate$ = date$("01/01/0001")
cDate$ = date$(0) ' 01/01/1901
sDate$ = date$("01/01/1970")


=={{header|Scala}}==
import java.util.{Date, TimeZone, Locale}
import java.text.DateFormat

val df=DateFormat.getDateTimeInstance(DateFormat.LONG, DateFormat.LONG, Locale.ENGLISH)
df.setTimeZone(TimeZone.getTimeZone("UTC"))
println(df.format(new Date(0)))

{{out}}
January 1, 1970 12:00:00 AM UTC


=={{header|Seed7}}==
The Seed7 library [http://seed7.sourceforge.net/libraries/time.htm time.s7i]
defines the type [http://seed7.sourceforge.net/manual/types.htm#time time],
which describes times and dates. For dates the proleptic Gregorian calendar is used
(which assumes that the Gregorian calendar was even in effect at dates preceding its official introduction).
This convention is used according to ISO 8601, which also defines that positive and
negative years exist and that the year preceding 1 is 0.
Therefore the epoch is the beginning of the year 0.
$ include "seed7_05.s7i";
include "time.s7i";

const proc: main is func
begin
writeln(time.value);
end func;

{{out}}

0000-01-01 00:00:00 UTC


=={{header|Standard ML}}==
- Date.toString (Date.fromTimeUniv Time.zeroTime);
val it = "Thu Jan 1 00:00:00 1970" : string


=={{header|Tcl}}==
% clock format 0 -gmt 1
Thu Jan 01 00:00:00 GMT 1970


=={{header|TUSCRIPT}}==
$$ MODE TUSCRIPT
- epoch
number=1
dayofweeknr=DATE (date,day,month,year,number)
epoch=JOIN(year,"-",month,day)
PRINT "epoch: ", epoch," (daynumber ",number,")"
- today's daynumber
dayofweeknr=DATE (today,day,month,year,number)
date=JOIN (year,"-",month,day)
PRINT "today's date: ", date," (daynumber ", number,")"

{{out}}

epoch: 1-1-1 (daynumber 1)
today's date: 2011-12-14 (daynumber 734487)


=={{header|UNIX Shell}}==
The nonstandard option date -r takes seconds from the epoch, and prints date and time. See [http://www.openbsd.org/cgi-bin/man.cgi?query=date&apropos=0&sektion=1&manpath=OpenBSD+Current&arch=i386&format=html date(1) manual].
{{works with|OpenBSD}}
$ date -ur 0
Thu Jan 1 00:00:00 UTC 1970


On systems with GNU date, you can do

$ TZ=UTC date --date "$(date +%s) seconds ago"
Thu Jan 1 00:00:00 UTC 1970


=={{header|Visual Basic}}==
Sub Main()
Debug.Print Format(0, "dd mmm yyyy hh:mm")
End Sub

{{out|Output (in debug window)}}
30 Dec 1899 00:00

{{omit from|AutoHotkey}}
{{omit from|GUISS}}
{{omit from|Locomotive Basic}}
{{omit from|ZX Spectrum Basic}}

Show the epoch

Pete: /* {{header|Limbo}} */ Add a more creative example for Limbo.


{{task}}Choose popular date libraries used by your language and show the [[wp:Epoch_(reference_date)#Computing|epoch]] those libraries use. A demonstration is preferable (e.g. setting the internal representation of the date to 0 ms/ns/etc., or another way that will still show the epoch even if it is changed behind the scenes by the implementers), but text from (with links to) documentation is also acceptable where a demonstration is impossible/impractical. For consistency's sake, show the date in UTC time where possible.

See also: [[Date format]]

=={{header|Ada}}==
In Ada, time is a private type and is implementation defined, for instance, on 64 bit GNAT, time is represented internally as nanoseconds relative to Jan 1, 2150.

However, conversion from unix epoch seconds is also supported and shown below.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Formatting; use Ada.Calendar.Formatting;
with Ada.Calendar.Conversions; use Ada.Calendar.Conversions;
procedure ShowEpoch is
etime : Time := To_Ada_Time (0);
begin
Put_Line (Image (Date => etime));
end ShowEpoch;

{{out}}
1970-01-01 00:00:00


=={{header|AWK}}==

# syntax: GAWK -f SHOW_THE_EPOCH.AWK
# requires GNU Awk 4.0.1 or later
BEGIN {
print(strftime("%Y-%m-%d %H:%M:%S",0,1))
exit(0)
}

output:



1970-01-01 00:00:00


=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
INSTALL @lib$+"DATELIB"
PRINT FN_date$(0, "dd-MMM-yyyy")

'''Output:'''

17-Nov-1858


=={{header|C}}==
#include
#include

int main() {
time_t t = 0;
printf("%s", asctime(gmtime(&t)));
return 0;
}

{{out}}
Thu Jan  1 00:00:00 1970

=== Windows ===
FileTime, from the Win32 API, uses a different epoch.
{{libheader|Win32}}
#include
#include
#include

int
main()
{
FILETIME ft = {dwLowDateTime: 0, dwHighDateTime: 0}; /* Epoch */
SYSTEMTIME st;
wchar_t date[80], time[80];

/*
* Convert FILETIME (which counts 100-nanosecond intervals since
* the epoch) to SYSTEMTIME (which has year, month, and so on).
*
* The time is in UTC, because we never call
* SystemTimeToTzSpecificLocalTime() to convert it to local time.
*/
FileTimeToSystemTime(&ft, &st);

/*
* Format SYSTEMTIME as a string.
*/
if (GetDateFormatW(LOCALE_USER_DEFAULT, DATE_LONGDATE, &st, NULL,
date, sizeof date / sizeof date[0]) == 0 ||
GetTimeFormatW(LOCALE_USER_DEFAULT, 0, &st, NULL,
time, sizeof time / sizeof time[0]) == 0) {
fwprintf(stderr, L"Error!\n");
return 1;
}

wprintf(L"FileTime epoch is %ls, at %ls (UTC).\n", date, time);
return 0;
}

{{out}}
FileTime epoch is Monday, January 01, 1601, at 12:00:00 AM (UTC).


=={{header|C sharp|C#}}==
using System;

class Program
{
static void Main()
{
Console.WriteLine(new DateTime());
}
}

{{out}}
1-1-0001 0:00:00


=={{header|C++}}==
{{works with|C++11}}
{{works with|gcc|4.5.3}}
Doesn't work with MSVC 10 SP1
#include
#include
#include
int main()
{
std::chrono::system_clock::time_point epoch;
std::time_t t = std::chrono::system_clock::to_time_t(epoch);
std::cout << std::asctime(std::gmtime(&t)) << '\n';
return 0;
}

{{out}}
Thu Jan  1 00:00:00 1970

{{libheader|boost}}
#include
#include
int main()
{
std::cout << boost::posix_time::ptime( boost::posix_time::min_date_time ) << '\n';
return 0;
}

{{out}}
1400-Jan-01 00:00:00


=={{header|Clojure}}==
(println (java.util.Date. 0))
Output (since Clojure 1.5)
#inst "1970-01-01T00:00:00.000-00:00"

=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. epoch.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 epoch-date.
03 year PIC 9(4).
03 month PIC 99.
03 dday PIC 99.

PROCEDURE DIVISION.
MOVE FUNCTION DATE-OF-INTEGER(1) TO epoch-date

DISPLAY year "-" month "-" dday

GOBACK
.


{{out}}
1601-01-01


=={{header|Common Lisp}}==
(multiple-value-bind (second minute hour day month year) (decode-universal-time 0 0)
(format t "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D" year month day hour minute second))

{{out}}
1900-01-01 00:00:00


=={{header|D}}==
The Date struct of the standard library module "std.datetime" represents a date in the Proleptic Gregorian Calendar ranging from 32,768 B.C. to 32,767 A.D.

=={{header|Dart}}==
main() {
print(new Date.fromEpoch(0,new TimeZone.utc()));
}

{{out}}
1970-01-01 00:00:00.000Z


=={{header|Delphi}}==
program ShowEpoch;

{$APPTYPE CONSOLE}

uses SysUtils;

begin
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', 0));
end.

{{out}}
1899-12-30 00:00:00.000


=={{header|Erlang}}==
Erlang uses 2 3-tuples for time and date manipulation. It is possible to get the current values from the operating system. It is also possible to transform these values to/from gregorian seconds. Those are seconds since the date and time interpreted with the Gregorian calendar extended back to year 0. Perhaps the epoch is the date and time at gregorian seconds 0?


2> calendar:universal_time().
{{2013,9,13},{8,3,16}}
3> calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
63546278932
4> calendar:gregorian_seconds_to_datetime(63546278932).
{{2013,9,13},{8,8,52}}
11> calendar:gregorian_seconds_to_datetime(0).
{{0,1,1},{0,0,0}}



=={{header|F_Sharp|F#}}==
printfn "%s" ((new System.DateTime()).ToString("u"))
{{out}}
0001-01-01 00:00:00Z


=={{header|Factor}}==

IN: USE: calendar calendar.format
IN: 0 micros>timestamp timestamp>ymdhms .
"1970-01-01 00:00:00"


=={{header|Forth}}==
{{works with|4tH|3.61.3}}
include lib/longjday.4th
0 posix>jday .longjday cr

{{out}}

Thursday, January 1, 1970


=={{header|Go}}==
package main
import ("fmt"; "time")

func main() {
fmt.Println(time.Time{})
}

{{out}}
This is UNIX format. The 1 on the end is the full year, not two or four digit year.

Mon Jan 1 00:00:00 +0000 UTC 1


=={{header|Groovy}}==
Groovy uses the UNIX epoch.
def date = new Date(0)
def format = new java.text.SimpleDateFormat('yyyy-MM-dd\'T\'HH:mm:ss.SSSZ')
format.timeZone = TimeZone.getTimeZone('UTC')
println (format.format(date))

{{out}}
1970-01-01T00:00:00.000+0000


=={{header|Haskell}}==
===Old time library===
The ClockTime type is abstract in Haskell 98, but is defined in GHC.
{{works with|GHC}}
import System.Time

main = putStrLn $ calendarTimeToString $ toUTCTime $ TOD 0 0

{{out}}
Thu Jan  1 00:00:00 UTC 1970

===New time library===
{{works with|GHC}}
import Data.Time

main = print $ UTCTime (ModifiedJulianDay 0) 0

{{out}}
1858-11-17 00:00:00 UTC


=={{header|Icon}} and {{header|Unicon}}==
Date and Time can be accessed via a number of keywords and functions
* The following are available in both Icon and Unicon
** &clock, &date, &dateline, and &time deal with current times and dates
* The following are specific to Unicon
** &now provides the number of seconds since the epoch, Jan 1, 1970 00:00:00
** ctime(integer) takes the number of seconds since the epoch and returns the date and time as a string in the local timezone
** gtime(integer) takes the number of seconds since the epoch and returns the date and time as a string in UTC
** gettimeofday() returns a record with the current time since the epoch in seconds and microseconds
{{libheader|Icon Programming Library}}
* [http://www.cs.arizona.edu/icon/library/src/procs/datetime.icn datetime routines] use a global variable 'DateBaseYear' which defaults to Jan 1, 1970 00:00:00 but can be set if desired.
* The example below uses only a couple of the datetime procedures
link printf,datetime

procedure main()
# Unicon
now := gettimeofday().sec
if now = &now then printf("&now and gettimeofday().sec are equal\n")
printf("Now (UTC) %s, (local) %s\n",gtime(now),ctime(now))
printf("Epoch %s\n",gtime(0))
# Icon and Unicon
now := DateToSec(&date) + ClockToSec(&clock)
printf("Now is also %s and %s\n",SecToDate(now),SecToDateLine(now))
end

{{out|Sample Output}}
&now and gettimeofday().sec are equal
Now (UTC) Tue Aug 09 10:43:23 2011, (local) Tue Aug 09 06:43:23 2011
Epoch Thu Jan 01 00:00:00 1970
Now is also 2011/08/09 and Tuesday, August 9, 2011 6:43 am


=={{header|J}}==
J does not have an epoch. J's native representation of date and time is a six element list: year, month, day, hour, minute, second. For example:
6!:0''
2011 8 8 20 25 44.725

(August 8, 2011, 8:25:44 pm)

That said, the 'dates' library does have an epoch:
require'dates'
todate 0
1800 1 1


=={{header|Java}}==
DateFormat is needed to set the timezone. Printing date alone would show this date in the timezone/locale of the machine that the program is running on. The epoch used in java.util.Date (as well as java.sql.Date, which can be subbed into this example) is actually in GMT, but there isn't a significant difference between that and UTC for lots of applications ([http://download.oracle.com/javase/7/docs/api/java/util/Date.html#getTime() documentation for java.util.Date]).
import java.text.DateFormat;
import java.util.Date;
import java.util.TimeZone;

public class DateTest{
public static void main(String[] args) {
Date date = new Date(0);
DateFormat format = DateFormat.getDateTimeInstance();
format.setTimeZone(TimeZone.getTimeZone("UTC"));
System.out.println(format.format(date));
}
}

{{out}}
Jan 1, 1970 12:00:00 AM

On my PC I see
01.01.1970 00:00:00


=={{header|JavaScript}}==
document.write(new Date(0).toUTCString());
{{out}}
Thu, 01 Jan 1970 00:00:00 GMT




=={{header|Lasso}}==
date(0.00)
date(0)


{{out}}
1969-12-31 19:00:00
1969-12-31 19:00:00


=={{header|Limbo}}==
implement Epoch;

include "sys.m"; sys: Sys;
include "draw.m";
include "daytime.m"; daytime: Daytime;
Tm: import daytime;

Epoch: 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;
daytime = load Daytime Daytime->PATH;
sys->print("%s\n", daytime->text(daytime->gmt(0)));
}


Of course, this could also be done by mangling the namespace and forging the current date, locking it to the epoch:

implement Epoch;

include "sys.m"; sys: Sys;
include "draw.m";
include "daytime.m"; daytime: Daytime;
Tm: import daytime;

Epoch: 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;
daytime = load Daytime Daytime->PATH;

# Create a file containing a zero:
fd := sys->open("/tmp/0", Sys->OWRITE);
if(fd == nil) {
sys->fprint(sys->fildes(2), "Couldn't open /tmp/0 for writing: %r\n");
raise "fail:errors";
}
sys->fprint(fd, "0");
fd = nil; # Files with no references are closed immediately.

# Fork the namespace so as not to disturb the parent
# process's concept of time:
sys->pctl(Sys->FORKNS, nil);
# Bind that file over /dev/time:
sys->bind("/tmp/0", "/dev/time", Sys->MREPL);

# Print the "current" date, now the epoch:
sys->print("%s\n", daytime->text(daytime->gmt(daytime->now())));
}


{{out}}
Thu Jan 01 00:00:00 GMT 1970


=={{header|Mathematica}}==
DateString[0]
->Mon 1 Jan 1900 00:00:00

=={{header|MATLAB}} / {{header|Octave}}==
Matlab and Octave store date/time number in a floating point number counting the days.
d = [0,1,2,3.5,-3.5,1000*365,1000*366,now+[-1,0,1]];
for k=1:length(d)
printf('day %f\t%s\n',d(k),datestr(d(k),0))
disp(datevec(d(k)))
end;

{{out}}
day 0.000000	31-Dec--001 00:00:00
-1 12 31 0 0 0
day 1.000000 01-Jan-0000 00:00:00
0 1 1 0 0 0
day 2.000000 02-Jan-0000 00:00:00
0 1 2 0 0 0
day 3.500000 03-Jan-0000 12:00:00
0 1 3 12 0 0
day -3.500000 27-Dec--001 12:00:00
-1 12 27 12 0 0
day 365000.000000 02-May-0999 00:00:00
999 5 2 0 0 0
day 366000.000000 27-Jan-1002 00:00:00
1002 1 27 0 0 0
day 734908.972013 09-Feb-2012 23:19:41
2012.0000 2.0000 9.0000 23.0000 19.0000 41.9633
day 734909.972013 10-Feb-2012 23:19:41
2012.0000 2.0000 10.0000 23.0000 19.0000 41.9633
day 734910.972013 11-Feb-2012 23:19:41
2012.0000 2.0000 11.0000 23.0000 19.0000 41.9633


=={{header|Maxima}}==
timedate(0);
"1900-01-01 10:00:00+10:00"


=={{header|NetRexx}}==
{{trans|Java}}
/* NetRexx */
options replace format comments java crossref symbols nobinary

import java.text.DateFormat

edate = Date(0)
zulu = DateFormat.getDateTimeInstance()
zulu.setTimeZone(TimeZone.getTimeZone('UTC'))
say zulu.format(edate)
return

'''Output:'''

Jan 1, 1970 12:00:00 AM


=={{header|NewLISP}}==
(date 0)
->"Thu Jan 01 01:00:00 1970"


=={{header|Objective-C}}==
#import

int main(int argc, const char *argv[]) {
NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];

NSDate *t = [NSDate dateWithTimeIntervalSinceReferenceDate:0];
NSDateFormatter *dateFormatter = [[[NSDateFormatter alloc] init] autorelease];
[dateFormatter setTimeZone:[NSTimeZone timeZoneWithName:@"UTC"]];
[dateFormatter setDateFormat:@"yyyy-MM-dd HH:mm:ss ZZ"];
NSLog(@"%@", [dateFormatter stringFromDate:t]);

[pool release];
return 0;
}

{{out|Log}}
2001-01-01 00:00:00 +0000


=={{header|OCaml}}==
open Unix

let months = [| "January"; "February"; "March"; "April"; "May"; "June";
"July"; "August"; "September"; "October"; "November"; "December" |]

let () =
let t = Unix.gmtime 0.0 in
Printf.printf "%s %d, %d\n" months.(t.tm_mon) t.tm_mday (1900 + t.tm_year)

{{out|Execution}}
$ ocaml unix.cma epoch.ml
January 1, 1970


=={{header|Pascal}}==
This works with [[Free_Pascal| Free Pascal]]:
Program ShowEpoch;

uses
SysUtils;

begin
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Now));
Writeln(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', 0));
end.

{{out}}

:> ./SelfDescribingNumber
2011-12-13 00:57:41.378
1899-12-30 00:00:00.000


=={{header|Perl}}==
print scalar gmtime 0, "\n";
{{out}}
Thu Jan  1 00:00:00 1970


=={{header|Perl 6}}==
say DateTime.new(0)
{{out}}

1970-01-01T00:00:00Z


=={{header|PHP}}==
echo gmdate('r', 0), "\n";
?>

{{out}}
Thu, 01 Jan 1970 00:00:00 +0000


=={{header|PicoLisp}}==
The 'date' function in PicoLisp returns a day number, starting first of March of the year zero. Calculated according to the gregorian calendar (despite that that calendar wasn't used in 0 AD yet).
: (date 1)
-> (0 3 1) # Year zero, March 1st


=={{header|PL/I}}==
*process source attributes xref;
epoch: Proc Options(main);
/*********************************************************************
* 20.08.2013 Walter Pachl shows that PL/I uses 15 Oct 1582 as epoch
* DAYS returns a FIXED BINARY(31,0) value which is the number of days
* (in Lilian format) corresponding to the date d.
*********************************************************************/
Dcl d Char(17);
Put Edit(datetime(),days(datetime()))
(Skip,a,f(15));
d='15821015000000000';
Put Edit(d ,days(d))
(Skip,a,f(15));
d='15821014000000000';
Put Edit(d ,days(d))
(Skip,a,f(15));
End;

Result:

20130820072642956 157365
15821015000000000 1
15821014000000000
IBM0512I ONCODE=2112 X in SECS(X,Y) or DAYS(X,Y) was outside the
supported range.
At offset +00000283 in procedure with entry EPOCH


=={{header|PowerShell}}==
PowerShell uses .NET's DateTime structure and an integer can simply be casted appropriately:
[datetime] 0
{{out}}
Monday, January 01, 0001 12:00:00 AM


=={{header|PureBasic}}==
If OpenConsole()
PrintN(FormatDate("Y = %yyyy M = %mm D = %dd, %hh:%ii:%ss", 0))

Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf

{{out}}
Y = 1970  M = 01  D = 01, 00:00:00


=={{header|Python}}==
>>> import time
>>> time.asctime(time.gmtime(0))
'Thu Jan 1 00:00:00 1970'
>>>


=={{header|R}}==
> epoch <- 0
> class(epoch) <- class(Sys.time())
> format(epoch, "%Y-%m-%d %H:%M:%S %Z")
[1] "1970-01-01 00:00:00 UTC"


=={{header|Racket}}==

#lang racket
(require racket/date)
(date->string (seconds->date 0 #f))


Output:

"Thursday, January 1st, 1970"


=={{header|REXX}}==
The epoch for the REXX language built-in function DATE is January 1st, year 1.
/*REXX program shows the # of days since the epoch for the DATE function*/

say ' today is' date() /*today's is format: mm MON YYYY */

days=date('Basedate') /*only 1st char of option is used*/
say right(days,35) "days since the REXX base date of January 1st, year 1"

say 'and today is:' date(,days,'B') /*this should be today (still). */

/*──────── The above statement is only valid for the newer REXXes,*/
/*──────── older versions don't support the 2nd and 3rd arguments.*/

'''output'''

today is 3 Aug 2012
734717 days since the REXX base date of January 1st, year 1
and today is: 3 Aug 2012


=={{header|Ruby}}==
irb(main):001:0> Time.at(0).utc
=> 1970-01-01 00:00:00 UTC

=={{header|Run BASIC}}==
eDate$ = date$("01/01/0001")
cDate$ = date$(0) ' 01/01/1901
sDate$ = date$("01/01/1970")


=={{header|Scala}}==
import java.util.{Date, TimeZone, Locale}
import java.text.DateFormat

val df=DateFormat.getDateTimeInstance(DateFormat.LONG, DateFormat.LONG, Locale.ENGLISH)
df.setTimeZone(TimeZone.getTimeZone("UTC"))
println(df.format(new Date(0)))

{{out}}
January 1, 1970 12:00:00 AM UTC


=={{header|Seed7}}==
The Seed7 library [http://seed7.sourceforge.net/libraries/time.htm time.s7i]
defines the type [http://seed7.sourceforge.net/manual/types.htm#time time],
which describes times and dates. For dates the proleptic Gregorian calendar is used
(which assumes that the Gregorian calendar was even in effect at dates preceding its official introduction).
This convention is used according to ISO 8601, which also defines that positive and
negative years exist and that the year preceding 1 is 0.
Therefore the epoch is the beginning of the year 0.
$ include "seed7_05.s7i";
include "time.s7i";

const proc: main is func
begin
writeln(time.value);
end func;

{{out}}

0000-01-01 00:00:00 UTC


=={{header|Standard ML}}==
- Date.toString (Date.fromTimeUniv Time.zeroTime);
val it = "Thu Jan 1 00:00:00 1970" : string


=={{header|Tcl}}==
% clock format 0 -gmt 1
Thu Jan 01 00:00:00 GMT 1970


=={{header|TUSCRIPT}}==
$$ MODE TUSCRIPT
- epoch
number=1
dayofweeknr=DATE (date,day,month,year,number)
epoch=JOIN(year,"-",month,day)
PRINT "epoch: ", epoch," (daynumber ",number,")"
- today's daynumber
dayofweeknr=DATE (today,day,month,year,number)
date=JOIN (year,"-",month,day)
PRINT "today's date: ", date," (daynumber ", number,")"

{{out}}

epoch: 1-1-1 (daynumber 1)
today's date: 2011-12-14 (daynumber 734487)


=={{header|UNIX Shell}}==
The nonstandard option date -r takes seconds from the epoch, and prints date and time. See [http://www.openbsd.org/cgi-bin/man.cgi?query=date&apropos=0&sektion=1&manpath=OpenBSD+Current&arch=i386&format=html date(1) manual].
{{works with|OpenBSD}}
$ date -ur 0
Thu Jan 1 00:00:00 UTC 1970


On systems with GNU date, you can do

$ TZ=UTC date --date "$(date +%s) seconds ago"
Thu Jan 1 00:00:00 UTC 1970


=={{header|Visual Basic}}==
Sub Main()
Debug.Print Format(0, "dd mmm yyyy hh:mm")
End Sub

{{out|Output (in debug window)}}
30 Dec 1899 00:00

{{omit from|AutoHotkey}}
{{omit from|GUISS}}
{{omit from|Locomotive Basic}}
{{omit from|ZX Spectrum Basic}}

Rot-13

Pete: Add Limbo rot13 (Luckily, I had already written/tested this.)


{{task|Encryption}}Implement a "rot-13" function (or procedure, class, subroutine, or other "callable" object as appropriate to your programming environment). Optionally wrap this function in a utility program which acts like a common [[UNIX]] utility, performing a line-by-line rot-13 encoding of every line of input contained in each file listed on its command line, or (if no filenames are passed thereon) acting as a filter on its "standard input." (A number of UNIX scripting languages and utilities, such as ''awk'' and ''sed'' either default to processing files in this way or have command line switches or modules to easily implement these wrapper semantics, e.g., [[Perl]] and [[Python]]).

The "rot-13" encoding is commonly known from the early days of Usenet "Netnews" as a way of obfuscating text to prevent casual reading of [[wp:Spoiler (media)|spoiler]] or potentially offensive material. Many news reader and mail user agent programs have built-in "rot-13" encoder/decoders or have the ability to feed a message through any external utility script for performing this (or other) actions.

The definition of the rot-13 function is to simply replace every letter of the ASCII alphabet with the letter which is "rotated" 13 characters "around" the 26 letter alphabet from its normal cardinal position (wrapping around from "z" to "a" as necessary). Thus the letters "abc" become "nop" and so on. Technically rot-13 is a "monoalphabetic substitution cipher" with a trivial "key". A proper implementation should work on upper and lower case letters, preserve case, and pass all non-alphabetic characters in the input stream through without alteration.

=={{header|6502 Assembly}}==
Written for the BeebAsm assembler, which uses '&' to indicate a hexadecimal number. Call with the address of a zero terminated string in X and Y.
On exit X is preserved, Y is the length of the string and A is zero.

buffer = &70 ; or anywhere in zero page that's good

org &1900
.rot13
stx buffer
sty buffer+1
ldy #0
.loop lda (buffer),y
bne decode ; quit on ASCII 0
rts
.decode cmp #&7b ; high range
bcs next
cmp #&41 ; low range
bcc next
cmp #&4f
bcc add13
cmp #&5b
bcc sub13
cmp #&61
bcc next
cmp #&6f
bcc add13
bcs sub13 ; saves a byte over a jump
.next iny
jmp loop
.add13 adc #13 ; we only get here via bcc; so clc not needed
jmp storeit
.sub13 sec
sbc #13
.storeit sta (buffer),y
jmp next


=={{header|ACL2}}==
(include-book "arithmetic-3/top" :dir :system)

(defun char-btn (c low high)
(and (char>= c low)
(char<= c high)))

(defun rot-13-cs (cs)
(cond ((endp cs) nil)
((or (char-btn (first cs) #\a #\m)
(char-btn (first cs) #\A #\M))
(cons (code-char (+ (char-code (first cs)) 13))
(rot-13-cs (rest cs))))
((or (char-btn (first cs) #\n #\z)
(char-btn (first cs) #\N #\Z))
(cons (code-char (- (char-code (first cs)) 13))
(rot-13-cs (rest cs))))
(t (cons (first cs) (rot-13-cs (rest cs))))))

(defun rot-13 (s)
(coerce (rot-13-cs (coerce s 'list)) 'string))


=={{header|Ada}}==
with Ada.Text_IO.Text_Streams; use Ada.Text_IO.Text_Streams;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Command_Line; use Ada.Command_Line;

procedure Rot_13 is

From_Sequence : Character_Sequence := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
Result_Sequence : Character_Sequence := "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM";
Rot_13_Mapping : Character_Mapping := To_Mapping(From_Sequence, Result_Sequence);

In_Char : Character;
Stdio : Stream_Access := Stream(Ada.Text_IO.Standard_Input);
Stdout : Stream_Access := Stream(Ada.Text_Io.Standard_Output);
Input : Ada.Text_Io.File_Type;

begin
if Argument_Count > 0 then
for I in 1..Argument_Count loop
begin
Ada.Text_Io.Open(File => Input, Mode => Ada.Text_Io.In_File, Name => Argument(I));
Stdio := Stream(Input);
while not Ada.Text_Io.End_Of_File(Input) loop
In_Char :=Character'Input(Stdio);
Character'Output(Stdout, Value(Rot_13_Mapping, In_Char));
end loop;
Ada.Text_IO.Close(Input);
exception
when Ada.Text_IO.Name_Error =>
Ada.Text_Io.Put_Line(File => Ada.Text_Io.Standard_Error, Item => "File " & Argument(I) & " is not a file.");
when Ada.Text_Io.Status_Error =>
Ada.Text_Io.Put_Line(File => Ada.Text_Io.Standard_Error, Item => "File " & Argument(I) & " is already opened.");
end;
end loop;
else
while not Ada.Text_Io.End_Of_File loop
In_Char :=Character'Input(Stdio);
Character'Output(Stdout, Value(Rot_13_Mapping, In_Char));
end loop;
end if;
end Rot_13;

=={{header|ALGOL 68}}==
{{trans|Modula-3}}

{{works with|ALGOL 68|Standard - no extensions to language used}}
{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}}

BEGIN
CHAR c;
on logical file end(stand in, (REF FILE f)BOOL: (stop; SKIP));
on line end(stand in, (REF FILE f)BOOL: (print(new line); FALSE));
DO
read(c);
IF c >= "A" AND c <= "M" OR c >= "a" AND c <= "m" THEN
c := REPR(ABS c + 13)
ELIF c >= "N" AND c <= "Z" OR c >= "n" AND c <= "z" THEN
c := REPR(ABS c - 13)
FI;
print(c)
OD
END # rot13 #

Sample run on linux:

$ echo Big fjords vex quick waltz nymph! | a68g Rot-13.a68
Ovt swbeqf irk dhvpx jnygm alzcu!

=={{header|AppleScript}}==
Using '''do shell script'''
to rot13(textString)
do shell script "tr a-zA-Z n-za-mN-ZA-M <<<" & quoted form of textString
end rot13

Pure AppleScript solution
to rot13(textString)
local outChars
set outChars to {}
repeat with ch in (characters of textString)
if (ch >= "a" and ch <= "m") or (ch >= "A" and ch <= "M") then
set ch to character id (id of ch + 13)
else if (ch >= "n" and ch <= "z") or (ch >= "N" and ch <= "Z") then
set ch to character id (id of ch - 13)
end
set end of outChars to ch
end
return outChars as text
end rot13

Demo code:
rot13("nowhere ABJURER")
Output:
abjurer NOWHERE


=={{header|AutoHotkey}}==
Simple alphabet remapping method by Raccoon. Similar to a translate() function in many languages.
ROT13(string) ; by Raccoon July-2009
{
Static a := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ "
Static b := "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM "
s=
Loop, Parse, string
{
c := substr(b,instr(a,A_LoopField,True),1)
if (c != " ")
s .= c
else
s .= A_LoopField
}
Return s
}


Simple ASCII math method by Raccoon. Add or subtract 13 depending on the character's decimal value.
ROT13(string) ; by Raccoon July-2009
{
s=
Loop, Parse, string
{
c := asc(A_LoopField)
if (c >= 97) && (c <= 109) || (c >= 65) && (c <= 77)
c += 13
else if (c >= 110) && (c <= 122) || (c >= 78) && (c <= 90)
c -= 13
s .= chr(c)
}
Return s
}


Code modified from [http://www.autohotkey.com/forum/viewtopic.php?t=8421 stringmod] by [http://www.autohotkey.com/forum/author-HugoV.html Hugo]: [http://www.autohotkey.com/forum/viewtopic.php?t=44657&postdays=0&postorder=asc&start=45 ahk discussion]
Str0=Hello, This is a sample text with 1 2 3 or other digits!@#$^&*()-_=
Str1 := Rot13(Str0)
Str2 := Rot13(Str1)
MsgBox % Str0 "`n" Str1 "`n" Str2

Rot13(string)
{
Loop Parse, string
{
char := Asc(A_LoopField)
; o is 'A' code if it is an uppercase letter, and 'a' code if it is a lowercase letter
o := Asc("A") * (Asc("A") <= char && char <= Asc("Z")) + Asc("a") * (Asc("a") <= char && char <= Asc("z"))
If (o > 0)
{
; Set between 0 and 25, add rotation factor, modulus alphabet size
char := Mod(char - o + 13, 26)
; Transform back to char, upper or lower
char := Chr(char + o)
}
Else
{
; Non alphabetic, unchanged
char := A_LoopField
}
rStr .= char
}
Return rStr
}


=={{header|AWK}}==
BEGIN {
for(i=0; i < 256; i++) {
amap[sprintf("%c", i)] = i
}
for(l=amap["a"]; l <= amap["z"]; l++) {
rot13[l] = sprintf("%c", (((l-amap["a"])+13) % 26 ) + amap["a"])
}
FS = ""
}
{
o = ""
for(i=1; i <= NF; i++) {
if ( amap[tolower($i)] in rot13 ) {
c = rot13[amap[tolower($i)]]
if ( tolower($i) != $i ) c = toupper(c)
o = o c
} else {
o = o $i
}
}
print o
}


=={{header|BASIC}}==
{{works with|QBasic}}

CLS
INPUT "Enter a string: ", s$
ans$ = ""
FOR a = 1 TO LEN(s$)
letter$ = MID$(s$, a, 1)
IF letter$ >= "A" AND letter$ <= "Z" THEN
char$ = CHR$(ASC(letter$) + 13)
IF char$ > "Z" THEN char$ = CHR$(ASC(char$) - 26)
ELSEIF letter$ >= "a" AND letter$ <= "z" THEN
char$ = CHR$(ASC(letter$) + 13)
IF char$ > "z" THEN char$ = CHR$(ASC(char$) - 26)
ELSE
char$ = letter$
END IF
ans$ = ans$ + char$
NEXT a
PRINT ans$


===Alternate version===
This version does the rotation in-place without the use of a second variable.

INPUT "Enter a string "; Text$
FOR c% = 1 TO LEN(Text$)
SELECT CASE ASC(MID$(Text$, c%, 1))
CASE 65 TO 90
MID$(Text$, c%, 1) = CHR$(65 + ((ASC(MID$(Text$, c%, 1)) - 65 + 13) MOD 26))
CASE 97 TO 122
MID$(Text$, c%, 1) = CHR$(97 + ((ASC(MID$(Text$, c%, 1)) - 97 + 13) MOD 26))
END SELECT
NEXT c%
PRINT "Converted......: "; Text$


Sample output:
Enter a string ? Oolite quick Thargoid jumps lazy Vipers = blown up + special fx
Converted......: Bbyvgr dhvpx Gunetbvq whzcf ynml Ivcref = oybja hc + fcrpvny sk

See also: [[#BBC BASIC|BBC BASIC]], [[#FBSL|FBSL]], [[#GW-BASIC|GW-BASIC]], [[#Liberty BASIC|Liberty BASIC]], [[#Locomotive Basic|Locomotive Basic]], [[#PureBasic|PureBasic]], [[#Run BASIC|Run BASIC]], [[#TI-83 BASIC|TI-83 BASIC]], [[#Visual Basic .NET|Visual Basic .NET]], [[#ZX Spectrum Basic|ZX Spectrum Basic]]

=={{header|BBC BASIC}}==

REPEAT
INPUT A$
PRINT FNrot13(A$)
UNTIL FALSE
END

DEF FNrot13(A$)
LOCAL A%,B$,C$
IF A$="" THEN =""
FOR A%=1 TO LEN A$
C$=MID$(A$,A%,1)
IF C$<"A" OR (C$>"Z" AND C$<"a") OR C$>"z" THEN
B$=B$+C$
ELSE
IF (ASC(C$) AND &DF) B$=B$+CHR$(ASC(C$)+13)
ELSE
B$=B$+CHR$(ASC(C$)-13)
ENDIF
ENDIF
NEXT A%
=B$


=={{header|Befunge}}==
~:"z"`#v_:"m"`#v_:"`"` |>
:"Z"`#v_:"M"`#v_:"@"`|>
: 0 `#v_@v-6-7< >
, < <+6+7 <

=={{header|Burlesque}}==


blsq ) "HELLO WORLD"{{'A'Zr\\/Fi}m[13?+26.%'A'Zr\\/si}ww
"URYYB JBEYQ"
blsq ) "URYYB JBEYQ"{{'A'Zr\\/Fi}m[13?+26.%'A'Zr\\/si}ww
"HELLO WORLD"


=={{header|C}}==
#include
#include
#include

#define MAXLINE 1024

char *rot13(char *s)
{
char *p=s;
int upper;

while(*p) {
upper=toupper(*p);
if(upper>='A' && upper<='M') *p+=13;
else if(upper>='N' && upper<='Z') *p-=13;
++p;
}
return s;
}

void rot13file(FILE *fp)
{
static char line[MAXLINE];
while(fgets(line, MAXLINE, fp)>0) fputs(rot13(line), stdout);
}

int main(int argc, char *argv[])
{
int n;
FILE *fp;

if(argc>1) {
for(n=1; n if(!(fp=fopen(argv[n], "r"))) {
fprintf(stderr, "ERROR: Couldn\'t read %s\n", argv[n]);
exit(EXIT_FAILURE);
}
rot13file(fp);
fclose(fp);
}
} else rot13file(stdin);

return EXIT_SUCCESS;
}


===Alternative version===
This version rot13'd lowercase and uppercase letters.

File can be processing simply by piping:
cat filename | ./rot13

#include
#include

char rot13_char(char s);

int main(int argc, char *argv[]) {
int c;
if (argc != 1) {
fprintf(stderr, "Usage: %s\n", argv[0]);
return 1;
}
while((c = getchar()) != EOF) {
putchar(rot13_char(c));
}

return 0;
}

char rot13_char(char c) {
if (isalpha(c)) {
char alpha = islower(c) ? 'a' : 'A';
return (c - alpha + 13) % 26 + alpha;
}
return c;
}


=={{header|C sharp|C#}}==
using System;
using System.IO;
using System.Linq;
using System.Text;

class Program
{
static char Rot13(char c)
{
if ('a' <= c && c <= 'm' || 'A' <= c && c <= 'M')
{
return (char)(c + 13);
}
if ('n' <= c && c <= 'z' || 'N' <= c && c <= 'Z')
{
return (char)(c - 13);
}
return c;
}

static string Rot13(string s)
{
return new StringBuilder().Append(s.Select(Rot13).ToArray()).ToString();
}


static void Main(string[] args)
{
foreach (var file in args.Where(file => File.Exists(file)))
{
Console.WriteLine(Rot13(File.ReadAllText(file)));
}
if (!args.Any())
{
Console.WriteLine(Rot13(Console.In.ReadToEnd()));
}
}
}


=={{header|C++}}==
#include
#include
#include
#include
#include
#include

// the rot13 function
std::string rot13(std::string s)
{
static std::string const
lcalph = "abcdefghijklmnopqrstuvwxyz",
ucalph = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";

std::string result;
std::string::size_type pos;

result.reserve(s.length());

for (std::string::iterator it = s.begin(); it != s.end(); ++it)
{
if ( (pos = lcalph.find(*it)) != std::string::npos )
result.push_back(lcalph[(pos+13) % 26]);
else if ( (pos = ucalph.find(*it)) != std::string::npos )
result.push_back(ucalph[(pos+13) % 26]);
else
result.push_back(*it);
}

return result;
}

// function to output the rot13 of a file on std::cout
// returns false if an error occurred processing the file, true otherwise
// on entry, the argument is must be open for reading
int rot13_stream(std::istream& is)
{
std::string line;
while (std::getline(is, line))
{
if (!(std::cout << rot13(line) << "\n"))
return false;
}
return is.eof();
}

// the main program
int main(int argc, char* argv[])
{
if (argc == 1) // no arguments given
return rot13_stream(std::cin)? EXIT_SUCCESS : EXIT_FAILURE;

std::ifstream file;
for (int i = 1; i < argc; ++i)
{
file.open(argv[i], std::ios::in);
if (!file)
{
std::cerr << argv[0] << ": could not open for reading: " << argv[i] << "\n";
return EXIT_FAILURE;
}
if (!rot13_stream(file))
{
if (file.eof())
// no error occurred for file, so the error must have been in output
std::cerr << argv[0] << ": error writing to stdout\n";
else
std::cerr << argv[0] << ": error reading from " << argv[i] << "\n";
return EXIT_FAILURE;
}
file.clear();
file.close();
if (!file)
std::cerr << argv[0] << ": warning: closing failed for " << argv[i] << "\n";
}
return EXIT_SUCCESS;
}


Here is an other approach which can rotate by any number:
{{libheader|Boost}}
#include
#include
#include // output_filter
#include // put
#include
#include
namespace io = boost::iostreams;

class rot_output_filter : public io::output_filter
{
public:
explicit rot_output_filter(int r=13):rotby(r),negrot(alphlen-r){};

template
bool put(Sink& dest, int c){
char uc = toupper(c);

if(('A' <= uc) && (uc <= ('Z'-rotby)))
c = c + rotby;
else if ((('Z'-rotby) <= uc) && (uc <= 'Z'))
c = c - negrot;
return boost::iostreams::put(dest, c);
};
private:
static const int alphlen = 26;
const int rotby;
const int negrot;
};

int main(int argc, char *argv[])
{
io::filtering_ostream out;
out.push(rot_output_filter(13));
out.push(std::cout);

if (argc == 1) out << std::cin.rdbuf();
else for(int i = 1; i < argc; ++i){
std::ifstream in(argv[i]);
out << in.rdbuf();
}
}



=={{header|Clojure}}==
(defn rot-13 [c]
(let [i (int c)]
(cond
(or (and (>= i (int \a)) (<= i (int \m)))
(and (>= i (int \A)) (<= i (int \M))))
(char (+ i 13))
(or (and (>= i (int \n)) (<= i (int \z)))
(and (>= i (int \N)) (<= i (int \Z))))
(char (- i 13))
:else c)))

(apply str (map rot-13 "abcxyzABCXYZ")) ;; output "nopklmNOPKLM"

An alternative implementation using a closure or two:
(let [A (into #{} "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
A-map (zipmap A (take 52 (drop 26 (cycle A))))]

(defn rot13[in-str]
(reduce str (map #(if (A %1) (A-map %1) %1) in-str))))

(rot13 "The Quick Brown Fox Jumped Over The Lazy Dog!") ;; produces "Gur Dhvpx Oebja Sbk Whzcrq Bire Gur Ynml Qbt!"


=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. rot-13.

DATA DIVISION.
LOCAL-STORAGE SECTION.
78 STR-LENGTH VALUE 100.

78 normal-lower VALUE "abcdefghijklmnopqrstuvwxyz".
78 rot13-lower VALUE "nopqrstuvwxyzabcdefghijklm".

78 normal-upper VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
78 rot13-upper VALUE "NOPQRSTUVWXYZABCDEFGHIJKLM".

LINKAGE SECTION.
01 in-str PIC X(STR-LENGTH).
01 out-str PIC X(STR-LENGTH).

PROCEDURE DIVISION USING VALUE in-str, REFERENCE out-str.
MOVE in-str TO out-str

INSPECT out-str CONVERTING normal-lower TO rot13-lower
INSPECT out-str CONVERTING normal-upper TO rot13-upper

GOBACK
.


=={{header|Common Lisp}}==
The standard gives implementations great leeway with respect to character encodings, so we can't rely on the convenient properties of ASCII.
(defconstant +alphabet+
'(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P
#\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z))

(defun rot13 (s)
(map 'string
(lambda (c &aux (n (position (char-upcase c) +alphabet+)))
(if n
(funcall
(if (lower-case-p c) #'char-downcase #'identity)
(nth (mod (+ 13 n) 26) +alphabet+))
c))
s))


====Assuming ASCII Character Set====
Though the standard intentionally doesn't specify encoding, every popular implementation today uses ASCII.
(defun rot13 (string)
(map 'string
(lambda (char &aux (code (char-code char)))
(if (alpha-char-p char)
(if (> (- code (char-code (if (upper-case-p char)
#\A #\a))) 12)
(code-char (- code 13))
(code-char (+ code 13)))
char))
string))

(rot13 "Moron") ; -> "Zbeba"


=={{header|Cubescript}}==
alias rot13 [
push alpha [
"A B C D E F G H I J K L M N O P Q R S T U V W X Y Z"
"a b c d e f g h i j k l m n o p q r s t u v w x y z"
] [ push chars [] [
loop i (strlen $arg1) [
looplist n $alpha [
if (! (listlen $chars)) [
alias chars (? (> (listindex $n (substr $arg1 $i 1)) -1) $n [])
]
]
alias arg1 (
concatword (substr $arg1 0 $i) (
? (listlen $chars) (
at $chars (
mod (+ (
listindex $chars (substr $arg1 $i 1)
) 13 ) (listlen $chars)
)
) (substr $arg1 $i 1)
) (substr $arg1 (+ $i 1) (strlen $arg1))
)
alias chars []
]
] ]
result $arg1
]


Usage:
>>> rot13 "Hello World"
> Uryyb Jbeyq
>>> rot13 "Gur Dhvpx Oebja Sbk Whzcf Bire Gur Ynml Qbt!"
> The Quick Brown Fox Jumps Over The Lazy Dog!


=={{header|D}}==
===Using Standard Functions===
import std.stdio;
import std.ascii: letters, U = uppercase, L = lowercase;
import std.string: makeTrans, translate;

immutable r13 = makeTrans(letters,
//U[13 .. $] ~ U[0 .. 13] ~
U[13 .. U.length] ~ U[0 .. 13] ~
L[13 .. L.length] ~ L[0 .. 13]);

void main() {
writeln("This is the 1st test!".translate(r13, null));
}

{{out}}
The Quick Brown Fox Jumps Over The Lazy Dog!

===Imperative Implementation===
import std.stdio, std.string, std.traits;

pure S rot13(S)(in S s) if (isSomeString!S) {
return rot(s, 13);
}

pure S rot(S)(in S s, in int key) if (isSomeString!S) {
auto r = s.dup;

foreach (i, ref c; r) {
if ('a' <= c && c <= 'z')
c = ((c - 'a' + key) % 26 + 'a');
else if ('A' <= c && c <= 'Z')
c = ((c - 'A' + key) % 26 + 'A');
}
return cast(S) r;
}

void main() {
"Gur Dhvpx Oebja Sbk Whzcf Bire Gur Ynml Qbt!".rot13().writeln();
}


=={{header|Déjà Vu}}==

rot-13:
)
for ch in chars swap:
ord ch
if <= 65 dup:
if >= 90 dup:
+ 13 - swap 65
+ 65 % swap 26
if <= 97 dup:
if >= 122 dup:
+ 13 - swap 97
+ 97 % swap 26
chr
concat(

!print rot-13 "Snape kills Frodo with Rosebud."

{{out}}
Fancr xvyyf Sebqb jvgu Ebfrohq.


=={{header|E}}==
pragma.enable("accumulator")

var rot13Map := [].asMap()
for a in ['a', 'A'] {
for i in 0..!26 {
rot13Map with= (a + i, E.toString(a + (i + 13) % 26))
}
}

def rot13(s :String) {
return accum "" for c in s { _ + rot13Map.fetch(c, fn{ c }) }
}


=={{header|Erlang}}==

rot13(Str) ->
F = fun(C) when (C >= $A andalso C =< $M); (C >= $a andalso C =< $m) -> C + 13;
(C) when (C >= $N andalso C =< $Z); (C >= $n andalso C =< $z) -> C - 13;
(C) -> C
end,
lists:map(F, Str).


=={{header|Euphoria}}==
{{works with|Euphoria|4.0.0}}

include std/types.e
include std/text.e

atom FALSE = 0
atom TRUE = not FALSE

function Rot13( object oStuff )
integer iOffset
integer bIsUpper
object oResult
sequence sAlphabet = "abcdefghijklmnopqrstuvwxyz"
if sequence(oStuff) then
oResult = repeat( 0, length( oStuff ) )
for i = 1 to length( oStuff ) do
oResult[ i ] = Rot13( oStuff[ i ] )
end for
else
bIsUpper = FALSE
if t_upper( oStuff ) then
bIsUpper = TRUE
oStuff = lower( oStuff )
end if
iOffset = find( oStuff, sAlphabet )
if iOffset != 0 then
iOffset += 13
iOffset = remainder( iOffset, 26 )
if iOffset = 0 then iOffset = 1 end if
oResult = sAlphabet[iOffset]
if bIsUpper then
oResult = upper(oResult)
end if
else
oResult = oStuff --sprintf( "%s", oStuff )
end if
end if
return oResult
end function

puts( 1, Rot13( "abjurer NOWHERE." ) & "\n" )


=={{header|F_Sharp|F#}}==
Illustrates turning a string into an array of chars then composition of type casting with a conversion function. We create a composite that converts its input to an integer, calls the convertion function and
then casts to a char type. The result is an array of modified chars that we can use to create a new string.
let rot13 (s : string) =
let rot c =
match c with
| c when c > 64 && c < 91 -> ((c - 65 + 13) % 26) + 65
| c when c > 96 && c < 123 -> ((c - 97 + 13) % 26) + 97
| _ -> c
s |> Array.of_seq
|> Array.map(int >> rot >> char)
|> (fun seq -> new string(seq))


=={{header|Factor}}==
#! /usr/bin/env factor

USING: kernel io ascii math combinators sequences ;
IN: rot13

: rot-base ( ch ch -- ch ) [ - 13 + 26 mod ] keep + ;

: rot13-ch ( ch -- ch )
{
{ [ dup letter? ] [ CHAR: a rot-base ] }
{ [ dup LETTER? ] [ CHAR: A rot-base ] }
[ ]
}
cond ;

: rot13 ( str -- str ) [ rot13-ch ] map ;

: main ( -- )
[ readln dup ]
[ rot13 print flush ]
while
drop ;

MAIN: main


=={{header|FALSE}}==
[^$1+][$32|$$'z>'a@>|$[\%]?~[13\'m>[_]?+]?,]#%

=={{header|Fantom}}==


class Rot13
{
static Str rot13 (Str input)
{
Str result := ""
input.each |Int c|
{
if ((c.lower >= 'a') && (c.lower <= 'm'))
result += (c+13).toChar
else if ((c.lower >= 'n') && (c.lower <= 'z'))
result += (c-13).toChar
else
result += c.toChar
}
return result
}

public static Void main (Str[] args)
{
if (args.size == 1)
{ // process each line of given file
Str filename := args[0]
File(filename.toUri).eachLine |Str line|
{
echo (rot13(line))
}
}
else
{
echo ("Test:")
Str text := "abcstuABCSTU123!+-"
echo ("Text $text becomes ${rot13(text)}")
}
}
}


=={{header|FBSL}}==
Implements a circular queue, finds the required character and then rotates the queue forward 13 places. Would do as a solution to Caesar Cipher with a different rotation number. Please note that FBSL is not case sensitive, thus the use of lstrcmp.
#APPTYPE CONSOLE

REM Create a CircularQueue object
REM CQ.Store item
REM CQ.Find items
REM CQ.Forward nItems
REM CQ.Recall

REM SO CQ init WITH "A"... "Z"
REM CQ.Find "B"
REM QC.Forward 13
REM QC.Recall

CLASS CircularQueue
items[]
head
tail
here

SUB INITIALIZE(dArray)
head = 0
tail = 0
here = 0
FOR DIM i = LBOUND(dArray) TO UBOUND(dArray)
items[tail] = dArray[i]
tail = tail + 1
NEXT
END SUB

SUB TERMINATE()
REM
END SUB

METHOD Put(s AS STRING)
items[tail] = s
tail = tail + 1
END METHOD

METHOD Find(s AS STRING)
FOR DIM i = head TO tail - 1
IF items[i] = s THEN
here = i
RETURN TRUE
END IF
NEXT
RETURN FALSE
END METHOD

METHOD Move(n AS INTEGER)
DIM bound AS INTEGER = UBOUND(items) + 1
here = (here + n) MOD bound
END METHOD

METHOD Recall()
RETURN items[here]
END METHOD

PROPERTY Size()
RETURN COUNT(items)
END PROPERTY
END CLASS

DIM CQ AS NEW CircularQueue({"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"})

DIM c AS STRING
DIM isUppercase AS INTEGER
DIM s AS STRING = "nowhere ABJURER"

FOR DIM i = 1 TO LEN(s)
c = MID(s, i, 1)
isUppercase = lstrcmp(LCASE(c), c)
IF CQ.Find(UCASE(c)) THEN
CQ.Move(13)
PRINT IIF(isUppercase, UCASE(CQ.Recall()), LCASE(CQ.Recall())) ;
ELSE
PRINT c;
END IF
NEXT

PAUSE


=={{header|Forth}}==

A simple version, using nested conditionals.
: r13 ( c -- o )
dup 32 or \ tolower
dup [char] a [char] z 1+ within if
[char] m > if -13 else 13 then +
else drop then ;


A table driven version which should be more efficient. The mechanism is flexible enough to express any sort of transform.
: ,chars ( end start -- )
do i c, loop ;

: xlate create does> ( c -- c' ) + c@ ;

xlate rot13
char A 0 ,chars
char Z 1+ char N ,chars
char N char A ,chars
char a char Z 1+ ,chars
char z 1+ char n ,chars
char n char a ,chars
256 char z 1+ ,chars

: rot13-string ( addr len -- )
over + swap do i c@ rot13 i c! loop ;

: .rot13" ( string -- )
[char] " parse 2dup rot13-string type ;

.rot13" abjurer NOWHERE" \ nowhere ABJURER


=={{header|Fortran}}==
{{works with|Fortran|90 and later}}
program test_rot_13

implicit none
integer, parameter :: len_max = 256
integer, parameter :: unit = 10
character (len_max) :: file
character (len_max) :: fmt
character (len_max) :: line
integer :: arg
integer :: arg_max
integer :: iostat

write (fmt, '(a, i0, a)') '(a', len_max, ')'
arg_max = iargc ()
if (arg_max > 0) then
! Encode all files listed on the command line.
do arg = 1, arg_max
call getarg (arg, file)
open (unit, file = file, iostat = iostat)
if (iostat /= 0) cycle
do
read (unit, fmt = fmt, iostat = iostat) line
if (iostat /= 0) exit
write (*, '(a)') trim (rot_13 (line))
end do
close (unit)
end do
else
! Encode standard input.
do
read (*, fmt = fmt, iostat = iostat) line
if (iostat /= 0) exit
write (*, '(a)') trim (rot_13 (line))
end do
end if

contains

function rot_13 (input) result (output)

implicit none
character (len_max), intent (in) :: input
character (len_max) :: output
integer :: i

output = input
do i = 1, len_trim (output)
select case (output (i : i))
case ('A' : 'M', 'a' : 'm')
output (i : i) = char (ichar (output (i : i)) + 13)
case ('N' : 'Z', 'n' : 'z')
output (i : i) = char (ichar (output (i : i)) - 13)
end select
end do

end function rot_13

end program test_rot_13

Note: iargc and getarg are common extensions that are implemented by e.g. the Intel Fortran Compiler, G95 and gfortran.

Sample usage:
> cat foo.txt
foo
> cat bar.txt
bar
> ./rot_13 foo.txt bar.txt
sbb
one
> ./rot_13 < foo.txt
sbb
> cat foo.txt bar.txt | ./rot_13
sbb
one

=={{header|GAP}}==
rot13 := function(s)
local upper, lower, c, n, t;
upper := "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
lower := "abcdefghijklmnopqrstuvwxyz";
t := [ ];
for c in s do
n := Position(upper, c);
if n <> fail then
Add(t, upper[((n+12) mod 26) + 1]);
else
n := Position(lower, c);
if n <> fail then
Add(t, lower[((n+12) mod 26) + 1]);
else
Add(t, c);
fi;
fi;
od;
return t;
end;

a := "England expects that every man will do his duty";
# "England expects that every man will do his duty"
b := rot13(a);
# "Ratynaq rkcrpgf gung rirel zna jvyy qb uvf qhgl"
c := rot13(b);
# "England expects that every man will do his duty"


=={{header|Gema}}==
/[a-mA-M]/=@int-char{@add{@char-int{$1};13}}
/[n-zN-Z]/=@int-char{@sub{@char-int{$1};13}}


=={{header|GML}}==

#define rot13
var in, out, i, working;
in = argument0;
out = "";
for (i = 1; i <= string_length(in); i += 1)
{
working = ord(string_char_at(in, i));
if ((working > 64) && (working < 91))
{
working += 13;
if (working > 90)
{
working -= 26;
}
}
else if ((working > 96) && (working < 123))
{
working += 13;
if (working > 122) working -= 26;
}
out += chr(working);
}
return out;


The above code is called like this:
show_message(rot13("My dog has fleas!"));

Output (in a message box):
Zl qbt unf syrnf!

=={{header|Go}}==
package main

import (
"fmt"
"strings"
)

func rot13char(c rune) rune {
if c >= 'a' && c <= 'm' || c >= 'A' && c <= 'M' {
return c + 13
} else if c >= 'n' && c <= 'z' || c >= 'N' && c <= 'Z' {
return c - 13
}
return c
}

func rot13(s string) string {
return strings.Map(rot13char, s)
}

func main() {
fmt.Println(rot13("nowhere ABJURER"))
}

Output:

abjurer NOWHERE


=={{header|Groovy}}==
Solution:
def rot13 = { String s ->
(s as List).collect { ch ->
switch (ch) {
case ('a'..'m') + ('A'..'M'):
return (((ch as char) + 13) as char)
case ('n'..'z') + ('N'..'Z'):
return (((ch as char) - 13) as char)
default:
return ch
}
}.inject ("") { string, ch -> string += ch}
}


Test program:
println rot13("Noyr jnf V, 'rer V fnj Ryon.")

Output:
Able was I, 'ere I saw Elba.


=={{header|GW-BASIC}}==
10 INPUT "Enter a string: ",A$
20 GOSUB 50
30 PRINT B$
40 END
50 FOR I=1 TO LEN(A$)
60 N=ASC(MID$(A$,I,1))
70 E=255
80 IF N>64 AND N<91 THEN E=90 ' uppercase
90 IF N>96 AND N<123 THEN E=122 ' lowercase
100 IF E<255 THEN N=N+13
110 IF N>E THEN N=N-26
120 B$=B$+CHR$(N)
130 NEXT
140 RETURN


=={{header|Haskell}}==
Straightforward implementation by checking multiple cases:

import Data.Char

rot13 :: Char -> Char
rot13 c
| toLower c >= 'a' && toLower c <= 'm' = chr (ord c + 13)
| toLower c >= 'n' && toLower c <= 'z' = chr (ord c - 13)
| otherwise = c


To wrap that as an utility program, here's a quick implementation of a general framework:

import System.Environment
import System.IO
import System.Directory
import Control.Monad

hInteract :: (String -> String) -> Handle -> Handle -> IO ()
hInteract f hIn hOut =
hGetContents hIn >>= hPutStr hOut . f

processByTemp :: (Handle -> Handle -> IO ()) -> String -> IO ()
processByTemp f name = do
hIn <- openFile name ReadMode
let tmp = name ++ "$"
hOut <- openFile tmp WriteMode
f hIn hOut
hClose hIn
hClose hOut
removeFile name
renameFile tmp name

process :: (Handle -> Handle -> IO ()) -> [String] -> IO ()
process f [] = f stdin stdout
process f ns = mapM_ (processByTemp f) ns


Then the wrapped program is simply
main = do
names <- getArgs
process (hInteract (map rot13)) names


Note that the framework will read the file lazily, which also provides buffering.

=={{header|HicEst}}==
CHARACTER c, txt='abc? XYZ!', cod*100

DO i = 1, LEN_TRIM(txt)
c = txt(i)
n = ICHAR(txt(i))
IF( (c >= 'a') * (c <= 'm') + (c >= 'A') * (c <= 'M') ) THEN
c = CHAR( ICHAR(c) + 13 )
ELSEIF( (c >= 'n') * (c <= 'z') + (c >= 'N') * (c <= 'Z') ) THEN
c = CHAR( ICHAR(c) - 13 )
ENDIF

cod(i) = c
ENDDO

WRITE(ClipBoard, Name) txt, cod ! txt=abc? XYZ!; cod=nop? KLM!;
END


=={{header|Icon}} and {{header|Unicon}}==
procedure main(arglist)
file := open(arglist[1],"r") | &input
every write(rot13(|read(file)))
end

procedure rot13(s) #: returns rot13(string)
static a,n
initial {
a := &lcase || &ucase
(&lcase || &lcase) ? n := ( move(13), move(*&lcase) )
(&ucase || &ucase) ? n ||:= ( move(13), move(*&ucase) )
}
return map(s,a,n)
end

This example uses a number of Icon features.
* alternation ( x | y ) selects and opens a file if supplied or fall back to standard output
* repeated alternation ( |x ) is used to generate the contents of the input file
* the rot13 procedure does a one time setup (initially) of persistent (static) mapping strings so the procedure can return the rot13 mapping
* the setup exploits the ordered cset variables &lcase and &ucase coercing them into strings
* the rot13 mapping string is then aggregated with strings taken by offsetting into double length values to avoid unnecessary and messy rotation

=={{header|J}}==
rot13=: {&((65 97+/~i.2 13) |.@[} i.256)&.(a.&i.)

For example:

rot13 'abc! ABC!'
nop! NOP!

Compare with the solution to the [[Change_string_case#J|Change String Case]] task.

=={{header|Java}}==
import java.io.*;

public class Rot13 {
public static void main(String[] args) {
BufferedReader in;
if (args.length >= 1) {
for (String file : args) {
try {
in = new BufferedReader(new FileReader(file));
String line;
while ((line = in.readLine()) != null) {
System.out.println(convert(line));
}
} catch (IOException e) {
e.printStackTrace();
}
}
} else {
try {
in = new BufferedReader(new InputStreamReader(System.in));
String line;
while ((line = in.readLine()) != null) {
System.out.println(convert(line));
}
} catch (IOException e) {
e.printStackTrace();
}
}
}

public static String convert(String msg) {
StringBuilder retVal = new StringBuilder();
for (char a : msg.toCharArray()) {
if (a >= 'A' && a <= 'Z') {
a += 13;
if (a > 'Z') {
a -= 26;
}
} else if (a >= 'a' && a <= 'z') {
a += 13;
if (a > 'z') {
a -= 26;
}
}
retVal.append(a);
}
return retVal.toString();
}
}


=={{header|JavaScript}}==
function rot13(c) {
return c.replace(/([a-m])|([n-z])/ig, function($0,$1,$2) {
return String.fromCharCode($1 ? $1.charCodeAt(0) + 13 : $2 ? $2.charCodeAt(0) - 13 : 0) || $0;
});
}
rot13("ABJURER nowhere") // NOWHERE abjurer


TDD with Jasmine using Underscore.js


function rot13(value){
if (!value)
return "";

function singleChar(c) {
if (c.toUpperCase() < "A" || c.toUpperCase() > "Z")
return c;

if (c.toUpperCase() <= "M")
return String.fromCharCode(c.charCodeAt(0) + 13);

return String.fromCharCode(c.charCodeAt(0) - 13);
}

return _.map(value.split(""), singleChar).join("");
}

describe("Rot-13", function() {
it("Given nothing will return nothing", function() {
expect(rot13()).toBe("");
});

it("Given empty string will return empty string", function() {
expect(rot13("")).toBe("");
});

it("Given A will return N", function() {
expect(rot13("A")).toBe("N");
});

it("Given B will return O", function() {
expect(rot13("B")).toBe("O");
});

it("Given N will return A", function() {
expect(rot13("N")).toBe("A");
});

it("Given Z will return M", function() {
expect(rot13("Z")).toBe("M");
});

it("Given ZA will return MN", function() {
expect(rot13("ZA")).toBe("MN");
});

it("Given HELLO will return URYYB", function() {
expect(rot13("HELLO")).toBe("URYYB");
});

it("Given hello will return uryyb", function() {
expect(rot13("hello")).toBe("uryyb");
});


it("Given hello1 will return uryyb1", function() {
expect(rot13("hello1")).toBe("uryyb1");
});
});


=={{header|Julia}}==
function rot13(c::Char)
c in 'a':'z' ? 'a' + (c - 'a' + 13)%26 :
c in 'A':'Z' ? 'A' + (c - 'A' + 13)%26 :
c
end

rot13(s::String) = map(rot13,CharString(s...))


{{out}}
julia> rot13("abcdefghijklmnopqrtuvwxyz 123 ABCDEFGHIJKLMNOPQRTUVWXYZ")
"nopqrstuvwxyzabcdeghijklm 123 NOPQRSTUVWXYZABCDEGHIJKLM"


=={{header|K}}==
rot13: {a:+65 97+\:2 13#!26;_ci@[!256;a;:;|a]_ic x}

rot13 "Testing! 1 2 3"
"Grfgvat! 1 2 3"




=={{header|LabVIEW}}==
{{VI solution|LabVIEW_Rot-13.png}}

=={{header|Lasso}}==

// Extend the string type

define string->rot13 => {
local(
rot13 = bytes,
i, a, b
)

with char in .eachCharacter
let int = #char->integer
do {
// We only modify these ranges, set range if we should modify
#int >= 65 and #int < 91 ? local(a=65,b=91) |
#int >= 97 and #int < 123 ? local(a=97,b=123) | local(a=0,b=0)

if(#a && #b) => {
#i = (#int+13) % #b // loop back if past ceiling (#b)
#i += #a * (1 - #i / #a) // offset if below floor (#a)
#rot13->import8bits(#i) // import the new character
else
#rot13->append(#char) // just append the character
}
}

return #rot13->asstring
}


;Example:
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'->rot13

'Where do you find a dog with no legs?
Evtug jurer lbh yrsg uvz.'->rot13


{{out}}
NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm

Jurer qb lbh svaq n qbt jvgu ab yrtf?
Right where you left him.


;Another implementation:

define rot13(p::string) => {
local(
rot13 = bytes,
a = bytes('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'),
b = bytes('NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm'),
i
)

with char in #p->eachCharacter
let c = bytes(#char) do {
#i = #a->find(#b)
#i ? #rot13->import8bits(#b->get(#i)) | #rot13->append(#c)
}

return #rot13->asString
}

rot13('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')


{{out}}

NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm


=={{header|Liberty BASIC}}==
Liberty BASIC string comparisons are not ascii-based.
Verbose version:
input "Type some text to be encoded, then ENTER. ";tx$

tex$ = Rot13$(tx$)
print tex$
'check
print Rot13$(tex$)

wait

Function Rot13$(t$)
if t$="" then
Rot13$=""
exit function
end if
for i = 1 to len(t$)
c$=mid$(t$,i,1)
ch$=c$
if (asc(c$)>=asc("A")) and (asc(c$)<=asc("Z")) then
ch$=chr$(asc(c$)+13)
if (asc(ch$)>asc("Z")) then ch$=chr$(asc(ch$)-26)
end if
if (asc(c$)>=asc("a")) and (asc(c$)<=asc("z")) then
ch$=chr$(asc(c$)+13)
if (asc(ch$)>asc("z")) then ch$=chr$(asc(ch$)-26)
end if
rot$=rot$+ch$
next
Rot13$=rot$
end function


Concise:
Function Rot13$(t$)
for i = 1 to len(t$)
ch$=mid$(t$,i,1)
if (asc(ch$)>=asc("A")) and (asc(ch$)<=asc("Z")) then
ch$=chr$(asc("A")+ (asc(ch$)-asc("A")+13) mod 26)
end if
if (asc(ch$)>=asc("a")) and (asc(ch$)<=asc("z")) then
ch$=chr$(asc("a")+ (asc(ch$)-asc("a")+13) mod 26)
end if
Rot13$=Rot13$+ch$
next
end function


=={{header|Limbo}}==

A fairly straightforward version that uses a lookup table, based on Inferno's cat(1).

implement Rot13;

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

Rot13: module
{
init: fn(ctxt: ref Draw->Context, argv: list of string);
};

stdout: ref Sys->FD;
tab: array of int;

init(nil: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
stdout = sys->fildes(1);
inittab();
args = tl args;
if(args == nil)
args = "-" :: nil;
for(; args != nil; args = tl args){
file := hd args;
if(file != "-"){
fd := sys->open(file, Sys->OREAD);
if(fd == nil){
sys->fprint(sys->fildes(2), "rot13: cannot open %s: %r\n", file);
raise "fail:bad open";
}
rot13cat(fd, file);
}else
rot13cat(sys->fildes(0), "");
}
}

inittab()
{
tab = array[256] of int;
for(i := 0; i < 256; i++)
tab[i] = i;

for(i = 'a'; i <= 'z'; i++)
tab[i] = (((i - 'a') + 13) % 26) + 'a';
for(i = 'A'; i <= 'Z'; i++)
tab[i] = (((i - 'A') + 13) % 26) + 'A';
}


rot13(s: string): string
{
for(i := 0; i < len s; i++) {
if(s[i] < 256)
s[i] = tab[s[i]];
}
return s;
}

rot13cat(fd: ref Sys->FD, file: string)
{
buf := array[Sys->ATOMICIO] of byte;

while((n := sys->read(fd, buf, len buf)) > 0) {
obuf := array of byte (rot13(string buf));
if(sys->write(stdout, obuf, n) < n) {
sys->fprint(sys->fildes(2), "rot13: write error: %r\n");
raise "fail:write error";
}
}
if(n < 0) {
sys->fprint(sys->fildes(2), "rot13: error reading %s: %r\n", file);
raise "fail:read error";
}
}


=={{header|LiveCode}}==
function rot13 S
repeat with i = 1 to length(S)
get chartonum(char i of S)
if it < 65 or it > 122 or (it > 90 and it < 97) then next repeat
put char it - 64 of "NOPQRSTUVWXYZABCDEFGHIJKLM nopqrstuvwxyzabcdefghijklm" into char i of S
end repeat
return S
end rot13



=={{header|Locomotive Basic}}==

10 INPUT "Enter a string: ",a$
20 GOSUB 50
30 PRINT b$
40 END
50 FOR i=1 TO LEN(a$)
60 n=ASC(MID$(a$,i,1))
70 e=255
80 IF n>64 AND n<91 THEN e=90 ' uppercase
90 IF n>96 AND n<123 THEN e=122 ' lowercase
100 IF e<255 THEN n=n+13
110 IF n>e THEN n=n-26
120 b$=b$+CHR$(n)
130 NEXT
140 RETURN


=={{header|Logo}}==
to rot13 :c
make "a difference ascii lowercase :c ascii "a
if or :a < 0 :a > 25 [output :c]
make "delta ifelse :a < 13 [13] [-13]
output char sum :delta ascii :c
end

print map "rot13 "|abjurer NOWHERE|
nowhere ABJURER

=={{header|Lua}}==
function rot(l, o) return (l < 26 and l > -1) and string.char((l+13)%26 + o) end
a, A = string.byte'a', string.byte'A'
val = io.read()
val = val:gsub("(.)", function(l) return rot(l:byte()-a,a) or rot(l:byte()-A,A) or l end)
print(val)


=={{header|Maple}}==
There is a built-in command for this in Maple.
> StringTools:-Encode( "The Quick Brown Fox Jumped Over The Lazy Dog!", encoding = rot13 );
"Gur Dhvpx Oebja Sbk Whzcrq Bire Gur Ynml Qbt!"


=={{header|Mathematica}}==
ruleslower=Thread[#-> RotateLeft[#, 13]]&[CharacterRange["a", "z"]];
rulesupper=Thread[#-> RotateLeft[#, 13]]&[CharacterRange["A", "Z"]];
rules=Join[ruleslower,rulesupper];
text="Hello World! Are you there!?"
text=StringReplace[text,rules]
text=StringReplace[text,rules]

gives back:
Hello World! Are you there!?
Uryyb Jbeyq! Ner lbh gurer!?
Hello World! Are you there!?


=={{header|MATLAB}}==
function r=rot13(s)
if ischar(s)
r=s; % preallocation and copy of non-letters
for i=1:size(s,1)
for j=1:size(s,2)
if isletter(s(i,j))
if s(i,j)>=97 % lower case
base = 97;
else % upper case
base = 65;
end
r(i,j)=char(mod(s(i,j)-base+13,26)+base);
end
end
end
else
error('Argument must be a CHAR')
end
end

Call it like this:
>> rot13('Hello World!')

ans =

Uryyb Jbeyq!


It is possible to vectorize this code, the example below is not fully vectorized in order to make the order of operations clear. It is possible to reduce this solution to two lines by integrating the "selectedLetters" calculations directly into the line following them.

function text = rot13(text)
if ischar(text)

selectedLetters = ( (text >= 'A') & (text <= 'Z') ); %Select upper case letters
text(selectedLetters) = char( mod( text(selectedLetters)-'A'+13,26 )+'A' );

selectedLetters = ( (text >= 'a') & (text <= 'z') ); %Select lower case letters
text(selectedLetters) = char( mod( text(selectedLetters)-'a'+13,26 )+'a' );

else
error('Argument must be a string.')
end
end


Sample Output:
>> plainText = char((64:123))

plainText =

@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{

>> rot13(plainText)

ans =

@NOPQRSTUVWXYZABCDEFGHIJKLM[\]^_`nopqrstuvwxyzabcdefghijklm{


=={{header|Maxima}}==
rot13(a) := simplode(map(ascii, map(lambda([n],
if (n >= 65 and n <= 77) or (n >= 97 and n <= 109) then n + 13
elseif (n >= 78 and n <= 90) or (n >= 110 and n <= 122) then n - 13
else n), map(cint, sexplode(a)))))$

lowercase: "abcdefghijklmnopqrstuvwxyz"$
uppercase: "ABCDEFGHIJKLMNOPQRSTUVWXYZ"$

rot13(lowercase);
"nopqrstuvwxyzabcdefghijklm"

rot13(uppercase);
"NOPQRSTUVWXYZABCDEFGHIJKLM"

rot13("The quick brown fox jumps over the lazy dog");
"Gur dhvpx oebja sbk whzcf bire gur ynml qbt"

rot13(%);
"The quick brown fox jumps over the lazy dog"


=={{header|Mirah}}==
def rot13 (value:string)
result = ""
d = ' '.toCharArray[0]
value.toCharArray.each do |c|
testChar = Character.toLowerCase(c)
if testChar <= 'm'.toCharArray[0] && testChar >= 'a'.toCharArray[0] then
d = char(c + 13)
end
if testChar <= 'z'.toCharArray[0] && testChar >= 'n'.toCharArray[0] then
d = char(c - 13)
end
result += d
end
result
end


puts rot13("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")


=={{header|MMIX}}==
// main registers
p IS $255 % text pointer
c GREG % char
cc GREG % uppercase copy of c
u GREG % all purpose

LOC Data_Segment
GREG @
Test BYTE "dit is een bericht voor de keizer",#a,0

LOC #100
Main LDA p,Test
TRAP 0,Fputs,StdOut % show text to encrypt
LDA p,Test % points to text to encrypt
JMP 4F
// do in place text encryption
% REPEAT
2H ADD cc,c,0 % copy char
SUB cc,cc,' ' % make uppercase
CMP u,cc,'A'
BN u,3F % IF c < 'A' OR c > 'Z' THEN next char
CMP u,cc,'Z'
BP u,3F
CMP u,cc,'N' % ELSE
BN u,1F % IF c < 'N' THEN encrypt 'up'
SUB c,c,26 % ELSE char ready for encrypt 'down'
1H INCL c,13 % encrypt char
STBU c,p % replace char with encrypted char
3H INCL p,1 % move to next char
4H LDBU c,p % get next char
PBNZ c,2B % UNTIL EOT
// print result
LDA p,Test
TRAP 0,Fputs,StdOut % show encrypted text
TRAP 0,Halt,0

Example:
~/MIX/MMIX/Progs> mmix rot13simpl
dit is een bericht voor de keizer
qvg vf rra orevpug ibbe qr xrvmre


=={{header|Modula-3}}==
This implementation reads from '''stdin''' and writes to '''stdout'''.
MODULE Rot13 EXPORTS Main;

IMPORT Stdio, Rd, Wr;

VAR c: CHAR;

<*FATAL ANY*>

BEGIN
WHILE NOT Rd.EOF(Stdio.stdin) DO
c := Rd.GetChar(Stdio.stdin);
IF c >= 'A' AND c <= 'M' OR c >= 'a' AND c <= 'm' THEN
c := VAL(ORD((ORD(c) + 13)), CHAR);
ELSIF c >= 'N' AND c <= 'Z' OR c >= 'n' AND c <= 'z' THEN
c := VAL(ORD((ORD(c) - 13)), CHAR);
END;
Wr.PutChar(Stdio.stdout, c);
END;
END Rot13.


Output:

martin@thinkpad:~$ ./prog
Foo bar baz
Sbb one onm
martin@thinkpad:~$ echo "Bar baz foo" | ./prog
One onm sbb
martin@thinkpad:~$ echo "Foo bar baz" > foo.txt
martin@thinkpad:~$ echo "quux zeepf" >> foo.txt
martin@thinkpad:~$ cat foo.txt | ./prog
Sbb one onm
dhhk mrrcs


=={{header|MUMPS}}==
Rot13(in) New low,rot,up
Set up="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Set low="abcdefghijklmnopqrstuvwxyz"
Set rot=$Extract(up,14,26)_$Extract(up,1,13)
Set rot=rot_$Extract(low,14,26)_$Extract(low,1,13)
Quit $Translate(in,up_low,rot)

Write $$Rot13("Hello World!") ; Uryyb Jbeyq!
Write $$Rot13("ABCDEFGHIJKLMNOPQRSTUVWXYZ") ; NOPQRSTUVWXYZABCDEFGHIJKLM


=={{header|NetRexx}}==
This sample leverages the code demonstrated in the [[Caesar cipher#NetRexx|Caesar cipher – NetRexx]] task.
/* NetRexx */
options replace format comments java crossref savelog symbols nobinary

parse arg fileNames

rdr = BufferedReader

do
if fileNames.length > 0 then do
loop n_ = 1 for fileNames.words
fileName = fileNames.word(n_)
rdr = BufferedReader(FileReader(File(fileName)))
encipher(rdr)
end n_
end
else do
rdr = BufferedReader(InputStreamReader(System.in))
encipher(rdr)
end
catch ex = IOException
ex.printStackTrace
end

return

method encipher(rdr = BufferedReader) public static signals IOException

loop label l_ forever
line = rdr.readLine
if line = null then leave l_
say rot13(line)
end l_
return

method rot13(input) public static signals IllegalArgumentException

return caesar(input, 13, isFalse)

method caesar(input = Rexx, idx = int, caps = boolean) public static signals IllegalArgumentException

if idx < 1 | idx > 25 then signal IllegalArgumentException()

-- 12345678901234567890123456
itab = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
shift = itab.length - idx
parse itab tl +(shift) tr
otab = tr || tl

if caps then input = input.upper

cipher = input.translate(itab || itab.lower, otab || otab.lower)

return cipher

method caesar_encipher(input = Rexx, idx = int, caps = boolean) public static signals IllegalArgumentException

return caesar(input, idx, caps)

method caesar_decipher(input = Rexx, idx = int, caps = boolean) public static signals IllegalArgumentException

return caesar(input, int(26) - idx, isFalse)

method caesar_encipher(input = Rexx, idx = int) public static signals IllegalArgumentException

return caesar(input, idx, isFalse)

method caesar_decipher(input = Rexx, idx = int) public static signals IllegalArgumentException

return caesar(input, int(26) - idx, isFalse)

method caesar_encipher(input = Rexx, idx = int, opt = Rexx) public static signals IllegalArgumentException

return caesar(input, idx, opt)

method caesar_decipher(input = Rexx, idx = int, opt = Rexx) public static signals IllegalArgumentException

return caesar(input, int(26) - idx, opt)

method caesar(input = Rexx, idx = int, opt = Rexx) public static signals IllegalArgumentException

if opt.upper.abbrev('U') >= 1 then caps = isTrue
else caps = isFalse

return caesar(input, idx, caps)

method caesar(input = Rexx, idx = int) public static signals IllegalArgumentException

return caesar(input, idx, isFalse)

method isTrue public static returns boolean
return (1 == 1)

method isFalse public static returns boolean
return \isTrue


'''Output''' ''(using the source file as input)'':

/* ArgErkk */
bcgvbaf ercynpr sbezng pbzzragf wnin pebffers fnirybt flzobyf abovanel

cnefr net svyrAnzrf

eqe = OhssrerqErnqre

qb
vs svyrAnzrf.yratgu > 0 gura qb
ybbc a_ = 1 sbe svyrAnzrf.jbeqf
svyrAnzr = svyrAnzrf.jbeq(a_)
eqe = OhssrerqErnqre(SvyrErnqre(Svyr(svyrAnzr)))
rapvcure(eqe)
raq a_
raq
ryfr qb
eqe = OhssrerqErnqre(VachgFgernzErnqre(Flfgrz.va))
rapvcure(eqe)
raq
pngpu rk = VBRkprcgvba
rk.cevagFgnpxGenpr
raq

erghea

zrgubq rapvcure(eqe = OhssrerqErnqre) choyvp fgngvp fvtanyf VBRkprcgvba

ybbc ynory y_ sberire
yvar = eqe.ernqYvar
vs yvar = ahyy gura yrnir y_
fnl ebg13(yvar)
raq y_
erghea

zrgubq ebg13(vachg) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, 13, vfSnyfr)

zrgubq pnrfne(vachg = Erkk, vqk = vag, pncf = obbyrna) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

vs vqk < 1 | vqk > 25 gura fvtany VyyrtnyNethzragRkprcgvba()

-- 12345678901234567890123456
vgno = 'NOPQRSTUVWXYZABCDEFGHIJKLM'
fuvsg = vgno.yratgu - vqk
cnefr vgno gy +(fuvsg) ge
bgno = ge || gy

vs pncf gura vachg = vachg.hccre

pvcure = vachg.genafyngr(vgno || vgno.ybjre, bgno || bgno.ybjre)

erghea pvcure

zrgubq pnrfne_rapvcure(vachg = Erkk, vqk = vag, pncf = obbyrna) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vqk, pncf)

zrgubq pnrfne_qrpvcure(vachg = Erkk, vqk = vag, pncf = obbyrna) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vag(26) - vqk, vfSnyfr)

zrgubq pnrfne_rapvcure(vachg = Erkk, vqk = vag) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vqk, vfSnyfr)

zrgubq pnrfne_qrpvcure(vachg = Erkk, vqk = vag) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vag(26) - vqk, vfSnyfr)

zrgubq pnrfne_rapvcure(vachg = Erkk, vqk = vag, bcg = Erkk) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vqk, bcg)

zrgubq pnrfne_qrpvcure(vachg = Erkk, vqk = vag, bcg = Erkk) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vag(26) - vqk, bcg)

zrgubq pnrfne(vachg = Erkk, vqk = vag, bcg = Erkk) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

vs bcg.hccre.nooeri('H') >= 1 gura pncf = vfGehr
ryfr pncf = vfSnyfr

erghea pnrfne(vachg, vqk, pncf)

zrgubq pnrfne(vachg = Erkk, vqk = vag) choyvp fgngvp fvtanyf VyyrtnyNethzragRkprcgvba

erghea pnrfne(vachg, vqk, vfSnyfr)

zrgubq vfGehr choyvp fgngvp ergheaf obbyrna
erghea (1 == 1)

zrgubq vfSnyfr choyvp fgngvp ergheaf obbyrna
erghea \vfGehr


=={{header|Objeck}}==

bundle Default {
class Rot13 {
function : Main(args : String[]) ~ Nil {
Rot13("nowhere ABJURER")->PrintLine();
}

function : native : Rot13(text : String) ~ String {
rot := "";
each(i : text) {
c := text->Get(i);
if(c >= 'a' & c <= 'm' | c >= 'A' & c <= 'M') {
rot->Append(c + 13);
}
else if(c >= 'n' & c <= 'z' | c >= 'N' & c <= 'Z') {
rot->Append(c - 13);
}
else {
rot->Append(c);
};
};

return rot;
}
}
}


=={{header|OCaml}}==

Straightforward implementation for characters by using character range patterns:

let rot13 c = match c with
| 'A'..'M' | 'a'..'m' -> char_of_int (int_of_char c + 13)
| 'N'..'Z' | 'n'..'z' -> char_of_int (int_of_char c - 13)
| _ -> c


We provide a function for converting whole strings:

let rot13_str s =
let len = String.length s in
let result = String.create len in
for i = 0 to len - 1 do
result.[i] <- rot13 s.[i]
done;
result

(* or in OCaml 4.00+:
let rot13_str = String.map rot13
*)


And here is a utility program that converts the content read on sdtin and write it to stdout:

let () =
try while true do
String.iter (fun c -> print_char (rot13 c)) (read_line());
print_newline()
done with End_of_file -> ()


=={{header|Oz}}==
declare
fun {RotChar C}
if C >= &A andthen C =< &Z then &A + (C - &A + 13) mod 26
elseif C >= &a andthen C =< &z then &a + (C - &a + 13) mod 26
else C
end
end

fun {Rot13 S}
{Map S RotChar}
end
in
{System.showInfo {Rot13 "NOWHERE Abjurer 42"}}
{System.showInfo {Rot13 {Rot13 "NOWHERE Abjurer 42"}}}


=={{header|PARI/GP}}==
rot13(s)={
s=Vecsmall(s);
for(i=1,#s,
if(s[i]>109&s[i]<123,s[i]-=13,if(s[i]<110&s[i]>96,s[i]+=13,if(s[i]>77&s[i]<91,s[i]-=13,if(s[i]<78&s[i]>64,s[i]+=13))))
);
Strchr(s)
};


=={{header|Pascal}}==
program rot13(input, output);

function rot13(someText: string): string;
var
i: integer;
ch: char;
resultText: string = '';

begin
for i := 1 to Length(someText) do begin
ch := someText[i];
case ch of
'A' .. 'M', 'a' .. 'm': ch := chr(ord(ch)+13);
'N' .. 'Z', 'n' .. 'z': ch := chr(ord(ch)-13)
end;
resultText := resultText + ch
end;
rot13 := resultText
end;

var
line: string;

begin
while not eof(input) do begin
readln(line);
writeln(rot13(line))
end
end.



=={{header|Perl}}==
sub rot13 {
my $string = shift;
$string =~ tr/A-Za-z/N-ZA-Mn-za-m/;
return $string;
}

print rot13($_) while (<>);


Input:
NOWHERE Abjurer

Output:
ABJURER Nowhere

This one-liner version demonstrates that most of the verbosity above was simply needed to define a function:

perl -pe 'tr/A-Za-z/N-ZA-Mn-za-m/'

=={{header|Perl 6}}==
{{works with|Rakudo Star|2013.07}}

sub rot13 { $^s.trans: 'a..mn..z' => 'n..za..m', :ii }

multi MAIN () { print rot13 slurp }
multi MAIN (*@files) { print rot13 [~] map &slurp, @files }


This illustrates use of multi-dispatch to MAIN based on number of arguments.

=={{header|PHP}}==
PHP has a built-in function for this:
echo str_rot13('foo'), "\n";
will output
sbb

Here is an implementation:
function rot13($s) {
return strtr($s, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz',
'NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm');
}

echo rot13('foo'), "\n";
?>


Output:
sbb

=={{header|PicoLisp}}==
(de rot13-Ch (C)
(if
(or
(member C '`(apply circ (chop "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
(member C '`(apply circ (chop "abcdefghijklmnopqrstuvwxyz"))) )
(get @ 14)
C ) )

or:
(de rot13-Ch (C)
(cond
((>= "M" (uppc C) "A")
(char (+ (char C) 13)) )
((>= "Z" (uppc C) "N")
(char (- (char C) 13)) )
(T C) ) )

Then call it as:
(de rot13-stdIn ()
(while (line)
(prinl (mapcar rot13-Ch @)) ) )


=={{header|Pike}}==

import Crypto;

int main(){
string r = rot13("Hello, World");
write(r + "\n");
}


=={{header|PL/I}}==

rotate: procedure (in) options (main); /* 2 March 2011 */
declare in character (100) varying;
declare line character (500) varying;
declare input file;

open file (input) title ('/' || in || ',type(text),recsize(500)' );

on endfile (input) stop;

do forever;
get file (input) edit (line) (L);
line = translate (
line, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz',
'NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm');
put edit (line) (a); put skip;
end;
end;

Data file:

"The time has come,"
the walrus said,
"to speak of many things;
of ships and shoes and sealing wax;
of cabbages and kings."

Output:

"Gur gvzr unf pbzr,"
gur jnyehf fnvq,
"gb fcrnx bs znal guvatf;
bs fuvcf naq fubrf naq frnyvat jnk;
bs pnoontrf naq xvatf."


=={{header|PostScript}}==
{{libheader|initlib}}

/r13 {
4 dict begin
/rotc {
{
{{{64 gt} {91 lt}} all?} {65 - 13 + 26 mod 65 +} is?
{{{95 gt} {123 lt}} all?} {97 - 13 + 26 mod 97 +} is?
} cond
}.
{rotc} map cvstr
end}.


=={{header|Pop11}}==

In Pop11 characters are just integers, so we can use integer
comparisons and arithmetic (assuming ASCII based encoding).

define rot13(s);
lvars j, c;
for j from 1 to length(s) do
s(j) -> c;
if `A` <= c and c <= `M` or `a` <= c and c <= `m` then
c + 13 -> s(j);
elseif `N` <= c and c <= `Z` or `n` <= c and c <= `z` then
c - 13 -> s(j);
endif;
endfor;
s;
enddefine;

rot13('NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm') =>


=={{header|PowerShell}}==


Function ROT13($String)
{
$Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
$Cipher = "NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm"
Foreach($Char in $String.ToCharArray())
{
If ( $Char -match "[A-Za-z]" )
{ $NewString += $Cipher.Chars($Alphabet.IndexOf($Char)) }
else
{ $NewString += $Char }
}
Return $NewString
}


=={{header|Prolog}}==
Works with SWI-Prolog.
rot13(Str, SR) :-
maplist(rot, Str, Str1),
string_to_list(SR, Str1).

rot(C, C1) :-
( member(C, "abcdefghijklmABCDEFGHIJKLM") -> C1 is C+13;
( member(C, "nopqrstuvwxyzNOPQRSTUVWXYZ") -> C1 is C-13; C1 = C)).

Output :
?- rot13("The Quick Brown Fox Jumped Over The Lazy Dog!", SR).
SR = "Gur Dhvpx Oebja Sbk Whzcrq Bire Gur Ynml Qbt!".


=={{header|PureBasic}}==
Declare.s Rot13(text_to_code.s)

If OpenConsole()
Define txt$

Print("Enter a string to encode: "): txt$=Input()

PrintN("Coded : "+Rot13(txt$))
PrintN("Decoded: "+Rot13(Rot13(txt$)))

Print("Press ENTER to quit."): Input()
CloseConsole()
EndIf

Procedure.s Rot13(s.s)
Protected.i i
Protected.s t, u
For i=1 To Len(s)
t=Mid(s,i,1)
Select Asc(t)
Case Asc("a") To Asc("m"), Asc("A") To Asc("M")
t=chr(Asc(t)+13)
Case Asc("n") To Asc("z"), Asc("N") To Asc("Z")
t=chr(Asc(t)-13)
EndSelect
u+t
Next
ProcedureReturn u
EndProcedure


=={{header|Python}}==
Python 2.x (but not 3.x) has built-in rot13 encoding and decoding:
{{works with|Python|2.x}}

>>> u'foo'.encode('rot13')
'sbb'
>>> 'sbb'.decode('rot13')
u'foo'


Here is an implementation:

{{works with|Python|2.x}}
#!/usr/bin/env python
import string
def rot13(s):
"""Implement the rot-13 encoding function: "rotate" each letter by the
letter that's 13 steps from it (wrapping from z to a)
"""
return s.translate(
string.maketrans(
string.ascii_uppercase + string.ascii_lowercase,
string.ascii_uppercase[13:] + string.ascii_uppercase[:13] +
string.ascii_lowercase[13:] + string.ascii_lowercase[:13]
)
)
if __name__ == "__main__":
"""Peform line-by-line rot-13 encoding on any files listed on our
command line or act as a standard UNIX filter (if no arguments
specified).
"""
import fileinput
for line in fileinput.input():
print rot13(line), # (Note the trailing comma; avoid double-spacing our output)!


The ''str.translate()'' and ''string.maketrans()'' functions make the function's definition almost trivial. It's a one-line function with some line wrapping for legibility. The ''fileinput'' module similarly makes the wrapper functionality trivial to implement. (This implementation is about seven logical lines long).

{{works with|Python|3.x}}
In Python 3.x, the ''string.maketrans()'' function actually only works for the ''bytes'' type, and has been deprecated since 3.1. If you want to work on strings (''str'' type), you need to use ''str.maketrans()'':
#!/usr/bin/env python
import string
def rot13(s):
"""Implement the rot-13 encoding function: "rotate" each letter by the
letter that's 13 steps from it (wrapping from z to a)
"""
return s.translate(
str.maketrans(
string.ascii_uppercase + string.ascii_lowercase,
string.ascii_uppercase[13:] + string.ascii_uppercase[:13] +
string.ascii_lowercase[13:] + string.ascii_lowercase[:13]
)
)
if __name__ == "__main__":
"""Peform line-by-line rot-13 encoding on any files listed on our
command line or act as a standard UNIX filter (if no arguments
specified).
"""
import fileinput
for line in fileinput.input():
print(rot13(line), end="")


=={{header|R}}==
rot13 <- function(x)
{
old <- paste(letters, LETTERS, collapse="", sep="")
new <- paste(substr(old, 27, 52), substr(old, 1, 26), sep="")
chartr(old, new, x)
}
x <- "The Quick Brown Fox Jumps Over The Lazy Dog!.,:;'#~[]{}"
rot13(x) # "Gur Dhvpx Oebja Sbk Whzcf Bire Gur Ynml Qbt!.,:;'#~[]{}"
x2 <- paste(letters, LETTERS, collapse="", sep="")
rot13(x2) # "nNoOpPqQrRsStTuUvVwWxXyYzZaAbBcCdDeEfFgGhHiIjJkKlLmM"

For a slightly more general function, see the [http://stat.ethz.ch/R-manual/R-patched/library/base/html/chartr.html example on the chartr help page].

=={{header|Racket}}==

#!/bin/env racket
#lang racket/base

(define (run i o)
(for ([ch (in-producer regexp-match #f #rx#"[a-zA-Z]" i 0 #f o)])
(define b (bytes-ref (car ch) 0))
(define a (if (< b 96) 65 97))
(write-byte (+ (modulo (+ 13 (- b a)) 26) a))))

(require racket/cmdline)
(command-line
#:help-labels "(\"-\" specifies standard input)"
#:args files
(for ([f (if (null? files) '("-") files)])
(if (equal? f "-")
(run (current-input-port) (current-output-port))
(call-with-input-file f (λ(i) (run i (current-output-port)))))))


=={{header|Raven}}==
define rot13 use $str
$str each chr
dup m/[A-Ma-m]/ if
ord 13 + chr
else
dup m/[N-Zn-z]/ if
ord 13 - chr
$str length list "" join

"12!ABJURER nowhere"
dup print "\nas rot13 is\n" print
rot13
print "\n" print

{{out}}
12!ABJURER nowhere
as rot13 is
12!NOWHERE abjurer


=={{header|REBOL}}==
REBOL [
Title: "Rot-13"
Date: 2009-12-14
Author: oofoe
URL: http://rosettacode.org/wiki/Rot-13
]

; Test data has upper and lower case characters as well as characters
; that should not be transformed, like numbers, spaces and symbols.

text: "This is a 28-character test!"

print "Using cipher table:"

; I build a set of correspondence lists here. 'x' is the letters from
; A-Z, in both upper and lowercase form. Note that REBOL can iterate
; directly over the alphabetic character sequence in the for loop. 'y'
; is the cipher form, 'x' rotated by 26 characters (remember, I have
; the lower and uppercase forms together). 'r' holds the final result,
; built as I iterate across the 'text' string. I search for the
; current character in the plaintext list ('x'), if I find it, I get
; the corresponding character from the ciphertext list
; ('y'). Otherwise, I pass the character through untransformed, then
; return the final string.

rot-13: func [
"Encrypt or decrypt rot-13 with tables."
text [string!] "Text to en/decrypt."
/local x y r i c
] [
x: copy "" for i #"a" #"z" 1 [append x rejoin [i uppercase i]]
y: rejoin [copy skip x 26 copy/part x 26]
r: copy ""

repeat i text [append r either c: find/case x i [y/(index? c)][i]]
r
]

; Note that I am setting the 'text' variable to the result of rot-13
; so I can reuse it again on the next call. The rot-13 algorithm is
; reversible, so I can just run it again without modification to decrypt.

print [" Encrypted:" text: rot-13 text]
print [" Decrypted:" text: rot-13 text]


print "Using parse:"

clamp: func [
"Contain a value within two enclosing values. Wraps if necessary."
x v y
][
x: to-integer x v: to-integer v y: to-integer y
case [v < x [y - v] v > y [v - y + x - 1] true v]
]

; I'm using REBOL's 'parse' word here. I set up character sets for
; upper and lower-case letters, then let parse walk across the
; text. It looks for matches to upper-case letters, then lower-case,
; then skips to the next one if it can't find either. If a matching
; character is found, it's mathematically incremented by 13 and
; clamped to the appropriate character range. parse changes the
; character in place in the string, hence this is a destructive
; operation.

rot-13: func [
"Encrypt or decrypt rot-13 with parse."
text [string!] "Text to en/decrypt. Note: Destructive!"
] [
u: charset [#"A" - #"Z"]
l: charset [#"a" - #"z"]

parse text [some [
i: ; Current position.
u (i/1: to-char clamp #"A" i/1 + 13 #"Z") | ; Upper case.
l (i/1: to-char clamp #"a" i/1 + 13 #"z") | ; Lower case.
skip]] ; Ignore others.
text
]

; As you see, I don't need to re-assign 'text' anymore.

print [" Encrypted:" rot-13 text]
print [" Decrypted:" rot-13 text]


Output:

Using cipher table:
Encrypted: Guvf vf n 28-punenpgre grfg!
Decrypted: This is a 28-character test!
Using parse:
Encrypted: Guvf vf n 28-punenpgre grfg!
Decrypted: This is a 28-character test!


=={{header|Retro}}==
{{
: rotate ( cb-c ) tuck - 13 + 26 mod + ;
: rotate? ( c-c )
dup 'a 'z within [ 'a rotate ] ifTrue
dup 'A 'Z within [ 'A rotate ] ifTrue ;
---reveal---
: rot13 ( s-s ) dup [ [ @ rotate? ] sip ! ] ^types'STRING each@ ;
}}

"abcdef123GHIJKL" rot13 dup puts cr rot13 puts
"abjurer NOWHERE" rot13 puts


=={{header|REXX}}==
/*REXX program to encode several text strings with ROT 13 algorithm. */
aa = 'foo'
say 'simple text = 'aa
say ' rot13 text = 'rot13(aa)
say

bb = 'bar'
say 'simple text = 'bb
say ' rot13 text = 'rot13(bb)
say

cc = "Noyr jnf V, 'rer V fnj Ryon."
say 'simple text = 'cc
say ' rot13 text = 'rot13(cc)
say

dd = 'abc? ABC!'
say 'simple text = 'dd
say ' rot13 text = 'rot13(dd)
say

ee = 'abjurer NOWHERE'
say 'simple text = 'ee
say ' rot13 text = 'rot13(ee)
exit /*stick a fork in it, we're done.*/

/*──────────────────────────────────ROT13 subroutine────────────────────*/
rot13: return translate(arg(1),,
'abcdefghijklmABCDEFGHIJKLMnopqrstuvwxyzNOPQRSTUVWXYZ',,
'nopqrstuvwxyzNOPQRSTUVWXYZabcdefghijklmABCDEFGHIJKLM')

'''output'''

simple text = foo
rot13 text = sbb

simple text = bar
rot13 text = one

simple text = Noyr jnf V, 'rer V fnj Ryon.
rot13 text = Able was I, 'ere I saw Elba.

simple text = abc? ABC!
rot13 text = nop? NOP!

simple text = abjurer NOWHERE
rot13 text = nowhere ABJURER


=={{header|Ruby}}==
# Returns a copy of _s_ with rot13 encoding.
def rot13(s)
s.tr('A-Za-z', 'N-ZA-Mn-za-m')
end

# Perform rot13 on files from command line, or standard input.
while line = ARGF.gets
print rot13(line)
end


One can run ruby rot13.rb file1 file2 to rot13 those files, or run ruby rot13.rb to rot13 the standard input.

Input:
ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz

Output:
NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm

=={{header|Run BASIC}}==
INPUT "Enter a string: "; s$
ans$ = ""
FOR a = 1 TO LEN(s$)
letter$ = MID$(s$, a, 1)
IF letter$ >= "A" AND letter$ <= "Z" THEN
char$ = CHR$(ASC(letter$) + 13)
IF char$ > "Z" THEN char$ = CHR$(ASC(char$) - 26)
else
if letter$ >= "a" AND letter$ <= "z" THEN char$ = CHR$(ASC(letter$) + 13)
IF char$ > "z" THEN char$ = CHR$(ASC(char$) - 26) ELSE char$ = letter$
END IF
ans$ = ans$ + char$
NEXT a
PRINT ans$
Output:
Enter a string: ?abc
nop
Enter a string: ?ABC
NOP


=={{header|Scala}}==
scala> def rot13(s: String) = s map {
| case c if 'a' <= c.toLower && c.toLower <= 'm' => c + 13 toChar
| case c if 'n' <= c.toLower && c.toLower <= 'z' => c - 13 toChar
| case c => c
| }
rot13: (s: String)String

scala> rot13("7 Cities of Gold.")
res61: String = 7 Pvgvrf bs Tbyq.

scala> rot13(res61)
res62: String = 7 Cities of Gold.


=={{header|Scheme}}==
(define (rot13 str)
(define (rot13-char c)
(integer->char (+ (char->integer c)
(cond ((and (char>=? c #\a) (char 13)
((and (char>=? c #\A) (char 13)
((and (char>=? c #\n) (char<=? c #\z))
-13)
((and (char>=? c #\N) (char<=? c #\Z))
-13)
(else
0)))))
(list->string (map rot13-char (string->list str))))


=={{header|sed}}==
The two translations (upper and lower case) are separate only for documentation and ease of understanding; they could be combined into one command.
y/abcdefghijklmnopqrstuvwxyz/nopqrstuvwxyzabcdefghijklm/
y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/NOPQRSTUVWXYZABCDEFGHIJKLM/


=={{header|Seed7}}==

This rot13 program reads from standard input and writes to standard output:
$ include "seed7_05.s7i";

const proc: main is func
local
var char: ch is ' ';
begin
ch := getc(IN);
while not eof(IN) do
if (ch >= 'a' and ch <= 'm') or (ch >= 'A' and ch <= 'M') then
ch := chr(ord(ch) + 13);
elsif (ch >= 'n' and ch <= 'z') or (ch >= 'N' and ch <= 'Z') then
ch := chr(ord(ch) - 13);
end if;
write(ch);
ch := getc(IN);
end while;
end func;

=={{header|Slate}}==
A shell script:

#!/usr/local/bin/slate

ch@(String Character traits) rot13
[| value |
upper ::= ch isUppercase.
value := ch toLowercase as: Integer.
(value >= 97) /\ [value < 110]
ifTrue: [value += 13]
ifFalse: [(value > 109) /\ [value <= 122]
ifTrue: [value -= 13]].
upper
ifTrue: [(value as: String Character) toUppercase]
ifFalse: [value as: String Character]
].

lobby define: #Rot13Encoder &parents: {Encoder}.

c@(Rot13Encoder traits) convert
[
[c in isAtEnd] whileFalse: [c out nextPut: c in next rot13].
].

(Rot13Encoder newFrom: Console reader to: Console writer) convert.


Normal functions:

ch@(String Character traits) rot13
[| value |
upper ::= ch isUppercase.
value := ch toLowercase as: Integer.
(value >= 97) /\ [value < 110]
ifTrue: [value += 13]
ifFalse: [(value > 109) /\ [value <= 122]
ifTrue: [value -= 13]].
upper
ifTrue: [(value as: String Character) toUppercase]
ifFalse: [value as: String Character]
].

s@(String traits) rot13
[
result ::= s newSameSize.
s doWithIndex: [| :each :index | result at: index put: each rot13].
result
].

slate[37]> 'abc123' rot13.
'nop123'


=={{header|Smalltalk}}==
{{works with|GNU Smalltalk}}
Here we implemented three ways. The first one is the simplest. The second demonstrates extending the String class with a generic rot method, which in turn uses two ''new'' method for the class Character (+ and -). The third one is an imitation of the tr '[a-m][n-z]' '[n-z][a-m]' approach (see UNIX Shell example), done through a block closure and using also the new method trFrom:to: for Character.

"1. simple approach"
rot13 := [ :string |
string collect: [ :each | | index |
index := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'
indexOf: each ifAbsent: [ 0 ]. "Smalltalk uses 1-based indexing"
index isZero
ifTrue: [ each ]
ifFalse: [ 'nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM' at:
index ] ] ].

(rot13 value: 'Test123') printNl "gives 'Grfg123'"

"2. extending built-in classes"
Character extend [
+ inc [
(inc isKindOf: Character)
ifTrue: [
^ ( Character value: ((self asInteger) + (inc asInteger)) )
] ifFalse: [
^ ( Character value: ((self asInteger) + inc) )
]
]
- inc [
^ ( self + (inc asInteger negated) )
]
trFrom: map1 to: map2 [
(map1 includes: self) ifTrue: [
^ map2 at: (map1 indexOf: self)
] ifFalse: [ ^self ]
]
].

String extend [
rot: num [ |s|
s := String new.
self do: [ :c |
((c asLowercase) between: $a and: $z)
ifTrue: [ |c1|
c1 := ( $a + ((((c asLowercase) - $a + num) asInteger) rem:26)).
(c isLowercase) ifFalse: [ c1 := c1 asUppercase ].
s := s, (c1 asString)
]
ifFalse: [
s := s, (c asString)
]
].
^s
]
].

('abcdefghijklmnopqrstuvwxyz123!' rot: 13) displayNl.
(('abcdefghijklmnopqrstuvwxyz123!' rot: 13) rot: 13) displayNl.



"2. using a 'translation'. Not very idiomatic Smalltalk code"
rotThirteen := [ :s | |m1 m2 r|
r := String new.
m1 := OrderedCollection new.
0 to: 25 do: [ :i | m1 add: ($a + i) ].
m2 := OrderedCollection new.
0 to: 25 do: [ :i | m2 add: ($a + ((i+13) rem: 26)) ].
s do: [ :c |
(c between: $a and: $z) | (c between: $A and: $Z)
ifTrue: [ | a |
a := (c asLowercase) trFrom: m1 to: m2.
(c isUppercase) ifTrue: [ a := a asUppercase ].
r := r, (a asString)]
ifFalse: [ r := r, (c asString) ]
].
r
].

(rotThirteen value: 'abcdefghijklmnopqrstuvwxyz123!') displayNl.


=={{header|SNOBOL4}}==

{{works with|Macro Spitbol}}
{{works with|Snobol4+}}
{{works with|CSnobol}}

* # Function using replace( )
define('rot13(s)u1,u2,l1,l2') :(rot13_end)
rot13 &ucase len(13) . u1 rem . u2
&lcase len(13) . l1 rem . l2
rot13 = replace(s,&ucase &lcase,u2 u1 l2 l1) :(return)
rot13_end

* # Function using pattern
define('rot13s(s)c')
alfa = &ucase &ucase &lcase &lcase :(rot13s_end)
rot13s s len(1) . c = :f(return)
alfa break(c) len(13) len(1) . c
rot13s = rot13s c :(rot13s)
rot13s_end

* # Test and display both
str = rot13("I abjure the $19.99 trinket!")
output = str; output = rot13(str)
str = rot13s("He's a real Nowhere Man.")
output = str; output = rot13s(str)
end


Output:
V nowher gur $19.99 gevaxrg!
I abjure the $19.99 trinket!
Ur'f n erny Abjurer Zna.
He's a real Nowhere Man.


=={{header|Standard ML}}==
fun rot13char c =
if c >= #"a" andalso c <= #"m" orelse c >= #"A" andalso c <= #"M" then
chr (ord c + 13)
else if c >= #"n" andalso c <= #"z" orelse c >= #"N" andalso c <= #"Z" then
chr (ord c - 13)
else
c

val rot13 = String.map rot13char


=={{header|SQL}}==
{{works with|T-SQL}}

with cte(num) as
(
select 1
union all
select num+1
from cte
)
select cast((
select char(ascii(chr) +
case
when ascii(chr) between ascii('a') and ascii('m') or
ascii(chr) between ascii('A') and ascii('M') then 13
when ascii(chr) between ascii('n') and ascii('z') or
ascii(chr) between ascii('N') and ascii('Z') then -13
else 0
end)
from
(
select top(1000) num,
-- your string to be converted to ROT13
substring('The Quick Brown Fox Jumps Over The Lazy Dog',num,1) chr
from cte
) tmp
For XML PATH ('')) as xml).value('.', 'VARCHAR(max)') rot13
option (maxrecursion 0)


=={{header|Tcl}}==
proc rot13 line {
string map {
a n b o c p d q e r f s g t h u i v j w k x l y m z
n a o b p c q d r e s f t g u h v i w j x k y l z m
A N B O C P D Q E R F S G T H U I V J W K X L Y M Z
N A O B P C Q D R E S F T G U H V I W J X K Y L Z M
} $line
}


Using {{libheader|TclX}} we can write
package require Tclx
proc rot13 str {
translit "A-Za-z" "N-ZA-Mn-za-m" $str
}


=={{header|TorqueScript}}==
--[[User:Ipquarx|Ipquarx]] 8:45 PM
function rot13(%string)
{
%alph = "abcdefghijklmnopqrstuvwxyz";
%len = strLen(%string);

for(%a = 0; %a < %len; %a++)
{
%char = getSubStr(%string,%a,1);
%pos = striPos(%alph, %char);

if(%pos < 0)
%out = %out @ %char;
else
{
if(strPos(%alph, %char) < 0)
%out = %out @ strUpr(getSubStr(%alph, (%pos + 13) % 26));
else
%out = %out @ getSubStr(%alph, (%pos + 13) % 26);
}
}
return %out;
}


=={{header|TI-83 BASIC}}==
Calculator symbol translations:

"STO" arrow: →

Perfoms ROT-13 on the contents of Str1. Also uses the string variables Str0 and Str2 and the real variable N.

:"ABCDEFGHIJKLMNOPQRSTUVWXYZ→Str0
:".→Str2
:For(N,1,length(Str1
:If inString(Str0,sub(Str1,N,1
:Then
:inString(Str0,sub(Str1,N,1
:Ans+13-26(Ans>13
:Str2+sub(Str0,Ans,1→Str2
:Else
:Str2+sub(Str1,N,1→Str2
:End
:End
:sub(Str2,2,length(Str2)-1→Str1


=={{header|TXR}}==

Via definition and subsequent use of a named filter.

@(deffilter rot13
("a" "n") ("b" "o") ("c" "p") ("d" "q") ("e" "r") ("f" "s") ("g" "t")
("h" "u") ("i" "v") ("j" "w") ("k" "x") ("l" "y") ("m" "z") ("n" "a")
("o" "b") ("p" "c") ("q" "d") ("r" "e") ("s" "f") ("t" "g") ("u" "h")
("v" "i") ("w" "j") ("x" "k") ("y" "l") ("z" "m")
("A" "N") ("B" "O") ("C" "P") ("D" "Q") ("E" "R") ("F" "S") ("G" "T")
("H" "U") ("I" "V") ("J" "W") ("K" "X") ("L" "Y") ("M" "Z") ("N" "A")
("O" "B") ("P" "C") ("Q" "D") ("R" "E") ("S" "F") ("T" "G") ("U" "H")
("V" "I") ("W" "J") ("X" "K") ("Y" "L") ("Z" "M"))
@(collect :vars ())
@line
@ (output :filter rot13)
@line
@ (end)
@(end)


The :vars () argument to collect means that it still iterates, but doesn't actually collect anything (empty list of variables). This is important, so that there isn't a growing data structure being accumulated as the input is processed.

=={{header|UNIX Shell}}==
===[[Bourne Shell]]===

#!/bin/sh
function rot13 () {
tr '[a-m][n-z][A-M][N-Z]' '[n-z][a-m][N-Z][A-M]'
}

cat ${1+"$@"} | rot13


UNIX shell assumes availability of the standard UNIX utility commands (in the "coreutils" package on Linux systems, for example); thus the ''tr'' (translate) command is trivially provided with the proper arguments to perform the rotations. A simple tr a-zA-Z n-za-mN-ZA-M would work with modern systems that follow [[POSIX]]. Our tr '[a-m][n-z][A-M][N-Z]' '[n-z][a-m][N-Z][A-M]' also works with those older System V systems. For newer systems, it translates '[' and ']' to themselves. (Refer to [http://www.openbsd.org/cgi-bin/man.cgi?query=tr&apropos=0&sektion=1&manpath=OpenBSD+Current&arch=i386&format=html#STANDARDS OpenBSD tr(1) manual page, section STANDARDS].)

This example shows proper quoting around "$@" (magical argument list) such that this script work properly even if some of the files named on the command line contain embedded spaces or other such characters. (The ${1+"$@"} check, unnecessary in modern systems, allows the script to work even on older systems where a bare "$@" expanded to a single empty string when no arguments were supplied).

=={{header|Unlambda}}==
``ci`d``@i`c``s`d```?aic.n``s`d```?bic.o``s`d```?cic.p``s`d```?dic.q``s`d```?eic
.r``s`d```?fic.s``s`d```?gic.t``s`d```?hic.u``s`d```?iic.v``s`d```?jic.w``s`d```
?kic.x``s`d```?lic.y``s`d```?mic.z``s`d```?nic.a``s`d```?oic.b``s`d```?pic.c``s`
d```?qic.d``s`d```?ric.e``s`d```?sic.f``s`d```?tic.g``s`d```?uic.h``s`d```?vic.i
``s`d```?wic.j``s`d```?xic.k``s`d```?yic.l``s`d```?zic.m``s`d```?Nic.A``s`d```?O
ic.B``s`d```?Pic.C``s`d```?Qic.D``s`d```?Ric.E``s`d```?Sic.F``s`d```?Tic.G``s`d`
``?Uic.H``s`d```?Vic.I``s`d```?Wic.J``s`d```?Xic.K``s`d```?Yic.L``s`d```?Zic.M``
s`d```?Aic.N``s`d```?Bic.O``s`d```?Cic.P``s`d```?Dic.Q``s`d```?Eic.R``s`d```?Fic
.S``s`d```?Gic.T``s`d```?Hic.U``s`d```?Iic.V``s`d```?Jic.W``s`d```?Kic.X``s`d```
?Lic.Y``s`d```?Mic.Z`d`|c


=={{header|Ursala}}==
I/O in Ursala is meant to be handled automatically as much as possible by the run time system.
This source text describes only a function that operates on the contents of a list of files passed
to it as an argument, with the transformed files returned as a result. The #executable compiler
directive and its parameters mean that this source will be compiled to an executable file
with the required command line interface. The rot13 encryption algorithm itself is a simple
finite map implemented in a half line of code.
#import std

#executable (<'parameterized','default-to-stdin'>,<>)

rot = ~command.files; * contents:= ~contents; * * -:~& -- ^p(~&,rep13~&zyC)~~ ~=`A-~ letters


=={{header|Vedit macro language}}==
Using ROT13.TBL from [http://cu2.home.comcast.net/~cu2/vedit/ here]
Translate_Load("ROT13.TBL")
Translate_Block(0, File_Size)


You can execute the macro from DOS command prompt with the following command:
vpw -q -x rot13.vdm inputfile -a outputfile

In addition to translating a block of text, the translate table allows viewing and editing ROT-13 text without translating the actual file into ASCII.
The displayed characters and keyboard input are translated on-the-fly.
This is the normal way to edit for example DOS/OEM and EBCDIC files.

=={{header|Visual Basic .NET}}==
'''Platform:''' [[.NET]]

{{works with|Visual Basic .NET|9.0+}}
Module Module1

Private Function rot13(ByVal str As String) As String
Dim newChars As Char(), i, j As Integer, original, replacement As String

original = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
replacement = "NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm"

newChars = str.ToCharArray()

For i = 0 To newChars.Length - 1
For j = 0 To 51
If newChars(i) = original(j) Then
newChars(i) = replacement(j)
Exit For
End If
Next
Next

Return New String(newChars)
End Function

End Module

This solution just uses simple textual substitution, since the number of characters involved is small. If the cipher involved more characters, it would be better to use character arithmetic; however, this is not encouraged in VB.Net.

=={{header|Wart}}==
def (rot13 s)
(as string
(map rot13
(as list s)))

Alphabet <- "abcdefghijklmnopqrstuvwxyz"
def (rot13 c) :case (and string?.c len.c=1)
if ("a" <= c <= "z")
let idx (pos c Alphabet)
Alphabet (idx+13 % 26)
("A" <= c <= "Z")
(downcase.c -> rot13 -> upcase)
:else
c


Output:
(rot13 "Moron")
=> "Zbeba"


=={{header|X86 Assembly}}==
Using Linux/FASM.
format ELF executable 3
entry start

segment readable writeable
buf rb 1

segment readable executable
start: mov eax, 3 ; syscall "read"
mov ebx, 0 ; stdin
mov ecx, buf ; buffer for read byte
mov edx, 1 ; len (read one byte)
int 80h

cmp eax, 0 ; EOF?
jz exit

xor eax, eax ; load read char to eax
mov al, [buf]
cmp eax, "A" ; see if it is in ascii a-z or A-Z
jl print
cmp eax, "z"
jg print
cmp eax, "Z"
jle rotup
cmp eax, "a"
jge rotlow
jmp print

rotup: sub eax, "A"-13 ; do rot 13 for A-Z
cdq
mov ebx, 26
div ebx
add edx, "A"
jmp rotend

rotlow: sub eax, "a"-13 ; do rot 13 for a-z
cdq
mov ebx, 26
div ebx
add edx, "a"

rotend: mov [buf], dl

print: mov eax, 4 ; syscall write
mov ebx, 1 ; stdout
mov ecx, buf ; *char
mov edx, 1 ; string length
int 80h

jmp start

exit: mov eax,1 ; syscall exit
xor ebx,ebx ; exit code
int 80h


=={{header|XPL0}}==
Usage: rot13 outfile.txt
code ChIn=7, ChOut=8;
int C, CC;
repeat C:= ChIn(1); CC:= C&~$20; \CC handles lowercase too
ChOut(0, C + (if CC>=^A & CC<=^M then +13
else if CC>=^N & CC<=^Z then -13
else 0));
until C = $1A; \EOF


=={{header|XSLT}}==
Textual transforms are one of the domains XSLT was designed for.


ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm







This will transform the input:
The Abjurer was to be found Nowhere.
into:
The Nowhere was to be found Abjurer.

=={{header|ZX Spectrum Basic}}==
{{trans|QBasic}}

10 CLS
20 INPUT "Enter a string: ", s$
30 LET a$ = "": REM a$ is the encoded string
40 FOR l = 1 TO LEN(s$)
50 LET i$ = s$(l): REM i$ is the letter being worked on
60 IF i$ < "A" OR i$ > "Z" THEN GO TO 100
70 LET c$ = CHR$(CODE(i$) + 13): REM c$ is the encoded letter
80 IF c$ > "Z" THEN LET c$ = CHR$(CODE(c$) - 26)
90 GO TO 300
100 IF i$ < "a" OR i$ > "z" THEN GO TO 200
110 LET c$ = CHR$(CODE(i$) + 13)
120 IF c$ > "z" THEN LET c$ = CHR$(CODE(c$) - 26)
130 GO TO 300
200 LET c$ = i$
300 LET a$ = a$ + c$
310 NEXT l
320 PRINT a$

Greatest common divisor

Pete: Limbo version.


{{task|Arithmetic operations}}[[Category:Recursion]]
This task requires the finding of the greatest common divisor of two integers.

=={{header|ACL2}}==
(include-book "arithmetic-3/floor-mod/floor-mod" :dir :system)

(defun gcd$ (x y)
(declare (xargs :guard (and (natp x) (natp y))))
(cond ((or (not (natp x)) (< y 0))
nil)
((zp y) x)
(t (gcd$ y (mod x y)))))


=={{header|ActionScript}}==
//Euclidean algorithm
function gcd(a:int,b:int):int
{
var tmp:int;
//Swap the numbers so a >= b
if(a < b)
{
tmp = a;
a = b;
b = tmp;
}
//Find the gcd
while(b != 0)
{
tmp = a % b;
a = b;
b = tmp;
}
return a;
}

=={{header|Ada}}==
with Ada.Text_Io; use Ada.Text_Io;

procedure Gcd_Test is
function Gcd (A, B : Integer) return Integer is
M : Integer := A;
N : Integer := B;
T : Integer;
begin
while N /= 0 loop
T := M;
M := N;
N := T mod N;
end loop;
return M;
end Gcd;

begin
Put_Line("GCD of 100, 5 is" & Integer'Image(Gcd(100, 5)));
Put_Line("GCD of 5, 100 is" & Integer'Image(Gcd(5, 100)));
Put_Line("GCD of 7, 23 is" & Integer'Image(Gcd(7, 23)));
end Gcd_Test;


Output:

GCD of 100, 5 is 5
GCD of 5, 100 is 5
GCD of 7, 23 is 1


=={{header|Aime}}==
o_integer(gcd(33, 77));
o_byte('\n');
o_integer(gcd(49865, 69811));
o_byte('\n');


=={{header|ALGOL 68}}==
{{works with|ALGOL 68|Revision 1 - no extensions to language used}}

{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}}
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of FORMATted transput}}
PROC gcd = (INT a, b) INT: (
IF a = 0 THEN
b
ELIF b = 0 THEN
a
ELIF a > b THEN
gcd(b, a MOD b)
ELSE
gcd(a, b MOD a)
FI
);
test:(
INT a = 33, b = 77;
printf(($x"The gcd of"g" and "g" is "gl$,a,b,gcd(a,b)));
INT c = 49865, d = 69811;
printf(($x"The gcd of"g" and "g" is "gl$,c,d,gcd(c,d)))
)

Output:

The gcd of +33 and +77 is +11
The gcd of +49865 and +69811 is +9973



=={{header|Alore}}==

def gcd(a as Int, b as Int) as Int
while b != 0
a,b = b, a mod b
end
return Abs(a)
end


== {{header|APL}} ==
{{works with|Dyalog APL}}
33 49865 ∨ 77 69811
11 9973

If you're interested in how you'd write GCD in Dyalog, if Dyalog didn't have a primitive for it, (i.e. using other algorithms mentioned on this page: iterative, recursive, binary recursive), see [http://www.dyalog.com/dfnsdws/n_gcd.htm different ways to write GCD in Dyalog].

{{works with|APL2}}
⌈/(^/0=A∘.|X)/A←⍳⌊/X←49865 69811
9973


== {{header|AutoIt}} ==

_GCD(18, 12)
_GCD(1071, 1029)
_GCD(3528, 3780)

Func _GCD($ia, $ib)
Local $ret = "GCD of " & $ia & " : " & $ib & " = "
Local $imod
While True
$imod = Mod($ia, $ib)
If $imod = 0 Then Return ConsoleWrite($ret & $ib & @CRLF)
$ia = $ib
$ib = $imod
WEnd
EndFunc ;==>_GCD


Output:
GCD of 18 : 12 = 6
GCD of 1071 : 1029 = 21
GCD of 3528 : 3780 = 252




=={{header|AWK}}==
The following scriptlet defines the gcd() function, then reads pairs of numbers from stdin, and reports their gcd on stdout.
$ awk 'func gcd(p,q){return(q?gcd(q,(p%q)):p)}{print gcd($1,$2)}'
12 16
4
22 33
11
45 67
1

=={{header|AutoHotkey}}==
contributed by Laszlo on the ahk [http://www.autohotkey.com/forum/post-276379.html#276379 forum]
GCD(a,b) {
Return b=0 ? Abs(a) : Gcd(b,mod(a,b))
}


=={{header|Batch File}}==
Recursive method
:: gcd.cmd
@echo off
:gcd
if "%2" equ "" goto :instructions
if "%1" equ "" goto :instructions

if %2 equ 0 (
set final=%1
goto :done
)
set /a res = %1 %% %2
call :gcd %2 %res%
goto :eof

:done
echo gcd=%final%
goto :eof

:instructions
echo Syntax:
echo GCD {a} {b}
echo.


=={{header|BASIC}}==
{{works with|QuickBasic|4.5}}
===Iterative===
function gcd(a%, b%)
if a > b then
factor = a
else
factor = b
end if
for l = factor to 1 step -1
if a mod l = 0 and b mod l = 0 then
gcd = l
end if
next l
gcd = 1
end function

===Recursive===
function gcd(a%, b%)
if a = 0 gcd = b
if b = 0 gcd = a
if a > b gcd = gcd(b, a mod b)
gcd = gcd(a, b mod a)
end function


=={{header|BBC BASIC}}==
DEF FN_GCD_Iterative_Euclid(A%, B%)
LOCAL C%
WHILE B%
C% = A%
A% = B%
B% = C% MOD B%
ENDWHILE
= ABS(A%)


=={{header|Bc}}==
{{works with|GNU bc}}
{{trans|C}}

Utility functions:
define even(a)
{
if ( a % 2 == 0 ) {
return(1);
} else {
return(0);
}
}

define abs(a)
{
if (a<0) {
return(-a);
} else {
return(a);
}
}


'''Iterative (Euclid)'''
define gcd_iter(u, v)
{
while(v) {
t = u;
u = v;
v = t % v;
}
return(abs(u));
}


'''Recursive'''

define gcd(u, v)
{
if (v) {
return ( gcd(v, u%v) );
} else {
return (abs(u));
}
}


'''Iterative (Binary)'''

define gcd_bin(u, v)
{
u = abs(u);
v = abs(v);
if ( u < v ) {
t = u; u = v; v = t;
}
if ( v == 0 ) { return(u); }
k = 1;
while (even(u) && even(v)) {
u = u / 2; v = v / 2;
k = k * 2;
}
if ( even(u) ) {
t = -v;
} else {
t = u;
}
while (t) {
while (even(t)) {
t = t / 2;
}

if (t > 0) {
u = t;
} else {
v = -t;
}
t = u - v;
}
return (u * k);
}


=={{header|Befunge}}==
#v&< @.$<
:<\g05%p05:_^#


=={{header|Bracmat}}==
Bracmat uses the Euclidean algorithm to simplify fractions. The den function extracts the denominator from a fraction.
(gcd=a b.!arg:(?a.?b)&!b*den$(!a*!b^-1)^-1);
Example:
{?} gcd$(49865.69811)
{!} 9973


=={{header|C}}/{{header|C++}}==
===Iterative Euclid algorithm===
int
gcd_iter(int u, int v) {
int t;
while (v) {
t = u;
u = v;
v = t % v;
}
return u < 0 ? -u : u; /* abs(u) */
}


===Recursive Euclid algorithm===
int gcd(int u, int v) {
return (v != 0)?gcd(v, u%v):u;
}


===Iterative binary algorithm===
int
gcd_bin(int u, int v) {
int t, k;

u = u < 0 ? -u : u; /* abs(u) */
v = v < 0 ? -v : v;
if (u < v) {
t = u;
u = v;
v = t;
}
if (v == 0)
return u;

k = 1;
while (u & 1 == 0 && v & 1 == 0) { /* u, v - even */
u >>= 1; v >>= 1;
k <<= 1;
}

t = (u & 1) ? -v : u;
while (t) {
while (t & 1 == 0)
t >>= 1;

if (t > 0)
u = t;
else
v = -t;

t = u - v;
}
return u * k;
}


=={{header|c sharp|C#}}==
{{trans|ActionScript}}

static void Main(string[] args)
{
Console.WriteLine("GCD of {0} and {1} is {2}", 1, 1, gcd(1, 1));
Console.WriteLine("GCD of {0} and {1} is {2}", 1, 10, gcd(1, 10));
Console.WriteLine("GCD of {0} and {1} is {2}", 10, 100, gcd(10, 100));
Console.WriteLine("GCD of {0} and {1} is {2}", 5, 50, gcd(5, 50));
Console.WriteLine("GCD of {0} and {1} is {2}", 8, 24, gcd(8, 24));
Console.WriteLine("GCD of {0} and {1} is {2}", 36, 17, gcd(36, 17));
Console.WriteLine("GCD of {0} and {1} is {2}", 36, 18, gcd(36, 18));
Console.WriteLine("GCD of {0} and {1} is {2}", 36, 19, gcd(36, 19));
for (int x = 1; x < 36; x++)
{
Console.WriteLine("GCD of {0} and {1} is {2}", 36, x, gcd(36, x));
}
Console.Read();
}

private static int gcd(int a, int b)
{
int t;

// Ensure B > A
if (a > b)
{
t = b;
b = a;
a = t;
}

// Find
while (b != 0)
{
t = a % b;
a = b;
b = t;
}

return a;
}


Example output:

GCD of 1 and 1 is 1
GCD of 1 and 10 is 1
GCD of 10 and 100 is 10
GCD of 5 and 50 is 5
GCD of 8 and 24 is 8
GCD of 36 and 1 is 1
GCD of 36 and 2 is 2
..
GCD of 36 and 16 is 4
GCD of 36 and 17 is 1
GCD of 36 and 18 is 18
..
..
GCD of 36 and 33 is 3
GCD of 36 and 34 is 2
GCD of 36 and 35 is 1


=={{header|Clojure}}==

(defn gcd
"(gcd a b) computes the greatest common divisor of a and b."
[a b]
(if (zero? b)
a
(recur b (mod a b))))


That recur call is the same as (gcd b (mod a b)), but makes use of Clojure's explicit tail call optimization.

=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. GCD.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 A PIC 9(10) VALUE ZEROES.
01 B PIC 9(10) VALUE ZEROES.
01 TEMP PIC 9(10) VALUE ZEROES.

PROCEDURE DIVISION.
Begin.
DISPLAY "Enter first number, max 10 digits."
ACCEPT A
DISPLAY "Enter second number, max 10 digits."
ACCEPT B
IF A < B
MOVE B TO TEMP
MOVE A TO B
MOVE TEMP TO B
END-IF

PERFORM UNTIL B = 0
MOVE A TO TEMP
MOVE B TO A
DIVIDE TEMP BY B GIVING TEMP REMAINDER B
END-PERFORM
DISPLAY "The gcd is " A
STOP RUN.


=={{header|Cobra}}==


class Rosetta
def gcd(u as number, v as number) as number
u, v = u.abs, v.abs
while v > 0
u, v = v, u % v
return u

def main
print "gcd of [12] and [8] is [.gcd(12, 8)]"
print "gcd of [12] and [-8] is [.gcd(12, -8)]"
print "gcd of [96] and [27] is [.gcd(27, 96)]"
print "gcd of [51] and [34] is [.gcd(34, 51)]"


Output:

gcd of 12 and 8 is 4
gcd of 12 and -8 is 4
gcd of 96 and 27 is 3
gcd of 51 and 34 is 17


=={{header|CoffeeScript}}==

Simple recursion

gcd = (x, y) ->
if y == 0 then x else gcd y, x % y


Since JS has no TCO, here's a version with no recursion

gcd = (x, y) ->
[1..(Math.min x, y)].reduce (acc, v) ->
if x % v == 0 and y % v == 0 then v else acc


=={{header|Common Lisp}}==
Common Lisp provides a ''gcd'' function.

CL-USER> (gcd 2345 5432)
7


Here is an implementation using the do macro. We call the function gcd2 so as not to conflict with common-lisp:gcd.

(defun gcd2 (a b)
(do () ((zerop b) (abs a))
(shiftf a b (mod a b))))


Here is a tail-recursive implementation.

(defun gcd2 (a b)
(if (zerop b) a
(gcd2 b (mod a b))))


The last implementation is based on the loop macro.

(defun gcd2 (a b)
(loop for x = a then y
and y = b then (mod x y)
until (zerop y)
finally (return x)))

=={{header|Component Pascal}}==
BlackBox Component Builder

MODULE Operations;
IMPORT StdLog,Args,Strings;

PROCEDURE Gcd(a,b: LONGINT):LONGINT;
VAR
r: LONGINT;
BEGIN
LOOP
r := a MOD b;
IF r = 0 THEN RETURN b END;
a := b;b := r
END
END Gcd;

PROCEDURE DoGcd*;
VAR
x,y,done: INTEGER;
p: Args.Params;
BEGIN
Args.Get(p);
IF p.argc >= 2 THEN
Strings.StringToInt(p.args[0],x,done);
Strings.StringToInt(p.args[1],y,done);
StdLog.String("gcd("+p.args[0]+","+p.args[1]+")=");StdLog.Int(Gcd(x,y));StdLog.Ln
END
END DoGcd;

END Operations.

Execute:

^Q Operations.DoGcd 12 8 ~

^Q Operations.DoGcd 100 5 ~

^Q Operations.DoGcd 7 23 ~

^Q Operations.DoGcd 24 -112 ~

Output:

gcd(12 ,8 )= 4
gcd(100 ,5 )= 5
gcd(7 ,23 )= 1
gcd(24 ,-112 )= -8

=={{header|D}}==
import std.stdio, std.numeric;

long myGCD(in long x, in long y) pure nothrow {
if (y == 0)
return x;
return myGCD(y, x % y);
}

void main() {
writeln(gcd(15, 10)); // from Phobos
writeln(myGCD(15, 10));
}

{{out}}
5
5


=={{header|Dc}}==
[dSa%Lard0
This code assumes that there are two integers on the stack.
dc -e'28 24 [dSa%Lard0

=={{header|DWScript}}==
PrintLn(Gcd(231, 210));
Output:
21


=={{header|E}}==
{{trans|Python}}

def gcd(var u :int, var v :int) {
while (v != 0) {
def r := u %% v
u := v
v := r
}
return u.abs()
}


=={{header|Eiffel}}==
{{trans|D}}


class
APPLICATION

create
make

feature -- Implementation

gcd (x: INTEGER y: INTEGER): INTEGER
do
if y = 0 then
Result := x
else
Result := gcd (y, x \\ y);
end
end

feature {NONE} -- Initialization

make
-- Run application.
do
print (gcd (15, 10))
print ("%N")
end

end


=={{header|Emacs Lisp}}==


(defun gcd (a b)
(cond
((< a b) (gcd a (- b a)))
((> a b) (gcd (- a b) b))
(t a)))


=={{header|Erlang}}==

% Implemented by Arjun Sunel
-module(gcd).
-export([main/0]).

main() ->gcd(-36,4).

gcd(A, 0) -> A;

gcd(A, B) -> gcd(B, A rem B).

{{out}}
4


=={{header|Euler Math Toolbox}}==

Non-recursive version in Euler Math Toolbox. Note, that there is a built-in command.


>ggt(123456795,1234567851)
33
>function myggt (n:index, m:index) ...
$ if n $ repeat
$ k=mod(n,m);
$ if k==0 then return m; endif;
$ if k==1 then return 1; endif;
$ {n,m}={m,k};
$ end;
$ endfunction
>myggt(123456795,1234567851)
33


=={{header|Euphoria}}==
{{trans|C/C++}}
===Iterative Euclid algorithm===
function gcd_iter(integer u, integer v)
integer t
while v do
t = u
u = v
v = remainder(t, v)
end while
if u < 0 then
return -u
else
return u
end if
end function


===Recursive Euclid algorithm===
function gcd(integer u, integer v)
if v then
return gcd(v, remainder(u, v))
elsif u < 0 then
return -u
else
return u
end if
end function


===Iterative binary algorithm===
function gcd_bin(integer u, integer v)
integer t, k
if u < 0 then -- abs(u)
u = -u
end if
if v < 0 then -- abs(v)
v = -v
end if
if u < v then
t = u
u = v
v = t
end if
if v = 0 then
return u
end if
k = 1
while and_bits(u,1) = 0 and and_bits(v,1) = 0 do
u = floor(u/2) -- u >>= 1
v = floor(v/2) -- v >>= 1
k *= 2 -- k <<= 1
end while
if and_bits(u,1) then
t = -v
else
t = u
end if
while t do
while and_bits(t, 1) = 0 do
t = floor(t/2)
end while
if t > 0 then
u = t
else
v = -t
end if
t = u - v
end while
return u * k
end function


=={{header|Ezhil}}==

## இந்த நிரல் இரு எண்களுக்கு இடையிலான மீச்சிறு பொது மடங்கு (LCM), மீப்பெரு பொது வகுத்தி (GCD) என்ன என்று கணக்கிடும்

நிரல்பாகம் மீபொவ(எண்1, எண்2)

@(எண்1 == எண்2) ஆனால்

## இரு எண்களும் சமம் என்பதால், அந்த எண்ணேதான் அதன் மீபொவ

பின்கொடு எண்1

@(எண்1 > எண்2) இல்லைஆனால்

சிறியது = எண்2
பெரியது = எண்1

இல்லை

சிறியது = எண்1
பெரியது = எண்2

முடி

மீதம் = பெரியது % சிறியது

@(மீதம் == 0) ஆனால்

## பெரிய எண்ணில் சிறிய எண் மீதமின்றி வகுபடுவதால், சிறிய எண்தான் மீப்பெரு பொதுவகுத்தியாக இருக்கமுடியும்

பின்கொடு சிறியது

இல்லை

தொடக்கம் = சிறியது - 1

நிறைவு = 1

@(எண் = தொடக்கம், எண் >= நிறைவு, எண் = எண் - 1) ஆக

மீதம்1 = சிறியது % எண்

மீதம்2 = பெரியது % எண்

## இரு எண்களையும் மீதமின்றி வகுக்கக்கூடிய பெரிய எண்ணைக் கண்டறிகிறோம்

@((மீதம்1 == 0) && (மீதம்2 == 0)) ஆனால்

பின்கொடு எண்

முடி

முடி

முடி

முடி

அ = int(உள்ளீடு("ஓர் எண்ணைத் தாருங்கள் "))
ஆ = int(உள்ளீடு("இன்னோர் எண்ணைத் தாருங்கள் "))

பதிப்பி "நீங்கள் தந்த இரு எண்களின் மீபொவ (மீப்பெரு பொது வகுத்தி, GCD) = ", மீபொவ(அ, ஆ)


=={{header|F_Sharp|F#}}==

let rec gcd a b =
if b = 0
then abs a
else gcd b (a % b)

>gcd 400 600
val it : int = 200


=={{header|Factor}}==
: gcd ( a b -- c )
[ abs ] [
[ nip ] [ mod ] 2bi gcd
] if-zero ;


=={{header|FALSE}}==
10 15$ [0=~][$@$@$@\/*-$]#%. { gcd(10,15)=5 }

=={{header|Fantom}}==


class Main
{
static Int gcd (Int a, Int b)
{
a = a.abs
b = b.abs
while (b > 0)
{
t := a
a = b
b = t % b
}
return a
}

public static Void main()
{
echo ("GCD of 51, 34 is: " + gcd(51, 34))
}
}


=={{header|Forth}}==
: gcd ( a b -- n )
begin dup while tuck mod repeat drop ;


=={{header|Fortran}}==
{{works with|Fortran|95 and later}}
===Recursive Euclid algorithm===
recursive function gcd_rec(u, v) result(gcd)
integer :: gcd
integer, intent(in) :: u, v

if (mod(u, v) /= 0) then
gcd = gcd_rec(v, mod(u, v))
else
gcd = v
end if
end function gcd_rec


===Iterative Euclid algorithm===
subroutine gcd_iter(value, u, v)
integer, intent(out) :: value
integer, intent(inout) :: u, v
integer :: t

do while( v /= 0 )
t = u
u = v
v = mod(t, v)
enddo
value = abs(u)
end subroutine gcd_iter


A different version, and implemented as function

function gcd(v, t)
integer :: gcd
integer, intent(in) :: v, t
integer :: c, b, a

b = t
a = v
do
c = mod(a, b)
if ( c == 0) exit
a = b
b = c
end do
gcd = b ! abs(b)
end function gcd


===Iterative binary algorithm===
subroutine gcd_bin(value, u, v)
integer, intent(out) :: value
integer, intent(inout) :: u, v
integer :: k, t

u = abs(u)
v = abs(v)
if( u < v ) then
t = u
u = v
v = t
endif
if( v == 0 ) then
value = u
return
endif
k = 1
do while( (mod(u, 2) == 0).and.(mod(v, 2) == 0) )
u = u / 2
v = v / 2
k = k * 2
enddo
if( (mod(u, 2) == 0) ) then
t = u
else
t = -v
endif
do while( t /= 0 )
do while( (mod(t, 2) == 0) )
t = t / 2
enddo
if( t > 0 ) then
u = t
else
v = -t
endif
t = u - v
enddo
value = u * k
end subroutine gcd_bin


===Notes on performance===
gcd_iter(40902, 24140) takes us about '''2.8''' µsec

gcd_bin(40902, 24140) takes us about '''2.5''' µsec

=={{header|Frink}}==
Frink has a builtin gcd[x,y] function that returns the GCD of two integers (which can be arbitrarily large.)

println[gcd[12345,98765]]


== {{header|GAP}} ==
# Built-in
GcdInt(35, 42);
# 7

# Euclidean algorithm
GcdInteger := function(a, b)
local c;
a := AbsInt(a);
b := AbsInt(b);
while b > 0 do
c := a;
a := b;
b := RemInt(c, b);
od;
return a;
end;

GcdInteger(35, 42);
# 7


=={{header|Genyris}}==
===Recursive===
def gcd (u v)
u = (abs u)
v = (abs v)
cond
(equal? v 0) u
else (gcd v (% u v))


===Iterative===
def gcd (u v)
u = (abs u)
v = (abs v)
while (not (equal? v 0))
var tmp (% u v)
u = v
v = tmp
u

=={{header|GML}}==


var n,m,r;
n = max(argument0,argument1);
m = min(argument0,argument1);
while (m != 0)
{
r = n mod m;
n = m;
m = r;
}
return a;


=={{header|gnuplot}}==
gcd (a, b) = b == 0 ? a : gcd (b, a % b)
Example:
print gcd (111111, 1111)
Output:
11

=={{header|Go}}==
===Iterative===
package main

import "fmt"

func gcd(x, y int) int {
for y != 0 {
x, y = y, x%y
}
return x
}

func main() {
fmt.Println(gcd(33, 77))
fmt.Println(gcd(49865, 69811))
}

===Builtin===
(This is just a wrapper for big.GCD)
package main

import (
"fmt"
"math/big"
)

func gcd(x, y int64) int64 {
return new(big.Int).GCD(nil, nil, big.NewInt(x), big.NewInt(y)).Int64()
}

func main() {
fmt.Println(gcd(33, 77))
fmt.Println(gcd(49865, 69811))
}

{{out|Output in either case}}

11
9973


=={{header|Groovy}}==

===Recursive===
def gcdR
gcdR = { m, n -> m = m.abs(); n = n.abs(); n == 0 ? m : m%n == 0 ? n : gcdR(n, m%n) }


===Iterative===
def gcdI = { m, n -> m = m.abs(); n = n.abs(); n == 0 ? m : { while(m%n != 0) { t=n; n=m%n; m=t }; n }() }

Test program:
println " R I"
println "gcd(28, 0) = ${gcdR(28, 0)} == ${gcdI(28, 0)}"
println "gcd(0, 28) = ${gcdR(0, 28)} == ${gcdI(0, 28)}"
println "gcd(0, -28) = ${gcdR(0, -28)} == ${gcdI(0, -28)}"
println "gcd(70, -28) = ${gcdR(70, -28)} == ${gcdI(70, -28)}"
println "gcd(70, 28) = ${gcdR(70, 28)} == ${gcdI(70, 28)}"
println "gcd(28, 70) = ${gcdR(28, 70)} == ${gcdI(28, 70)}"
println "gcd(800, 70) = ${gcdR(800, 70)} == ${gcdI(800, 70)}"
println "gcd(27, -70) = ${gcdR(27, -70)} == ${gcdI(27, -70)}"


Output:
                R     I
gcd(28, 0) = 28 == 28
gcd(0, 28) = 28 == 28
gcd(0, -28) = 28 == 28
gcd(70, -28) = 14 == 14
gcd(70, 28) = 14 == 14
gcd(28, 70) = 14 == 14
gcd(800, 70) = 10 == 10
gcd(27, -70) = 1 == 1


=={{header|Haskell}}==

That is already available as the function ''gcd'' in the Prelude. Here's the implementation:

gcd :: (Integral a) => a -> a -> a
gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined"
gcd x y = gcd' (abs x) (abs y) where
gcd' a 0 = a
gcd' a b = gcd' b (a `rem` b)


=={{header|HicEst}}==
FUNCTION gcd(a, b)
IF(b == 0) THEN
gcd = ABS(a)
ELSE
aa = a
gcd = b
DO i = 1, 1E100
r = ABS(MOD(aa, gcd))
IF( r == 0 ) RETURN
aa = gcd
gcd = r
ENDDO
ENDIF
END


=={{header|Icon}} and {{header|Unicon}}==
link numbers # gcd is part of the Icon Programming Library
procedure main(args)
write(gcd(arg[1], arg[2])) | "Usage: gcd n m")
end


{{libheader|Icon Programming Library}} [http://www.cs.arizona.edu/icon/library/procs/numbers.htm numbers] implements this as:

procedure gcd(i,j) #: greatest common divisor
local r

if (i | j) < 1 then runerr(501)

repeat {
r := i % j
if r = 0 then return j
i := j
j := r
}
end


=={{header|J}}==
x+.y

For example:

12 +. 30
6


Note that +. is a single, two character token. GCD is a primitive in J (and anyone that has studied the right kind of mathematics should instantly recognize why the same operation is used for both GCD and OR -- among other things, GCD and boolean OR both have the same identity element: 0, and of course they produce the same numeric results on the same arguments (when we are allowed to use the usual 1 bit implementation of 0 and 1 for false and true)).

=={{header|Java}}==
===Iterative===
public static long gcd(long a, long b){
long factor= Math.max(a, b);
for(long loop= factor;loop > 1;loop--){
if(a % loop == 0 && b % loop == 0){
return loop;
}
}
return 1;
}

===Iterative Euclid's Algorithm===

public static int gcd(int a, int b) //valid for positive integers.
{
while(b > 0)
{
int c = a % b;
a = b;
b = c;
}
return a;
}


===Optimized Iterative===

static int gcd(int a,int b)
{
int min=a>b?b:a,max=a+b-min, div=min;
for(int i=1;i if(max%div==0)
return div;
return 1;
}


===Iterative binary algorithm===
{{trans|C/C++}}
public static long gcd(long u, long v){
long t, k;

if (v == 0) return u;

u = Math.abs(u);
v = Math.abs(v);
if (u < v){
t = u;
u = v;
v = t;
}

for(k = 1; (u & 1) == 0 && (v & 1) == 0; k <<= 1){
u >>= 1; v >>= 1;
}

t = (u & 1) != 0 ? -v : u;
while (t != 0){
while ((t & 1) == 0) t >>= 1;

if (t > 0)
u = t;
else
v = -t;

t = u - v;
}
return u * k;
}

===Recursive===
public static long gcd(long a, long b){
if(a == 0) return b;
if(b == 0) return a;
if(a > b) return gcd(b, a % b);
return gcd(a, b % a);
}

===Built-in===
import java.math.BigInteger;

public static long gcd(long a, long b){
return BigInteger.valueOf(a).gcd(BigInteger.valueOf(b)).longValue();
}


=={{header|JavaScript}}==
Iterative.
function gcd(a,b) {
if (a < 0) a = -a;
if (b < 0) b = -b;
if (b > a) {var temp = a; a = b; b = temp;}
while (true) {
a %= b;
if (a == 0) return b;
b %= a;
if (b == 0) return a;
}
}


Recursive.
function gcd_rec(a, b) {
if (b) {
return gcd_rec(b, a % b);
} else {
return Math.abs(a);
}
}


For an array of integers
function GCD(A) // A is an integer array (e.g. [57,0,-45,-18,90,447])
{
var n = A.length, x = A[0] < 0 ? -A[0] : A[0];
for (var i = 1; i < n; i++)
{ var y = A[i] < 0 ? -A[i] : A[i];
while (x && y){ x > y ? x %= y : y %= x; }
x += y;
}
return x;
}

/* For example:
GCD([57,0,-45,-18,90,447]) -> 3
*/


=={{header|Joy}}==
DEFINE gcd == [0 >] [dup rollup rem] while pop.

=={{header|Julia}}==
Julia includes a built-in gcd function:
julia> gcd(4,12)
4
julia> gcd(6,12)
6
julia> gcd(7,12)
1

The actual implementation of this function in Julia 0.2's standard library is reproduced here:
function gcd{T<:Integer}(a::T, b::T)
neg = a < 0
while b != 0
t = b
b = rem(a, b)
a = t
end
g = abs(a)
neg ? -g : g
end

(For arbitrary-precision integers, Julia calls a different implementation from the GMP library.)

=={{header|K}}==
gcd:{:[~x;y;_f[y;x!y]]}

=={{header|LabVIEW}}==
{{trans|AutoHotkey}}
It may be helpful to read about [http://digital.ni.com/public.nsf/allkb/7140920082C3AC15862572840015A81E Recursion in LabVIEW].

{{VI snippet}}

[[File:LabVIEW Greatest common divisor.png]]
=={{header|Liberty BASIC}}==
'iterative Euclid algorithm
print GCD(-2,16)
end

function GCD(a,b)
while b
c = a
a = b
b = c mod b
wend
GCD = abs(a)
end function


=={{header|Limbo}}==

gcd(x: int, y: int): int
{
if(y == 0)
return x;
return(y, x % y);
}


=={{header|LiveCode}}==
function gcd x,y
repeat until y = 0
put x mod y into z
put y into x
put z into y
end repeat
return x
end gcd



=={{header|Logo}}==
to gcd :a :b
if :b = 0 [output :a]
output gcd :b modulo :a :b
end


=={{header|Lua}}==
{{trans|C}}
function gcd(a,b)
if b ~= 0 then
return gcd(b, a % b)
else
return math.abs(a)
end
end

function demo(a,b)
print("GCD of " .. a .. " and " .. b .. " is " .. gcd(a, b))
end

demo(100, 5)
demo(5, 100)
demo(7, 23)


Output:

GCD of 100 and 5 is 5
GCD of 5 and 100 is 5
GCD of 7 and 23 is 1


=={{header|Lucid}}==
===dataflow algorithm===
gcd(n,m) where
z = [% n, m %] fby if x > y then [% x - y, y %] else [% x, y - x%] fi;
x = hd(z);
y = hd(tl(z));
gcd(n, m) = (x asa x*y eq 0) fby eod;
end


=={{header|Maple}}==
To compute the greatest common divisor of two integers in Maple, use the procedure igcd.

igcd( a, b )

For example,

> igcd( 24, 15 );
3



=={{header|Mathematica}}==
GCD[a, b]

=={{header|MATLAB}}==
function [gcdValue] = greatestcommondivisor(integer1, integer2)
gcdValue = gcd(integer1, integer2);


=={{header|Maxima}}==
/* There is a function gcd(a, b) in Maxima, but one can rewrite it */
gcd2(a, b) := block([a: abs(a), b: abs(b)], while b # 0 do [a, b]: [b, mod(a, b)], a)$

/* both will return 2^97 * 3^48 */
gcd(100!, 6^100), factor;
gcd2(100!, 6^100), factor;


=={{header|MAXScript}}==
===Iterative Euclid algorithm===
fn gcdIter a b =
(
while b > 0 do
(
c = mod a b
a = b
b = c
)
abs a
)


===Recursive Euclid algorithm===
fn gcdRec a b =
(
if b > 0 then gcdRec b (mod a b) else abs a
)


=={{header|MIPS Assembly}}==
gcd:
# a0 and a1 are the two integer parameters
# return value is in v0
move $t0, $a0
move $t1, $a1
loop:
beq $t1, $0, done
div $t0, $t1
move $t0, $t1
mfhi $t1
j loop
done:
move $v0, $t0
jr $ra


=={{header|МК-61/52}}==

ИПA ИПB / П9 КИП9 ИПA ИПB ПA ИП9 *
- ПB x=0 00 ИПA С/П


Enter: n = РA, m = РB (n > m).

=={{header|Modula-2}}==
MODULE ggTkgV;

FROM InOut IMPORT ReadCard, WriteCard, WriteLn, WriteString, WriteBf;

VAR x, y, u, v : CARDINAL;

BEGIN
WriteString ("x = "); WriteBf; ReadCard (x);
WriteString ("y = "); WriteBf; ReadCard (y);
u := x;
v := y;
WHILE x # y DO
(* ggT (x, y) = ggT (x0, y0), x * v + y * u = 2 * x0 * y0 *)
IF x > y THEN
x := x - y;
u := u + v
ELSE
y := y - x;
v := v + u
END
END;
WriteString ("ggT ="); WriteCard (x, 6); WriteLn;
WriteString ("kgV ="); WriteCard ((u+v) DIV 2, 6); WriteLn;
WriteString ("u ="); WriteCard (u, 6); WriteLn;
WriteString ("v ="); WriteCard (v , 6); WriteLn
END ggTkgV.

Producing the output
jan@Beryllium:~/modula/Wirth/PIM$ ggtkgv
x = 12
y = 20
ggT = 4
kgV = 60
u = 44
v = 76
jan@Beryllium:~/modula/Wirth/PIM$ ggtkgv
x = 123
y = 255
ggT = 3
kgV = 10455
u = 13773
v = 7137


=={{header|Modula-3}}==
MODULE GCD EXPORTS Main;

IMPORT IO, Fmt;

PROCEDURE GCD(a, b: CARDINAL): CARDINAL =
BEGIN
IF a = 0 THEN
RETURN b;
ELSIF b = 0 THEN
RETURN a;
ELSIF a > b THEN
RETURN GCD(b, a MOD b);
ELSE
RETURN GCD(a, b MOD a);
END;
END GCD;

BEGIN
IO.Put("GCD of 100, 5 is " & Fmt.Int(GCD(100, 5)) & "\n");
IO.Put("GCD of 5, 100 is " & Fmt.Int(GCD(5, 100)) & "\n");
IO.Put("GCD of 7, 23 is " & Fmt.Int(GCD(7, 23)) & "\n");
END GCD.


Output:

GCD of 100, 5 is 5
GCD of 5, 100 is 5
GCD of 7, 23 is 1


=={{header|MUMPS}}==

GCD(A,B)
QUIT:((A/1)'=(A\1))!((B/1)'=(B\1)) 0
SET:A<0 A=-A
SET:B<0 B=-B
IF B'=0
FOR SET T=A#B,A=B,B=T QUIT:B=0 ;ARGUEMENTLESS FOR NEEDS TWO SPACES
QUIT A


Ouput:

CACHE>S X=$$GCD^ROSETTA(12,24) W X
12
CACHE>S X=$$GCD^ROSETTA(24,-112) W X
8
CACHE>S X=$$GCD^ROSETTA(24,-112.2) W X
0


=={{header|MySQL}}==


DROP FUNCTION IF EXISTS gcd;
DELIMITER |

CREATE FUNCTION gcd(x INT, y INT)
RETURNS INT
BEGIN
SET @dividend=GREATEST(ABS(x),ABS(y));
SET @divisor=LEAST(ABS(x),ABS(y));
IF @divisor=0 THEN
RETURN @dividend;
END IF;
SET @gcd=NULL;
SELECT gcd INTO @gcd FROM
(SELECT @tmp:=@dividend,
@dividend:=@divisor AS gcd,
@divisor:=@tmp % @divisor AS remainder
FROM mysql.help_relation WHERE @divisor>0) AS x
WHERE remainder=0;
RETURN @gcd;
END;|

DELIMITER ;

SELECT gcd(12345, 9876);


+------------------+
| gcd(12345, 9876) |
+------------------+
| 2469 |
+------------------+
1 row in set (0.00 sec)

=={{header|NetRexx}}==
/* NetRexx */
options replace format comments java crossref symbols nobinary

numeric digits 2000
runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Euclid's algorithm - iterative implementation
method gcdEucidI(a_, b_) public static
loop while b_ > 0
c_ = a_ // b_
a_ = b_
b_ = c_
end
return a_

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Euclid's algorithm - recursive implementation
method gcdEucidR(a_, b_) public static
if b_ \= 0 then a_ = gcdEucidR(b_, a_ // b_)
return a_

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
-- pairs of numbers, each number in the pair separated by a colon, each pair separated by a comma
parse arg tests
if tests = '' then
tests = '0:0, 6:4, 7:21, 12:36, 33:77, 41:47, 99:51, 100:5, 7:23, 1989:867, 12345:9876, 40902:24140, 49865:69811, 137438691328:2305843008139952128'

-- most of what follows is for formatting
xiterate = 0
xrecurse = 0
ll_ = 0
lr_ = 0
lgi = 0
lgr = 0
loop i_ = 1 until tests = ''
xiterate[0] = i_
xrecurse[0] = i_
parse tests pair ',' tests
parse pair l_ ':' r_ .

-- get the GCDs
gcdi = gcdEucidI(l_, r_)
gcdr = gcdEucidR(l_, r_)

xiterate[i_] = l_ r_ gcdi
xrecurse[i_] = l_ r_ gcdr
ll_ = ll_.max(l_.strip.length)
lr_ = lr_.max(r_.strip.length)
lgi = lgi.max(gcdi.strip.length)
lgr = lgr.max(gcdr.strip.length)
end i_
-- save formatter sizes in stems
xiterate[-1] = ll_ lr_ lgi
xrecurse[-1] = ll_ lr_ lgr

-- present results
showResults(xiterate, 'Euclid''s algorithm - iterative')
showResults(xrecurse, 'Euclid''s algorithm - recursive')
say
if verifyResults(xiterate, xrecurse) then
say 'Success: Results of iterative and recursive methods match'
else
say 'Error: Results of iterative and recursive methods do not match'
say
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method showResults(stem, title) public static
say
say title
parse stem[-1] ll lr lg
loop v_ = 1 to stem[0]
parse stem[v_] lv rv gcd .
say lv.right(ll)',' rv.right(lr) ':' gcd.right(lg)
end v_
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method verifyResults(stem1, stem2) public static returns boolean
if stem1[0] \= stem2[0] then signal BadArgumentException
T = (1 == 1)
F = \T
verified = T
loop i_ = 1 to stem1[0]
if stem1[i_] \= stem2[i_] then do
verified = F
leave i_
end
end i_
return verified

{{out}}

Euclid's algorithm - iterative
0, 0 : 0
6, 4 : 2
7, 21 : 7
12, 36 : 12
33, 77 : 11
41, 47 : 1
99, 51 : 3
100, 5 : 5
7, 23 : 1
1989, 867 : 51
12345, 9876 : 2469
40902, 24140 : 34
49865, 69811 : 9973
137438691328, 2305843008139952128 : 262144

Euclid's algorithm - recursive
0, 0 : 0
6, 4 : 2
7, 21 : 7
12, 36 : 12
33, 77 : 11
41, 47 : 1
99, 51 : 3
100, 5 : 5
7, 23 : 1
1989, 867 : 51
12345, 9876 : 2469
40902, 24140 : 34
49865, 69811 : 9973
137438691328, 2305843008139952128 : 262144

Success: Results of iterative and recursive methods match

=={{header|NewLISP}}==
(gcd 12 36)
→ 12


=={{header|Nial}}==
Nial provides gcd in the standard lib.
|loaddefs 'niallib/gcd.ndf'
|gcd 6 4
=2


defining it for arrays
# red is the reduction operator for a sorted list
# one is termination condition
red is cull filter (0 unequal) link [mod [rest, first] , first]
one is or [= [1 first, tally], > [2 first, first]]
gcd is fork [one, first, gcd red] sort <=


Using it
|gcd 9 6 3
=3


=={{header|Nimrod}}==
Ported from Pascal example
===Recursive Euclid algorithm===
proc gcd_recursive(u, v: int64): int64 =
if u %% v != 0:
result = gcd_recursive(v, u %% v)
else:
result = v

===Iterative Euclid algorithm===
proc gcd_iterative(u1, v1: int64): int64 =
var t: int64 = 0
var u = u1
var v = v1
while v != 0:
t = u
u = v
v = t %% v
result = abs(u)

===Iterative binary algorithm===
proc gcd_binary(u1, v1: int64): int64 =
var t, k: int64
var u = u1
var v = v1
u = abs(u)
v = abs(v)
if u < v:
t = u
u = v
v = t
if v == 0:
result = u
else:
k = 1
while (u %% 2 == 0) and (v %% 2 == 0):
u = u shl 1
v = v shl 1
k = k shr 1
if (u %% 2) == 0:
t = u
else:
t = -v
while t != 0:
while (t %% 2) == 0:
t = t div 2
if t > 0:
u = t
else:
v = -t
t = u - v
result = u * k

echo ("GCD(", 49865, ", ", 69811, "): ", gcd_iterative(49865, 69811), " (iterative)")
echo ("GCD(", 49865, ", ", 69811, "): ", gcd_recursive(49865, 69811), " (recursive)")
echo ("GCD(", 49865, ", ", 69811, "): ", gcd_binary (49865, 69811), " (binary)")

{{out}}
GCD(49865, 69811): 9973 (iterative)
GCD(49865, 69811): 9973 (recursive)
GCD(49865, 69811): 9973 (binary)


=={{header|Objeck}}==

bundle Default {
class GDC {
function : Main(args : String[]), Nil {
for(x := 1; x < 36; x += 1;) {
IO.Console->GetInstance()->Print("GCD of ")->Print(36)->Print(" and ")->Print(x)->Print(" is ")->PrintLine(GDC(36, x));
};
}

function : native : GDC(a : Int, b : Int), Int {
t : Int;

if(a > b) {
t := b; b := a; a := t;
};

while (b <> 0) {
t := a % b; a := b; b := t;
};

return a;
}
}
}


=={{header|OCaml}}==
let rec gcd a b =
if a = 0 then b
else if b = 0 then a
else if a > b then gcd b (a mod b)
else gcd a (b mod a)


=== Built-in ===
#load "nums.cma";;
open Big_int;;
let gcd a b =
int_of_big_int (gcd_big_int (big_int_of_int a) (big_int_of_int b))


=={{header|Octave}}==

r = gcd(a, b)

=={{header|Order}}==
{{trans|bc}}
#include

#define ORDER_PP_DEF_8gcd ORDER_PP_FN( \
8fn(8U, 8V, \
8if(8isnt_0(8V), 8gcd(8V, 8remainder(8U, 8V)), 8U)))
// No support for negative numbers


=={{header|Oz}}==
declare
fun {UnsafeGCD A B}
if B == 0 then
A
else
{UnsafeGCD B A mod B}
end
end

fun {GCD A B}
if A == 0 andthen B == 0 then
raise undefined(gcd 0 0) end
else
{UnsafeGCD {Abs A} {Abs B}}
end
end
in
{Show {GCD 456 ~632}}


=={{header|PARI/GP}}==
gcd(a,b)

[[PASCAL]]
program GCF (INPUT, OUTPUT);
var
a,b,c:integer;
begin
writeln('Enter 1st number');
read(a);
writeln('Enter 2nd number');
read(b);
while (a*b<>0)
do
begin
c:=a;
a:=b mod a;
b:=c;
end;
writeln('GCF :=', a+b );
end.

By: NG

=={{header|Pascal}}==
===Recursive Euclid algorithm===
function gcd_recursive(u, v: longint): longint;
begin
if u mod v <> 0 then
gcd_recursive := gcd_recursive(v, u mod v)
else
gcd_recursive := v;
end;


===Iterative Euclid algorithm===
function gcd_iterative(u, v: longint): longint;
var
t: longint;
begin
while v <> 0 do
begin
t := u;
u := v;
v := t mod v;
end;
gcd_iterative := abs(u);
end;


===Iterative binary algorithm===
function gcd_binary(u, v: longint): longint;
var
t, k: longint;
begin
u := abs(u);
v := abs(v);
if u < v then
begin
t := u;
u := v;
v := t;
end;
if v = 0 then
gcd_binary := u
else
begin
k := 1;
while (u mod 2 = 0) and (v mod 2 = 0) do
begin
u := u >> 1;
v := v >> 1;
k := k << 1;
end;
if u mod 2 = 0 then
t := u
else
t := -v;
while t <> 0 do
begin
while t mod 2 = 0 do
t := t div 2;
if t > 0 then
u := t
else
v := -t;
t := u - v;
end;
gcd_binary := u * k;
end;
end;


Demo program:

Program GreatestCommonDivisorDemo(output);
begin
writeln ('GCD(', 49865, ', ', 69811, '): ', gcd_iterative(49865, 69811), ' (iterative)');
writeln ('GCD(', 49865, ', ', 69811, '): ', gcd_recursive(49865, 69811), ' (recursive)');
writeln ('GCD(', 49865, ', ', 69811, '): ', gcd_binary (49865, 69811), ' (binary)');
end.

Output:
GCD(49865, 69811): 9973 (iterative)
GCD(49865, 69811): 9973 (recursive)
GCD(49865, 69811): 9973 (binary)


=={{header|Perl}}==
===Iterative Euclid algorithm===
sub gcd_iter($$) {
my ($u, $v) = @_;
while ($v) {
($u, $v) = ($v, $u % $v);
}
return abs($u);
}


===Recursive Euclid algorithm===
sub gcd($$) {
my ($u, $v) = @_;
if ($v) {
return gcd($v, $u % $v);
} else {
return abs($u);
}
}


===Iterative binary algorithm===
sub gcd_bin($$) {
my ($u, $v) = @_;
$u = abs($u);
$v = abs($v);
if ($u < $v) {
($u, $v) = ($v, $u);
}
if ($v == 0) {
return $u;
}
my $k = 1;
while ($u & 1 == 0 && $v & 1 == 0) {
$u >>= 1;
$v >>= 1;
$k <<= 1;
}
my $t = ($u & 1) ? -$v : $u;
while ($t) {
while ($t & 1 == 0) {
$t >>= 1;
}
if ($t > 0) {
$u = $t;
} else {
$v = -$t;
}
$t = $u - $v;
}
return $u * $k;
}


===Notes on performance===
use Benchmark qw(cmpthese);

my $u = 40902;
my $v = 24140;
cmpthese(-5, {
'gcd' => sub { gcd($u, $v); },
'gcd_iter' => sub { gcd_iter($u, $v); },
'gcd_bin' => sub { gcd_bin($u, $v); },
});


Output on 'Intel(R) Pentium(R) 4 CPU 1.50GHz' / Linux / Perl 5.8.8:

Rate gcd_bin gcd_iter gcd
gcd_bin 321639/s -- -12% -20%
gcd_iter 366890/s 14% -- -9%
gcd 401149/s 25% 9% --


===Built-in===
use Math::BigInt;

sub gcd($$) {
Math::BigInt::bgcd(@_)->numify();
}


=={{header|Perl 6}}==

===Iterative===
sub gcd (Int $a is copy, Int $b is copy) {
$a & $b == 0 and fail;
($a, $b) = ($b, $a % $b) while $b;
return abs $a;
}


===Recursive===
multi gcd (0, 0) { fail }
multi gcd (Int $a, 0) { abs $a }
multi gcd (Int $a, Int $b) { gcd $b, $a % $b }


===Concise===
my &gcd = { (abs $^a, abs $^b, * % * ... 0)[*-2] }

===Actually, it's a built-in infix===
my $gcd = $a gcd $b;
Because it's an infix, you can use it with various meta-operators:
[gcd] @list; # reduce with gcd
@alist Zgcd @blist; # lazy zip with gcd
@alist Xgcd @blist; # lazy cross with gcd
@alist »gcd« @blist; # parallel gcd


=={{header|PicoLisp}}==
(de gcd (A B)
(until (=0 B)
(let M (% A B)
(setq A B B M) ) )
(abs A) )


=={{header|PHP}}==

===Iterative===

function gcdIter($n, $m) {
while(true) {
if($n == $m) {
return $m;
}
if($n > $m) {
$n -= $m;
} else {
$m -= $n;
}
}
}


===Recursive===

function gcdRec($n, $m)
{
if($m > 0)
return gcdRec($m, $n % $m);
else
return abs($n);
}


=={{header|PL/I}}==

GCD: procedure (a, b) returns (fixed binary (31)) recursive;
declare (a, b) fixed binary (31);

if b = 0 then return (a);

return (GCD (b, mod(a, b)) );

end GCD;


=={{header|Pop11}}==
===Built-in gcd===
gcd_n(15, 12, 2) =>

Note: the last argument gives the number of other arguments (in
this case 2).
===Iterative Euclid algorithm===
define gcd(k, l) -> r;
lvars k , l, r = l;
abs(k) -> k;
abs(l) -> l;
if k < l then (k, l) -> (l, k) endif;
while l /= 0 do
(l, k rem l) -> (k, l)
endwhile;
k -> r;
enddefine;


=={{header|PostScript}}==
{{libheader|initlib}}

/gcd {
{
{0 gt} {dup rup mod} {pop exit} ifte
} loop
}.

=={{header|PowerShell}}==
===Recursive Euclid Algorithm===
function Get-GCD ($x, $y)
{
if ($x -eq $y) { return $y }
if ($x -gt $y) {
$a = $x
$b = $y
}
else {
$a = $y
$b = $x
}
while ($a % $b -ne 0) {
$tmp = $a % $b
$a = $b
$b = $tmp
}
return $b
}


=={{header|Prolog}}==
===Recursive Euclid Algorithm===
gcd(X, 0, X):- !.
gcd(0, X, X):- !.
gcd(X, Y, D):- X > Y, !, Z is X mod Y, gcd(Y, Z, D).
gcd(X, Y, D):- Z is Y mod X, gcd(X, Z, D).


===Repeated Subtraction===
gcd(X, 0, X):- !.
gcd(0, X, X):- !.
gcd(X, Y, D):- X =< Y, !, Z is Y - X, gcd(X, Z, D).
gcd(X, Y, D):- gcd(Y, X, D).



=={{header|PureBasic}}==
'''Iterative'''
Procedure GCD(x, y)
Protected r
While y <> 0
r = x % y
x = y
y = r
Wend
ProcedureReturn y
EndProcedure


'''Recursive'''
Procedure GCD(x, y)
Protected r
r = x % y
If (r > 0)
y = GCD(y, r)
EndIf
ProcedureReturn y
EndProcedure


=={{header|Purity}}==

data Iterate = f => FoldNat $g . $f>

data Sub = Iterate Pred
data IsZero = . UnNat

data Eq = FoldNat
<
const IsZero,
eq => n => IfThenElse (IsZero $n)
False
($eq (Pred $n))
>

data step = gcd => n => m =>
IfThenElse (Eq $m $n)
(Pair $m $n)
(IfThenElse (Compare Leq $n $m)
($gcd (Sub $m $n) $m)
($gcd (Sub $n $m) $n))

data gcd = Iterate (gcd => uncurry (step (curry $gcd)))


=={{header|Python}}==
===Built-in===
{{works with|Python|2.6+}}
from fractions import gcd

===Iterative Euclid algorithm===
def gcd_iter(u, v):
while v:
u, v = v, u % v
return abs(u)


===Recursive Euclid algorithm===
'''Interpreter:''' [[Python]] 2.5
def gcd(u, v):
return gcd(v, u % v) if v else abs(u)


===Tests===
>>> gcd(0,0)
0
>>> gcd(0, 10) == gcd(10, 0) == gcd(-10, 0) == gcd(0, -10) == 10
True
>>> gcd(9, 6) == gcd(6, 9) == gcd(-6, 9) == gcd(9, -6) == gcd(6, -9) == gcd(-9, 6) == 3
True
>>> gcd(8, 45) == gcd(45, 8) == gcd(-45, 8) == gcd(8, -45) == gcd(-8, 45) == gcd(45, -8) == 1
True
>>> gcd(40902, 24140) # check Knuth :)
34

===Iterative binary algorithm===
See [[The Art of Computer Programming]] by Knuth (Vol.2)
def gcd_bin(u, v):
u, v = abs(u), abs(v) # u >= 0, v >= 0
if u < v:
u, v = v, u # u >= v >= 0
if v == 0:
return u

# u >= v > 0
k = 1
while u & 1 == 0 and v & 1 == 0: # u, v - even
u >>= 1; v >>= 1
k <<= 1

t = -v if u & 1 else u
while t:
while t & 1 == 0:
t >>= 1
if t > 0:
u = t
else:
v = -t
t = u - v
return u * k


===Notes on performance===
gcd(40902, 24140) takes us about '''17''' µsec (Euclid, not built-in)

gcd_iter(40902, 24140) takes us about '''11''' µsec

gcd_bin(40902, 24140) takes us about '''41''' µsec

=={{header|Qi}}==

(define gcd
A 0 -> A
A B -> (gcd B (MOD A B)))


=={{header|R}}==
"%gcd%" <- function(u, v) {
ifelse(u %% v != 0, v %gcd% (u%%v), v)
}


"%gcd%" <- function(v, t) {
while ( (c <- v%%t) != 0 ) {
v <- t
t <- c
}
}


print(50 %gcd% 75)

=={{header|Racket}}==

Racket provides a built-in gcd function. Here's a program that computes the gcd of 14 and 63:

#lang racket

(gcd 14 63)


Here's an explicit implementation. Note that since Racket is tail-calling, the memory behavior of this program is "loop-like", in the sense that this program will consume no more memory than a loop-based implementation.

#lang racket

;; given two nonnegative integers, produces their greatest
;; common divisor using Euclid's algorithm
(define (gcd a b)
(if (= b 0)
a
(gcd b (modulo a b))))

;; some test cases!
(module+ test
(require rackunit)
(check-equal? (gcd (* 2 3 3 7 7)
(* 3 3 7 11))
(* 3 3 7))
(check-equal? (gcd 0 14) 14)
(check-equal? (gcd 13 0) 13))


=={{header|Rascal}}==

===Iterative Euclidean algorithm===

public int gcd_iterative(int a, b){
if(a == 0) return b;
while(b != 0){
if(a > b) a -= b;
else b -= a;}
return a;
}

An example:

rascal>gcd_iterative(1989, 867)
int: 51


===Recursive Euclidean algorithm===

public int gcd_recursive(int a, b){
return (b == 0) ? a : gcd_recursive(b, a%b);
}

An example:

rascal>gcd_recursive(1989, 867)
int: 51


=={{header|Raven}}==
===Recursive Euclidean algorithm===
define gcd use $u, $v
$v 0 > if
$u $v % $v gcd
else
$u abs

24140 40902 gcd

{{out}}
34

=={{header|REBOL}}==
gcd: func [
{Returns the greatest common divisor of m and n.}
m [integer!]
n [integer!]
/local k
] [
; Euclid's algorithm
while [n > 0] [
k: m
m: n
n: k // m
]
m
]


=={{header|Retro}}==
This is from the math extensions library.

: gcd ( ab-n ) [ tuck mod dup ] while drop ;

=={{header|REXX}}==
===version 1===
The GCD subroutine can handle more than two arguments.

It also can handle any number of integers within any argument(s), making it easier to use when

computing Frobenius numbers (also known as ''postage stamp'' or ''coin'' numbers).
/*REXX pgm finds GCD (Greatest Common Divisor) of any number of integers*/
numeric digits 2000 /*handle up to 2K digit numbers.*/
call gcd 0 0 ; call gcd 55 0 ; call gcd 0 66
call gcd 7,21 ; call gcd 41,47 ; call gcd 99 , 51
call gcd 24, -8 ; call gcd -36, 9 ; call gcd -54, -6
call gcd 14 0 7 ; call gcd 14 7 0 ; call gcd 0 14 7
call gcd 15 10 20 30 55 ; call gcd 137438691328 2305843008139952128 /*◄──two perfect numbers.*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────GCD subroutine──────────────────────*/
gcd: procedure; $=; do i=1 for arg(); $=$ arg(i); end /*arg list.*/
parse var $ x z .; if x=0 then x=z; x=abs(x) /*handle special 0 case.*/

do j=2 to words($); y=abs(word($,j)); if y=0 then iterate
do until _==0; _=x//y; x=y; y=_; end /*◄── the heavy lifting.*/
end /*j*/

say 'GCD (Greatest Common Divisor) of ' translate(space($),",",' ') " is " x
return x

'''output'''

GCD (Greatest Common Divisor) of 0,0 is 0
GCD (Greatest Common Divisor) of 55,0 is 55
GCD (Greatest Common Divisor) of 0,66 is 66
GCD (Greatest Common Divisor) of 7,21 is 7
GCD (Greatest Common Divisor) of 41,47 is 1
GCD (Greatest Common Divisor) of 99,51 is 3
GCD (Greatest Common Divisor) of 24,-8 is 8
GCD (Greatest Common Divisor) of -36,9 is 9
GCD (Greatest Common Divisor) of -54,-6 is 6
GCD (Greatest Common Divisor) of 14,0,7 is 7
GCD (Greatest Common Divisor) of 14,7,0 is 7
GCD (Greatest Common Divisor) of 0,14,7 is 7
GCD (Greatest Common Divisor) of 15,10,20,30,55 is 5
GCD (Greatest Common Divisor) of 137438691328,2305843008139952128 is 262144


===version 2===
Recursive function (as in PL/I):

/* REXX ***************************************************************
* using PL/I code extended to many arguments
* 17.08.2012 Walter Pachl
* 18.08.2012 gcd(0,0)=0
**********************************************************************/
numeric digits 300 /*handle up to 300 digit numbers.*/
Call test 7,21 ,'7 '
Call test 4,7 ,'1 '
Call test 24,-8 ,'8'
Call test 55,0 ,'55'
Call test 99,15 ,'3 '
Call test 15,10,20,30,55,'5'
Call test 496,8128 ,'16'
Call test 496,8128 ,'8' /* test wrong expectation */
Call test 0,0 ,'0' /* by definition */
Exit

test:
/**********************************************************************
* Test the gcd function
**********************************************************************/
n=arg() /* Number of arguments */
gcde=arg(n) /* Expected result */
gcdx=gcd(arg(1),arg(2)) /* gcd of the first 2 numbers */
Do i=2 To n-2 /* proceed with all te others */
If arg(i+1)<>0 Then
gcdx=gcd(gcdx,arg(i+1))
End
If gcdx=arg(arg()) Then /* result is as expected */
tag='as expected'
Else /* result is not correct */
Tag='*** wrong. expected:' gcde
numbers=arg(1) /* build sting to show the input */
Do i=2 To n-1
numbers=numbers 'and' arg(i)
End
say left('the GCD of' numbers 'is',45) right(gcdx,3) tag
Return

GCD: procedure
/**********************************************************************
* Recursive procedure as shown in PL/I
**********************************************************************/
Parse Arg a,b
if b = 0 then return abs(a)
return GCD(b,a//b)

Output:

the GCD of 7 and 21 is 7 as expected
the GCD of 4 and 7 is 1 as expected
the GCD of 24 and -8 is 8 as expected
the GCD of 55 and 0 is 55 as expected
the GCD of 99 and 15 is 3 as expected
the GCD of 15 and 10 and 20 and 30 and 55 is 5 as expected
the GCD of 496 and 8128 is 16 as expected
the GCD of 496 and 8128 is 16 *** wrong. expected: 8
the GCD of 0 and 0 is 0 as expected


=={{header|Ruby}}==

That is already available as the ''gcd'' method of integers:

irb(main):001:0> require 'rational'#Not necessary in Ruby 1.9+
=> true
irb(main):002:0> 40902.gcd(24140)
=> 34


Here's an implementation:
def gcd(u, v)
u, v = u.abs, v.abs
while v > 0
u, v = v, u % v
end
u
end


=={{header|Run BASIC}}==
print abs(gcd(-220,160))
function gcd(gcd,b)
while b
c = gcd
gcd = b
b = c mod b
wend
end function



=={{header|Rust}}==
===Built-in===
use std::num::gcd;

===Iterative Euclid algorithm===
fn gcd(mut m: int, mut n: int) -> int {
while m != 0 {
let temp = m;
m = n % temp;
n = temp;
}
n.abs()
}


===Recursive Euclid algorithm===
fn gcd(m: int, n: int) -> int {
if m == 0
{ n.abs() }
else
{ gcd(n % m, m) }
}


===Tests===

println!("{}",gcd(399,-3999));
println!("{}",gcd(0,3999));
println!("{}",gcd(13*13,13*29));

3
3999
13


=={{header|Sather}}==
{{trans|bc}}
class MATH is

gcd_iter(u, v:INT):INT is
loop while!( v.bool );
t ::= u; u := v; v := t % v;
end;
return u.abs;
end;

gcd(u, v:INT):INT is
if v.bool then return gcd(v, u%v); end;
return u.abs;
end;


private swap(inout a, inout b:INT) is
t ::= a;
a := b;
b := t;
end;

gcd_bin(u, v:INT):INT is
t:INT;

u := u.abs; v := v.abs;
if u < v then swap(inout u, inout v); end;
if v = 0 then return u; end;
k ::= 1;
loop while!( u.is_even and v.is_even );
u := u / 2; v := v / 2;
k := k * 2;
end;
if u.is_even then
t := -v;
else
t := u;
end;
loop while!( t.bool );
loop while!( t.is_even );
t := t / 2;
end;
if t > 0 then
u := t;
else
v := -t;
end;
t := u - v;
end;
return u * k;
end;

end;


class MAIN is
main is
a ::= 40902;
b ::= 24140;
#OUT + MATH::gcd_iter(a, b) + "\n";
#OUT + MATH::gcd(a, b) + "\n";
#OUT + MATH::gcd_bin(a, b) + "\n";
-- built in
#OUT + a.gcd(b) + "\n";
end;
end;


=={{header|Scala}}==
def gcd(a: Int, b: Int): Int = if (b == 0) a.abs else gcd(b, a % b)

Using pattern matching

@tailrec
def gcd(a: Int, b: Int): Int = {
b match {
case 0 => a
case _ => gcd(b, (a % b))
}
}


=={{header|Scheme}}==
(define (gcd a b)
(if (= b 0)
a
(gcd b (modulo a b))))


or using the standard function included with Scheme (takes any number of arguments):
(gcd a b)

=={{header|Sed}}==

#! /bin/sed -nf

# gcd.sed Copyright (c) 2010 by Paweł Zuzelski
# dc.sed Copyright (c) 1995 - 1997 by Greg Ubben

# usage:
#
# echo N M | ./gcd.sed
#
# Computes the greatest common divisor of N and M integers using euclidean
# algorithm.

s/^/|P|K0|I10|O10|?~/

s/$/ [lalb%sclbsalcsblb0
:next
s/|?./|?/
s/|?#[ -}]*/|?/
/|?!*[lLsS;:<>=]\{0,1\}$/N
/|?!*[-+*/%^<>=]/b binop
/^|.*|?[dpPfQXZvxkiosStT;:]/b binop
/|?[_0-9A-F.]/b number
/|?\[/b string
/|?l/b load
/|?L/b Load
/|?[sS]/b save
/|?c/ s/[^|]*//
/|?d/ s/[^~]*~/&&/
/|?f/ s//&[pSbz0 /|?x/ s/\([^~]*~\)\(.*|?x\)~*/\2\1/
/|?[KIO]/ s/.*|\([KIO]\)\([^|]*\).*|?\1/\2~&/
/|?T/ s/\.*0*~/~/
# a slow, non-stackable array implementation in dc, just for completeness
# A fast, stackable, associative array implementation could be done in sed
# (format: {key}value{key}value...), but would be longer, like load & save.
/|?;/ s/|?;\([^{}]\)/|?~[s}s{L{s}q]S}[S}l\1L}1-d0>}s\1L\1l{xS\1]dS{xL}/
/|?:/ s/|?:\([^{}]\)/|?~[s}L{s}L{s}L}s\1q]S}S}S{[L}1-d0>}S}l\1s\1L\1l{xS\1]dS{x/
/|?[ ~ cdfxKIOT]/b next
/|?\n/b next
/|?[pP]/b print
/|?k/ s/^\([0-9]\{1,3\}\)\([.~].*|K\)[^|]*/\2\1/
/|?i/ s/^\(-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}\)\(~.*|I\)[^|]*/\2\1/
/|?o/ s/^\(-\{0,1\}[1-9][0-9]*\.\{0,1\}[0-9]*\)\(~.*|O\)[^|]*/\2\1/
/|?[kio]/b pop
/|?t/b trunc
/|??/b input
/|?Q/b break
/|?q/b quit
h
/|?[XZz]/b count
/|?v/b sqrt
s/.*|?\([^Y]\).*/\1 is unimplemented/
s/\n/\\n/g
l
g
b next

:print
/^-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}~.*|?p/!b Print
/|O10|/b Print

# Print a number in a non-decimal output base. Uses registers a,b,c,d.
# Handles fractional output bases (O<-1 or O>=1), unlike other dc's.
# Converts the fraction correctly on negative output bases, unlike
# UNIX dc. Also scales the fraction more accurately than UNIX dc.
#
s,|?p,&KSa0kd[[-]Psa0la-]Sad0>a[0P]sad0=a[A*2+]saOtd0>a1-ZSd[[[[ ]P]sclb1\
!=cSbLdlbtZ[[[-]P0lb-sb]sclb0>c1+]sclb0!c]scdld>cscSdLbP]q]Sb\
[t[1P1-d0bO1!c[A]sbdA=c[B]sbd\
B=c[C]sbdC=c[D]sbdD=c[E]sbdE=c[F]sb]xscLbP]~Sd[dtdZOZ+k1O/Tdsb[.5]*[.1]O\
X^*dZkdXK-1+ktsc0kdSb-[Lbdlb*lc+tdSbO*-lb0!=aldx]dsaxLbsb]sad1!>a[[.]POX\
+sb1[SbO*dtdldx-LbO*dZlb! b next

:Print
/|?p/s/[^~]*/&\
~&/
s/\(.*|P\)\([^|]*\)/\
\2\1/
s/\([^~]*\)\n\([^~]*\)\(.*|P\)/\1\3\2/
h
s/~.*//
/./{ s/.//; p; }
# Just s/.//p would work if we knew we were running under the -n option.
# Using l vs p would kind of do \ continuations, but would break strings.
g

:pop
s/[^~]*~//
b next

:load
s/\(.*|?.\)\(.\)/\20~\1/
s/^\(.\)0\(.*|r\1\([^~|]*\)~\)/\1\3\2/
s/.//
b next

:Load
s/\(.*|?.\)\(.\)/\2\1/
s/^\(.\)\(.*|r\1\)\([^~|]*~\)/|\3\2/
/^|/!i\
register empty
s/.//
b next

:save
s/\(.*|?.\)\(.\)/\2\1/
/^\(.\).*|r\1/ !s/\(.\).*|/&r\1|/
/|?S/ s/\(.\).*|r\1/&~/
s/\(.\)\([^~]*~\)\(.*|r\1\)[^~|]*~\{0,1\}/\3\2/
b next

:quit
t quit
s/|?[^~]*~[^~]*~/|?q/
t next
# Really should be using the -n option to avoid printing a final newline.
s/.*|P\([^|]*\).*/\1/
q

:break
s/[0-9]*/&;987654321009;/
:break1
s/^\([^;]*\)\([1-9]\)\(0*\)\([^1]*\2\(.\)[^;]*\3\(9*\).*|?.\)[^~]*~/\1\5\6\4/
t break1
b pop

:input
N
s/|??\(.*\)\(\n.*\)/|?\2~\1/
b next

:count
/|?Z/ s/~.*//
/^-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}$/ s/[-.0]*\([^.]*\)\.*/\1/
/|?X/ s/-*[0-9A-F]*\.*\([0-9A-F]*\).*/\1/
s/|.*//
/~/ s/[^~]//g

s/./a/g
:count1
s/a\{10\}/b/g
s/b*a*/&a9876543210;/
s/a.\{9\}\(.\).*;/\1/
y/b/a/
/a/b count1
G
/|?z/ s/\n/&~/
s/\n[^~]*//
b next

:trunc
# for efficiency, doesn't pad with 0s, so 10k 2 5/ returns just .40
# The X* here and in a couple other places works around a SunOS 4.x sed bug.
s/\([^.~]*\.*\)\(.*|K\([^|]*\)\)/\3;9876543210009909:\1,\2/
:trunc1
s/^\([^;]*\)\([1-9]\)\(0*\)\([^1]*\2\(.\)[^:]*X*\3\(9*\)[^,]*\),\([0-9]\)/\1\5\6\4\7,/
t trunc1
s/[^:]*:\([^,]*\)[^~]*/\1/
b normal

:number
s/\(.*|?\)\(_\{0,1\}[0-9A-F]*\.\{0,1\}[0-9A-F]*\)/\2~\1~/
s/^_/-/
/^[^A-F~]*~.*|I10|/b normal
/^[-0.]*~/b normal
s:\([^.~]*\)\.*\([^~]*\):[Ilb^lbk/,\1\2~0A1B2C3D4E5F1=11223344556677889900;.\2:
:digit
s/^\([^,]*\),\(-*\)\([0-F]\)\([^;]*\(.\)\3[^1;]*\(1*\)\)/I*+\1\2\6\5~,\2\4/
t digit
s:...\([^/]*.\)\([^,]*\)[^.]*\(.*|?.\):\2\3KSb[99]k\1]SaSaXSbLalb0 b next

:string
/|?[^]]*$/N
s/\(|?[^]]*\)\[\([^]]*\)]/\1|{\2|}/
/|?\[/b string
s/\(.*|?\)|{\(.*\)|}/\2~\1[/
s/|{/[/g
s/|}/]/g
b next

:binop
/^[^~|]*~[^|]/ !i\
stack empty
//!b next
/^-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}~/ !s/[^~]*\(.*|?!*[^!=<>]\)/0\1/
/^[^~]*~-\{0,1\}[0-9]*\.\{0,1\}[0-9]\{1,\}~/ !s/~[^~]*\(.*|?!*[^!=<>]\)/~0\1/
h
/|?\*/b mul
/|?\//b div
/|?%/b rem
/|?^/b exp

/|?[+-]/ s/^\(-*\)\([^~]*~\)\(-*\)\([^~]*~\).*|?\(-\{0,1\}\).*/\2\4s\3o\1\3\5/
s/\([^.~]*\)\([^~]*~[^.~]*\)\(.*\)/<\1,\2,\3|=-~.0,123456789<> /^<\([^,]*,[^~]*\)\.*0*~\1\.*0*~/ s/ :cmp1
s/^\(<[^,]*\)\([0-9]\),\([^,]*\)\([0-9]\),/\1,\2\3,\4/
t cmp1
/^<\([^~]*\)\([^~]\)[^~]*~\1\(.\).*|=.*\3.*\2/ s//
/|?/{
s/^\([<>]\)\(-[^~]*~-.*\1\)\(.\)/\3\2/
s/^\(.\)\(.*|?!*\)\1/\2!\1/
s/|?![^!]\(.\)/&l\1x/
s/[^~]*~[^~]*~\(.*|?\)!*.\(.*\)|=.*/\1\2/
b next
}
s/\(-*\)\1|=.*/;9876543210;9876543210/
/o-/ s/;9876543210/;0123456789/
s/^>\([^~]*~\)\([^~]*~\)s\(-*\)\(-*o\3\(-*\)\)/>\2\1s\5\4/

s/,\([0-9]*\)\.*\([^,]*\),\([0-9]*\)\.*\([0-9]*\)/\1,\2\3.,\4;0/
:right1
s/,\([0-9]\)\([^,]*\),;*\([0-9]\)\([0-9]*\);*0*/\1,\2\3,\4;0/
t right1
s/.\([^,]*\),~\(.*\);0~s\(-*\)o-*/\1~\30\2~/

:addsub1
s/\(.\{0,1\}\)\(~[^,]*\)\([0-9]\)\(\.*\),\([^;]*\)\(;\([^;]*\(\3[^;]*\)\).*X*\1\(.*\)\)/\2,\4\5\9\8\7\6/
s/,\([^~]*~\).\{10\}\(.\)[^;]\{0,9\}\([^;]\{0,1\}\)[^;]*/,\2\1\3/
# could be done in one s/// if we could have >9 back-refs...
/^~.*~;/!b addsub1

:endbin
s/.\([^,]*\),\([0-9.]*\).*/\1\2/
G
s/\n[^~]*~[^~]*//

:normal
s/^\(-*\)0*\([0-9.]*[0-9]\)[^~]*/\1\2/
s/^[^1-9~]*~/0~/
b next

:mul
s/\(-*\)\([0-9]*\)\.*\([0-9]*\)~\(-*\)\([0-9]*\)\.*\([0-9]*\).*|K\([^|]*\).*/\1\4\2\5.!\3\6,|\2<\3~\5>\6:\7;9876543210009909/

:mul1
s/![0-9]\([^<]*\)<\([0-9]\{0,1\}\)\([^>]*\)>\([0-9]\{0,1\}\)/0!\1\2<\3\4>/
/![0-9]/ s/\(:[^;]*\)\([1-9]\)\(0*\)\([^0]*\2\(.\).*X*\3\(9*\)\)/\1\5\6\4/
/<~[^>]*>:0*;/!t mul1

s/\(-*\)\1\([^>]*\).*/;\2^>:9876543210aaaaaaaaa/

:mul2
s/\([0-9]~*\)^/^\1/
s/<\([0-9]*\)\(.*[~^]\)\([0-9]*\)>/\1<\2>\3/

:mul3
s/>\([0-9]\)\(.*\1.\{9\}\(a*\)\)/\1>\2;9\38\37\36\35\34\33\32\31\30/
s/\(;[^<]*\)\([0-9]\)<\([^;]*\).*\2[0-9]*\(.*\)/\4\1<\2\3/
s/a[0-9]/a/g
s/a\{10\}/b/g
s/b\{10\}/c/g
/|0*[1-9][^>]*>0*[1-9]/b mul3

s/;/a9876543210;/
s/a.\{9\}\(.\)[^;]*\([^,]*\)[0-9]\([.!]*\),/\2,\1\3/
y/cb/ba/
/|<^/!b mul2
b endbin

:div
# CDDET
/^[-.0]*[1-9]/ !i\
divide by 0
//!b pop
s/\(-*\)\([0-9]*\)\.*\([^~]*~-*\)\([0-9]*\)\.*\([^~]*\)/\2.\3\1;0\4.\5;0/
:div1
s/^\.0\([^.]*\)\.;*\([0-9]\)\([0-9]*\);*0*/.\1\2.\3;0/
s/^\([^.]*\)\([0-9]\)\.\([^;]*;\)0*\([0-9]*\)\([0-9]\)\./\1.\2\30\4.\5/
t div1
s/~\(-*\)\1\(-*\);0*\([^;]*[0-9]\)[^~]*/~123456789743222111~\2\3/
s/\(.\(.\)[^~]*\)[^9]*\2.\{8\}\(.\)[^~]*/\3~\1/
s,|?.,&SaSadSaKdlaZ+LaX-1+[sb1]Sbd1>bkLatsbLa[dSa2lbla*-*dLa!=a]dSaxsakLasbLb*t,
b next

:rem
s,|?%,&Sadla/LaKSa[999]k*Lak-,
b next

:exp
# This decimal method is just a little faster than the binary method done
# totally in dc: 1LaKLb [kdSb*LbK]Sb [[.5]*d0ktdSa /^[^~]*\./i\
fraction in exponent ignored
s,[^-0-9].*,;9d**dd*8*d*d7dd**d*6d**d5d*d*4*d3d*2lbd**1lb*0,
:exp1
s/\([0-9]\);\(.*\1\([d*]*\)[^l]*\([^*]*\)\(\**\)\)/;dd*d**d*\4\3\5\2/
t exp1
G
s,-*.\{9\}\([^9]*\)[^0]*0.\(.*|?.\),\2~saSaKdsaLb0kLbkK*+k1\1LaktsbkLax,
s,|?.,&SadSbdXSaZla-SbKLaLadSb[0Lb-d1lb-*d+K+0kkSb[1Lb/]q]Sa0>a[dk]sadK b next

:sqrt
# first square root using sed: 8k2v at 1:30am Dec 17, 1996
/^-/i\
square root of negative number
/^[-0]/b next
s/~.*//
/^\./ s/0\([0-9]\)/\1/g
/^\./ !s/[0-9][0-9]/7/g
G
s/\n/~/
s,|?.,&K1+k KSbSb[dk]SadXdKa]dsaxsasaLbsaLatLbk K1-kt,
b next

# END OF GSU dc.sed


=={{header|Seed7}}==
const func integer: gcd (in var integer: a, in var integer: b) is func
result
var integer: gcd is 0;
local
var integer: help is 0;
begin
while a <> 0 do
help := b rem a;
b := a;
a := help;
end while;
gcd := b;
end func;

Original source: [http://seed7.sourceforge.net/algorith/math.htm#gcd]

=={{header|SETL}}==
a := 33; b := 77;
print(" the gcd of",a," and ",b," is ",gcd(a,b));

c := 49865; d := 69811;
print(" the gcd of",c," and ",d," is ",gcd(c,d));

proc gcd (u, v);
return if v = 0 then abs u else gcd (v, u mod v) end;
end;


Output:
the gcd of 33 and 77 is 11
the gcd of 49865 and 69811 is 9973


=={{header|Sidef}}==

== Built-in ==

var arr = [100, 1_000, 10_000, 20];
var gcd = Math.gcd(arr->asList);


== Recursive Euclid algorithm ==

func gcd(a, b) {
b.isZero ?: (a.abs; gcd(b, a % b));
}


=={{header|Slate}}==

Slate's Integer type has gcd defined:

40902 gcd: 24140

===Iterative Euclid algorithm===

x@(Integer traits) gcd: y@(Integer traits)
"Euclid's algorithm for finding the greatest common divisor."
[| n m temp |
n: x.
m: y.
[n isZero] whileFalse: [temp: n. n: m \\ temp. m: temp].
m abs
].


===Recursive Euclid algorithm===
x@(Integer traits) gcd: y@(Integer traits)
[
y isZero
ifTrue: [x]
ifFalse: [y gcd: x \\ y]
].


=={{header|Smalltalk}}==
The Integer class has its gcd method.

(40902 gcd: 24140) displayNl

An reimplementation of the Iterative Euclid's algorithm would be:

|gcd_iter|

gcd_iter := [ :a :b |
|u v|
u := a. v := b.
[ v > 0 ]
whileTrue: [ |t|
t := u.
u := v.
v := t rem: v
].
u abs
].

(gcd_iter value: 40902 value: 24140) printNl.


=={{header|SNOBOL4}}==
define('gcd(i,j)') :(gcd_end)
gcd ?eq(i,0) :s(freturn)
?eq(j,0) :s(freturn)

loop gcd = remdr(i,j)
gcd = ?eq(gcd,0) j :s(return)
i = j
j = gcd :(loop)
gcd_end

output = gcd(1071,1029)
end


=={{header|Standard ML}}==
fun gcd a 0 = a
| gcd a b = gcd b (a mod b)


=={{header|Tcl}}==
===Iterative Euclid algorithm===
package require Tcl 8.5
namespace path {::tcl::mathop ::tcl::mathfunc}
proc gcd_iter {p q} {
while {$q != 0} {
lassign [list $q [% $p $q]] p q
}
abs $p
}


===Recursive Euclid algorithm===
proc gcd {p q} {
if {$q == 0} {
return $p
}
gcd $q [expr {$p % $q}]
}

With Tcl 8.6, this can be optimized slightly to:
proc gcd {p q} {
if {$q == 0} {
return $p
}
tailcall gcd $q [expr {$p % $q}]
}

(Tcl does not perform automatic tail-call optimization introduction because that makes any potential error traces less informative.)

===Iterative binary algorithm===
package require Tcl 8.5
namespace path {::tcl::mathop ::tcl::mathfunc}
proc gcd_bin {p q} {
if {$p == $q} {return [abs $p]}
set p [abs $p]
if {$q == 0} {return $p}
set q [abs $q]
if {$p < $q} {lassign [list $q $p] p q}
set k 1
while {($p & 1) == 0 && ($q & 1) == 0} {
set p [>> $p 1]
set q [>> $q 1]
set k [<< $k 1]
}
set t [expr {$p & 1 ? -$q : $p}]
while {$t} {
while {$t & 1 == 0} {set t [>> $t 1]}
if {$t > 0} {set p $t} {set q [- $t]}
set t [- $p $q]
}
return [* $p $k]
}


===Notes on performance===
foreach proc {gcd_iter gcd gcd_bin} {
puts [format "%-8s - %s" $proc [time {$proc $u $v} 100000]]
}

Outputs:
gcd_iter - 4.46712 microseconds per iteration
gcd - 5.73969 microseconds per iteration
gcd_bin - 9.25613 microseconds per iteration


=={{header|TI-83 BASIC}}, {{header|TI-89 BASIC}}==
gcd(A,B)

=={{header|TSE SAL}}==


// library: math: get: greatest: common: divisor greatest common divisor whole numbers. Euclid's algorithm. Recursive version 1.0.0.0.3 (filenamemacro=getmacdi.s) [] [] [kn, ri, su, 20-01-2013 14:22:41]
INTEGER PROC FNMathGetGreatestCommonDivisorI( INTEGER x1I, INTEGER x2I )
//
IF ( x2I == 0 )
//
RETURN( x1I )
//
ENDIF
//
RETURN( FNMathGetGreatestCommonDivisorI( x2I, x1I MOD x2I ) )
//
END

PROC Main()
STRING s1[255] = "353"
STRING s2[255] = "46"
REPEAT
IF ( NOT ( Ask( " = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
IF ( NOT ( Ask( " = ", s2, _EDIT_HISTORY_ ) ) AND ( Length( s2 ) > 0 ) ) RETURN() ENDIF
Warn( FNMathGetGreatestCommonDivisorI( Val( s1 ), Val( s2 ) ) ) // gives e.g. 1
UNTIL FALSE
END




=={{header|TXR}}==

@(bind g @(gcd (expt 2 123) (expt 6 49)))

g="562949953421312"


=={{header|UNIX Shell}}==
{{works with|Bourne Shell}}
gcd() {
# Calculate $1 % $2 until $2 becomes zero.
until test 0 -eq "$2"; do
# Parallel assignment: set -- 1 2
set -- "$2" "`expr "$1" % "$2"`"
done

# Echo absolute value of $1.
test 0 -gt "$1" && set -- "`expr 0 - "$1"`"
echo "$1"
}

gcd -47376 87843
# => 987


==={{header|C Shell}}===
alias gcd eval \''set gcd_args=( \!*:q ) \\
@ gcd_u=$gcd_args[2] \\
@ gcd_v=$gcd_args[3] \\
while ( $gcd_v != 0 ) \\
@ gcd_t = $gcd_u % $gcd_v \\
@ gcd_u = $gcd_v \\
@ gcd_v = $gcd_t \\
end \\
if ( $gcd_u < 0 ) @ gcd_u = - $gcd_u \\
@ $gcd_args[1]=$gcd_u \\
'\'

gcd result -47376 87843
echo $result
# => 987


=={{header|Ursala}}==
This doesn't need to be defined because it's a library function, but
it can be defined like this based on a recursive implementation of
Euclid's algorithm. This isn't the simplest possible solution because
it includes a bit shifting optimization that happens when both operands
are even.
#import nat

gcd = ~&B?\~&Y ~&alh^?\~&arh2faltPrXPRNfabt2RCQ @a ~&ar^?\~&al ^|R/~& ^/~&r remainder

test program:
#cast %nWnAL

test = ^(~&,gcd)* <(25,15),(36,16),(120,45),(30,100)>

output:
<
(25,15): 5,
(36,16): 4,
(120,45): 15,
(30,100): 10>


=={{header|V}}==
like joy
===iterative===
[gcd
[0 >] [dup rollup %]
while
pop
].

===recursive===
like python

[gcd
[zero?] [pop]
[swap [dup] dip swap %]
tailrec].

same with view: (swap [dup] dip swap % is replaced with a destructuring view)

[gcd
[zero?] [pop]
[[a b : [b a b %]] view i]
tailrec].

running it
|1071 1029 gcd
=21

=={{header|VBA}}==
This function uses repeated subtractions. Simple but not very efficient.


Public Function GCD(a As Long, b As Long) As Long
While a <> b
If a > b Then a = a - b Else b = b - a
Wend
GCD = a
End Function


Example:


print GCD(1280, 240)
80
print GCD(3475689, 23566319)
7
a=123456789
b=234736437
print GCD((a),(b))
3


A note on the last example: using brackets forces a and b to be evaluated before GCD is called. Not doing this will cause a compile error because a and b are not the same type as in the function declaration (they are Variant, not Long). Alternatively you can use the conversion function CLng as in print GCD(CLng(a),CLng(b))

=={{header|Wortel}}==
Operator
@gcd a b
Number expression
!#~kg a b
Iterative
&[a b] [@vars[t] @while b @:{t b b %a b a t} a]
Recursive
&{gcd a b} ?{b !!gcd b %a b @abs a}

=={{header|x86 Assembly}}==
Using GNU Assembler syntax:
.text
.global pgcd

pgcd:
push %ebp
mov %esp, %ebp

mov 8(%ebp), %eax
mov 12(%ebp), %ecx
push %edx

.loop:
cmp $0, %ecx
je .end
xor %edx, %edx
div %ecx
mov %ecx, %eax
mov %edx, %ecx
jmp .loop

.end:
pop %edx
leave
ret


=={{header|XPL0}}==
include c:\cxpl\codes;

func GCD(U, V); \Return the greatest common divisor of U and V
int U, V;
int T;
[while V do \Euclid's method
[T:= U; U:= V; V:= rem(T/V)];
return abs(U);
];

\Display the GCD of two integers entered on command line
IntOut(0, GCD(IntIn(8), IntIn(8)))

Execute Brain****

Pete: Add a Limbo implementation.


{{task}}[[Category:Compilers and Interpreters]]
{{implementation|Brainf***}}RCBF is a set of [[Brainf***]] compilers and interpreters written for Rosetta Code in a variety of languages. Below are links to each of the versions of RCBF.

An implementation need only properly implement the following instructions:
* [     (left bracket)
* ]     (right bracket)
* +     (plus sign)
* -     (minus sign)
* <     (less than sign)
* >     (greater than sign)
* ,     (comma)
* .     (period)
Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory.



=={{header|ALGOL 68}}==

[[/ALGOL 68|Implementation in Algol 68]].

=={{header|Ada}}==

[[/Ada|Implementation in Ada]].

=={{header|AutoHotkey}}==

[[/AutoHotkey|Implementation in AutoHotkey]].

=={{header|AutoIt}}==

; AutoFucck
; A AutoIt Brainfuck Interpreter
; by minx
; AutoIt Version: 3.3.8.x

; Commands:
; - DEC
; + INC
; [ LOOP START
; ] LOOP END
; . Output cell value as ASCII Chr
; , Input a ASCII char (cell value = ASCII code)
; : Ouput cell value as integer
; ; Input a Integer
; _ Output a single whitespace
; / Output an Carriage Return and Line Feed

; You can load & save .atf Files.

#include
#include
#include
#include
#include

HotKeySet("{F5}", "_Runn")

$hMain = GUICreate("Autofuck - Real Brainfuck Interpreter", 600, 525)
$mMain = GUICtrlCreateMenu("File")
Global $mCode = GUICtrlCreateMenu("Code")
$mInfo = GUICtrlCreateMenu("Info")
$mCredits = GUICtrlCreateMenuItem("Credits", $mInfo)
$mFile_New = GUICtrlCreateMenuItem("New", $mMain)
$mFile_Open = GUICtrlCreateMenuItem("Open", $mMain)
$mFile_Save = GUICtrlCreateMenuItem("Save", $mMain)
Global $mCode_Run = GUICtrlCreateMenuItem("Run [F5]", $mCode)
Global $lStatus = GUICtrlCreateLabel("++ Autofuck started...", 5, 480, 590, 20, $SS_SUNKEN)
GUICtrlSetFont(-1, Default, Default, Default, "Courier New")
$eCode = GUICtrlCreateEdit("", 5, 5, 590, 350)
GUICtrlSetFont(-1, Default, Default, Default, "Courier New")
$eConsole = GUICtrlCreateEdit("", 5, 360, 590, 115, $ES_WANTRETURN)
GUICtrlSetFont(-1, Default, Default, Default, "Courier New")
GUISetState()

While 1
$nMsg = GUIGetMsg()
Switch $nMsg
Case $mFile_New
GUICtrlSetData($eCode, "")
Case $mFile_Open
GUICtrlSetData($eCode, FileRead(FileOpenDialog("Open Autofuck script", @DesktopDir, "Autofuck (*.atf)")))
Case $mFile_Save
FileWrite(FileOpen(StringReplace(FileSaveDialog("Save Autofuck script", @DesktopDir, "Autofuck (*.atf)"), ".atf", "") &".atf", 2), GUICtrlRead($eCode))
Case $GUI_EVENT_CLOSE
Exit
Case $mCredits
MsgBox(0, "Autofuck", "Copyright by: "&@CRLF&"minx (autoit.de)"&@CRLF&"crashdemons (autoitscript.com)")
EndSwitch
WEnd

Func _Runn()
$Timer = TimerInit()
GUICtrlSetData($lStatus, "++ Program started")
Global $tData=DllStructCreate('BYTE[65536]')
Global $pData=0
GUICtrlSetData($eConsole, "")
Local $aError[6]=['','Unmatched closing bracket during search','Unmatched opening bracket during search','Unexpected closing bracket','Data pointer passed left boundary','Data pointer passed right boundary']
Local $sError=''
Local $i=_Run(GUICtrlRead($eCode))
If @error>=0 And @error<6 Then $sError=$aError[@error]
If StringLen($sError) Then GUICtrlSetData($eConsole, 'ERROR: '&$sError&'.'&@CRLF&'Ending Instruction Pointer: '&($i-1)&@CRLF&'Current Data Pointer: '&$pData)
GUICtrlSetData($lStatus, "++ Program terminated. Runtime: "& Round( TimerDiff($Timer) / 1000, 4) &"s")
EndFunc

Func _Run($Code,$iStart=1,$iEnd=0)
If $iEnd<1 Then $iEnd=StringLen($Code)
For $i = $iStart to $iEnd
Switch StringMid($Code, $i, 1)
Case ">"
$pData+=1
If $pData=65536 Then Return SetError(5,0,$i)
Case "<"
$pData-=1
If $pData<0 Then Return SetError(4,0,$i)
Case "+"
DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)+1,$pData+1)
Case "-"
DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)-1,$pData+1)
Case ":"
GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & (DllStructGetData($tData,1,$pData+1)))
Case "."
GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & Chr(DllStructGetData($tData,1,$pData+1)))
Case ";"
Local $cIn=StringMid(InputBox('Autofuck','Enter Number'),1)
DllStructSetData($tData,1,Number($cIn),$pData+1)
Case ","
Local $cIn=StringMid(InputBox('Autofuck','Enter one ASCII character'),1,1)
DllStructSetData($tData,1,Asc($cIn),$pData+1)
Case "["
Local $iStartSub=$i
Local $iEndSub=_MatchBracket($Code,$i,$iEnd)
If @error<>0 Then Return SetError(@error,0,$iEndSub)
While DllStructGetData($tData,1,$pData+1)<>0
Local $iRet=_Run($Code,$iStartSub+1,$iEndSub-1)
If @error<>0 Then Return SetError(@error,0,$iRet)
WEnd
$i=$iEndSub
Case ']'
Return SetError(3,0,$i)
Case "_"
GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&" ")
Case "/"
GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&@CRLF)
EndSwitch
Next
Return 0
EndFunc

Func _MatchBracket($Code,$iStart=1,$iEnd=0)
If $iEnd<1 Then $iEnd=StringLen($Code)
Local $Open=0
For $i=$iStart To $iEnd
Switch StringMid($Code,$i,1)
Case '['
$Open+=1
Case ']'
$Open-=1
If $Open=0 Then Return $i
If $Open<0 Then Return SetError(1,0,$i)
EndSwitch
Next
If $Open>0 Then Return SetError(2,0,$i)
Return 0
EndFunc


=={{header|BASIC}}==

[[/BASIC/QuickBasic|Implementation in BASIC]] (QuickBasic dialect).

==={{header|Applesoft BASIC}}===
0 ON NOT T GOTO 20 : FOR A = T TO L : B = PEEK(S + P) : ON C%(ASC(MID$(C$, A, T))) GOSUB 1, 2, 3, 4, 5, 8, 6, 7 : NEXT A : END
1 P = P + T : ON P < E GOTO 11 : O = 1E99
2 P = P - T : ON P > M GOTO 11 : O = 1E99
3 B = B + T : B = B - (B > U) * B : GOTO 9
4 B = B - T : B = B - (B < 0) * (B - U) : GOTO 9
5 PRINT CHR$(B); : RETURN
6 D = T : ON NOT B GOTO 10 : RETURN
7 D = M : ON NOT NOT B GOTO 10 : RETURN
8 GET B$ : B = LEN(B$) : IF B THEN B = ASC(B$)
9 POKE S + P, B : RETURN
10 FOR K = D TO 0 STEP 0 : A = A + D : K = K + D%(ASC(MID$(C$, A, T))) : NEXT K : RETURN
11 RETURN
20 HIMEM: 38401
21 LOMEM: 8185
22 DIM C%(14999) : CLEAR
23 POKE 105, PEEK(175)
24 POKE 106, PEEK(176)
25 POKE 107, PEEK(175)
26 POKE 108, PEEK(176)
27 POKE 109, PEEK(175)
28 POKE 110, PEEK(176)
29 HIMEM: 8192
30 T = 1
31 M = -1
32 S = 8192
33 E = 30000
34 U = 255
35 DIM C%(255), D%(255)
43 C%(ASC("+")) = 3
44 C%(ASC(",")) = 6
45 C%(ASC("-")) = 4
46 C%(ASC(".")) = 5
60 C%(ASC("<")) = 2
62 C%(ASC(">")) = 1
91 C%(ASC("[")) = 7
92 D%(ASC("[")) = 1
93 C%(ASC("]")) = 8
94 D%(ASC("]")) = -1
95 C$ = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>>---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++."
98 L = LEN(C$)
99 GOTO


=={{header|BBC BASIC}}==
bf$ = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>" + \
\ ">---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++."
PROCbrainfuck(bf$)
END

DEF PROCbrainfuck(b$)
LOCAL B%, K%, M%, P%
DIM M% LOCAL 65535
B% = 1 : REM pointer to string
K% = 0 : REM bracket counter
P% = 0 : REM pointer to memory
FOR B% = 1 TO LEN(b$)
CASE MID$(b$,B%,1) OF
WHEN "+": M%?P% += 1
WHEN "-": M%?P% -= 1
WHEN ">": P% += 1
WHEN "<": P% -= 1
WHEN ".": VDU M%?P%
WHEN ",": M%?P% = GET
WHEN "[":
IF M%?P% = 0 THEN
K% = 1
B% += 1
WHILE K%
IF MID$(b$,B%,1) = "[" THEN K% += 1
IF MID$(b$,B%,1) = "]" THEN K% -= 1
B% += 1
ENDWHILE
ENDIF
WHEN "]":
IF M%?P% <> 0 THEN
K% = -1
B% -= 1
WHILE K%
IF MID$(b$,B%,1) = "[" THEN K% += 1
IF MID$(b$,B%,1) = "]" THEN K% -= 1
B% -= 1
ENDWHILE
ENDIF
ENDCASE
NEXT
ENDPROC

Output:
Hello World!


=={{header|Brat}}==

[[/Brat|Implementation in Brat]]

=={{header|Burlesque}}==


".""X"r~"-""\/^^{vvvv}c!!!-.256.%{vvvv}c!sa\/"r~"+""\/^^{vvvv}c!!!+.
256.%{vvvv}c!sa\/"r~"[""{"r~"]""}{\/^^{vvvv}c!!!}w!"r~">""+."r~"<""
-."r~"X""\/^^{vvvv}c!!!L[+]\/+]\/+]^^3\/.+1RAp^\/+]\/[-1RA^^-]\/[-\/
"r~"\'\'1 128r@{vv0}m[0"\/.+pse!vvvv<-sh


However, this implementation does not support input. Also, output is visible only after the brainfuck program terminated.
This is due to the limitation that Burlesque does not have actual I/O.

=={{header|C}}==

[[/C|Implementation in C]].

=={{header|C sharp|C#}}==

[[/Csharp|Implementation in C#]].

=={{header|C++}}==

[[/C++|Implementation in C++]].

=={{header|Clojure}}==
(ns brainfuck)

(def ^:dynamic *input*)

(def ^:dynamic *output*)

(defrecord Data [ptr cells])

(defn inc-ptr [next-cmd]
(fn [data]
(next-cmd (update-in data [:ptr] inc))))

(defn dec-ptr [next-cmd]
(fn [data]
(next-cmd (update-in data [:ptr] dec))))

(defn inc-cell [next-cmd]
(fn [data]
(next-cmd (update-in data [:cells (:ptr data)] (fnil inc 0)))))

(defn dec-cell [next-cmd]
(fn [data]
(next-cmd (update-in data [:cells (:ptr data)] (fnil dec 0)))))

(defn output-cell [next-cmd]
(fn [data]
(set! *output* (conj *output* (get (:cells data) (:ptr data) 0)))
(next-cmd data)))

(defn input-cell [next-cmd]
(fn [data]
(let [[input & rest-input] *input*]
(set! *input* rest-input)
(next-cmd (update-in data [:cells (:ptr data)] input)))))

(defn if-loop [next-cmd loop-cmd]
(fn [data]
(next-cmd (loop [d data]
(if (zero? (get (:cells d) (:ptr d) 0))
d
(recur (loop-cmd d)))))))

(defn terminate [data] data)

(defn split-cmds [cmds]
(letfn [(split [[cmd & rest-cmds] loop-cmds]
(when (nil? cmd) (throw (Exception. "invalid commands: missing ]")))
(case cmd
\[ (let [[c l] (split-cmds rest-cmds)]
(recur c (str loop-cmds "[" l "]")))
\] [(apply str rest-cmds) loop-cmds]
(recur rest-cmds (str loop-cmds cmd))))]
(split cmds "")))

(defn compile-cmds [[cmd & rest-cmds]]
(if (nil? cmd)
terminate
(case cmd
\> (inc-ptr (compile-cmds rest-cmds))
\< (dec-ptr (compile-cmds rest-cmds))
\+ (inc-cell (compile-cmds rest-cmds))
\- (dec-cell (compile-cmds rest-cmds))
\. (output-cell (compile-cmds rest-cmds))
\, (input-cell (compile-cmds rest-cmds))
\[ (let [[cmds loop-cmds] (split-cmds rest-cmds)]
(if-loop (compile-cmds cmds) (compile-cmds loop-cmds)))
\] (throw (Exception. "invalid commands: missing ["))
(compile-cmds rest-cmds))))

(defn compile-and-run [cmds input]
(binding [*input* input *output* []]
(let [compiled-cmds (compile-cmds cmds)]
(println (compiled-cmds (Data. 0 {}))))
(println *output*)
(println (apply str (map char *output*)))))

brainfuck> (compile-and-run "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." [])
{:ptr 4, :cells {4 10, 3 33, 2 100, 1 87, 0 0}}
[72 101 108 108 111 32 87 111 114 108 100 33 10]
Hello World!

nil


The alternate implementation at [[Execute Brain****/Clojure]] showcases a rather different approach.

=={{header|COBOL}}==

[[/COBOL|Implementation in COBOL]].

=={{header|Common Lisp}}==

[[/Common Lisp|Implementation in Common Lisp]].

=={{header|D}}==

[[/D|Implementation in D]].

=={{header|dodo0}}==

#Import some functions
clojure('count', 1) -> size
clojure('nth', 2) -> charAt
clojure('inc', 1) -> inc
clojure('dec', 1) -> dec
clojure('char', 1) -> char
clojure('int', 1) -> int
clojure('read-line', 0) -> readLine

#The characters we will need
charAt("\n", 0) -> newLine
charAt("@", 0) -> exitCommand
charAt("+", 0) -> incrCommand
charAt("-", 0) -> decrCommand
charAt("<", 0) -> shlCommand
charAt(">", 0) -> shrCommand
charAt(".", 0) -> printCommand
charAt(",", 0) -> inputCommand
charAt("[", 0) -> repeatCommand
charAt("]", 0) -> endCommand

#Read a character from a line of input.
fun readChar -> return
(
readLine() -> line
size(line) -> length

#Return the ith character and a continuation
fun nextFromLine -> i, return
(
'='(i, length) -> eol
if (eol) ->
(
return(newLine, readChar) #end of line
)
|
charAt(line, i) -> value
inc(i) -> i
fun next (-> return) nextFromLine(i, return) | next
return(value, next)
)
| nextFromLine

nextFromLine(0, return) #first character (position 0)
)
| readChar

#Define a buffer as a value and a left and right stack
fun empty (-> return, throw) throw("Error: out of bounds") | empty
fun fill (-> return, throw) return(0, fill) | fill

fun makeBuffer -> value, left, right, return
(
fun buffer (-> return) return(value, left, right) | buffer
return(buffer)
)
| makeBuffer

fun push -> value, stack, return
(
fun newStack (-> return, throw) return(value, stack) | newStack
return(newStack)
)
| push

#Brainf*** operations
fun noop -> buffer, input, return
(
return(buffer, input)
)
| noop

fun selectOp -> command, return
(
'='(command, incrCommand) -> eq
if (eq) ->
(
fun increment -> buffer, input, return
(
buffer() -> value, left, right
inc(value) -> value
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| increment
return(increment)
)
|
'='(command, decrCommand) -> eq
if (eq) ->
(
fun decrement -> buffer, input, return
(
buffer() -> value, left, right
dec(value) -> value
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| decrement
return(decrement)
)
|
'='(command, shlCommand) -> eq
if (eq) ->
(
fun shiftLeft -> buffer, input, return
(
buffer() -> value, left, right
push(value, right) -> right
left() -> value, left
(
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| message
println(message) ->
exit()
)
| shiftLeft
return(shiftLeft)
)
|
'='(command, shrCommand) -> eq
if (eq) ->
(
fun shiftRight -> buffer, input, return
(
buffer() -> value, left, right
push(value, left) -> left
right() -> value, right
(
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| message
println(message) ->
exit()
)
| shiftRight
return(shiftRight)
)
|
'='(command, printCommand) -> eq
if (eq) ->
(
fun putChar -> buffer, input, return
(
buffer() -> value, left, right
char(value) -> value
'print'(value) -> dummy
'flush'() -> dummy
return(buffer, input)
)
| putChar
return(putChar)
)
|
'='(command, inputCommand) -> eq
if (eq) ->
(
fun getChar -> buffer, input, return
(
input() -> letter, input
int(letter) -> letter
buffer() -> value, left, right
makeBuffer(letter, left, right) -> buffer
return(buffer, input)
)
| getChar
return(getChar)
)
|
return(noop)
)
| selectOp

#Repeat until zero operation
fun whileLoop -> buffer, input, continue, break
(
buffer() -> value, left, right
'='(value, 0) -> zero
if (zero) ->
(
break(buffer, input)
)
|
continue(buffer, input) -> buffer, input
whileLoop(buffer, input, continue, break)
)
| whileLoop

#Convert the Brainf*** program into dodo0 instructions
fun compile -> input, endmark, return
(
input() -> command, input

'='(command, endmark) -> eq
if (eq) ->
(
return(noop, input) #the end, stop compiling
)
|
#Put in sequence the current operation and the rest of the program
fun chainOp -> op, input, return
(
compile(input, endmark) -> program, input
fun exec -> buffer, input, return
(
op(buffer, input) -> buffer, input
program(buffer, input, return)
)
| exec
return(exec, input)
)
| chainOp

'='(command, repeatCommand) -> eq
if (eq) ->
(
compile(input, endCommand) -> body, input #compile until "]"

#Repeat the loop body until zero
fun repeat -> buffer, input, return
(
whileLoop(buffer, input, body, return)
)
| repeat
chainOp(repeat, input, return)
)
|
selectOp(command) -> op
chainOp(op, input, return)
)
| compile

#Main program
compile(readChar, exitCommand) -> program, input
makeBuffer(0, empty, fill) -> buffer
input() -> nl, input #consume newline from input

#Execute the program instructions
program(buffer, input) -> buffer, input
exit()

Execution:

$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@
Hello World!


=={{header|E}}==

[[/E|Implementation in E]].

=={{header|Elena}}==

[[/Elena|Implementation in Elena]]

=={{header|Erlang}}==

[[/Erlang|Implementation in Erlang]].

=={{header|Forth}}==

[[/Forth|Implementation in Forth]].

=={{header|F_Sharp|F#}}==

[[/F Sharp|Implementation in F#]].
=={{header|GAP}}==
# Here . and , print and read an integer, not a character
Brainfuck := function(prog)
local pointer, stack, leftcells, rightcells, instr, stackptr, len,
output, input, jump, i, j, set, get;
input := InputTextUser();
output := OutputTextUser();
instr := 1;
pointer := 0;
leftcells := [ ];
rightcells := [ ];
stack := [ ];
stackptr := 0;
len := Length(prog);
jump := [ ];

get := function()
local p;
if pointer >= 0 then
p := pointer + 1;
if IsBound(rightcells[p]) then
return rightcells[p];
else
return 0;
fi;
else
p := -pointer;
if IsBound(leftcells[p]) then
return leftcells[p];
else
return 0;
fi;
fi;
end;

set := function(value)
local p;
if pointer >= 0 then
p := pointer + 1;
if value = 0 then
Unbind(rightcells[p]);
else
rightcells[p] := value;
fi;
else
p := -pointer;
if value = 0 then
Unbind(leftcells[p]);
else
leftcells[p] := value;
fi;
fi;
end;

# find jumps for faster execution
for i in [1 .. len] do
if prog[i] = '[' then
stackptr := stackptr + 1;
stack[stackptr] := i;
elif prog[i] = ']' then
j := stack[stackptr];
stackptr := stackptr - 1;
jump[i] := j;
jump[j] := i;
fi;
od;

while instr <= len do
c := prog[instr];
if c = '<' then
pointer := pointer - 1;
elif c = '>' then
pointer := pointer + 1;
elif c = '+' then
set(get() + 1);
elif c = '-' then
set(get() - 1);
elif c = '.' then
WriteLine(output, String(get()));
elif c = ',' then
set(Int(Chomp(ReadLine(input))));
elif c = '[' then
if get() = 0 then
instr := jump[instr];
fi;
elif c = ']' then
if get() <> 0 then
instr := jump[instr];
fi;
fi;
instr := instr + 1;
od;
CloseStream(input);
CloseStream(output);
# for debugging purposes, return last state
return [leftcells, rightcells, pointer];
end;

# An addition
Brainfuck("+++.<+++++.[->+<]>.");
# 3
# 5
# 8

=={{header|Go}}==
Fixed size data store, no bounds checking.
package main

import "fmt"

func main() {
// example program is current Brain**** solution to
// Hello world/Text task. only requires 10 bytes of data store!
bf(10, `++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++
++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>>
>+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++.
<+++++++.--------.<<<<<+.<+++.---.`)
}

func bf(dLen int, is string) {
ds := make([]byte, dLen) // data store
var dp int // data pointer
for ip := 0; ip < len(is); ip++ {
switch is[ip] {
case '>':
dp++
case '<':
dp--
case '+':
ds[dp]++
case '-':
ds[dp]--
case '.':
fmt.Printf("%c", ds[dp])
case ',':
fmt.Scanf("%c", &ds[dp])
case '[':
if ds[dp] == 0 {
for nc := 1; nc > 0; {
ip++
if is[ip] == '[' {
nc++
} else if is[ip] == ']' {
nc--
}
}
}
case ']':
if ds[dp] != 0 {
for nc := 1; nc > 0; {
ip--
if is[ip] == ']' {
nc++
} else if is[ip] == '[' {
nc--
}
}
}
}
}
}

Output:

Goodbye, World!


=={{header|Groovy}}==

class BrainfuckProgram {

def program = '', memory = [:]
def instructionPointer = 0, dataPointer = 0

def execute() {
while (instructionPointer < program.size()) {
switch(program[instructionPointer++]) {
case '>': dataPointer++; break;
case '<': dataPointer--; break;
case '+': memory[dataPointer] = memoryValue + 1; break;
case '-': memory[dataPointer] = memoryValue - 1; break;
case ',': memory[dataPointer] = System.in.read(); break;
case '.': print((char)memoryValue); break;
case '[': handleLoopStart(); break;
case ']': handleLoopEnd(); break;
}
}
}

private getMemoryValue() { memory[dataPointer] ?: 0 }

private handleLoopStart() {
if (memoryValue) return

int depth = 1;
while (instructionPointer < program.size()) {
switch(program[instructionPointer++]) {
case '[': depth++; break;
case ']': if (!(--depth)) return;
}
}
throw new IllegalStateException('Could not find matching end bracket')
}

private handleLoopEnd() {
int depth = 0
while (instructionPointer >= 0) {
switch(program[--instructionPointer]) {
case ']': depth++; break;
case '[': if (!(--depth)) return; break;
}
}
throw new IllegalStateException('Could not find matching start bracket')
}
}

Testing:
new BrainfuckProgram(program: '++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.').execute()
{{out}}
Hello World!



=={{header|Haskell}}==

[[/Haskell|Implementation in Haskell]].

=={{header|Icon}} and {{header|Unicon}}==
[[/Icon|Implementation in Icon/Unicon]].

=={{header|J}}==

[[/J|Implementation in J]].

=={{header|Java}}==

[[/Java|Implementation in Java]].

=={{header|JavaScript}}==

[[/JavaScript|Implementation in JavaScript]].

=={{header|Limbo}}==

Expects the program to be the first argument, compiles to bytecode (without optimization), uses a 1MB array of cells (and wraps), includes some rudimentary compiler diagnostics.

implement Bf;

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

Bf: module {
init: fn(nil: ref Draw->Context, args: list of string);
ARENASZ: con 1024 * 1024;
EXIT, INC, DEC, JZ, JNZ, INCP, DECP, READ, WRITE: con iota;
};

init(nil: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
args = tl args;
if(args == nil || len args != 1) {
sys->fprint(sys->fildes(2), "usage: bf program");
raise "fail:usage";
}
code := compile(hd args);
execute(code, array[ARENASZ] of { * => byte 0 });
}

compile(p: string): array of int
{
marks: list of int = nil;
code := array[len p * 2 + 1] of { * => EXIT };
pc := 0;
for(i := 0; i < len p; i++) {
case p[i] {
'-' => code[pc++] = DEC;
'+' => code[pc++] = INC;
'<' => code[pc++] = DECP;
'>' => code[pc++] = INCP;
',' => code[pc++] = READ;
'.' => code[pc++] = WRITE;
'[' =>
code[pc++] = JZ;
marks = pc++ :: marks;
']' =>
if(marks == nil) {
sys->fprint(sys->fildes(2), "bf: unmatched ']' at character %d.", pc);
raise "fail:errors";
}
c := hd marks;
marks = tl marks;
code[pc++] = JNZ;
code[c] = pc;
code[pc++] = c;
}
}
if(marks != nil) {
sys->fprint(sys->fildes(2), "bf: unmatched '['.");
raise "fail:errors";
}
return code;
}

execute(code: array of int, arena: array of byte)
{
pc := 0;
p := 0;
buf := array[1] of byte;
for(;;) {
case code[pc] {
DEC => arena[p]--;
INC => arena[p]++;
DECP =>
p--;
if(p < 0)
p = len arena - 1;
INCP =>
p = (p + 1) % len arena;
READ =>
sys->read(sys->fildes(0), buf, 1);
arena[p] = buf[0];
WRITE =>
buf[0] = arena[p];
sys->write(sys->fildes(1), buf, 1);
JNZ =>
if(arena[p] != byte 0)
pc = code[pc + 1];
else
pc++;
JZ =>
if(arena[p] == byte 0)
pc = code[pc + 1];
else
pc++;
EXIT => return;
}
pc++;
}
}



=={{header|Lua}}==

[[/Lua|Implementation in Lua]].

=={{header|Mathematica}}==

bf[program_, input_] :=
Module[{p = Characters[program], pp = 0, m, mp = 0, bc = 0,
instr = StringToStream[input]},
m[_] = 0;
While[pp < Length@p,
pp++;
Switch[p[[pp]],
">", mp++,
"<", mp--,
"+", m[mp]++,
"-", m[mp]--,
".", BinaryWrite["stdout", m[mp]],
",", m[mp] = BinaryRead[instr],
"[", If[m[mp] == 0,
bc = 1;
While[bc > 0, pp++; Switch[p[[pp]], "[", bc++, "]", bc--]]],
"]", If[m[mp] != 0,
bc = -1;
While[bc < 0, pp--; Switch[p[[pp]], "[", bc++, "]", bc--]]]]];
Close[instr];];
bf[program_] := bf[program, ""]


Expamle:

bf["++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.
<<+++++++++++++++.>.+++.------.--------.>+.>."]


Output:

Hello World!


=={{header|Modula-3}}==

[[/Modula-3|Implementation in Modula-3]].

=={{header|Nimrod}}==

import strutils

proc jumpBackward(pos: var int, program: string) =
var level = 1
while pos > 0 and level != 0:
dec pos
case program[pos]
of '[':
dec level
of ']':
inc level
else:
discard 1
dec pos

proc jumpForward(pos: var int, program: string) =
var level = 1
while pos < program.len and level != 0:
inc pos
case program[pos]
of ']':
inc level
of '[':
dec level
else:
discard 1

proc bf(program: string) =
var tape: array[0..20, int]
var pointer = 0
var pos = 0
var indent = 0

while pos < program.len:
var token = program[pos]
case token
of '+':
inc tape[pointer]
of '-':
dec tape[pointer]
of ',':
tape[pointer] = int(stdin.readChar())
of '.':
stdout.write(chr(tape[pointer]))
of '[':
if tape[pointer] == 0:
jumpForward(pos, program)
of ']':
if tape[pointer] != 0:
jumpBackward(pos, program)
of '>':
inc pointer
of '<':
dec pointer
else:
discard 1
inc pos

var addition = ",>++++++[<-------->-],[<+>-]<."
var hello_world = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."

bf(addition)
# bf(hello_world)


=={{header|OCaml}}==

[[/OCaml|Implementation in OCaml]].

=={{header|PARI/GP}}==
A case statement would have been really useful here...
BF(prog)={
prog=Vec(Str(prog));
my(codeptr,ptr=1,v=vector(1000),t);
while(codeptr++ <= #prog,
t=prog[codeptr];
if(t=="+",
v[ptr]++
,
if(t=="-",
v[ptr]--
,
if(t==">",
ptr++
,
if(t=="<",
ptr--
,
if(t=="[" && !v[ptr],
t=1;
while(t,
if(prog[codeptr++]=="[",t++);
if(prog[codeptr]=="]",t--)
);
);
if(t=="]"&&v[ptr],
t=1;
while(t,
if(prog[codeptr--]=="[",t--);
if(prog[codeptr]=="]",t++)
)
);
if(t==".",
print1(Strchr(v[ptr]))
);
if(t==",",
v[ptr]=Vecsmall(input)[1]
)
)
)
)
)
)
};


=={{header|Perl}}==

[[/Perl|Implementation in Perl]].

=={{header|Perl 6}}==

[[/Perl_6|Implementation in Perl 6]].

=={{header|PHP}}==

{{Needs-review|PHP|Near-duplicate entries; gurus please check.}}

See also [[/PHP|this alternate implementation]].

function brainfuck_interpret(&$s, &$_s, &$d, &$_d, &$i, &$_i, &$o) {
do {
switch($s[$_s]) {
case '+': $d[$_d] = chr(ord($d[$_d]) + 1); break;
case '-': $d[$_d] = chr(ord($d[$_d]) - 1); break;
case '>': $_d++; if(!isset($d[$_d])) $d[$_d] = chr(0); break;
case '<': $_d--; break;
case '.': $o .= $d[$_d]; break;
case ',': $d[$_d] = $_i==strlen($i) ? chr(0) : $i[$_i++]; break;
case '[':
if((int)ord($d[$_d]) == 0) {
$brackets = 1;
while($brackets && $_s++ < strlen($s)) {
if($s[$_s] == '[')
$brackets++;
else if($s[$_s] == ']')
$brackets--;
}
}
else {
$pos = $_s++-1;
if(brainfuck_interpret($s, $_s, $d, $_d, $i, $_i, $o))
$_s = $pos;
}
break;
case ']': return ((int)ord($d[$_d]) != 0);
}
} while(++$_s < strlen($s));
}

function brainfuck($source, $input='') {
$data = array();
$data[0] = chr(0);
$data_index = 0;
$source_index = 0;
$input_index = 0;
$output = '';

brainfuck_interpret($source, $source_index,
$data, $data_index,
$input, $input_index,
$output);
return $output;
}
?>


=={{header|PicoLisp}}==
This solution uses a doubly-linked list for the cell space. That list consists
of a single cell initially, and grows automatically in both directions. The
value in each cell is unlimited.
(off "Program")

(de compile (File)
(let Stack NIL
(setq "Program"
(make
(in File
(while (char)
(case @
(">"
(link
'(setq Data
(or
(cddr Data)
(con (cdr Data) (cons 0 (cons Data))) ) ) ) )
("<"
(link
'(setq Data
(or
(cadr Data)
(set (cdr Data) (cons 0 (cons NIL Data))) ) ) ) )
("+" (link '(inc Data)))
("-" (link '(dec Data)))
("." (link '(prin (char (car Data)))))
("," (link '(set Data (char (read)))))
("["
(link
'(setq Code
((if (=0 (car Data)) cdar cdr) Code) ) )
(push 'Stack (chain (cons))) )
("]"
(unless Stack
(quit "Unbalanced ']'") )
(link
'(setq Code
((if (n0 (car Data)) cdar cdr) Code) ) )
(let (There (pop 'Stack) Here (cons There))
(chain (set There Here)) ) ) ) ) ) ) )
(when Stack
(quit "Unbalanced '['") ) ) )

(de execute ()
(let Data (cons 0 (cons)) # Create initial cell
(for (Code "Program" Code) # Run program
(eval (pop 'Code)) )
(while (cadr Data) # Find beginning of data
(setq Data @) )
(filter prog Data '(T NIL .)) ) ) # Return data space

Output:
: (compile "hello.bf")
-> NIL

: (execute)
Goodbye, World!
-> (0 10 33 44 71 87 98 100 114 121)


===Alternative solution===

# This implements a BrainFuck *interpreter* similar to the "official" one.
# It has 30000 unsigned 8-bit cells with wrapping, going off the bounds
# of the memory results in an error.
(de bf (Prg)
(let (P Prg S NIL D (need 30000 0) Dp D F T )
(while P
(case (car P)
("+" (if F (set Dp (% (inc (car Dp) 256)))))
("-" (if F (set Dp (% (dec (car Dp) 256)))))
(">" (if F (setq Dp (cdr Dp))))
("<" (if F (setq Dp (prior Dp D))))
("." (if F (prin (char (car Dp)))))
("," (if F (set Dp (char (read)))))
("["
(push 'S (if F (prior P Prg)))
(setq F (n0 (car Dp))) )
("]"
(and (setq F (pop 'S))
(n0 (car Dp))
(setq P F) ) ) )
(pop 'P) ) ) )

# A little "Hello world! test of the interpreter."
(bf (chop ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]
>++++++++[<++++>-] <.>+++++++++++[<++++++++>-]<-.--------.+++.------.---
-----.[-]>++++++++[<++++>- ]<+.[-]++++++++++." ) )
(bye)


=={{header|PureBasic}}==

[[/PureBasic|Implementation in PureBasic]]

=={{header|Python}}==

[[/Python|Implementation in Python]].

=={{header|Racket}}==
[http://hashcollision.org/brainfudge/ Brainfudge] is an implementation of Brain**** in Racket.
Read the tutorial to see you can integrate a new language into the Racket system. The tutorial
also shows how to get IDE support from DrRacket.

As an appetizer this runs in Racket as is:


#lang planet dyoo/bf
++++++[>++++++++++++<-]>.
>++++++++++[>++++++++++<-]>+.
+++++++..+++.>++++[>+++++++++++<-]>.
<+++[>----<-]>.<<<<<+++[>+++++<-]>.
>>.+++.------.--------.>>+.


=={{header|Retro}}==

[[/Retro|Implementation in Retro]].

=={{header|REXX}}==
The REXX code is original, but the BRAINF░CK program was modified from the example given in Wikipedia: [http://en.wikipedia.org/wiki/Brainfuck]
/*REXX program to implement the Brainf*ck (self-censored) language. */
#.=0 /*initialize the infinite "tape".*/
p=0 /*the "tape" cell pointer. */
!=0 /* ! is the instruction pointer.*/
parse arg $ /*allow CBLF to specify a BF pgm.*/
/* │ No pgm? Then use default.*/
if $='' then $=, /* ↓ displays: Hello, World! */
"++++++++++ initialize cell #0 to 10; then loop: ",
"[ > +++++++ add 7 to cell #1; final result: 70 ",
" > ++++++++++ add 10 to cell #2; final result: 100 ",
" > +++ add 3 to cell #3; final result 30 ",
" > + add 1 to cell #4; final result 10 ",
" <<<< - ] decrement cell #0 ",
"> ++ . display 'H' which is ASCII 72 (decimal) ",
"> + . display 'e' which is ASCII 101 (decimal) ",
"+++++++ .. display 'll' which is ASCII 108 (decimal) {2}",
"+++ . display 'o' which is ASCII 111 (decimal) ",
"> ++ . display ' ' which is ASCII 32 (decimal) ",
"<< +++++++++++++++ . display 'W' which is ASCII 87 (decimal) ",
"> . display 'o' which is ASCII 111 (decimal) ",
"+++ . display 'r' which is ASCII 114 (decimal) ",
"------ . display 'l' which is ASCII 108 (decimal) ",
"-------- . display 'd' which is ASCII 100 (decimal) ",
"> + . display '!' which is ASCII 33 (decimal) "
/*(above) note Brainf*ck comments*/
do forever; !=!+1; if !==0 | !>length($) then leave; x=substr($,!,1)
select /*examine the current instruction*/
when x=='+' then #.p=#.p + 1 /*increment the "tape" cell by 1.*/
when x=='-' then #.p=#.p - 1 /*decrement the "tape" cell by 1.*/
when x=='>' then p=p + 1 /*increment the pointer by 1.*/
when x=='<' then p=p - 1 /*decrement the pointer by 1.*/
when x=='[' then != forward() /*go forward to ]+1 if #.P =0.*/
when x==']' then !=backward() /*go backward to [+1 if #.P ¬0.*/
when x=='.' then call charout ,d2c(#.p) /*display a "tape" cell.*/
when x==',' then do; say 'input a value:'; parse pull #.p; end
otherwise iterate
end /*select*/
end /*forever*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────FORWARD subroutine──────────────────*/
forward: if #.p\==0 then return !; c=1 /* C is the [ nested counter.*/
do k=!+1 to length($); z=substr($,k,1)
if z=='[' then do; c=c+1; iterate; end
if z==']' then do; c=c-1; if c==0 then leave; end
end /*k*/
return k
/*──────────────────────────────────BACKWARD subroutine─────────────────*/
backward: if #.p==0 then return !; c=1 /* C is the ] nested counter.*/
do k=!-1 to 1 by -1; z=substr($,k,1)
if z==']' then do; c=c+1; iterate; end
if z=='[' then do; c=c-1; if c==0 then return k+1; end
end /*k*/

'''output''' when using the default program as input

Hello World!


=={{header|Ruby}}==

[[/Ruby|Implementation in Ruby]].

=={{header|Seed7}}==
$ include "seed7_05.s7i";

const proc: brainF (in string: source, inout file: input, inout file: output) is func
local
var array char: memory is 100000 times '\0\';
var integer: dataPointer is 50000;
var integer: instructionPointer is 1;
var integer: nestingLevel is 0;
begin
while instructionPointer <= length(source) do
case source[instructionPointer] of
when {'>'}: incr(dataPointer);
when {'<'}: decr(dataPointer);
when {'+'}: incr(memory[dataPointer]);
when {'-'}: decr(memory[dataPointer]);
when {'.'}: write(output, memory[dataPointer]);
when {','}: memory[dataPointer] := getc(input);
when {'['}: # Forward if zero at dataPointer
if memory[dataPointer] = '\0\' then
nestingLevel := 1;
repeat
incr(instructionPointer);
case source[instructionPointer] of
when {'['}: incr(nestingLevel);
when {']'}: decr(nestingLevel);
end case;
until nestingLevel = 0;
end if;
when {']'}: # Backward if non-zero at dataPointer
if memory[dataPointer] <> '\0\' then
nestingLevel := 1;
repeat
decr(instructionPointer);
case source[instructionPointer] of
when {'['}: decr(nestingLevel);
when {']'}: incr(nestingLevel);
end case;
until nestingLevel = 0;
end if;
end case;
incr(instructionPointer);
end while;
end func;

const proc: brainF (in string: source) is func
begin
brainF(source, IN, OUT);
end func;

const proc: main is func
begin
brainF("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");
end func;


Output:

Hello World!


=={{header|Standard ML}}==

[[/Standard ML|Implementation in Standard ML]].

=={{header|TI-83 BASIC}}==

[[/TI-83 BASIC|Implementation in TI-83 BASIC]].

=={{header|TI-89 BASIC}}==

[[/TI-89 BASIC|Implementation in TI-89 Basic]].

=={{header|Tcl}}==

[[/Tcl|Implementation in Tcl]].

{{omit from|GUISS}}

Hostname

Pete: Correctly alphabetize.


{{task|Programming environment operations}}[[Category:Networking and Web Interaction]]

Find the name of the host on which the routine is running.

=={{header|Ada}}==
Works with GCC/GNAT
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets;

procedure Demo is
begin
Put_Line (GNAT.Sockets.Host_Name);
end Demo;


=={{header|ALGOL 68}}==

{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}}


{{works with|POSIX|.1}}
STRING hostname;
get(read OF execve child pipe("/bin/hostname","hostname",""), hostname);
print(("hostname: ", hostname, new line))


=={{header|Aikido}}==

println (System.hostname)


=={{header|AutoHotkey}}==
MsgBox % A_ComputerName

=={{header|AWK}}==
$ awk 'BEGIN{print ENVIRON["HOST"]}'
E51A08ZD


=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
INSTALL @lib$+"SOCKLIB"
PROC_initsockets
PRINT "hostname: " FN_gethostname
PROC_exitsockets


=={{header|C}}/{{header|C++}}==
{{works with|gcc|4.0.1}}

{{works with|POSIX|.1}}
#include
#include
#include
#include

int main(void)
{
char name[_POSIX_HOST_NAME_MAX + 1];
return gethostname(name, sizeof name) == -1 || printf("%s\n", name) < 0 ? EXIT_FAILURE : EXIT_SUCCESS;
}


=={{header|C sharp|C#}}==
System.Net.Dns.GetHostName();

=={{header|Caché ObjectScript}}==
Write ##class(%SYS.System).GetNodeName()


=={{header|Clojure}}==


(.. java.net.InetAddress getLocalHost getHostName)



java -cp clojure.jar clojure.main -e "(.. java.net.InetAddress getLocalHost getHostName)"


=={{header|CoffeeScript}}==

os = require 'os'
console.log os.hostname()


=={{header|Common Lisp}}==
Another operating system feature that is implemented differently across lisp implementations. Here we show how to create a function that obtains the required result portably by working differently for each supported implementation. This technique is heavily used to make portable lisp libraries.
(defun get-host-name ()
#+sbcl (machine-instance)
#+clisp (let ((s (machine-instance))) (subseq s 0 (position #\Space s)))
#-(or sbcl clisp) (error "get-host-name not implemented"))


{{libheader|CFFI}}

Another way is to use the [[FFI]] to access POSIX' gethostname(2):

(cffi:defcfun ("gethostname" c-gethostname) :int
(buf :pointer) (len :unsigned-long))

(defun get-hostname ()
(cffi:with-foreign-object (buf :char 256)
(unless (zerop (c-gethostname buf 256))
(error "Can't get hostname"))
(values (cffi:foreign-string-to-lisp buf))))


BOA> (get-hostname)
"aurora"


=={{header|D}}==
import std.stdio, std.socket;

void main() {
writeln(Socket.hostName());
}


=={{header|Delphi}}==
program ShowHostName;

{$APPTYPE CONSOLE}

uses Windows;

var
lHostName: array[0..255] of char;
lBufferSize: DWORD;
begin
lBufferSize := 256;
if GetComputerName(lHostName, lBufferSize) then
Writeln(lHostName)
else
Writeln('error getting host name');
end.


=={{header|E}}==

makeCommand("hostname")()[0].trim()

Not exactly a good way to do it. A better way ought to be introduced along with a proper socket interface. [[Category:E examples needing attention]]

=={{header|F_Sharp|F#}}==
printfn "%s" (System.Net.Dns.GetHostName())

=={{header|Factor}}==
host-name

=={{header|Forth}}==
{{works with|GNU Forth|0.7.0}}
include unix/socket.fs

hostname type


=={{header|Erlang}}==
Host = net_adm:localhost().

=={{header|friendly interactive shell}}==
{{trans|UNIX Shell}}

hostname
or
uname -n

=={{header|Fortran}}==
{{works with|gfortran}}

The function/subroutine HOSTNM is a GNU extension.
program HostTest
character(len=128) :: name
call hostnm(name)
print *, name
end program HostTest


=={{header|Go}}==
package main

import (
"fmt"
"os"
)

func main() {
host, _ := os.Hostname()
fmt.Printf("hostname: %s\n", host)
}


=={{header|Groovy}}==

println InetAddress.localHost.hostName

=={{header|Harbour}}==

? Netname()

=={{header|Haskell}}==
{{libheader|network}}
import Network.BSD
main = do hostName <- getHostName
putStrLn hostName


=={{header|Icon}} and {{header|Unicon}}==
procedure main()
write(&host)
end


=={{header|IDL}}==
hostname = GETENV('computername')

=={{header|J}}==
NB. Load the socket libraries

load 'socket'
coinsert 'jsocket'

NB. fetch and implicitly display the hostname

> {: sdgethostname ''

NB. If fetching the hostname is the only reason for loading the socket libraries,
NB. and the hostname is fetched only once, then use a 'one-liner' to accomplish it:

> {: sdgethostname coinsert 'jsocket' [ load 'socket'


=={{header|Java}}==
import java.net.*;
class DiscoverHostName {
public static void main(final String[] args) {
try {
System.out.println(InetAddress.getLocalHost().getHostName());
} catch (UnknownHostException e) { // Doesn't actually happen, but Java requires it be handled.
}
}
}


=={{header|JavaScript}}==
{{works with|JScript}}
var network = new ActiveXObject('WScript.Network');
var hostname = network.computerName;
WScript.echo(hostname);


=={{header|Lasso}}==
This will ge the hostname as reported by the web server
[web_request->httpHost]
-> www.myserver.com

This will ge the hostname as reported by the system OS
define host_name => thread {

data
public initiated::date, // when the thread was initiated. Most likely at Lasso server startup
private hostname::string // as reported by the servers hostname

public onCreate() => {
.reset
}

public reset() => {
if(lasso_version(-lassoplatform) >> 'Win') => {
protect => {
local(process = sys_process('cmd',(:'hostname.exe')))
#process -> wait
.hostname = string(#process -> readstring) -> trim&
#process -> close
}
else
protect => {
local(process = sys_process('/bin/hostname'))
#process -> wait
.hostname = string(#process -> readstring) -> trim&
#process -> close
}
}
.initiated = date(date -> format(`yyyyMMddHHmmss`)) // need to set format to get rid of nasty hidden fractions of seconds
.hostname -> size == 0 ? .hostname = 'undefined'
}

public asString() => .hostname

}

host_name

-> mymachine.local

=={{header|Liberty BASIC}}==
lpBuffer$=Space$(128) + Chr$(0)
struct SIZE,sz As Long
SIZE.sz.struct=Len(lpBuffer$)

calldll #kernel32, "GetComputerNameA",lpBuffer$ as ptr, SIZE as struct, result as Long
CurrentComputerName$=Trim$(Left$(lpBuffer$, SIZE.sz.struct))

print CurrentComputerName$


=={{header|Lua}}==
Requires: LuaSocket
socket = require "socket"
print( socket.dns.gethostname() )


=={{header|Maple}}==
Sockets:-GetHostName()

=={{header|Mathematica}}==
$MachineName

=={{header|MATLAB}}==
This is a built-in MATLAB function. "failed" is a Boolean which will be false if the command sent to the OS succeeds. "hostname" is a string containing the system's hostname, provided that the external command hostname exists.

[failed,hostname] = system('hostname')

=={{header|mIRC Scripting Language}}==
echo -ag $host

=={{header|Modula-3}}==
MODULE Hostname EXPORTS Main;

IMPORT IO, OSConfig;

BEGIN
IO.Put(OSConfig.HostName() & "\n");
END Hostname.


=={{header|MUMPS}}==
Write $Piece($System,":")

=={{header|NetRexx}}==
/* NetRexx */
options replace format comments java crossref savelog symbols binary

say InetAddress.getLocalHost.getHostName


=={{header|NewLISP}}==
(! "hostname")

=={{header|Objective-C}}==

Cocoa / Cocoa Touch / GNUstep:


NSLog(@"%@", [[NSProcessInfo processInfo] hostName]);


Example Output:


2010-09-16 16:20:00.000 Playground[1319:a0f] sierra117.local // Hostname is sierra117.local.


=={{header|Objeck}}==

use Net;

bundle Default {
class Hello {
function : Main(args : String[]) ~ Nil {
TCPSocket->HostName()->PrintLine();
}
}
}


=={{header|OCaml}}==
Unix.gethostname()

=={{header|Octave}}==
Similarly to [[Discover the Hostname#MATLAB|MATLAB]], we could call system command hostname to know the hostname. But we can also call the internal function uname() which returns a structure holding several informations, among these the hostname (nodename):

uname().nodename

=={{header|ooRexx}}==
These solutions are platform specific.
===Windows Platform===
A solution using ActiveX/OLE on Windows

say .oleObject~new('WScript.Network')~computerName

and one using the Windows environment variables

say value('COMPUTERNAME',,'environment')

===UNIX Platform===
Some UNIX solutions (tested under Mac OS X):

ooRexx (and [[REXX|Rexx]]) can issue commands directly to the shell it's running under.
Output of the shell commands will normally be STDOUT and STDERR.
These next two samples will simply output the host name to the console if the program is run from a command prompt.
:'''Note:''' The '''address command''' clause causes the contents of the literal string that follows it to be sent to the command shell.

address command 'hostname -f'

address command "echo $HOSTNAME"

Command output can also be captured by the program to allow further processing.
ooRexx provides an external data queue manager ('''''rxqueue''''') that can be used for this.
In the following examples output written to STDOUT/STDERR is piped into '''rxqueue''' which sends it in turn to a Rexx queue for further processing by the program:

/* Rexx */
address command "echo $HOSTNAME | rxqueue"
address command "hostname -f | rxqueue"
loop q_ = 1 while queued() > 0
parse pull hn
say q_~right(2)':' hn
end q_


A utility class is also provided as a wrapper around the external data queue:

/* Rexx */
qq = .rexxqueue~new()
address command "echo $HOSTNAME | rxqueue"
address command "hostname -f | rxqueue"
loop q_ = 1 while qq~queued() > 0
hn = qq~pull()
say q_~right(2)':' hn
end q_


=={{header|Oz}}==
{System.showInfo {OS.getHostByName 'localhost'}.name}

=={{header|Pascal}}==
For Windows systems see the [[Hostname#Delphi | Delphi]] example.
On Unix systems, FreePascal has the function GetHostName:
Program HostName;

uses
unix;

begin
writeln('The name of this computer is: ', GetHostName);
end.

Output example on Mac OS X:

The name of this computer is: MyComputer.local


=={{header|Perl}}==
{{works with|Perl|5.8.6}}

{{libheader|Sys::Hostname}}
use Sys::Hostname;

$name = hostname;

=={{header|Perl 6}}==
my $host = qx[hostname];

=={{header|PHP}}==
echo $_SERVER['HTTP_HOST'];

echo php_uname('n');

{{works with|PHP|5.3+}}
echo gethostname();

=={{header|PicoLisp}}==
This will just print the hostname:
(call 'hostname)
To use it as a string in a program:
(in '(hostname) (line T))

=={{header|Pike}}==
import System;

int main(){
write(gethostname() + "\n");
}


=={{header|PL/SQL}}==
SET serveroutput on
BEGIN
DBMS_OUTPUT.PUT_LINE(UTL_INADDR.GET_HOST_NAME);
END;


=={{header|Pop11}}==
lvars host = sys_host_name();

=={{header|PowerBASIC}}==
This retreives the localhost's name:

HOST NAME TO hostname$

This attempts to retreive the name of an arbitrary machine on the network (assuming ipAddress& is valid):

HOST NAME ipAddress& TO hostname$

=={{header|PowerShell}}==
Windows systems have the ComputerName environment variable which can be used:
$Env:COMPUTERNAME
Also PowerShell can use .NET classes and methods:
[Net.Dns]::GetHostName()

=={{header|PureBasic}}==
{{works with|PureBasic|4.41}}
InitNetwork()
answer$=Hostname()


=={{header|Python}}==
{{works with|Python|2.5}}
import socket
host = socket.gethostname()


=={{header|R}}==
Sys.info provides information about the platform that R is running on. The following code returns the hostname as a string.
Sys.info()[["nodename"]]
Note that Sys.info isn't guaranteed to be available on all platforms. As an alternative, you can call an OS command.
system("hostname", intern = TRUE)
... or retrieve an environment variable

env_var <- ifelse(.Platform$OS.type == "windows", "COMPUTERNAME", "HOSTNAME")
Sys.getenv(env_var)


=={{header|Racket}}==

#lang racket/base
(require mzlib/os)
(gethostname)


=={{header|REBOL}}==
print system/network/host

=={{header|REXX}}==
===REGINA and PC/REXX under most MS NT Windows===
This REXX solution is for REGINA and PC/REXX under the Microsoft NT family of Windows (XP, Vista, 7, etc).

Other names could be used for the 3rd argument.


The   ''computername''   is the same as the output for the   '''hostname.exe'''   program.
say value('COMPUTERNAME',,"ENVIRONMENT")
say value('OS',,"ENVIRONMENT")

'''output''' (using Windows/XP)

GERARD46
Windows_NT

===R4 and ROO under most MS NT Windows===
This REXX solution is for R4 and ROO under the Microsoft NT family of Windows (XP, Vista, 7, etc).

Other names could be used for the 3rd argument.
say value('COMPUTERNAME',,"SYSTEM")
say value('OS',,"SYSTEM")


===MS DOS (without Windows), userid===
Under Microsoft DOS (with no Windows), the closest thing to a name of a host would be the userid.
say userid()

===MS DOS (without Windows), version of DOS===
But perhaps the name or version of the MS DOS system would be more appropriate than the userid.
'VER' /*this passes the VER command to the MS DOS system. */
Each REXX interpreter has their own name (some have multiple names) for the environmental variables.

Different operating systems may call their hostnames by different identifiers.

IBM mainframes (at one time) called the name of the host as a ''nodename'' and it needn't be

specified, in which case an asterisk (*) is returned.

I recall (perhaps wrongly) that Windows/95 and Windows/98 had a different environmental name for the name of the host.

===UNIX Solution===
This solution is platform specific and uses features that are available to the Regina implementation of Rexx.
:Tested with Regina on Mac OS X. Should work on other UNIX/Linux distros.
/* Rexx */
address command "hostname -f" with output stem hn.
do q_ = 1 to hn.0
say hn.q_
end q_
exit


=={{header|Ruby}}==
require 'socket'
host = Socket.gethostname


=={{header|Run BASIC}}==
print Platform$ ' OS where Run BASIC is being hosted
print UserInfo$ ' Information about the user's web browser
print UserAddress$ ' IP address of the user


=={{header|Scala}}==
println(java.net.InetAddress.getLocalHost.getHostName)

=={{header|Scheme}}==
{{works with|Chicken Scheme}}
(use posix)
(get-host-name)

{{works with|Guile}}
(gethostname)

=={{header|Seed7}}==
The library [http://seed7.sourceforge.net/libraries/socket.htm socket.s7i]
defines the function [http://seed7.sourceforge.net/libraries/socket.htm#getHostname getHostname],
which returns the hostname.

$ include "seed7_05.s7i";
include "socket.s7i";

const proc: main is func
begin
writeln(getHostname);
end func;


=={{header|Slate}}==
Platform current nodeName

=={{header|SNOBOL4}}==

output = host(4,"HOSTNAME")
end


=={{header|Standard ML}}==
NetHostDB.getHostName ()

=={{header|Smalltalk}}==
{{works with|Smalltalk/X}}
OperatingSystem getHostName

=={{header|Tcl}}==
The basic introspection tool in TCL is the info command. It can be used to find out about the version of the current Tcl or Tk, the available commands and libraries, variables, functions, the level of recursive interpreter invocation, and, amongst a myriad other things, the name of the current machine:

set hname [info hostname]

=={{header|Toka}}==
2 import gethostname
1024 chars is-array foo
foo 1024 gethostname
foo type

=={{header|TUSCRIPT}}==

$$ MODE TUSCRIPT
host=HOST ()


=={{header|UNIX Shell}}==
hostname
or
uname -n

=={{header|Ursala}}==
The user-defined hostname function ignores its argument and returns a string.
#import cli

hostname = ~&hmh+ (ask bash)/<>+ <'hostname'>!

For example, the following function returns the square root of its argument
if it's running on host kremvax, but otherwise returns the square.
#import flo

creative_accounting = (hostname== 'kremvax')?(sqrt,sqr)


{{omit from|ACL2}}
{{omit from|Locomotive Basic|Does not have a hostname.}}
{{omit from|ML/I}}
{{omit from|PARI/GP}}
{{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}}
{{omit from|Unlambda|Does not have network access.}}
{{omit from|ZX Spectrum Basic|Does not have a hostname.}}

Hostname

Pete: Add a Limbo version


{{task|Programming environment operations}}[[Category:Networking and Web Interaction]]

Find the name of the host on which the routine is running.

=={{header|Ada}}==
Works with GCC/GNAT
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets;

procedure Demo is
begin
Put_Line (GNAT.Sockets.Host_Name);
end Demo;


=={{header|ALGOL 68}}==

{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}}


{{works with|POSIX|.1}}
STRING hostname;
get(read OF execve child pipe("/bin/hostname","hostname",""), hostname);
print(("hostname: ", hostname, new line))


=={{header|Aikido}}==

println (System.hostname)


=={{header|AutoHotkey}}==
MsgBox % A_ComputerName

=={{header|AWK}}==
$ awk 'BEGIN{print ENVIRON["HOST"]}'
E51A08ZD


=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
INSTALL @lib$+"SOCKLIB"
PROC_initsockets
PRINT "hostname: " FN_gethostname
PROC_exitsockets


=={{header|C}}/{{header|C++}}==
{{works with|gcc|4.0.1}}

{{works with|POSIX|.1}}
#include
#include
#include
#include

int main(void)
{
char name[_POSIX_HOST_NAME_MAX + 1];
return gethostname(name, sizeof name) == -1 || printf("%s\n", name) < 0 ? EXIT_FAILURE : EXIT_SUCCESS;
}


=={{header|C sharp|C#}}==
System.Net.Dns.GetHostName();

=={{header|Caché ObjectScript}}==
Write ##class(%SYS.System).GetNodeName()


=={{header|Clojure}}==


(.. java.net.InetAddress getLocalHost getHostName)



java -cp clojure.jar clojure.main -e "(.. java.net.InetAddress getLocalHost getHostName)"


=={{header|CoffeeScript}}==

os = require 'os'
console.log os.hostname()


=={{header|Common Lisp}}==
Another operating system feature that is implemented differently across lisp implementations. Here we show how to create a function that obtains the required result portably by working differently for each supported implementation. This technique is heavily used to make portable lisp libraries.
(defun get-host-name ()
#+sbcl (machine-instance)
#+clisp (let ((s (machine-instance))) (subseq s 0 (position #\Space s)))
#-(or sbcl clisp) (error "get-host-name not implemented"))


{{libheader|CFFI}}

Another way is to use the [[FFI]] to access POSIX' gethostname(2):

(cffi:defcfun ("gethostname" c-gethostname) :int
(buf :pointer) (len :unsigned-long))

(defun get-hostname ()
(cffi:with-foreign-object (buf :char 256)
(unless (zerop (c-gethostname buf 256))
(error "Can't get hostname"))
(values (cffi:foreign-string-to-lisp buf))))


BOA> (get-hostname)
"aurora"


=={{header|D}}==
import std.stdio, std.socket;

void main() {
writeln(Socket.hostName());
}


=={{header|Delphi}}==
program ShowHostName;

{$APPTYPE CONSOLE}

uses Windows;

var
lHostName: array[0..255] of char;
lBufferSize: DWORD;
begin
lBufferSize := 256;
if GetComputerName(lHostName, lBufferSize) then
Writeln(lHostName)
else
Writeln('error getting host name');
end.


=={{header|E}}==

makeCommand("hostname")()[0].trim()

Not exactly a good way to do it. A better way ought to be introduced along with a proper socket interface. [[Category:E examples needing attention]]

=={{header|F_Sharp|F#}}==
printfn "%s" (System.Net.Dns.GetHostName())

=={{header|Factor}}==
host-name

=={{header|Forth}}==
{{works with|GNU Forth|0.7.0}}
include unix/socket.fs

hostname type


=={{header|Erlang}}==
Host = net_adm:localhost().

=={{header|friendly interactive shell}}==
{{trans|UNIX Shell}}

hostname
or
uname -n

=={{header|Fortran}}==
{{works with|gfortran}}

The function/subroutine HOSTNM is a GNU extension.
program HostTest
character(len=128) :: name
call hostnm(name)
print *, name
end program HostTest


=={{header|Go}}==
package main

import (
"fmt"
"os"
)

func main() {
host, _ := os.Hostname()
fmt.Printf("hostname: %s\n", host)
}


=={{header|Groovy}}==

println InetAddress.localHost.hostName

=={{header|Harbour}}==

? Netname()

=={{header|Haskell}}==
{{libheader|network}}
import Network.BSD
main = do hostName <- getHostName
putStrLn hostName


=={{header|Icon}} and {{header|Unicon}}==
procedure main()
write(&host)
end


=={{header|IDL}}==
hostname = GETENV('computername')

=={{header|J}}==
NB. Load the socket libraries

load 'socket'
coinsert 'jsocket'

NB. fetch and implicitly display the hostname

> {: sdgethostname ''

NB. If fetching the hostname is the only reason for loading the socket libraries,
NB. and the hostname is fetched only once, then use a 'one-liner' to accomplish it:

> {: sdgethostname coinsert 'jsocket' [ load 'socket'


=={{header|Java}}==
import java.net.*;
class DiscoverHostName {
public static void main(final String[] args) {
try {
System.out.println(InetAddress.getLocalHost().getHostName());
} catch (UnknownHostException e) { // Doesn't actually happen, but Java requires it be handled.
}
}
}


=={{header|JavaScript}}==
{{works with|JScript}}
var network = new ActiveXObject('WScript.Network');
var hostname = network.computerName;
WScript.echo(hostname);


=={{header|Lasso}}==
This will ge the hostname as reported by the web server
[web_request->httpHost]
-> www.myserver.com

This will ge the hostname as reported by the system OS
define host_name => thread {

data
public initiated::date, // when the thread was initiated. Most likely at Lasso server startup
private hostname::string // as reported by the servers hostname

public onCreate() => {
.reset
}

public reset() => {
if(lasso_version(-lassoplatform) >> 'Win') => {
protect => {
local(process = sys_process('cmd',(:'hostname.exe')))
#process -> wait
.hostname = string(#process -> readstring) -> trim&
#process -> close
}
else
protect => {
local(process = sys_process('/bin/hostname'))
#process -> wait
.hostname = string(#process -> readstring) -> trim&
#process -> close
}
}
.initiated = date(date -> format(`yyyyMMddHHmmss`)) // need to set format to get rid of nasty hidden fractions of seconds
.hostname -> size == 0 ? .hostname = 'undefined'
}

public asString() => .hostname

}

host_name

-> mymachine.local

=={{header|Liberty BASIC}}==
lpBuffer$=Space$(128) + Chr$(0)
struct SIZE,sz As Long
SIZE.sz.struct=Len(lpBuffer$)

calldll #kernel32, "GetComputerNameA",lpBuffer$ as ptr, SIZE as struct, result as Long
CurrentComputerName$=Trim$(Left$(lpBuffer$, SIZE.sz.struct))

print CurrentComputerName$


=={{header|Limbo}}==
As with nearly anything in Inferno, it boils down to reading a file:

implement Hostname;

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

Hostname: 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;
# Technically, this program is wrong if the hostname is longer than 8k.
buf := array[Sys->ATOMICIO] of byte;

fd := sys->open("/dev/sysname", Sys->OREAD);
if(fd == nil)
die("Couldn't open /dev/sysname");

n := sys->read(fd, buf, len buf - 1);
if(n < 1)
die("Couldn't read /dev/sysname");

buf[n++] = byte '\n';
sys->write(sys->fildes(1), buf, n);
}

die(s: string)
{
sys->fprint(sys->fildes(2), "hostname: %s: %r", s);
raise "fail:errors";
}



=={{header|Lua}}==
Requires: LuaSocket
socket = require "socket"
print( socket.dns.gethostname() )


=={{header|Maple}}==
Sockets:-GetHostName()

=={{header|Mathematica}}==
$MachineName

=={{header|MATLAB}}==
This is a built-in MATLAB function. "failed" is a Boolean which will be false if the command sent to the OS succeeds. "hostname" is a string containing the system's hostname, provided that the external command hostname exists.

[failed,hostname] = system('hostname')

=={{header|mIRC Scripting Language}}==
echo -ag $host

=={{header|Modula-3}}==
MODULE Hostname EXPORTS Main;

IMPORT IO, OSConfig;

BEGIN
IO.Put(OSConfig.HostName() & "\n");
END Hostname.


=={{header|MUMPS}}==
Write $Piece($System,":")

=={{header|NetRexx}}==
/* NetRexx */
options replace format comments java crossref savelog symbols binary

say InetAddress.getLocalHost.getHostName


=={{header|NewLISP}}==
(! "hostname")

=={{header|Objective-C}}==

Cocoa / Cocoa Touch / GNUstep:


NSLog(@"%@", [[NSProcessInfo processInfo] hostName]);


Example Output:


2010-09-16 16:20:00.000 Playground[1319:a0f] sierra117.local // Hostname is sierra117.local.


=={{header|Objeck}}==

use Net;

bundle Default {
class Hello {
function : Main(args : String[]) ~ Nil {
TCPSocket->HostName()->PrintLine();
}
}
}


=={{header|OCaml}}==
Unix.gethostname()

=={{header|Octave}}==
Similarly to [[Discover the Hostname#MATLAB|MATLAB]], we could call system command hostname to know the hostname. But we can also call the internal function uname() which returns a structure holding several informations, among these the hostname (nodename):

uname().nodename

=={{header|ooRexx}}==
These solutions are platform specific.
===Windows Platform===
A solution using ActiveX/OLE on Windows

say .oleObject~new('WScript.Network')~computerName

and one using the Windows environment variables

say value('COMPUTERNAME',,'environment')

===UNIX Platform===
Some UNIX solutions (tested under Mac OS X):

ooRexx (and [[REXX|Rexx]]) can issue commands directly to the shell it's running under.
Output of the shell commands will normally be STDOUT and STDERR.
These next two samples will simply output the host name to the console if the program is run from a command prompt.
:'''Note:''' The '''address command''' clause causes the contents of the literal string that follows it to be sent to the command shell.

address command 'hostname -f'

address command "echo $HOSTNAME"

Command output can also be captured by the program to allow further processing.
ooRexx provides an external data queue manager ('''''rxqueue''''') that can be used for this.
In the following examples output written to STDOUT/STDERR is piped into '''rxqueue''' which sends it in turn to a Rexx queue for further processing by the program:

/* Rexx */
address command "echo $HOSTNAME | rxqueue"
address command "hostname -f | rxqueue"
loop q_ = 1 while queued() > 0
parse pull hn
say q_~right(2)':' hn
end q_


A utility class is also provided as a wrapper around the external data queue:

/* Rexx */
qq = .rexxqueue~new()
address command "echo $HOSTNAME | rxqueue"
address command "hostname -f | rxqueue"
loop q_ = 1 while qq~queued() > 0
hn = qq~pull()
say q_~right(2)':' hn
end q_


=={{header|Oz}}==
{System.showInfo {OS.getHostByName 'localhost'}.name}

=={{header|Pascal}}==
For Windows systems see the [[Hostname#Delphi | Delphi]] example.
On Unix systems, FreePascal has the function GetHostName:
Program HostName;

uses
unix;

begin
writeln('The name of this computer is: ', GetHostName);
end.

Output example on Mac OS X:

The name of this computer is: MyComputer.local


=={{header|Perl}}==
{{works with|Perl|5.8.6}}

{{libheader|Sys::Hostname}}
use Sys::Hostname;

$name = hostname;

=={{header|Perl 6}}==
my $host = qx[hostname];

=={{header|PHP}}==
echo $_SERVER['HTTP_HOST'];

echo php_uname('n');

{{works with|PHP|5.3+}}
echo gethostname();

=={{header|PicoLisp}}==
This will just print the hostname:
(call 'hostname)
To use it as a string in a program:
(in '(hostname) (line T))

=={{header|Pike}}==
import System;

int main(){
write(gethostname() + "\n");
}


=={{header|PL/SQL}}==
SET serveroutput on
BEGIN
DBMS_OUTPUT.PUT_LINE(UTL_INADDR.GET_HOST_NAME);
END;


=={{header|Pop11}}==
lvars host = sys_host_name();

=={{header|PowerBASIC}}==
This retreives the localhost's name:

HOST NAME TO hostname$

This attempts to retreive the name of an arbitrary machine on the network (assuming ipAddress& is valid):

HOST NAME ipAddress& TO hostname$

=={{header|PowerShell}}==
Windows systems have the ComputerName environment variable which can be used:
$Env:COMPUTERNAME
Also PowerShell can use .NET classes and methods:
[Net.Dns]::GetHostName()

=={{header|PureBasic}}==
{{works with|PureBasic|4.41}}
InitNetwork()
answer$=Hostname()


=={{header|Python}}==
{{works with|Python|2.5}}
import socket
host = socket.gethostname()


=={{header|R}}==
Sys.info provides information about the platform that R is running on. The following code returns the hostname as a string.
Sys.info()[["nodename"]]
Note that Sys.info isn't guaranteed to be available on all platforms. As an alternative, you can call an OS command.
system("hostname", intern = TRUE)
... or retrieve an environment variable

env_var <- ifelse(.Platform$OS.type == "windows", "COMPUTERNAME", "HOSTNAME")
Sys.getenv(env_var)


=={{header|Racket}}==

#lang racket/base
(require mzlib/os)
(gethostname)


=={{header|REBOL}}==
print system/network/host

=={{header|REXX}}==
===REGINA and PC/REXX under most MS NT Windows===
This REXX solution is for REGINA and PC/REXX under the Microsoft NT family of Windows (XP, Vista, 7, etc).

Other names could be used for the 3rd argument.


The   ''computername''   is the same as the output for the   '''hostname.exe'''   program.
say value('COMPUTERNAME',,"ENVIRONMENT")
say value('OS',,"ENVIRONMENT")

'''output''' (using Windows/XP)

GERARD46
Windows_NT

===R4 and ROO under most MS NT Windows===
This REXX solution is for R4 and ROO under the Microsoft NT family of Windows (XP, Vista, 7, etc).

Other names could be used for the 3rd argument.
say value('COMPUTERNAME',,"SYSTEM")
say value('OS',,"SYSTEM")


===MS DOS (without Windows), userid===
Under Microsoft DOS (with no Windows), the closest thing to a name of a host would be the userid.
say userid()

===MS DOS (without Windows), version of DOS===
But perhaps the name or version of the MS DOS system would be more appropriate than the userid.
'VER' /*this passes the VER command to the MS DOS system. */
Each REXX interpreter has their own name (some have multiple names) for the environmental variables.

Different operating systems may call their hostnames by different identifiers.

IBM mainframes (at one time) called the name of the host as a ''nodename'' and it needn't be

specified, in which case an asterisk (*) is returned.

I recall (perhaps wrongly) that Windows/95 and Windows/98 had a different environmental name for the name of the host.

===UNIX Solution===
This solution is platform specific and uses features that are available to the Regina implementation of Rexx.
:Tested with Regina on Mac OS X. Should work on other UNIX/Linux distros.
/* Rexx */
address command "hostname -f" with output stem hn.
do q_ = 1 to hn.0
say hn.q_
end q_
exit


=={{header|Ruby}}==
require 'socket'
host = Socket.gethostname


=={{header|Run BASIC}}==
print Platform$ ' OS where Run BASIC is being hosted
print UserInfo$ ' Information about the user's web browser
print UserAddress$ ' IP address of the user


=={{header|Scala}}==
println(java.net.InetAddress.getLocalHost.getHostName)

=={{header|Scheme}}==
{{works with|Chicken Scheme}}
(use posix)
(get-host-name)

{{works with|Guile}}
(gethostname)

=={{header|Seed7}}==
The library [http://seed7.sourceforge.net/libraries/socket.htm socket.s7i]
defines the function [http://seed7.sourceforge.net/libraries/socket.htm#getHostname getHostname],
which returns the hostname.

$ include "seed7_05.s7i";
include "socket.s7i";

const proc: main is func
begin
writeln(getHostname);
end func;


=={{header|Slate}}==
Platform current nodeName

=={{header|SNOBOL4}}==

output = host(4,"HOSTNAME")
end


=={{header|Standard ML}}==
NetHostDB.getHostName ()

=={{header|Smalltalk}}==
{{works with|Smalltalk/X}}
OperatingSystem getHostName

=={{header|Tcl}}==
The basic introspection tool in TCL is the info command. It can be used to find out about the version of the current Tcl or Tk, the available commands and libraries, variables, functions, the level of recursive interpreter invocation, and, amongst a myriad other things, the name of the current machine:

set hname [info hostname]

=={{header|Toka}}==
2 import gethostname
1024 chars is-array foo
foo 1024 gethostname
foo type

=={{header|TUSCRIPT}}==

$$ MODE TUSCRIPT
host=HOST ()


=={{header|UNIX Shell}}==
hostname
or
uname -n

=={{header|Ursala}}==
The user-defined hostname function ignores its argument and returns a string.
#import cli

hostname = ~&hmh+ (ask bash)/<>+ <'hostname'>!

For example, the following function returns the square root of its argument
if it's running on host kremvax, but otherwise returns the square.
#import flo

creative_accounting = (hostname== 'kremvax')?(sqrt,sqr)


{{omit from|ACL2}}
{{omit from|Locomotive Basic|Does not have a hostname.}}
{{omit from|ML/I}}
{{omit from|PARI/GP}}
{{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}}
{{omit from|Unlambda|Does not have network access.}}
{{omit from|ZX Spectrum Basic|Does not have a hostname.}}

Hostname

Pete: /* {{header|Limbo}} */


{{task|Programming environment operations}}[[Category:Networking and Web Interaction]]

Find the name of the host on which the routine is running.

=={{header|Ada}}==
Works with GCC/GNAT
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Sockets;

procedure Demo is
begin
Put_Line (GNAT.Sockets.Host_Name);
end Demo;


=={{header|ALGOL 68}}==

{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}}


{{works with|POSIX|.1}}
STRING hostname;
get(read OF execve child pipe("/bin/hostname","hostname",""), hostname);
print(("hostname: ", hostname, new line))


=={{header|Aikido}}==

println (System.hostname)


=={{header|AutoHotkey}}==
MsgBox % A_ComputerName

=={{header|AWK}}==
$ awk 'BEGIN{print ENVIRON["HOST"]}'
E51A08ZD


=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
INSTALL @lib$+"SOCKLIB"
PROC_initsockets
PRINT "hostname: " FN_gethostname
PROC_exitsockets


=={{header|C}}/{{header|C++}}==
{{works with|gcc|4.0.1}}

{{works with|POSIX|.1}}
#include
#include
#include
#include

int main(void)
{
char name[_POSIX_HOST_NAME_MAX + 1];
return gethostname(name, sizeof name) == -1 || printf("%s\n", name) < 0 ? EXIT_FAILURE : EXIT_SUCCESS;
}


=={{header|C sharp|C#}}==
System.Net.Dns.GetHostName();

=={{header|Caché ObjectScript}}==
Write ##class(%SYS.System).GetNodeName()


=={{header|Clojure}}==


(.. java.net.InetAddress getLocalHost getHostName)



java -cp clojure.jar clojure.main -e "(.. java.net.InetAddress getLocalHost getHostName)"


=={{header|CoffeeScript}}==

os = require 'os'
console.log os.hostname()


=={{header|Common Lisp}}==
Another operating system feature that is implemented differently across lisp implementations. Here we show how to create a function that obtains the required result portably by working differently for each supported implementation. This technique is heavily used to make portable lisp libraries.
(defun get-host-name ()
#+sbcl (machine-instance)
#+clisp (let ((s (machine-instance))) (subseq s 0 (position #\Space s)))
#-(or sbcl clisp) (error "get-host-name not implemented"))


{{libheader|CFFI}}

Another way is to use the [[FFI]] to access POSIX' gethostname(2):

(cffi:defcfun ("gethostname" c-gethostname) :int
(buf :pointer) (len :unsigned-long))

(defun get-hostname ()
(cffi:with-foreign-object (buf :char 256)
(unless (zerop (c-gethostname buf 256))
(error "Can't get hostname"))
(values (cffi:foreign-string-to-lisp buf))))


BOA> (get-hostname)
"aurora"


=={{header|D}}==
import std.stdio, std.socket;

void main() {
writeln(Socket.hostName());
}


=={{header|Delphi}}==
program ShowHostName;

{$APPTYPE CONSOLE}

uses Windows;

var
lHostName: array[0..255] of char;
lBufferSize: DWORD;
begin
lBufferSize := 256;
if GetComputerName(lHostName, lBufferSize) then
Writeln(lHostName)
else
Writeln('error getting host name');
end.


=={{header|E}}==

makeCommand("hostname")()[0].trim()

Not exactly a good way to do it. A better way ought to be introduced along with a proper socket interface. [[Category:E examples needing attention]]

=={{header|F_Sharp|F#}}==
printfn "%s" (System.Net.Dns.GetHostName())

=={{header|Factor}}==
host-name

=={{header|Forth}}==
{{works with|GNU Forth|0.7.0}}
include unix/socket.fs

hostname type


=={{header|Erlang}}==
Host = net_adm:localhost().

=={{header|friendly interactive shell}}==
{{trans|UNIX Shell}}

hostname
or
uname -n

=={{header|Fortran}}==
{{works with|gfortran}}

The function/subroutine HOSTNM is a GNU extension.
program HostTest
character(len=128) :: name
call hostnm(name)
print *, name
end program HostTest


=={{header|Go}}==
package main

import (
"fmt"
"os"
)

func main() {
host, _ := os.Hostname()
fmt.Printf("hostname: %s\n", host)
}


=={{header|Groovy}}==

println InetAddress.localHost.hostName

=={{header|Harbour}}==

? Netname()

=={{header|Haskell}}==
{{libheader|network}}
import Network.BSD
main = do hostName <- getHostName
putStrLn hostName


=={{header|Icon}} and {{header|Unicon}}==
procedure main()
write(&host)
end


=={{header|IDL}}==
hostname = GETENV('computername')

=={{header|J}}==
NB. Load the socket libraries

load 'socket'
coinsert 'jsocket'

NB. fetch and implicitly display the hostname

> {: sdgethostname ''

NB. If fetching the hostname is the only reason for loading the socket libraries,
NB. and the hostname is fetched only once, then use a 'one-liner' to accomplish it:

> {: sdgethostname coinsert 'jsocket' [ load 'socket'


=={{header|Java}}==
import java.net.*;
class DiscoverHostName {
public static void main(final String[] args) {
try {
System.out.println(InetAddress.getLocalHost().getHostName());
} catch (UnknownHostException e) { // Doesn't actually happen, but Java requires it be handled.
}
}
}


=={{header|JavaScript}}==
{{works with|JScript}}
var network = new ActiveXObject('WScript.Network');
var hostname = network.computerName;
WScript.echo(hostname);


=={{header|Lasso}}==
This will ge the hostname as reported by the web server
[web_request->httpHost]
-> www.myserver.com

This will ge the hostname as reported by the system OS
define host_name => thread {

data
public initiated::date, // when the thread was initiated. Most likely at Lasso server startup
private hostname::string // as reported by the servers hostname

public onCreate() => {
.reset
}

public reset() => {
if(lasso_version(-lassoplatform) >> 'Win') => {
protect => {
local(process = sys_process('cmd',(:'hostname.exe')))
#process -> wait
.hostname = string(#process -> readstring) -> trim&
#process -> close
}
else
protect => {
local(process = sys_process('/bin/hostname'))
#process -> wait
.hostname = string(#process -> readstring) -> trim&
#process -> close
}
}
.initiated = date(date -> format(`yyyyMMddHHmmss`)) // need to set format to get rid of nasty hidden fractions of seconds
.hostname -> size == 0 ? .hostname = 'undefined'
}

public asString() => .hostname

}

host_name

-> mymachine.local

=={{header|Liberty BASIC}}==
lpBuffer$=Space$(128) + Chr$(0)
struct SIZE,sz As Long
SIZE.sz.struct=Len(lpBuffer$)

calldll #kernel32, "GetComputerNameA",lpBuffer$ as ptr, SIZE as struct, result as Long
CurrentComputerName$=Trim$(Left$(lpBuffer$, SIZE.sz.struct))

print CurrentComputerName$


=={{header|Limbo}}==
As with nearly anything in Inferno, it boils down to reading a file:

implement Hostname;

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

Hostname: 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;
buf := array[Sys->ATOMICIO] of byte;

fd := sys->open("/dev/sysname", Sys->OREAD);
if(fd == nil)
die("Couldn't open /dev/sysname");

n := sys->read(fd, buf, len buf - 1);
if(n < 1)
die("Couldn't read /dev/sysname");

buf[n++] = byte '\n';
sys->write(sys->fildes(1), buf, n);
}

die(s: string)
{
sys->fprint(sys->fildes(2), "hostname: %s: %r", s);
raise "fail:errors";
}


Sys->ATOMICIO is usually 8 kilobytes; this version truncates if you have a ridiculously long hostname.

=={{header|Lua}}==
Requires: LuaSocket
socket = require "socket"
print( socket.dns.gethostname() )


=={{header|Maple}}==
Sockets:-GetHostName()

=={{header|Mathematica}}==
$MachineName

=={{header|MATLAB}}==
This is a built-in MATLAB function. "failed" is a Boolean which will be false if the command sent to the OS succeeds. "hostname" is a string containing the system's hostname, provided that the external command hostname exists.

[failed,hostname] = system('hostname')

=={{header|mIRC Scripting Language}}==
echo -ag $host

=={{header|Modula-3}}==
MODULE Hostname EXPORTS Main;

IMPORT IO, OSConfig;

BEGIN
IO.Put(OSConfig.HostName() & "\n");
END Hostname.


=={{header|MUMPS}}==
Write $Piece($System,":")

=={{header|NetRexx}}==
/* NetRexx */
options replace format comments java crossref savelog symbols binary

say InetAddress.getLocalHost.getHostName


=={{header|NewLISP}}==
(! "hostname")

=={{header|Objective-C}}==

Cocoa / Cocoa Touch / GNUstep:


NSLog(@"%@", [[NSProcessInfo processInfo] hostName]);


Example Output:


2010-09-16 16:20:00.000 Playground[1319:a0f] sierra117.local // Hostname is sierra117.local.


=={{header|Objeck}}==

use Net;

bundle Default {
class Hello {
function : Main(args : String[]) ~ Nil {
TCPSocket->HostName()->PrintLine();
}
}
}


=={{header|OCaml}}==
Unix.gethostname()

=={{header|Octave}}==
Similarly to [[Discover the Hostname#MATLAB|MATLAB]], we could call system command hostname to know the hostname. But we can also call the internal function uname() which returns a structure holding several informations, among these the hostname (nodename):

uname().nodename

=={{header|ooRexx}}==
These solutions are platform specific.
===Windows Platform===
A solution using ActiveX/OLE on Windows

say .oleObject~new('WScript.Network')~computerName

and one using the Windows environment variables

say value('COMPUTERNAME',,'environment')

===UNIX Platform===
Some UNIX solutions (tested under Mac OS X):

ooRexx (and [[REXX|Rexx]]) can issue commands directly to the shell it's running under.
Output of the shell commands will normally be STDOUT and STDERR.
These next two samples will simply output the host name to the console if the program is run from a command prompt.
:'''Note:''' The '''address command''' clause causes the contents of the literal string that follows it to be sent to the command shell.

address command 'hostname -f'

address command "echo $HOSTNAME"

Command output can also be captured by the program to allow further processing.
ooRexx provides an external data queue manager ('''''rxqueue''''') that can be used for this.
In the following examples output written to STDOUT/STDERR is piped into '''rxqueue''' which sends it in turn to a Rexx queue for further processing by the program:

/* Rexx */
address command "echo $HOSTNAME | rxqueue"
address command "hostname -f | rxqueue"
loop q_ = 1 while queued() > 0
parse pull hn
say q_~right(2)':' hn
end q_


A utility class is also provided as a wrapper around the external data queue:

/* Rexx */
qq = .rexxqueue~new()
address command "echo $HOSTNAME | rxqueue"
address command "hostname -f | rxqueue"
loop q_ = 1 while qq~queued() > 0
hn = qq~pull()
say q_~right(2)':' hn
end q_


=={{header|Oz}}==
{System.showInfo {OS.getHostByName 'localhost'}.name}

=={{header|Pascal}}==
For Windows systems see the [[Hostname#Delphi | Delphi]] example.
On Unix systems, FreePascal has the function GetHostName:
Program HostName;

uses
unix;

begin
writeln('The name of this computer is: ', GetHostName);
end.

Output example on Mac OS X:

The name of this computer is: MyComputer.local


=={{header|Perl}}==
{{works with|Perl|5.8.6}}

{{libheader|Sys::Hostname}}
use Sys::Hostname;

$name = hostname;

=={{header|Perl 6}}==
my $host = qx[hostname];

=={{header|PHP}}==
echo $_SERVER['HTTP_HOST'];

echo php_uname('n');

{{works with|PHP|5.3+}}
echo gethostname();

=={{header|PicoLisp}}==
This will just print the hostname:
(call 'hostname)
To use it as a string in a program:
(in '(hostname) (line T))

=={{header|Pike}}==
import System;

int main(){
write(gethostname() + "\n");
}


=={{header|PL/SQL}}==
SET serveroutput on
BEGIN
DBMS_OUTPUT.PUT_LINE(UTL_INADDR.GET_HOST_NAME);
END;


=={{header|Pop11}}==
lvars host = sys_host_name();

=={{header|PowerBASIC}}==
This retreives the localhost's name:

HOST NAME TO hostname$

This attempts to retreive the name of an arbitrary machine on the network (assuming ipAddress& is valid):

HOST NAME ipAddress& TO hostname$

=={{header|PowerShell}}==
Windows systems have the ComputerName environment variable which can be used:
$Env:COMPUTERNAME
Also PowerShell can use .NET classes and methods:
[Net.Dns]::GetHostName()

=={{header|PureBasic}}==
{{works with|PureBasic|4.41}}
InitNetwork()
answer$=Hostname()


=={{header|Python}}==
{{works with|Python|2.5}}
import socket
host = socket.gethostname()


=={{header|R}}==
Sys.info provides information about the platform that R is running on. The following code returns the hostname as a string.
Sys.info()[["nodename"]]
Note that Sys.info isn't guaranteed to be available on all platforms. As an alternative, you can call an OS command.
system("hostname", intern = TRUE)
... or retrieve an environment variable

env_var <- ifelse(.Platform$OS.type == "windows", "COMPUTERNAME", "HOSTNAME")
Sys.getenv(env_var)


=={{header|Racket}}==

#lang racket/base
(require mzlib/os)
(gethostname)


=={{header|REBOL}}==
print system/network/host

=={{header|REXX}}==
===REGINA and PC/REXX under most MS NT Windows===
This REXX solution is for REGINA and PC/REXX under the Microsoft NT family of Windows (XP, Vista, 7, etc).

Other names could be used for the 3rd argument.


The   ''computername''   is the same as the output for the   '''hostname.exe'''   program.
say value('COMPUTERNAME',,"ENVIRONMENT")
say value('OS',,"ENVIRONMENT")

'''output''' (using Windows/XP)

GERARD46
Windows_NT

===R4 and ROO under most MS NT Windows===
This REXX solution is for R4 and ROO under the Microsoft NT family of Windows (XP, Vista, 7, etc).

Other names could be used for the 3rd argument.
say value('COMPUTERNAME',,"SYSTEM")
say value('OS',,"SYSTEM")


===MS DOS (without Windows), userid===
Under Microsoft DOS (with no Windows), the closest thing to a name of a host would be the userid.
say userid()

===MS DOS (without Windows), version of DOS===
But perhaps the name or version of the MS DOS system would be more appropriate than the userid.
'VER' /*this passes the VER command to the MS DOS system. */
Each REXX interpreter has their own name (some have multiple names) for the environmental variables.

Different operating systems may call their hostnames by different identifiers.

IBM mainframes (at one time) called the name of the host as a ''nodename'' and it needn't be

specified, in which case an asterisk (*) is returned.

I recall (perhaps wrongly) that Windows/95 and Windows/98 had a different environmental name for the name of the host.

===UNIX Solution===
This solution is platform specific and uses features that are available to the Regina implementation of Rexx.
:Tested with Regina on Mac OS X. Should work on other UNIX/Linux distros.
/* Rexx */
address command "hostname -f" with output stem hn.
do q_ = 1 to hn.0
say hn.q_
end q_
exit


=={{header|Ruby}}==
require 'socket'
host = Socket.gethostname


=={{header|Run BASIC}}==
print Platform$ ' OS where Run BASIC is being hosted
print UserInfo$ ' Information about the user's web browser
print UserAddress$ ' IP address of the user


=={{header|Scala}}==
println(java.net.InetAddress.getLocalHost.getHostName)

=={{header|Scheme}}==
{{works with|Chicken Scheme}}
(use posix)
(get-host-name)

{{works with|Guile}}
(gethostname)

=={{header|Seed7}}==
The library [http://seed7.sourceforge.net/libraries/socket.htm socket.s7i]
defines the function [http://seed7.sourceforge.net/libraries/socket.htm#getHostname getHostname],
which returns the hostname.

$ include "seed7_05.s7i";
include "socket.s7i";

const proc: main is func
begin
writeln(getHostname);
end func;


=={{header|Slate}}==
Platform current nodeName

=={{header|SNOBOL4}}==

output = host(4,"HOSTNAME")
end


=={{header|Standard ML}}==
NetHostDB.getHostName ()

=={{header|Smalltalk}}==
{{works with|Smalltalk/X}}
OperatingSystem getHostName

=={{header|Tcl}}==
The basic introspection tool in TCL is the info command. It can be used to find out about the version of the current Tcl or Tk, the available commands and libraries, variables, functions, the level of recursive interpreter invocation, and, amongst a myriad other things, the name of the current machine:

set hname [info hostname]

=={{header|Toka}}==
2 import gethostname
1024 chars is-array foo
foo 1024 gethostname
foo type

=={{header|TUSCRIPT}}==

$$ MODE TUSCRIPT
host=HOST ()


=={{header|UNIX Shell}}==
hostname
or
uname -n

=={{header|Ursala}}==
The user-defined hostname function ignores its argument and returns a string.
#import cli

hostname = ~&hmh+ (ask bash)/<>+ <'hostname'>!

For example, the following function returns the square root of its argument
if it's running on host kremvax, but otherwise returns the square.
#import flo

creative_accounting = (hostname== 'kremvax')?(sqrt,sqr)


{{omit from|ACL2}}
{{omit from|Locomotive Basic|Does not have a hostname.}}
{{omit from|ML/I}}
{{omit from|PARI/GP}}
{{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}}
{{omit from|Unlambda|Does not have network access.}}
{{omit from|ZX Spectrum Basic|Does not have a hostname.}}

Integer sequence

Pete: Add a Limbo version.


{{task}}Create a program that, when run, would display all integers from 1 to ∞ (or any relevant implementation limit), in sequence (i.e. 1, 2, 3, 4, etc) if given enough time.

An example may not be able to reach arbitrarily-large numbers based on implementations limits. For example, if integers are represented as a 32-bit unsigned value with 0 as the smallest representable value, the largest representable value would be 4,294,967,295. Some languages support arbitrarily-large numbers as a built-in feature, while others make use of a module or library.

If appropriate, provide an example which reflect the language implementation's common built-in limits as well as an example which supports arbitrarily large numbers, and describe the nature of such limitations—or lack thereof.

=={{header|0815}}==
}:_:<:1:+%<:a:~$^:_:

=={{header|Ada}}==
with Ada.Text_IO;
procedure Integers is
Value : Integer := 1;
begin
loop
Ada.Text_IO.Put_Line (Integer'Image (Value));
Value := Value + 1;
end loop;
end Integers;

alternative (iterating through all values of Positive (positive part of Integer) without endless loop):
with Ada.Text_IO;
procedure Positives is
begin
for Value in Positive'Range loop
Ada.Text_IO.Put_Line (Positive'Image (Value));
end loop;
end Positives;


=={{header|ALGOL 68}}==
{{works with|ALGOL 68|Revision 1 - no extensions to language used.}}
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny].}}
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted] ''transput''.}}
The upper limit of the loop variable ''i'' is ''max int'' currently ''+2147483647'' for [[ALGOL 68G]].
main:
(
FOR i DO
printf(($g(0)","$,i))
OD
)

Partial output:

1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,...


=={{header|Applesoft BASIC}}==
Integer variables can be within the range of -32767 to 32767.
10 I% = 1
20 PRINT I%;
30 I% = I% + 1
40 PRINT ", ";
50 GOTO 20

Last screen of scrolled output:
, 32646, 32647, 32648, 32649, 32650, 326
51, 32652, 32653, 32654, 32655, 32656, 3
2657, 32658, 32659, 32660, 32661, 32662,
32663, 32664, 32665, 32666, 32667, 3266
8, 32669, 32670, 32671, 32672, 32673, 32
674, 32675, 32676, 32677, 32678, 32679,
32680, 32681, 32682, 32683, 32684, 32685
, 32686, 32687, 32688, 32689, 32690, 326
91, 32692, 32693, 32694, 32695, 32696, 3
2697, 32698, 32699, 32700, 32701, 32702,
32703, 32704, 32705, 32706, 32707, 3270
8, 32709, 32710, 32711, 32712, 32713, 32
714, 32715, 32716, 32717, 32718, 32719,
32720, 32721, 32722, 32723, 32724, 32725
, 32726, 32727, 32728, 32729, 32730, 327
31, 32732, 32733, 32734, 32735, 32736, 3
2737, 32738, 32739, 32740, 32741, 32742,
32743, 32744, 32745, 32746, 32747, 3274
8, 32749, 32750, 32751, 32752, 32753, 32
754, 32755, 32756, 32757, 32758, 32759,
32760, 32761, 32762, 32763, 32764, 32765
, 32766, 32767
?ILLEGAL QUANTITY ERROR IN 30
]


=={{header|AutoHotkey}}==
This uses traytip to show the results. A msgbox, tooltip, or fileappend could also be used.
x=0
Loop
TrayTip, Count, % ++x


=={{header|AWK}}==
BEGIN {
for( i=0; i != i + 1; i++ )
print( i )
}


Awk uses floating-point numbers. This loop terminates when i becomes too large for integer precision. With IEEE doubles, this loop terminates when i reaches 2 ^ 53.

=={{header|BASIC}}==
{{works with|ZX Spectrum Basic}}
10 LET A = 0
20 LET A = A + 1
30 PRINT A
40 GO TO 20

{{works with|QBasic}}
A = 0
DO: A = A + 1: PRINT A: LOOP 1


=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
Native version, limited to 53-bit integers (maximum output 9007199254740992):
*FLOAT 64
REPEAT
i += 1
PRINT TAB(0,0) i;
UNTIL FALSE

Version using Huge Integer Math and Encryption library (up to 2^31 bits, but this program limited to 65535 decimal digits because of maximum string length):
INSTALL @lib$+"HIMELIB"
PROC_himeinit("")
reg% = 1

PROC_hiputdec(reg%, "0")
REPEAT
SYS `hi_Incr`, ^reg%, ^reg%
PRINT TAB(0,0) FN_higetdec(reg%);
UNTIL FALSE


=={{header|Bracmat}}==
{{trans|Ruby}}
Bracmat uses big numbers. Numbers are stored with a radix 10, each decimal digit occupying one byte. When multiplying or dividing, numbers are temporarily converted to radix 10000 (32-bit systems: 1 digit occupies two bytes) or radix 100000000 (64-bit systems: 1 digit occupies four bytes) to speed up the computation.
0:?n&whl'out$(1+!n:?n)

=={{header|Brainf***}}==
This program assumes that decrementing past zero wraps around, but it doesn't rely on cell size, other than that a cell can hold at least six bits. It also assumes the ASCII character set. This is an arbitrarily large number implementation.
++++++++++>>>+[[->>+<[+>->+<<---------------------------------------
-------------------[>>-<++++++++++<[+>-<]]>[-<+>]<++++++++++++++++++
++++++++++++++++++++++++++++++>]<[<]>>[-<+++++++++++++++++++++++++++
++++++++++++++++++++++>]>]>[>>>]<<<[.<<<]<.>>>+]


This modification of the previous program will print out 1 to the maximum cell value, still assuming wrapping. On many implementations, this will print out 1-255.
++++++++++>>-[>+[->>+<[+>->+<<--------------------------------------
--------------------[>>-<++++++++++<[+>-<]]>[-<+>]<+++++++++++++++++
+++++++++++++++++++++++++++++++>]<[<]>>[-<++++++++++++++++++++++++++
+++++++++++++++++++++++>]>]>[>>>]<<<[.<<<]<.>>-]


=={{header|Brat}}==
i = 1

loop {
p i
i = i + 1
}


=={{header|Burlesque}}==


1R@


=={{header|C}}==
Prints from 1 to max unsigned integer (usually 2**32 -1), then stops.
#include

int main()
{
unsigned int i = 0;
while (++i) printf("%u\n", i);

return 0;
}


==={{libheader|GMP}}===
This one never stops. It's not even likely that you'll run out of memory before you run out of patience. #include

int main()
{
mpz_t i;
mpz_init(i); /* zero now */

while (1) {
mpz_add_ui(i, i, 1); /* i = i + 1 */
gmp_printf("%Zd\n", i);
}

return 0;
}


==={{libheader|OpenSSL}}===
OpenSSL provides arbitrarily large integers.

#include /* BN_*() */
#include /* ERR_*() */
#include /* fprintf(), puts() */

void
fail(const char *message)
{
fprintf(stderr, "%s: error 0x%08lx\n", ERR_get_error());
exit(1);
}

int
main()
{
BIGNUM i;
char *s;

BN_init(&i);
for (;;) {
if (BN_add_word(&i, 1) == 0)
fail("BN_add_word");
s = BN_bn2dec(&i);
if (s == NULL)
fail("BN_bn2dec");
puts(s);
OPENSSL_free(s);
}
/* NOTREACHED */
}


=={{header|C sharp|C#}}==
using System;
using System.Numerics;

class Program
{
static void Main()
{
BigInteger i = 1;
while (true)
{
Console.WriteLine(i++);
}
}
}

=={{header|C++}}==
#include
#include

int main()
{
uint32_t i = 0;
while(true)
std::cout << ++i << std::endl;

return 0;
}


=={{header|Clean}}==
In Clean this example has a limit of basically 2147483648.
module IntegerSequence

import StdEnv

Start = [x \\ x <- [1..]]


Output:
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,..


=={{header|Clojure}}==
(map println (next (range)))

=={{header|COBOL}}==
IDENTIFICATION DIVISION.
PROGRAM-ID. Int-Sequence.

DATA DIVISION.
WORKING-STORAGE SECTION.
* *> 36 digits is the largest size a numeric field can have.
01 I PIC 9(36).

PROCEDURE DIVISION.
* *> Display numbers until I overflows.
PERFORM VARYING I FROM 1 BY 1 UNTIL I = 0
DISPLAY I
END-PERFORM

GOBACK
.


=={{header|CoffeeScript}}==
Like with most languages, counting is straightforward in CoffeeScript, so the program below tries to handle very large numbers. See the comments for starting the sequence from 1.


# This very limited BCD-based collection of functions
# makes it easy to count very large numbers. All arrays
# start off with the ones columns in position zero.
# Using arrays of decimal-based digits to model integers
# doesn't make much sense for most tasks, but if you
# want to keep counting forever, this does the trick.

BcdInteger =
from_string: (s) ->
arr = []
for c in s
arr.unshift parseInt(c)
arr

render: (arr) ->
s = ''
for elem in arr
s = elem.toString() + s
s

succ: (arr) ->
arr = (elem for elem in arr)
i = 0
while arr[i] == 9
arr[i] = 0
i += 1
arr[i] ||= 0
arr[i] += 1
arr

# To start counting from 1, change the next line!
big_int = BcdInteger.from_string "199999999999999999999999999999999999999999999999999999"
while true
console.log BcdInteger.render big_int
big_int = BcdInteger.succ big_int


output

> coffee foo.coffee | head -5
199999999999999999999999999999999999999999999999999999
200000000000000000000000000000000000000000000000000000
200000000000000000000000000000000000000000000000000001
200000000000000000000000000000000000000000000000000002
200000000000000000000000000000000000000000000000000003



=={{header|Common Lisp}}==

(loop for i from 1 do (print i))

If your compiler does tail call elimination (note: this has absolutely no advantage over normal loops):
(defun pp (x) (pp (1+ (print x))))
(funcall (compile 'pp) 1) ; it's less likely interpreted mode will eliminate tails


=={{header|Component Pascal}}==
BlackBox Component Builder

MODULE IntegerSequence;
IMPORT StdLog;

PROCEDURE Do*;
VAR
i: INTEGER;
BEGIN
FOR i := 0 TO MAX(INTEGER) DO;
StdLog.Int(i)
END;
StdLog.Ln
END Do;

END IntegerSequence.

Execute: ^Q IntegerSequence.Do

Output:

0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 ...

=={{header|D}}==
import std.stdio, std.bigint;

void main() {
BigInt i;
while (true)
writeln(++i);
}

Alternative:
import std.stdio, std.traits, std.bigint, std.string;

void integerSequence(T)() if (isIntegral!T || is(T == BigInt)) {
T now = 1;
T max = 0;
static if (!is(T == BigInt))
max = T.max;

do
write(now, " ");
while (now++ != max);

writeln("\nDone!");
}

void main() {
writeln("How much time do you have?");
writeln(" 0. I'm in hurry.");
writeln(" 1. I've some time.");
writeln(" 2. I'm on vacation.");
writeln(" 3. I'm unemployed...");
writeln(" 4. I'm immortal!");
write("Enter 0-4 or nothing to quit: ");

string answer;
readf("%s\n", &answer);

switch (answer.toLower()) {
case "0": integerSequence!ubyte(); break;
case "1": integerSequence!short(); break;
case "2": integerSequence!uint(); break;
case "3": integerSequence!long(); break;
case "4": integerSequence!BigInt(); break;
default: writeln("\nBye bye!"); break;
}
}


=={{header|Dc}}==
1[p1+lpx]dspx

=={{header|Delphi}}==
program IntegerSequence;

{$APPTYPE CONSOLE}

var
i: Integer;
begin
for i := 1 to High(i) do
WriteLn(i);
end.


=={{header|Déjà Vu}}==
1

while /= -- dup dup:
!. dup
++

drop


This continues to print numbers until double precision IEEE 754 cannot represent adjacent integers any more (9007199254740992, to be exact).

In the future, the implementation may switch to arbitrary precision, so it will keep running until memory fills up.

=={{header|DWScript}}==
High(i) returns the maximum supported value, typically, it is the highest signed 64 bit integer.

var i: Integer;

for i:=1 to High(i) do
PrintLn(i);


=={{header|E}}==

for i in int > 0 { println(i) }

=={{header|Eiffel}}==

class
APPLICATION
inherit
ARGUMENTS
create
make
feature {NONE} -- Initialization
make
-- Run application.
do
from
number := 0
until
number = number.max_value
loop
print(number)
print(", ")
number := number + 1
end
end
number:INTEGER_64
end


=={{header|Emacs Lisp}}==
Displays in the message area interactively, or to standard output under -batch.

(dotimes (i most-positive-fixnum)
(message "%d" (1+ i)))


=={{header|Erlang}}==

F = fun(FF, I) -> io:format("~p~n", [I]), FF(FF, I + 1) end, F(F,0).

=={{header|Euphoria}}==
integer i
i = 0
while 1 do
? i
i += 1
end while


=={{header|F_Sharp|F#}}==

// lazy sequence of integers starting with i
let rec integers i =
seq { yield i
yield! integers (i+1) }

Seq.iter (printfn "%d") (integers 1)


lazy sequence of int32 starting from 0
let integers = Seq.initInfinite id

lazy sequence of int32 starting from n
let integers n = Seq.initInfinite ((+) n)

lazy sequence (not necessarily of int32) starting from n (using unfold anamorphism)
let inline numbers n =
Seq.unfold (fun n -> Some (n, n + LanguagePrimitives.GenericOne)) n


> numbers 0 |> Seq.take 10;;
val it : seq = seq [0; 1; 2; 3; ...]
> let bignumber = 12345678901234567890123456789012345678901234567890;;
val bignumber : System.Numerics.BigInteger =
12345678901234567890123456789012345678901234567890
> numbers bignumber |> Seq.take 10;;
val it : seq =
seq
[12345678901234567890123456789012345678901234567890 {IsEven = true;
IsOne = false;
IsPowerOfTwo = false;
IsZero = false;
Sign = 1;};
12345678901234567890123456789012345678901234567891 {IsEven = false;
IsOne = false;
IsPowerOfTwo = false;
IsZero = false;
Sign = 1;};
12345678901234567890123456789012345678901234567892 {IsEven = true;
IsOne = false;
IsPowerOfTwo = false;
IsZero = false;
Sign = 1;};
12345678901234567890123456789012345678901234567893 {IsEven = false;
IsOne = false;
IsPowerOfTwo = false;
IsZero = false;
Sign = 1;}; ...]
> numbers 42.42 |> Seq.take 10;;
val it : seq = seq [42.42; 43.42; 44.42; 45.42; ...]

=={{header|Factor}}==
USE: lists.lazy
1 lfrom [ . ] leach


=={{header|Fantom}}==


class Main
{
public static Void main()
{
i := 1
while (true)
{
echo (i)
i += 1
}
}
}


Fantom's integers are 64-bit signed, and so the numbers will return to 0 and continue again, if you wait long enough!
You can use Java BigInteger via FFI

=={{header|Fish}}==
Since there aren't really libraries in Fish and I wouldn't know how to program arbitarily large integers, so here's an example that just goes on until the interpreter's number limit:
0>:n1+v
^o" "<


=={{header|Forth}}==
: ints ( -- )
0 begin 1+ dup cr u. dup -1 = until drop ;


=={{header|Fortran}}==
{{works with|Fortran|90 and later}}
program Intseq
implicit none

integer, parameter :: i64 = selected_int_kind(18)
integer(i64) :: n = 1

! n is declared as a 64 bit signed integer so the program will display up to
! 9223372036854775807 before overflowing to -9223372036854775808
do
print*, n
n = n + 1
end do
end program


=={{header|GAP}}==
InfiniteLoop := function()
local n;
n := 1;
while true do
Display(n);
n := n + 1;
od;
end;

# Prepare some coffee
InfiniteLoop();


=={{header|Go}}==
Size of int type is implementation dependent, but I think all implementations use 32 bits currently. After the maximum positive value, it rolls over to maximum negative, without error.
package main

import "fmt"

func main() {
for i := 1;; i++ {
fmt.Println(i)
}
}

The big number type does not roll over and is limited only by available memory, or practically, by whatever external factor halts cpu execution: human operator, lightning storm, cpu fan failure, heat death of universe, etc.
package main

import (
"big"
"fmt"
)

func main() {
one := big.NewInt(1)
for i := big.NewInt(1);; i.Add(i, one) {
fmt.Println(i)
}
}


=={{header|Groovy}}==
// 32-bit 2's-complement signed integer (int/Integer)
for (def i = 1; i > 0; i++) { println i }

// 64-bit 2's-complement signed integer (long/Long)
for (def i = 1L; i > 0; i+=1L) { println i }

// Arbitrarily-long binary signed integer (BigInteger)
for (def i = 1g; ; i+=1g) { println i }


=={{header|GUISS}}==

Graphical User Interface Support Script makes use of installed programs. There are no variables, no loop structures and no jumps within the language so iteration is achieved by repetative instructions. In this example, we will just use the desktop calculator and keep adding one to get a counter. We stop after counting to ten in this example.

Start,Programs,Accessories,Calculator,
Button:[plus],Button:1,Button:[equals],Button:[plus],Button:1,Button:[equals],
Button:[plus],Button:1,Button:[equals],Button:[plus],Button:1,Button:[equals],
Button:[plus],Button:1,Button:[equals],Button:[plus],Button:1,Button:[equals],
Button:[plus],Button:1,Button:[equals],Button:[plus],Button:1,Button:[equals],
Button:[plus],Button:1,Button:[equals],Button:[plus],Button:1,Button:[equals]


=={{header|Haskell}}==
mapM_ print [1..]

Or less imperatively:

putStr $ unlines $ map show [1..]

=={{header|Icon}} and {{header|Unicon}}==
Icon and Unicon support large integers by default. The built-in generator seq(i,j) yields the infinite sequence i, i+j, i+2*j, etc. Converting the results to strings for display will likely eat your lunch before the sequence will take its toll.

procedure main()
every write(seq(1)) # the most concise way
end


=={{header|J}}==
The following will count indefinitely but once the 32-bit (or 64-bit depending on J engine version) limit is reached, the results will be reported as floating point values (which would immediately halt on 64 bit J and halt with the 53 bit precision limit is exceeded on 32 bit J). Since that could take many, many centuries, even on a 32 bit machine, more likely problems include the user dying of old age and failing to pay the electric bill resulting in the machine being powered off.

count=: (smoutput ] >:)^:_

The above works with both fixed sized integers and floating point numbers (fixed sized integers are automatically promoted to floating point, if they overflow), but also works with extended precision integers (which will not overflow, unless they get so large that they cannot be represented in memory, but that should exceed lifetime of the universe, let alone lifetime of the computer).

This adds support for extended precision (in that it converts non-extended precision arguments to extended precision arguments) and will display integers to ∞ (or at least until the machine is turned off or interrupted or crashes).
count=: (smoutput ] >:)@x:^:_

=={{header|Java}}==
Long limit:
public class Count{
public static void main(String[] args){
for(long i = 1; ;i++) System.out.println(i);
}
}

"Forever":
import java.math.BigInteger;

public class Count{
public static void main(String[] args){
for(BigInteger i = BigInteger.ONE; ;i = i.add(BigInteger.ONE)) System.out.println(i);
}
}


=={{header|JavaScript}}==
var i = 0;

while (true)
document.write(++i + ' ');


=={{header|Joy}}==

1 [0 >] [dup put succ] while pop.


Counting stops at maxint, which is 2147483647

=={{header|Julia}}==
i = zero(BigInt) # or i = big(0)
while true
println(i += 1)
end

The built-in BigInt type is an arbitrary precision integer (based on the GMP library), so the value of i is limited only by available memory. To use (much faster) hardware fixed-width integer types, use e.g. zero(Int32) or zero(Int64). (Initializing i = 0 will use fixed-width integers that are the same size as the hardware address width, e.g. 64-bit on a 64-bit machine.)

=={{header|K}}==
{`0:"\n",$x+:1;x}/1

Using a while loop:

i:0; while[1;`0:"\n",$i+:1]

=={{header|Lang5}}==
0 do dup . 1 + loop

=={{header|Lasso}}==
local(number = 1)
while(#number > 0) => {^
#number++
' '
//#number > 100 ? #number = -2 // uncomment this row if you want to halt the run after proving concept
^}

This will run until you exhaust the system resources it's run under.

=={{header|Liberty BASIC}}==
Liberty BASIC handles extremely large integers. The following code was halted by user at 10,000,000 in test run.
while 1
i=i+1
locate 1,1
print i
scan
wend


=={{header|Limbo}}==
The int (32 bits) and big (64 bits) types are both signed, so they wrap around. This version uses the infinite precision integer library:

implement CountToInfinity;

include "sys.m"; sys: Sys;
include "draw.m";
include "ipints.m"; ipints: IPints;
IPint: import ipints;

CountToInfinity: 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;
ipints = load IPints IPints->PATH;

i := IPint.inttoip(0);
one := IPint.inttoip(1);
for(;;) {
sys->print("%s\n", i.iptostr(10));
i = i.add(one);
}
}


=={{header|Lua}}==

i = 1

-- in the event that the number inadvertently wraps around,
-- stop looping - this is unlikely with Lua's default underlying
-- number type (double), but on platform without double
-- the C type used for numbers can be changed
while i > 0 do
print( i )
i = i + 1
end


=={{header|Mathematica}}==
Built in arbitrary precision support meanst the following will not overflow.

x = 1;
Monitor[While[True, x++], x]


=={{header|MATLAB}} / {{header|Octave}}==

a = 1; while (1) printf('%i\n',a); a=a+1; end;

Typically, numbers are stored as double precision floating point numbers, giving accurate integer values up to about 2^53=bitmax('double')=9.0072e+15. Above this limit, round off errors occur. This limitation can be overcome by defining the numeric value as type int64 or uint64

a = uint64(1); while (1) printf('%i\n',a); a=a+1; end;

This will run up to 2^64 and then stop increasing, there will be no overflow.


>> a=uint64(10e16+1) % 10e16 is first converted into a double precision number causing some round-off error.
a = 100000000000000000
>> a=uint64(10e16)+1
a = 100000000000000001


The above limitations can be overcome with additional toolboxes for symbolic computation or multiprecision computing.

Matlab and Octave recommend vectorizing the code, one might pre-allocate the sequence up to a specific N.

N = 2^30; printf('%d\n', 1:N);

The main limitation is the available memory on your machine. The standard version of Octave has a limit that a single data structure can hold at most 2^31 elements. In order to overcome this limit, Octave must be compiled with "./configure --enable-64", but this is currently not well supported.

=={{header|Maxima}}==
for i do disp(i);

=={{header|МК-61/52}}==
1 П4 ИП4 С/П КИП4 БП 02

=={{header|ML/I}}==
MCSKIP "WITH" NL
"" Integer sequence
"" Will overflow when it reaches implementation-defined signed integer limit
MCSKIP MT,<>
MCINS %.
MCDEF DEMO WITHS NL AS %L1.%T1.
MCSET T1=T1+1
MCGO L1
>
DEMO


=={{header|NetRexx}}==
===Rexx Built In===
NetRexx provides built-in support for very large precision arithmetic via the Rexx class.
/* NetRexx */
options replace format comments java crossref symbols binary

k_ = Rexx
bigDigits = 999999999 -- Maximum setting for digits allowed by NetRexx
numeric digits bigDigits

loop k_ = 1
say k_
end k_


===Using BigInteger===
Java's BigInteger class is also available for very large precision arithmetic.
/* NetRexx */
options replace format comments java crossref symbols binary

import java.math.BigInteger

-- allow an option to change the output radix.
parse arg radix .
if radix.length() == 0 then radix = 10 -- default to decimal
k_ = BigInteger
k_ = BigInteger.ZERO

loop forever
k_ = k_.add(BigInteger.ONE)
say k_.toString(int radix)
end


=={{header|Nimrod}}==

var i:int64 = 0
while true:
i = i + 1
echo(i)


=={{header|Objeck}}==

bundle Default {
class Count {
function : Main(args : String[]) ~ Nil {
i := 0;
do {
i->PrintLine();
i += 1;
} while(i <> 0);
}
}
}


=={{header|OCaml}}==
with an imperative style:
let () =
let i = ref 0 in
while true do
print_int !i;
print_newline ();
incr i;
done


with a functional style:
let () =
let rec aux i =
print_int i;
print_newline ();
aux (succ i)
in
aux 0


=={{header|OpenEdge/Progress}}==
OpenEdge has three data types that can be used for this task:
  1. INTEGER (32-bit signed integer)
    DEF VAR ii AS INTEGER FORMAT "->>>>>>>>9" NO-UNDO.

    DO WHILE TRUE:
    ii = ii + 1.
    DISPLAY ii.
    END.

    When an integer rolls over its maximum of 2147483647 error 15747 is raised (Value # too large to fit in INTEGER.).

  2. INT64 (64-bit signed integer)
    DEF VAR ii AS INT64 FORMAT "->>>>>>>>>>>>>>>>>>9" NO-UNDO.

    DO WHILE TRUE:
    ii = ii + 1.
    DISPLAY ii.
    END.

    When a 64-bit integer overflows no error is raised and the signed integer becomes negative.

  3. DECIMAL (50 digits)
    DEF VAR de AS DECIMAL FORMAT "->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>9" NO-UNDO.

    DO WHILE TRUE:
    de = de + 1.
    DISPLAY de.
    END.

    When a decimal requires mores than 50 digits error 536 is raised (Decimal number is too large.).



=={{header|Order}}==
Order supports arbitrarily-large positive integers natively. However, the simple version:
#include

#define ORDER_PP_DEF_8printloop ORDER_PP_FN( \
8fn(8N, \
8do(8print(8to_lit(8N) 8comma 8space), \
8printloop(8inc(8N)))) )

ORDER_PP( 8printloop(1) )

... while technically fulfilling the task, will probably never display anything, as most C Preprocessor implementations won't print their output until the file is done processing. Since the C Preprocessor is not technically Turing-complete, the Order interpreter has a maximum number of steps it can execute - but this number is very, very large (from the documentation: "the Order interpreter could easily be extended with a couple of hundred macros to prolong the wait well beyond the estimated lifetime of the sun"), so the compiler is rather more likely to simply run out of memory.

To actually see anything with GCC, add a maximum limit so that the task can complete:
#include

#define ORDER_PP_DEF_8printloop ORDER_PP_FN( \
8fn(8N, \
8do(8print(8to_lit(8N) 8comma 8space), \
8when(8less(8N, 99), 8printloop(8inc(8N))))) )

ORDER_PP( 8printloop(1) ) // 1, ..., 99,


=={{header|PARI/GP}}==
n=0; while(1,print(++n))

=={{header|Pascal}}==
See also [[Integer_sequence#Delphi | Delphi]]
{{works with|Free_Pascal}}
Quad word has the largest positive range of all ordinal types
Program IntegerSequenceLimited;
var
Number: QWord = 0; // 8 bytes, unsigned: 0 .. 18446744073709551615
begin
repeat
writeln(Number);
inc(Number);
until false;
end.

{{libheader|GMP}}
With the gmp library your patience is probably the limit :-)
Program IntegerSequenceUnlimited;

uses
gmp;

var
Number: mpz_t;

begin
mpz_init(Number); //* zero now *//
repeat
mp_printf('%Zd' + chr(13) + chr(10), @Number);
mpz_add_ui(Number, Number, 1); //* increase Number *//
until false;
end.


=={{header|Perl}}==
my $i = 0;
print ++$i, "\n" while 1;


=={{header|Perl 6}}==
.say for 1..*

=={{header|PicoLisp}}==
(for (I 1 T (inc I))
(printsp I) )


=={{header|PL/I}}==

infinity: procedure options (main);
declare k fixed decimal (30);
put skip edit
((k do k = 1 to 999999999999999999999999999998))(f(31));
end infinity;


=={{header|PostScript}}==
{{libheader|initlib}}

1 {succ dup =} loop


=={{header|Prolog}}==
loop(I) :-
writeln(I),
I1 is I+1,
loop(I1).


===Constraint Handling Rules===
Works with SWI-Prolog and library '''CHR''' written by '''Tom Schrijvers''' and '''Jan Wielemaker'''
:- use_module(library(chr)).

:- chr_constraint loop/1.

loop(N) <=> writeln(N), N1 is N+1, loop(N1).


=={{header|PureBasic}}==
OpenConsole()
Repeat
a.q+1
PrintN(Str(a))
ForEver


=={{header|Python}}==
i=1
while i:
print(i)
i += 1


Or, alternatively:
from itertools import count

for i in count():
print(i)


Pythons integers are of arbitrary large precision and so programs would probably keep going until OS or hardware system failure.

=={{header|Racket}}==

Racket uses bignums, so counting should continue up to very large numbers. Naturally, printing these numbers will consume quite a bit of power.

#lang racket
(for ([i (in-naturals)]) (displayln i))


=={{header|Raven}}==
Raven uses signed 32 bit integer values.
1 as $i
repeat TRUE while
$i "%d\n" print $i 1000 + as $i


=={{header|Retro}}==
Retro uses signed integer values.

0 [ [ putn space ] sip 1+ dup 0 <> ] while drop

=={{header|REXX}}==
/*count all the protons, electrons, & whatnot in the universe, and then */
/*keep counting. According to some pundits in-the-know, one version of */
/*the big-bang theory is that the universe will collapse back to where */
/*it started, and this computer program will be still counting. */
/*┌────────────────────────────────────────────────────────────────────┐
│ Count all the protons (and electrons!) in the universe, and then │
│ keep counting. According to some pundits in-the-know, one version │
│ of the big-bang theory is that the universe will collapse back to │
│ where it started, and this computer program will still be counting.│
│ │
│ │
│ According to Sir Author Eddington in 1938 at his Tamer Lecture at │
│ Trinity Collecge (Cambridge), he postulated that there are exactly │
│ │
│ 136 ∙ 2^245 │
│ │
│ protons in the universe and the same number of electrons, which is │
│ equal to around 1.57477e+79. │
│ │
│ Although, a modern extimate is around 10^80. │
│ │
│ │
│ One estimate of the age of the universe is 13.7 billion years, │
│ or 4.32e+17 seconds. This'll be a piece of cake. │
└────────────────────────────────────────────────────────────────────┘*/
numeric digits 1000000000 /*just in case the universe slows down. */

/*this version of a DO loop increments J*/
do j=1 /*Sir Eddington's number, then a googol.*/
say j /*first, destroy some electrons. */
end
say 42 /*(see below for explanation of 42.) */
exit

/*This REXX program (as it will be limited to the NUMERIC DIGITS above, */
/*will only count up to 1000000000000000000000000000000000000000000... */
/*000000000000000000000000000000000000000000000000000000000000000000000 */
/* ... for another (almost) one billion more zeroes (then subtract 1).*/

/*if we can count 1,000 times faster than the fastest PeeCee, and we */
/*started at the moment of the big-bang, we'd be at only 1.72e+28, so */
/*we still have a little ways to go, eh? */

/*To clarify, we'd be 28 zeroes into a million zeroes. If PC's get */
/*1,000 times faster again, that would be 31 zeroes into a million. */

/*It only took Deep Thought 7.5 million years to come up with the */
/*answer to everything (and it double-checked the answer). It was 42.*/


=={{header|Ruby}}==

i = 0
puts(i += 1) while true


Ruby does not limit the size of numbers.

=={{header|Run BASIC}}==
while 1
i = i + 1
print i
wend

Eventually as it gets larger it becomes a floating point.

=={{header|Rust}}==
extern mod extra;
use extra::bigint::BigUint;
use std::num::One;

fn main() {
let one: BigUint = One::one();
let mut i: BigUint = One::one();

loop {
println(fmt!("%?", i.to_str()));
i = i + one;
}
}

Loops endlessly.

=={{header|Salmon}}==

Salmon has built-in unlimited-precision integer arithmetic, so these examples will all continue printing decimal values indefinitely, limited only by the amount of memory available (it requires O(log(n)) bits to store an integer n, so if your computer has 1 GB of memory, it will count to a number with on the order of 2^{80} digits).

iterate (i; [0...+oo])
i!;


or

for (i; 0; true)
i!;


or

variable i := 0;
while (true)
{
i!;
++i;
};


=={{header|Scala}}==
Stream from 1 foreach println

=={{header|Scheme}}==


(let loop ((i 1))
(display i) (newline)
(loop (+ 1 i)))


Scheme does not limit the size of numbers.

=={{header|Seed7}}==
Limit 2147483647:
$ include "seed7_05.s7i";

const proc: main is func
local
var integer: number is 0;
begin
repeat
incr(number);
writeln(number);
until number = 2147483647;
end func;

"Forever":
$ include "seed7_05.s7i";
include "bigint.s7i";

const proc: main is func
local
var bigInteger: number is 1_;
begin
repeat
writeln(number);
incr(number);
until FALSE;
end func;


=={{header|Smalltalk}}==
i := 0.
[
Stdout print:i; cr.
i := i + 1
] loop

will run forever.

=={{header|Tcl}}==
package require Tcl 8.5
while true {puts [incr i]}


=={{header|TUSCRIPT}}==
$$ MODE TUSCRIPT
LOOP n=0,999999999
n=n+1
ENDLOOP


=={{header|UNIX Shell}}==

#!/bin/sh
num=0
while true; do
echo $num
num=`expr $num + 1`
done


=={{header|Vala}}==

uint i = 0;
while (++i < uint.MAX)
stdout.printf("%u\n", i);


=={{header|Visual Basic .NET}}==
Visual Basic .NET supports an unsigned, 64 bit Integer (maxing out at a whopping 9 223 372 036 854 775 807), however, this is not an intrinsic type, it is a structure that is not supported by the CLS (Common Language Specification).

The CLS supported type (also a structure) is Decimal (an even more impressive range from positive 79 228 162 514 264 337 593 543 950 335 to negative 79 228 162 514 264 337 593 543 950 335), I have used a standard CLS Integer intrinsic type (from -2 147 483 648 through 2 147 483 647).

Note that attempting to store any value larger than the maximum value of any given type (say 2 147 483 648 for an Integer) will result in an OverflowException being thrown ("Arithmetic operation resulted in an overflow.")

For i As Integer = 0 To Integer.MaxValue
Console.WriteLine(i)
Next


=={{header|XPL0}}==
\Displays integers up to 2^31-1 = 2,147,483,647
code CrLf=9, IntOut=11;
int N;
[N:= 1;
repeat IntOut(0, N); CrLf(0);
N:= N+1;
until N<0;
]


[[Category:Iteration]]

Sum multiples of 3 and 5

Pete: Add a Limbo version


{{task}}The objective is to write a function that finds the sum of all positive multiples of 3 or 5 below ''n''. Show output for ''n'' = 1000.

'''Extra credit:''' do this efficiently for ''n'' = 1e20 or higher.

== {{header|APL}} ==
⎕IO←0
{+/((0=3|a)∨0=5|a)/a←⍳⍵} 1000
[http://ngn.github.io/apl/web/index.html#code=%7B+/%28%280%3D3%7Ca%29%u22280%3D5%7Ca%29/a%u2190%u2373%u2375%7D%201000,run=1 run]
{{out}}
233168


=={{header|AWK}}==
{{incorrect|AWK|Extra credit answer is 2333333333333333333316666666666666666668}}
Save this into file "sum_multiples_of3and5.awk"
#!/usr/bin/awk -f
{
n = $1-1;
printf("%.60g\n",sum(n,3)+sum(n,5)-sum(n,15));
}
function sum(n,d) {
m = int(n/d);
return (d*m*(m+1)/2);
}

Output of Gawk 4.0.1 and mawk
$ echo -e '1000\n1e20' |awk -f sum_multiples_of3and5.awk 
233168
2333333333333332940795175780693005303808


== {{header|BASIC}} ==
{{works with|FreeBASIC}}
Declare function mulsum35(n as integer) as integer
Function mulsum35(n as integer) as integer
Dim s as integer
For i as integer = 1 to n - 1
If (i mod 3 = 0) or (i mod 5 = 0) then
s += i
End if
Next i
Return s
End Function
Print mulsum35(1000)
Sleep
End

{{out}}
233168


=={{header|C#}}==
The following C# 5 / .Net 4 code is an efficient solution in that it does not iterate through the numbers 1 ... n - 1 in order to calculate the answer. On the other hand, the System.Numerics.BigInteger class (.Net 4 and upwards) is not itself efficient because calculations take place in software instead of hardware. Consequently, it may be faster to conduct the calculation for smaller values with native ("primitive") types using a 'brute force' iteration approach.


using System;
using System.Collections.Generic;
using System.Numerics;

namespace RosettaCode
{
class Program
{
static void Main()
{
List candidates = new List(new BigInteger[] { 1000, 100000, 10000000, 10000000000, 1000000000000000 });
candidates.Add(BigInteger.Parse("100000000000000000000"));

foreach (BigInteger candidate in candidates)
{
BigInteger c = candidate - 1;
BigInteger answer3 = GetSumOfNumbersDivisibleByN(c, 3);
BigInteger answer5 = GetSumOfNumbersDivisibleByN(c, 5);
BigInteger answer15 = GetSumOfNumbersDivisibleByN(c, 15);

Console.WriteLine("The sum of numbers divisible by 3 or 5 between 1 and {0} is {1}", c, answer3 + answer5 - answer15);
}

Console.ReadKey(true);
}

private static BigInteger GetSumOfNumbersDivisibleByN(BigInteger candidate, uint n)
{
BigInteger largest = candidate;
while (largest % n > 0)
largest--;
BigInteger totalCount = (largest / n);
BigInteger pairCount = totalCount / 2;
bool unpairedNumberOnFoldLine = (totalCount % 2 == 1);
BigInteger pairSum = largest + n;
return pairCount * pairSum + (unpairedNumberOnFoldLine ? pairSum / 2 : 0);
}

}
}

{{out}}
The sum of numbers divisible by 3 or 5 between 1 and 999 is 233168

The sum of numbers divisible by 3 or 5 between 1 and 99999 is 2333316668

The sum of numbers divisible by 3 or 5 between 1 and 9999999 is 23333331666668

The sum of numbers divisible by 3 or 5 between 1 and 9999999999 is 23333333331666666668

The sum of numbers divisible by 3 or 5 between 1 and 999999999999999 is 233333333333333166666666666668

The sum of numbers divisible by 3 or 5 between 1 and 99999999999999999999 is 2333333333333333333316666666666666666668

=={{header|C++}}==

#include

//--------------------------------------------------------------------------------------------------
typedef unsigned long long bigInt;

using namespace std;
//--------------------------------------------------------------------------------------------------
class m35
{
public:
void doIt( bigInt i )
{
bigInt sum = 0;
for( bigInt a = 1; a < i; a++ )
if( !( a % 3 ) || !( a % 5 ) ) sum += a;

cout << "Sum is " << sum << " for n = " << i << endl << endl;
}

// this method uses less than half iterations than the first one
void doIt_b( bigInt i )
{
bigInt sum = 0;
for( bigInt a = 0; a < 28; a++ )
{
if( !( a % 3 ) || !( a % 5 ) )
{
sum += a;
for( bigInt s = 30; s < i; s += 30 )
if( a + s < i ) sum += ( a + s );

}
}
cout << "Sum is " << sum << " for n = " << i << endl << endl;
}
};
//--------------------------------------------------------------------------------------------------
int main( int argc, char* argv[] )
{
m35 m; m.doIt( 1000 );
return system( "pause" );
}

{{out}}
Sum is 233168 for n = 1000

=={{header|Clojure}}==
'''Unoptimized'''
(defn sum-multiples
([n] (sum-multiples (dec n) 0))
([n sum]
(if (< n 3)
sum
(if (or (= 0 (mod n 3)) (= 0 (mod n 5)))
(recur (dec n) (+ sum n))
(recur (dec n) sum)))))


=={{header|COBOL}}==

Using OpenCOBOL.


Identification division.
Program-id. three-five-sum.

Data division.
Working-storage section.
01 ws-the-limit pic 9(18) value 1000.
01 ws-the-number pic 9(18).
01 ws-the-sum pic 9(18).
01 ws-sum-out pic z(18).

Procedure division.
Main-program.
Perform Do-sum
varying ws-the-number from 1 by 1
until ws-the-number = ws-the-limit.
Move ws-the-sum to ws-sum-out.
Display "Sum = " ws-sum-out.
End-run.

Do-sum.
If function mod(ws-the-number, 3) = zero
or function mod(ws-the-number, 5) = zero
then add ws-the-number to ws-the-sum.


Output:

Sum = 233168


Using triangular numbers:

Identification division.
Program-id. three-five-sum-fast.

Data division.
Working-storage section.
01 ws-num pic 9(18) value 1000000000.
01 ws-n5 pic 9(18).
01 ws-n3 pic 9(18).
01 ws-n15 pic 9(18).
01 ws-sum pic 9(18).
01 ws-out.
02 ws-out-num pic z(18).
02 filler pic x(3) value " = ".
02 ws-out-sum pic z(18).

Procedure division.
Main-program.
Perform
call "tri-sum" using ws-num 3 by reference ws-n3
call "tri-sum" using ws-num 5 by reference ws-n5
call "tri-sum" using ws-num 15 by reference ws-n15
end-perform.
Compute ws-sum = ws-n3 + ws-n5 - ws-n15.
Move ws-sum to ws-out-sum.
Move ws-num to ws-out-num.
Display ws-out.



Identification division.
Program-id. tri-sum.

Data division.
Working-storage section.
01 ws-n1 pic 9(18).
01 ws-n2 pic 9(18).

Linkage section.
77 ls-num pic 9(18).
77 ls-fac pic 9(18).
77 ls-ret pic 9(18).

Procedure division using ls-num, ls-fac, ls-ret.
Compute ws-n1 = (ls-num - 1) / ls-fac.
Compute ws-n2 = ws-n1 + 1.
Compute ls-ret = ls-fac * ws-n1 * ws-n2 / 2.
goback.


Output:

1000000000 = 233333333166666668


=={{header|Component Pascal}}==
BlackBox Component Builder

MODULE Sum3_5;
IMPORT StdLog, Strings, Args;

PROCEDURE DoSum(n: INTEGER):INTEGER;
VAR
i,sum: INTEGER;
BEGIN
sum := 0;i := 0;
WHILE (i < n) DO
IF (i MOD 3 = 0) OR (i MOD 5 = 0) THEN INC(sum,i) END;
INC(i)
END;
RETURN sum
END DoSum;

PROCEDURE Compute*;
VAR
params: Args.Params;
i,n,res: INTEGER;
BEGIN
Args.Get(params);
Strings.StringToInt(params.args[0],n,res);
StdLog.String("Sum: ");StdLog.Int(DoSum(n)); StdLog.Ln
END Compute;

END Sum3_5.

Execute: ^Q Sum3_5.Compute 1000 ~

Output:

Sum: 233168



=={{header|D}}==
import std.stdio, std.bigint;

BigInt sum35(in BigInt n) pure /*nothrow*/ {
static BigInt sumMul(in BigInt n, in int f) pure /*nothrow*/ {
immutable n1 = (n - 1) / f;
return f * n1 * (n1 + 1) / 2;
}

return sumMul(n, 3) + sumMul(n, 5) - sumMul(n, 15);
}

void main() {
1000.BigInt.sum35.writeln;
(10.BigInt ^^ 20).sum35.writeln;
}

{{out}}
233168
2333333333333333333316666666666666666668


=={{header|Déjà Vu}}==
sum-divisible n:
0
for i range 1 -- n:
if or = 0 % i 3 = 0 % i 5:
+ i

!. sum-divisible 1000

{{out}}
233168


=={{header|Erlang}}==
sum_3_5(X) when is_number(X) -> sum_3_5(erlang:round(X)-1, 0).
sum_3_5(X, Total) when X < 3 -> Total;
sum_3_5(X, Total) when X rem 3 =:= 0 orelse X rem 5 =:= 0 ->
sum_3_5(X-1, Total+X);
sum_3_5(X, Total) ->
sum_3_5(X-1, Total).

io:format("~B~n", [sum_3_5(1000)]).


{{out}}
233168



=={{header|F_Sharp|F#}}==
{{trans|Perl 6}}
let sum35 (n: int) =
Seq.init n (fun i -> i)
|> Seq.fold (fun sum i -> if i % 3 = 0 || i % 5 = 0 then sum + i else sum) 0

printfn "%d" (sum35 1000)
printfn "----------"

let sumUpTo (n : bigint) = n * (n + 1I) / 2I

let sumMultsBelow k n = k * (sumUpTo ((n-1I)/k))

let sum35fast n = (sumMultsBelow 3I n) + (sumMultsBelow 5I n) - (sumMultsBelow 15I n)

[for i = 0 to 30 do yield i]
|> List.iter (fun i -> printfn "%A" (sum35fast (bigint.Pow(10I, i))))

{{out}}
233168
----------
0
23
2318
233168
23331668
2333316668
233333166668
23333331666668
2333333316666668
233333333166666668
23333333331666666668
2333333333316666666668
233333333333166666666668
23333333333331666666666668
2333333333333316666666666668
233333333333333166666666666668
23333333333333331666666666666668
2333333333333333316666666666666668
233333333333333333166666666666666668
23333333333333333331666666666666666668
2333333333333333333316666666666666666668
233333333333333333333166666666666666666668
23333333333333333333331666666666666666666668
2333333333333333333333316666666666666666666668
233333333333333333333333166666666666666666666668
23333333333333333333333331666666666666666666666668
2333333333333333333333333316666666666666666666666668
233333333333333333333333333166666666666666666666666668
23333333333333333333333333331666666666666666666666666668
2333333333333333333333333333316666666666666666666666666668
233333333333333333333333333333166666666666666666666666666668


=={{header|FBSL}}==
Derived from BASIC version
#APPTYPE CONSOLE

FUNCTION sumOfThreeFiveMultiples(n AS INTEGER)
DIM sum AS INTEGER
FOR DIM i = 1 TO n - 1
IF (NOT (i MOD 3)) OR (NOT (i MOD 5)) THEN
INCR(sum, i)
END IF
NEXT
RETURN sum
END FUNCTION

PRINT sumOfThreeFiveMultiples(1000)
PAUSE

Output
233168

Press any key to continue...


=={{header|Forth}}==
: main ( n -- )
0 swap
3 do
i 3 mod 0= if
i +
else i 5 mod 0= if
i +
then then
loop
. ;

1000 main \ 233168 ok


Another FORTH version using the Inclusion/Exclusion Principle. The result is a double precision integer (128 bits on a 64 bit computer) which lets us calculate up to 10^18 (the max precision of a single precision 64 bit integer) Since this is Project Euler problem 1, the name of the main function is named euler1tower.

: third 2 pick ;

: >dtriangular ( n -- d )
dup 1+ m* d2/ ;

: sumdiv ( n m -- d )
dup >r / >dtriangular r> 1 m*/ ;

: sumdiv_3,5 ( n -- n )
dup 3 sumdiv third 5 sumdiv d+ rot 15 sumdiv d- ;

: euler1 ( -- n )
999 sumdiv_3,5 drop ;

: euler1tower ( -- )
1 \ power of 10
19 0 DO
cr dup 19 .r space dup 1- sumdiv_3,5 d.
10 *
LOOP drop ;

euler1 . 233168 ok
euler1tower
1 0
10 23
100 2318
1000 233168
10000 23331668
100000 2333316668
1000000 233333166668
10000000 23333331666668
100000000 2333333316666668
1000000000 233333333166666668
10000000000 23333333331666666668
100000000000 2333333333316666666668
1000000000000 233333333333166666666668
10000000000000 23333333333331666666666668
100000000000000 2333333333333316666666666668
1000000000000000 233333333333333166666666666668
10000000000000000 23333333333333331666666666666668
100000000000000000 2333333333333333316666666666666668
1000000000000000000 233333333333333333166666666666666668 ok


=={{header|Groovy}}==
def sumMul = { n, f -> BigInteger n1 = (n - 1) / f; f * n1 * (n1 + 1) / 2 }
def sum35 = { sumMul(it, 3) + sumMul(it, 5) - sumMul(it, 15) }

Test Code:
[(1000): 233168, (10e20): 233333333333333333333166666666666666666668].each { arg, value ->
println "Checking $arg == $value"
assert sum35(arg) == value
}

{{out}}
Checking 1000 == 233168
Checking 1.0E+21 == 233333333333333333333166666666666666666668


=={{header|Haskell}}==
{{Haskell}}
Also a method for calculating sum of multiples of any list of numbers.
import Data.List (nub)

sumMul n f = f * n1 * (n1 + 1) `div` 2 where n1 = (n - 1) `div` f
sum35 n = sumMul n 3 + sumMul n 5 - sumMul n 15

-- below are for variable length inputs
pairLCM [] = []
pairLCM (x:xs) = map (lcm x) xs ++ pairLCM xs

sumMulS _ [] = 0
sumMulS n s = sum (map (sumMul n) ss) - sumMulS n (pairLCM ss)
where ss = nub s

main = do
print $ sum35 1000
print $ sum35 100000000000000000000000000000000
print $ sumMulS 1000 [3,5]
print $ sumMulS 10000000 [2,3,5,7,11,13]

{{out}}
233168
2333333333333333333333333333333316666666666666666666666666666668
233168
41426953573049


=={{header|Icon}} and {{header|Unicon}}==

The following works in both langauges.

procedure main(A)
n := (integer(A[1]) | 1000)-1
write(sum(n,3)+sum(n,5)-sum(n,15))
end

procedure sum(n,m)
return m*((n/m)*(n/m+1)/2)
end


Sample output:


->sm35
233168
->sm35 100000000000000000000
2333333333333333333316666666666666666668
->


=={{header|J}}==


mp =: $:~ :(+/ .*) NB. matrix product
f =: (mp 0 = [: */ 3 5 |/ ])@:i.
assert 233168 -: f 1000 NB. ****************** THIS IS THE ANSWER FOR 1000

For the efficient computation with large n, we start with observation that the sum of these multiples with the reversed list follows a pattern.

g =: #~ (0 = [: */ 3 5&(|/))
assert 0 3 5 6 9 10 12 15 18 20 21 24 25 27 30 33 35 36 39 40 42 45 48 -: g i. 50
assert 48 48 47 46 48 46 47 48 48 47 46 48 46 47 48 48 47 46 48 46 47 48 48 -: (+ |.)g i. 50 NB. the pattern

assert (f -: -:@:(+/)@:(+|.)@:g@:i.) 50 NB. half sum of the pattern.

NB. continue...

Stealing the idea from the python implementation to use 3 simple patterns rather than 1 complicated pattern,

first =: 0&{
last =: first + skip * <.@:(skip %~ <:@:(1&{) - first)
skip =: 2&{
terms =: >:@:<.@:(skip %~ last - first)
sum_arithmetic_series =: -:@:(terms * first + last) NB. sum_arithmetic_series FIRST LAST SKIP
NB. interval is [FIRST, LAST)
NB. sum_arithmetic_series is more general than required.

(0,.10 10000 10000000000000000000x)(,"1 0"1 _)3 5 15x NB. demonstration: form input vectors for 10, ten thousand, and 1*10^(many)
0 10 3
0 10 5
0 10 15

0 10000 3
0 10000 5
0 10000 15

0 10000000000000000000 3
0 10000000000000000000 5
0 10000000000000000000 15



(0,.10 10000 10000000000000000000x)+`-/"1@:(sum_arithmetic_series"1@:(,"1 0"1 _))3 5 15x
23 23331668 23333333333333333331666666666666666668


=={{header|Java}}==
class SumMultiples {
public static long getSum(long n) {
long sum = 0;
for (int i = 3; i < n; i++) {
if (i % 3 == 0 || i % 5 == 0) sum += i;
}
return sum;
}
public static void main(String[] args) {
System.out.println(getSum(1000));
}
}

{{out}}
233168




=={{header|Lasso}}==
local(limit = 1)
while(#limit <= 100000) => {^
local(s = 0)
loop(-from=3,-to=#limit-1) => {
not (loop_count % 3) || not (loop_count % 5) ? #s += loop_count
}
'The sum of multiples of 3 or 5 between 1 and '+(#limit-1)+' is: '+#s+'\r'
#limit = integer(#limit->asString + '0')
^}

{{out}}
The sum of multiples of 3 or 5 between 1 and 0 is: 0
The sum of multiples of 3 or 5 between 1 and 9 is: 23
The sum of multiples of 3 or 5 between 1 and 99 is: 2318
The sum of multiples of 3 or 5 between 1 and 999 is: 233168
The sum of multiples of 3 or 5 between 1 and 9999 is: 23331668
The sum of multiples of 3 or 5 between 1 and 99999 is: 2333316668


=={{header|Limbo}}==

Uses the IPints library when the result will be very large.

implement Sum3and5;

include "sys.m"; sys: Sys;
include "draw.m";
include "ipints.m"; ipints: IPints;
IPint: import ipints;

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

ints: array of ref IPint;

init(nil: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
ipints = load IPints IPints->PATH;

# We use 1, 2, 3, 5, and 15:
ints = array[16] of ref IPint;
for(i := 0; i < len ints; i++)
ints[i] = IPint.inttoip(i);

args = tl args;
while(args != nil) {
h := hd args;
args = tl args;
# If it's big enough that the result might not
# fit inside a big, we use the IPint version.
if(len h > 9) {
sys->print("%s\n", isum3to5(IPint.strtoip(h, 10)).iptostr(10));
} else {
sys->print("%bd\n", sum3to5(big h));
}
}
}

triangle(n: big): big
{
return((n * (n + big 1)) / big 2);
}

sum_multiples(n: big, limit: big): big
{
return(n * triangle((limit - big 1) / n));
}

sum3to5(limit: big): big
{
return(
sum_multiples(big 3, limit) +
sum_multiples(big 5, limit) -
sum_multiples(big 15, limit));
}

itriangle(n: ref IPint): ref IPint
{
return n.mul(n.add(ints[1])).div(ints[2]).t0;
}

isum_multiples(n: ref IPint, limit: ref IPint): ref IPint
{
return n.mul(itriangle(limit.sub(ints[1]).div(n).t0));
}

isum3to5(limit: ref IPint): ref IPint
{
return(
isum_multiples(ints[3], limit).
add(isum_multiples(ints[5], limit)).
sub(isum_multiples(ints[15], limit)));
}


{{out}}
% sum3and5 1000 100000000000000000000
233168
2333333333333333333316666666666666666668



=={{header|Mathematica}}==
sum35[n_] :=
Sum[k, {k, 3, n - 1, 3}] + Sum[k, {k, 5, n - 1, 5}] -
Sum[k, {k, 15, n - 1, 15}]

sum35[1000]

{{out}}
233168

sum35[10^20]
{{out}}
233333333333333333333166666666666666666668


Another alternative is
Union @@ Range[0, 999, {3, 5}] // Tr

=={{header|MATLAB}} / {{header|Octave}}==
{{incorrect|MATLAB|Extra credit answer is 2333333333333333333316666666666666666668}}
{{incorrect|Octave|Extra credit answer is 2333333333333333333316666666666666666668}}
n=1:999; sum(n(mod(n,3)==0 | mod(n,5)==0))
ans =  233168

Another alternative is
n=1000; sum(0:3:n-1)+sum(0:5:n-1)-sum(0:15:n-1)
Of course, its more efficient to use [http://mathforum.org/library/drmath/view/57919.html Gauss' approach] of adding subsequent integers
n=1e20-1;
n3=floor(n/3);
n5=floor(n/5);
n15=floor(n/15);
(3*n3*(n3+1) + 5*n5*(n5+1) - 15*n15*(n15+1))/2

ans =  2.33333333333333e+39

=={{header|Maxima}}==
sumi(n, incr):= block([kmax: quotient(n, incr)],
''(ev(sum(incr*k, k, 1, kmax), simpsum)));

sum35(n):=sumi(n, 3) + sumi(n, 5) - sumi(n, 15);

sum35(1000);
sum35(10^20);

Output:
(%i16) sum35(1000);
(%o16) 234168
(%i17) sum35(10^20);
(%o17) 2333333333333333333416666666666666666668


=={{header|NetRexx}}==
Portions translation of [[#Perl 6|Perl 6]]
/* NetRexx */
options replace format comments java crossref symbols nobinary
numeric digits 40

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method summing(maxLimit = 1000) public static
mult = 0
loop mv = 0 while mv < maxLimit
if mv // 3 = 0 | mv // 5 = 0 then
mult = mult + mv
end mv
return mult

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- translation of perl 6
method sum_mults(first, limit) public static
last = limit - 1
last = last - last // first
sum = (last / first) * (first + last) % 2
return sum

method sum35(maxLimit) public static
return sum_mults(3, maxLimit) + sum_mults(5, maxLimit) - sum_mults(15, maxLimit)

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static

offset = 30
incr = 10

say 'Limit'.right(offset) || '|' || 'Sum'
say '-'.copies(offset) || '+' || '-'.copies(60)
timing = System.nanoTime
sum = summing()
timing = System.nanoTime - timing
say 1000.format.right(offset)'|'sum
say 'Elapsed time:' Rexx(timing * 1e-9).format(4, 6)'s'
say

say 'Limit'.right(offset) || '|' || 'Sum'
say '-'.copies(offset) || '+' || '-'.copies(60)
tmax = 1e+6
timing = System.nanoTime
mm = 1
loop while mm <= tmax
say mm.right(offset)'|'summing(mm)
mm = mm * incr
end
timing = System.nanoTime - timing
say 'Elapsed time:' Rexx(timing * 1e-9).format(4, 6)'s'
say

say 'Limit'.right(offset) || '|' || 'Sum'
say '-'.copies(offset) || '+' || '-'.copies(60)
timing = System.nanoTime
sum = sum35(1000)
timing = System.nanoTime - timing
say 1000.format.right(offset)'|'sum
say 'Elapsed time:' Rexx(timing * 1e-9).format(4, 6)'s'
say

say 'Limit'.right(offset) || '|' || 'Sum'
say '-'.copies(offset) || '+' || '-'.copies(60)
tmax = 1e+27
timing = System.nanoTime
mm = 1
loop while mm <= tmax
say mm.right(offset)'|'sum35(mm)
mm = mm * incr
end
timing = System.nanoTime - timing
say 'Elapsed time:' Rexx(timing * 1e-9).format(4, 6)'s'
say
return

{{out}}

Limit|Sum
------------------------------+------------------------------------------------------------
1000|233168
Elapsed time: 0.097668s

Limit|Sum
------------------------------+------------------------------------------------------------
1|0
10|23
100|2318
1000|233168
10000|23331668
100000|2333316668
1000000|233333166668
Elapsed time: 11.593837s

Limit|Sum
------------------------------+------------------------------------------------------------
1000|233168
Elapsed time: 0.000140s

Limit|Sum
------------------------------+------------------------------------------------------------
1|0
10|23
100|2318
1000|233168
10000|23331668
100000|2333316668
1000000|233333166668
10000000|23333331666668
100000000|2333333316666668
1000000000|233333333166666668
10000000000|23333333331666666668
100000000000|2333333333316666666668
1000000000000|233333333333166666666668
10000000000000|23333333333331666666666668
100000000000000|2333333333333316666666666668
1000000000000000|233333333333333166666666666668
10000000000000000|23333333333333331666666666666668
100000000000000000|2333333333333333316666666666666668
1000000000000000000|233333333333333333166666666666666668
10000000000000000000|23333333333333333331666666666666666668
100000000000000000000|2333333333333333333316666666666666666668
1000000000000000000000|233333333333333333333166666666666666666668
10000000000000000000000|23333333333333333333331666666666666666666668
100000000000000000000000|2333333333333333333333316666666666666666666668
1000000000000000000000000|233333333333333333333333166666666666666666666668
10000000000000000000000000|23333333333333333333333331666666666666666666666668
100000000000000000000000000|2333333333333333333333333316666666666666666666666668
1000000000000000000000000000|233333333333333333333333333166666666666666666666666668
Elapsed time: 0.005545s


=={{header|МК-61/52}}==
П1 0 П0 3 П4 ИП4 3 / {x} x#0
17 ИП4 5 / {x} x=0 21 ИП0 ИП4 +
П0 КИП4 ИП1 ИП4 - x=0 05 ИП0 С/П


Input: ''n''.

Output for n = 1000: ''233168''.

=={{header|PARI/GP}}==
ct(n,k)=n=n\k;k*n*(n+1)/2;
a(n)=ct(n,3)+ct(n,5)-ct(n,15);
a(1000)
a(1e20)

{{output}}
%1 = 234168
%2 = 2333333333333333333416666666666666666668


=={{header|Perl}}==
#!/usr/bin/perl
use strict ;
use warnings ;
use List::Util qw( sum ) ;

sub sum_3_5 {
my $limit = shift ;
return sum grep { $_ % 3 == 0 || $_ % 5 == 0 } ( 1..$limit - 1 ) ;
}

print "The sum is " . sum_3_5( 1000 ) . " !\n" ;

{{out}}
The sum is 233168 !


=={{header|Perl 6}}==
sub sum35($n) { [+] grep * %% (3|5), ^$n; }

say sum35 1000;

{{out}}
233168

Here's an analytical approach that scales much better for large values.
sub sum-mults($first, $limit) {
(my $last = $limit - 1) -= $last % $first;
($last div $first) * ($first + $last) div 2;
}

sub sum35(\n) {
sum-mults(3,n) + sum-mults(5,n) - sum-mults(15,n);
}

say sum35($_) for 1,10,100...10**30;

{{out}}
0
23
2318
233168
23331668
2333316668
233333166668
23333331666668
2333333316666668
233333333166666668
23333333331666666668
2333333333316666666668
233333333333166666666668
23333333333331666666666668
2333333333333316666666666668
233333333333333166666666666668
23333333333333331666666666666668
2333333333333333316666666666666668
233333333333333333166666666666666668
23333333333333333331666666666666666668
2333333333333333333316666666666666666668
233333333333333333333166666666666666666668
23333333333333333333331666666666666666666668
2333333333333333333333316666666666666666666668
233333333333333333333333166666666666666666666668
23333333333333333333333331666666666666666666666668
2333333333333333333333333316666666666666666666666668
233333333333333333333333333166666666666666666666666668
23333333333333333333333333331666666666666666666666666668
2333333333333333333333333333316666666666666666666666666668
233333333333333333333333333333166666666666666666666666666668


=={{header|Powershell}}==
Here is a cmdet that will provide the sum of unique multiples of any group of numbers below a given limit. I haven't attempted the extra credit here as the math is too complex for me at the moment.
function Get-SumOfMultiples
{
Param
(
[Parameter(
Position=0)]
$Cap = 1000,

[Parameter(
ValueFromRemainingArguments=$True)]
$Multiplier = (3,5)
)

$Multiples = @()
$Sum = 0
$multiplier |
ForEach-Object {
For($i = 1; $i -lt $Cap; $i ++)
{
If($i % $_ -eq 0)
{$Multiples += $i}
}
}

$Multiples |
select -Unique |
ForEach-Object {
$Sum += $_
}
$Sum
}

{{out}}
Get-SumOfMultiples

233168

{{out}}
Get-SumOfMultiples 1500 3 5 7 13

649444


=={{header|Prolog}}==
===Slow version===
sum_of_multiples_of_3_and_5_slow(N, TT) :-
sum_of_multiples_of_3_and_5(N, 1, 0, TT).

sum_of_multiples_of_3_and_5(N, K, S, S) :-
3 * K >= N.

sum_of_multiples_of_3_and_5(N, K, C, S) :-
T3 is 3 * K, T3 < N,
C3 is C + T3,
T5 is 5 * K,
( (T5 < N, K mod 3 =\= 0)
-> C5 is C3 + T5
; C5 = C3),
K1 is K+1,
sum_of_multiples_of_3_and_5(N, K1, C5, S).



===Fast version===
sum_of_multiples_of_3_and_5_fast(N, TT):-
maplist(compute_sum(N), [3,5,15], [TT3, TT5, TT15]),
TT is TT3 + TT5 - TT15.

compute_sum(N, N1, Sum) :-
( N mod N1 =:= 0
-> N2 is N div N1 - 1
; N2 is N div N1),
Sum is N1 * N2 * (N2 + 1) / 2.


Output :
 ?- sum_of_multiples_of_3_and_5_slow(1000, TT).
TT = 233168 .

?- sum_of_multiples_of_3_and_5_fast(100000000000000000000, TT).
TT = 2333333333333333333316666666666666666668.

=={{header|Python}}==
Three ways of performing the calculation are shown including direct calculation of the value without having to do explicit sums in sum35c()
def sum35a(n):
'Direct count'
# note: ranges go to n-1
return sum(x for x in range(n) if x%3==0 or x%5==0)

def sum35b(n):
"Count all the 3's; all the 5's; minus double-counted 3*5's"
# note: ranges go to n-1
return sum(range(3, n, 3)) + sum(range(5, n, 5)) - sum(range(15, n, 15))

def sum35c(n):
'Sum the arithmetic progressions: sum3 + sum5 - sum15'
consts = (3, 5, 15)
# Note: stop at n-1
divs = [(n-1) // c for c in consts]
sums = [d*c*(1+d)/2 for d,c in zip(divs, consts)]
return sums[0] + sums[1] - sums[2]

#test
for n in range(1001):
sa, sb, sc = sum35a(n), sum35b(n), sum35c(n)
assert sa == sb == sc # python tests aren't like those of c.

print('For n = %7i -> %i\n' % (n, sc))

# Pretty patterns
for p in range(7):
print('For n = %7i -> %i' % (10**p, sum35c(10**p)))

# Scalability
p = 20
print('\nFor n = %20i -> %i' % (10**p, sum35c(10**p)))


{{out}}
For n =    1000 -> 233168

For n = 1 -> 0
For n = 10 -> 23
For n = 100 -> 2318
For n = 1000 -> 233168
For n = 10000 -> 23331668
For n = 100000 -> 2333316668
For n = 1000000 -> 233333166668

For n = 100000000000000000000 -> 2333333333333333333316666666666666666668


=={{header|R}}==

m35 = function(n) sum(unique(c(
seq(3, n-1, by = 3), seq(5, n-1, by = 5))))
m35(1000) # 233168


=={{header|Racket}}==

#lang racket
(require math)

;;; A naive solution
(define (naive k)
(for/sum ([n (expt 10 k)]
#:when (or (divides? 3 n) (divides? 5 n)))
n))

(for/list ([k 7]) (naive k))


;;; Using the formula for an arithmetic sum
(define (arithmetic-sum a1 n Δa)
; returns a1+a2+...+an
(define an (+ a1 (* (- n 1) Δa)))
(/ (* n (+ a1 an)) 2))

(define (analytical k)
(define 10^k (expt 10 k))
(define (n d) (quotient (- 10^k 1) d))
(+ (arithmetic-sum 3 (n 3) 3)
(arithmetic-sum 5 (n 5) 5)
(- (arithmetic-sum 15 (n 15) 15))))

(for/list ([k 20]) (analytical k))

Output:

'(0 23 2318 233168 23331668 2333316668 233333166668)
'(0
23
2318
233168
23331668
2333316668
233333166668
23333331666668
2333333316666668
233333333166666668
23333333331666666668
2333333333316666666668
233333333333166666666668
23333333333331666666666668
2333333333333316666666666668
233333333333333166666666666668
23333333333333331666666666666668
2333333333333333316666666666666668
233333333333333333166666666666666668
23333333333333333331666666666666666668)


=={{header|REXX}}==
===version 1===
/* REXX ***************************************************************
* 14.05.2013 Walter Pachl
**********************************************************************/
Say mul35()
exit
mul35:
s=0
Do i=1 To 999
If i//3=0 | i//5=0 Then
s=s+i
End
Return s

Output:
233168


===version 2===
/* REXX ***************************************************************
* Translation from Perl6->NetRexx->REXX
* 15.05.2013 Walter Pachl
**********************************************************************/
Numeric Digits 100
call time 'R'
n=1
Do i=1 To 30
Say right(n,30) sum35(n)
n=n*10
End
Say time('E') 'seconds'
Exit

sum35: Procedure
Parse Arg maxLimit
return sum_mults(3, maxLimit) + sum_mults(5, maxLimit) - sum_mults(15, maxLimit)

sum_mults: Procedure
Parse Arg first, limit
last = limit - 1
last = last - last // first
sum = (last % first) * (first + last) % 2
return sum

Output:
                             1 0
10 23
100 2318
1000 233168
10000 23331668
100000 2333316668
1000000 233333166668
10000000 23333331666668
100000000 2333333316666668
1000000000 233333333166666668
10000000000 23333333331666666668
100000000000 2333333333316666666668
1000000000000 233333333333166666666668
10000000000000 23333333333331666666666668
100000000000000 2333333333333316666666666668
1000000000000000 233333333333333166666666666668
10000000000000000 23333333333333331666666666666668
100000000000000000 2333333333333333316666666666666668
1000000000000000000 233333333333333333166666666666666668
10000000000000000000 23333333333333333331666666666666666668
100000000000000000000 2333333333333333333316666666666666666668
1000000000000000000000 233333333333333333333166666666666666666668
10000000000000000000000 23333333333333333333331666666666666666666668
100000000000000000000000 2333333333333333333333316666666666666666666668
1000000000000000000000000 233333333333333333333333166666666666666666666668
10000000000000000000000000 23333333333333333333333331666666666666666666666668
100000000000000000000000000 2333333333333333333333333316666666666666666666666668
1000000000000000000000000000 233333333333333333333333333166666666666666666666666668
10000000000000000000000000000 23333333333333333333333333331666666666666666666666666668
100000000000000000000000000000 2333333333333333333333333333316666666666666666666666666668
0 milliseconds with rexx m35a > m35a.txt
46 millisecond with rexx m35a


===version 3===
This version automatically adjusts the numeric digits.

A little extra code was added to format the output nicely.

The formula used is a form of the Gauss Summation formula.
/*REXX pgm sums all integers from 1──>N─1 that're multiples of 3 or 5.*/
parse arg N t .; if N=='' then N=1000; if t=='' then t=1
numeric digits 9999; numeric digits max(9,20*length(N*10**t))
say 'The sum of all positive integers that are a multiple of 3 and 5 are:'
say /* [↓] change the look of nE+nn */
do t; parse value format(N,2,1,,0) 'E0' with y 'E' _ .; _=_+0
y=right((m/1)'e'_,5)'-1' /*allows for a bug in some REXXes*/
if t==1 then y=N-1 /*handle special case of one-time*/
sum=sumDivisors(N-1,3) + sumDivisors(N-1,5) - sumDivisors(N-1,3*5)
say 'integers from 1 ──►' y " is " sum
N=N*10 /*multiply by ten for next round.*/
end /*t*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────SUMDIVISORS subroutine──────────────*/
sumDivisors: procedure; parse arg x,d; _=x%d; return d*_*(_+1)%2

'''output''' when using the default input:

The sum of all positive integers that are a multiple of 3 and 5 are:

integers from 1 ──► 999 is 233168

'''output''' when using the input of: 1 80

The sum of all positive integers that are a multiple of 3 and 5 are:

integers from 1 ──► 1-1 is 0
integers from 1 ──► 1e1-1 is 23
integers from 1 ──► 1e2-1 is 2318
integers from 1 ──► 1e3-1 is 233168
integers from 1 ──► 1e4-1 is 23331668
integers from 1 ──► 1e5-1 is 2333316668
integers from 1 ──► 1e6-1 is 233333166668
integers from 1 ──► 1e7-1 is 23333331666668
integers from 1 ──► 1e8-1 is 2333333316666668
integers from 1 ──► 1e9-1 is 233333333166666668
integers from 1 ──► 1e10-1 is 23333333331666666668
integers from 1 ──► 1e11-1 is 2333333333316666666668
integers from 1 ──► 1e12-1 is 233333333333166666666668
integers from 1 ──► 1e13-1 is 23333333333331666666666668
integers from 1 ──► 1e14-1 is 2333333333333316666666666668
integers from 1 ──► 1e15-1 is 233333333333333166666666666668
integers from 1 ──► 1e16-1 is 23333333333333331666666666666668
integers from 1 ──► 1e17-1 is 2333333333333333316666666666666668
integers from 1 ──► 1e18-1 is 233333333333333333166666666666666668
integers from 1 ──► 1e19-1 is 23333333333333333331666666666666666668
integers from 1 ──► 1e20-1 is 2333333333333333333316666666666666666668
integers from 1 ──► 1e21-1 is 233333333333333333333166666666666666666668
integers from 1 ──► 1e22-1 is 23333333333333333333331666666666666666666668
integers from 1 ──► 1e23-1 is 2333333333333333333333316666666666666666666668
integers from 1 ──► 1e24-1 is 233333333333333333333333166666666666666666666668
integers from 1 ──► 1e25-1 is 23333333333333333333333331666666666666666666666668
integers from 1 ──► 1e26-1 is 2333333333333333333333333316666666666666666666666668
integers from 1 ──► 1e27-1 is 233333333333333333333333333166666666666666666666666668
integers from 1 ──► 1e28-1 is 23333333333333333333333333331666666666666666666666666668
integers from 1 ──► 1e29-1 is 2333333333333333333333333333316666666666666666666666666668
integers from 1 ──► 1e30-1 is 233333333333333333333333333333166666666666666666666666666668
integers from 1 ──► 1e31-1 is 23333333333333333333333333333331666666666666666666666666666668
integers from 1 ──► 1e32-1 is 2333333333333333333333333333333316666666666666666666666666666668
integers from 1 ──► 1e33-1 is 233333333333333333333333333333333166666666666666666666666666666668
integers from 1 ──► 1e34-1 is 23333333333333333333333333333333331666666666666666666666666666666668
integers from 1 ──► 1e35-1 is 2333333333333333333333333333333333316666666666666666666666666666666668
integers from 1 ──► 1e36-1 is 233333333333333333333333333333333333166666666666666666666666666666666668
integers from 1 ──► 1e37-1 is 23333333333333333333333333333333333331666666666666666666666666666666666668
integers from 1 ──► 1e38-1 is 2333333333333333333333333333333333333316666666666666666666666666666666666668
integers from 1 ──► 1e39-1 is 233333333333333333333333333333333333333166666666666666666666666666666666666668
integers from 1 ──► 1e40-1 is 23333333333333333333333333333333333333331666666666666666666666666666666666666668
integers from 1 ──► 1e41-1 is 2333333333333333333333333333333333333333316666666666666666666666666666666666666668
integers from 1 ──► 1e42-1 is 233333333333333333333333333333333333333333166666666666666666666666666666666666666668
integers from 1 ──► 1e43-1 is 23333333333333333333333333333333333333333331666666666666666666666666666666666666666668
integers from 1 ──► 1e44-1 is 2333333333333333333333333333333333333333333316666666666666666666666666666666666666666668
integers from 1 ──► 1e45-1 is 233333333333333333333333333333333333333333333166666666666666666666666666666666666666666668
integers from 1 ──► 1e46-1 is 23333333333333333333333333333333333333333333331666666666666666666666666666666666666666666668
integers from 1 ──► 1e47-1 is 2333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666668
integers from 1 ──► 1e48-1 is 233333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666668
integers from 1 ──► 1e49-1 is 23333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666668
integers from 1 ──► 1e50-1 is 2333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666668
integers from 1 ──► 1e51-1 is 233333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666668
integers from 1 ──► 1e52-1 is 23333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e53-1 is 2333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e54-1 is 233333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e55-1 is 23333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e56-1 is 2333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e57-1 is 233333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e58-1 is 23333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e59-1 is 2333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e60-1 is 233333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e61-1 is 23333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e62-1 is 2333333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e63-1 is 233333333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e64-1 is 23333333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e65-1 is 2333333333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e66-1 is 233333333333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e67-1 is 23333333333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e68-1 is 2333333333333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e69-1 is 233333333333333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e70-1 is 23333333333333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e71-1 is 2333333333333333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e72-1 is 233333333333333333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e73-1 is 23333333333333333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e74-1 is 2333333333333333333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e75-1 is 233333333333333333333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e76-1 is 23333333333333333333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e77-1 is 2333333333333333333333333333333333333333333333333333333333333333333333333333316666666666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e78-1 is 233333333333333333333333333333333333333333333333333333333333333333333333333333166666666666666666666666666666666666666666666666666666666666666666666666666668
integers from 1 ──► 1e79-1 is 23333333333333333333333333333333333333333333333333333333333333333333333333333331666666666666666666666666666666666666666666666666666666666666666666666666666668


=={{header|Ruby}}==

# Given two integers n1,n2 return sum of multiples upto n3
#
# Nigel_Galloway
# August 24th., 2013.
def g(n1, n2, n3)
g1 = n1*n2
(1..g1).select{|x| x%n1==0 or x%n2==0}.collect{|x| g2=(n3-x)/g1; (x+g1*g2+x)*(g2+1)}.inject{|sum,x| sum+x}/2
end

{{out}}

puts g(3,5,999)


233168


# For extra credit
puts g(3,5,100000000000000000000-1)


2333333333333333333316666666666666666668


=={{header|Run BASIC}}==
print multSum35(1000)
end
function multSum35(n)
for i = 1 to n - 1
If (i mod 3 = 0) or (i mod 5 = 0) then multSum35 = multSum35 + i
next i
end function
233168


=={{header|Scala}}==
def sum35( max:BigInt ) : BigInt = max match {

// Simplest solution but limited to Ints only
case j if j < 100000 => (1 until j.toInt).filter( i => i % 3 == 0 || i % 5 == 0 ).sum

// Using a custom iterator that takes Longs
case j if j < 10e9.toLong => {
def stepBy( step:Long ) : Iterator[Long] = new Iterator[Long] { private var i = step; def hasNext = true; def next() : Long = { val result = i; i = i + step; result } }
stepBy(3).takeWhile( _< j ).sum + stepBy(5).takeWhile( _< j ).sum - stepBy(15).takeWhile( _< j ).sum
}

// Using the formula for a Triangular number
case j => {
def triangle( i:BigInt ) = i * (i+1) / BigInt(2)
3 * triangle( (j-1)/3 ) + 5 * triangle( (j-1)/5 ) - 15 * triangle( (j-1)/15 )
}
}

{
for( i <- (0 to 20); n = "1"+"0"*i ) println( (" " * (21 - i)) + n + " => " + (" " * (21 - i)) + sum35(BigInt(n)) )
}

{{out}}
                     1 =>                      0
10 => 23
100 => 2318
1000 => 233168
10000 => 23331668
100000 => 2333316668
1000000 => 233333166668
10000000 => 23333331666668
100000000 => 2333333316666668
1000000000 => 233333333166666668
10000000000 => 23333333331666666668
100000000000 => 2333333333316666666668
1000000000000 => 233333333333166666666668
10000000000000 => 23333333333331666666666668
100000000000000 => 2333333333333316666666666668
1000000000000000 => 233333333333333166666666666668
10000000000000000 => 23333333333333331666666666666668
100000000000000000 => 2333333333333333316666666666666668
1000000000000000000 => 233333333333333333166666666666666668
10000000000000000000 => 23333333333333333331666666666666666668
100000000000000000000 => 2333333333333333333316666666666666666668


=={{header|Scheme}}==
(fold (lambda (x tot) (+ tot (if (or (zero? (remainder x 3)) (zero? (remainder x 5))) x 0))) 0 (iota 1000))

Output:

233168


Or, more clearly by decomposition:

(define (fac35? x)
(or (zero? (remainder x 3))
(zero? (remainder x 5))))

(define (fac35filt x tot)
(+ tot (if (fac35? x) x 0)))

(fold fac35filt 0 (iota 1000))


Output:

233168


For larger numbers iota can take quite a while just to build the list -- forget about waiting for all the computation to finish!

(define (trisum n fac)
(let* ((n1 (quotient (- n 1) fac))
(n2 (+ n1 1)))
(quotient (* fac n1 n2) 2)))

(define (fast35sum n)
(- (+ (trisum n 5) (trisum n 3)) (trisum n 15)))

(fast35sum 1000)
(fast35sum 100000000000000000000)


Output:

233168
2333333333333333333316666666666666666668


=={{header|Seed7}}==
$ include "seed7_05.s7i";
include "bigint.s7i";

const func bigInteger: sum35 (in bigInteger: n) is func
result
var bigInteger: sum35 is 0_;
local
const func bigInteger: sumMul (in bigInteger: n, in bigInteger: f) is func
result
var bigInteger: sumMul is 0_;
local
var bigInteger: n1 is 0_;
begin
n1 := pred(n) div f;
sumMul := f * n1 * succ(n1) div 2_;
end func;
begin
sum35 := sumMul(n, 3_) + sumMul(n, 5_) - sumMul(n, 15_);
end func;

const proc: main is func
begin
writeln(sum35(1000_));
writeln(sum35(10_ ** 20));
end func;


{{out}}

233168
2333333333333333333316666666666666666668


=={{header|Tcl}}==
# Fairly simple version; only counts by 3 and 5, skipping intermediates
proc mul35sum {n} {
for {set total [set threes [set fives 0]]} {$threes<=$n||$fives<=$n} {} {
if {$threes<$fives} {
incr total $threes
incr threes 3
} elseif {$threes>$fives} {
incr total $fives
incr fives 5
} else {
incr total $threes
incr threes 3
incr fives 5
}
}
return $total
}

However, that's pretty dumb. We can do much better by observing that the sum of the multiples of k below some n is k T_{n/k}, where T_i is the i'th [[wp:Triangular number|triangular number]], for which there exists a trivial formula. Then we simply use an overall formula of 3T_{n/3} + 5T_{n/5} - 15T_{n/15} (that is, summing the multiples of three and the multiples of five, and then subtracting the multiples of 15 which were double-counted).
# Smart version; no iteration so very scalable!
proc tcl::mathfunc::triangle {n} {expr {
$n * ($n+1) / 2
}}
# Note that the rounding on integer division is exactly what we need here.
proc sum35 {n} {expr {
3*triangle($n/3) + 5*triangle($n/5) - 15*triangle($n/15)
}}

Demonstrating:
puts [mul35sum 1000],[sum35 1000]
puts [mul35sum 10000000],[sum35 10000000]
# Just the quick one; waiting for the other would get old quickly...
puts [sum35 100000000000000000000]

{{out}}

234168,234168
23333341666668,23333341666668
2333333333333333333416666666666666666668


=={{header|Wortel}}==
@let {
sum35 ^(@sum \!-@(\~%%3 || \~%%5) @til)

!sum35 1000 ; returns 233168
}


=={{header|XPL0}}==
include c:\cxpl\stdlib;

func Sum1; \Return sum the straightforward way
int N, S;
[S:= 0;
for N:= 1 to 999 do
if rem(N/3)=0 or rem(N/5)=0 then S:= S+N;
return S;
];

func Sum2(D); \Return sum of sequence using N*(N+1)/2
int D;
int Q;
[Q:= (1000-1)/D;
return Q*(Q+1)/2*D;
];

func Sum3(D); \Return sum of sequence for really big number
string 0; \don't terminate strings by setting most significant bit
int D; \divisor
int I;
char P(40), Q(40), R(40); \product, quotient, result
[StrNDiv("99999999999999999999", D, Q, 20); \Q:= (1E20-1)/D
for I:= 0 to 17 do R(I):= ^0; \R:= D
R(18):= D/10 +^0;
R(19):= rem(0) +^0;
StrNMul(Q, R, P, 20); \P:= Q*R = Q*D
StrNAdd("00000000000000000001", Q, 20); \Q:= Q+1
StrNMul(P+20, Q, R, 20); \R:= P*Q = Q*D*(Q+1)
StrNDiv(R, 2, Q, 40); \Q:= P/2 = Q*D*(Q+1)/2
return Q; \(very temporary location)
];

char S(40), T;
[IntOut(0, Sum1); CrLf(0);
IntOut(0, Sum2(3) + Sum2(5) - Sum2(3*5)); CrLf(0);
StrNCopy(Sum3(3), S, 40);
StrNAdd(Sum3(5), S, 40);
T:= Sum3(3*5);
StrNSub(S, T, 40);
TextN(0, T, 40); CrLf(0);
]


{{out}}

233168
233168
2333333333333333333316666666666666666668

Execute a system command

Pete: Add a Limbo version.


{{Task|Programming environment operations}}

In this task, the goal is to run either the ls (dir on Windows) system command, or the pause system command.

=={{header|Ada}}==
Using the IEEE POSIX Ada standard, P1003.5c:
with POSIX.Unsafe_Process_Primitives;

procedure Execute_A_System_Command is
Arguments : POSIX.POSIX_String_List;
begin
POSIX.Append (Arguments, "ls");
POSIX.Unsafe_Process_Primitives.Exec_Search ("ls", Arguments);
end Execute_A_System_Command;


Importing the C system() function:
with Interfaces.C; use Interfaces.C;

procedure Execute_System is
function Sys (Arg : Char_Array) return Integer;
pragma Import(C, Sys, "system");
Ret_Val : Integer;
begin
Ret_Val := Sys(To_C("ls"));
end Execute_System;


Using the GNAT run-time library:

with Ada.Text_IO; use Ada.Text_IO;
with System.OS_Lib; use System.OS_Lib;

procedure Execute_Synchronously is
Result : Integer;
Arguments : Argument_List :=
( 1=> new String'("cmd.exe"),
2=> new String'("/C dir c:\temp\*.adb")
);
begin
Spawn
( Program_Name => "cmd.exe",
Args => Arguments,
Output_File_Descriptor => Standout,
Return_Code => Result
);
for Index in Arguments'Range loop
Free (Arguments (Index)); -- Free the argument list
end loop;
end Execute_Synchronously;


=={{header|Aikido}}==
The simplest way to do this is using the system() function. It returns a vector of strings (the output from the command).

var lines = system ("ls")
foreach line lines {
println (line)
}

If you don't want to process the output you can use the exec function. It writes the output to the standard output stream by default;

exec ("ls")

You also have the regular fork and execv calls available:

var pid = fork()
if (pid == 0) {
var args = ["/bin/ls"]
execv ("/bin/ls", args)
exit(1)
}
var status = 0
waitpid (pid, status)



=={{header|Aime}}==
sshell ss;

b_cast(ss_path(ss), "/bin/ls");

lf_p_text(ss_argv(ss), "ls");

o_text(ss_link(ss));


=={{header|ALGOL 68}}==
{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9 - "system" is not part of the standard's prelude.}}
system("ls")

Or the classic "!" shell escape can be implemented as an "!" operator:

{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9 - "system" & "ANDF" are not part of the standard's prelude.}}
OP ! = (STRING cmd)BOOL: system(cmd) = 0;

IF ! "touch test.tmp" ANDF ( ! "ls test.tmp" ANDF ! "rm test.tmp" ) THEN
print (("test.tmp now gone!", new line))
FI


=={{header|AppleScript}}==
do shell script "ls" without altering line endings
=={{header|Applesoft BASIC}}==
? CHR$(4)"CATALOG"
=={{header|AutoHotkey}}==
Run, %comspec% /k dir & pause

=={{header|AWK}}==

BEGIN {
system("ls")
}


=={{header|BASIC}}==

SHELL "dir"

=={{header|Batch file}}==

dir

=={{header|BBC BASIC}}==
On Acorn computers the *CAT command catalogues the current directory, the equivalent of the Unix ls command or the DOS/Windows dir command. The BBC BASIC OSCLI command passes a string to the Command Line Interpreter to execute a system command, it is the equivalent of C's system() command.
OSCLI "CAT"

With BBC BASIC for Windows you can execute the Windows dir command:
OSCLI "*dir":REM *dir to bypass BB4W's built-in dir command

And if running BBC BASIC on a Unix host, you can execute the ls command:
OSCLI "ls"

=={{header|Bracmat}}==
sys$dir

=={{header|Brat}}==
include :subprocess

p subprocess.run :ls #Lists files in directory


=={{header|Brlcad}}==


exec ls


=={{header|C}}==
ISO C & POSIX:

#include

int main()
{
system("ls");
return 0;
}


=={{header|C++}}==
{{works with|Visual C++|2005}}
system("pause");

=={{header|C sharp|C#}}==
Using Windows / .NET:
using System.Diagnostics;

namespace Execute
{
class Program
{
static void Main(string[] args)
{
Process.Start("cmd.exe", "/c dir");
}
}
}


{{works with|MCS|1.2.3.1}}
using System;

class Execute {
static void Main() {
System.Diagnostics.Process proc = new System.Diagnostics.Process();
proc.EnableRaisingEvents=false;
proc.StartInfo.FileName="ls";
proc.Start();
}
}

=={{header|Clojure}}==

(.. Runtime getRuntime (exec "cmd /C dir"))


user=> (use '[clojure.java.shell :only [sh]])

user=> (sh "ls" "-aul")

{:exit 0,
:out total 64
drwxr-xr-x 11 zkim staff 374 Jul 5 13:21 .
drwxr-xr-x 25 zkim staff 850 Jul 5 13:02 ..
drwxr-xr-x 12 zkim staff 408 Jul 5 13:02 .git
-rw-r--r-- 1 zkim staff 13 Jul 5 13:02 .gitignore
-rw-r--r-- 1 zkim staff 12638 Jul 5 13:02 LICENSE.html
-rw-r--r-- 1 zkim staff 4092 Jul 5 13:02 README.md
drwxr-xr-x 2 zkim staff 68 Jul 5 13:15 classes
drwxr-xr-x 5 zkim staff 170 Jul 5 13:15 lib
-rw-r--r--@ 1 zkim staff 3396 Jul 5 13:03 pom.xml
-rw-r--r--@ 1 zkim staff 367 Jul 5 13:15 project.clj
drwxr-xr-x 4 zkim staff 136 Jul 5 13:15 src
, :err }



user=> (use '[clojure.java.shell :only [sh]])

user=> (println (:out (sh "cowsay" "Printing a command-line output")))

_________________________________
< Printing a command-line output. >
---------------------------------
\ ^__^
\ (oo)\_______
(__)\ )\/\
||----w |
|| ||

nil


=={{header|CMake}}==
{{works with|Unix}}
execute_process(COMMAND ls)

Because of a quirk in the implementation ([http://cmake.org/gitweb?p=cmake.git;a=blob;f=Source/cmExecuteProcessCommand.cxx;hb=HEAD cmExecuteProcessCommand.cxx] and [http://cmake.org/gitweb?p=cmake.git;a=blob;f=Source/kwsys/ProcessUNIX.c;hb=HEAD ProcessUNIX.c]), CMake diverts the standard output to a pipe. The effect is like running ls | cat in the shell. The ''ls'' process inherits the original standard input and standard error, but receives a new pipe for standard output. CMake then reads this pipe and copies all data to the original standard output.

''execute_process()'' can also chain commands in a pipeline, and capture output.

# Calculate pi to 40 digits after the decimal point.
execute_process(
COMMAND printf "scale = 45; 4 * a(1) + 5 / 10 ^ 41\\n"
COMMAND bc -l
COMMAND sed -e "s/.\\{5\\}$//"
OUTPUT_VARIABLE pi OUTPUT_STRIP_TRAILING_WHITESPACE)
message(STATUS "pi is ${pi}")


-- pi is 3.1415926535897932384626433832795028841972


=={{header|COBOL}}==
{{works with|OpenCOBOL}}
CALL "SYSTEM" USING BY CONTENT "ls"

=={{header|CoffeeScript}}==
{{works with|Node.js}}

{ spawn } = require 'child_process'

ls = spawn 'ls'

ls.stdout.on 'data', ( data ) -> console.log "Output: #{ data }"

ls.stderr.on 'data', ( data ) -> console.error "Error: #{ data }"

ls.on 'close', -> console.log "'ls' has finished executing."


=={{header|Common Lisp}}==
{{works with|CMUCL}}
(with-output-to-string (stream) (extensions:run-program "ls" nil :output stream))

{{works with|LispWorks}}

(system:call-system "ls")

{{libheader|trivial-shell}}

(trivial-shell:shell-command "ls")

=={{header|D}}==
Note that this does not return the output of the command, other than the return value. That functionality can be accomplished via a call to shell().
std.process.system("ls");

=={{header|dc}}==
! ls
=={{header|DCL}}==
Directory
Or, shorterdir

=={{header|Delphi}}==
program ExecuteSystemCommand;

{$APPTYPE CONSOLE}

uses Windows, ShellApi;

begin
ShellExecute(0, nil, 'cmd.exe', ' /c dir', nil, SW_HIDE);
end.


=={{header|E}}==
def ls := makeCommand("ls")
ls("-l")

def [results, _, _] := ls.exec(["-l"])
when (results) -> {
def [exitCode, out, err] := results
print(out)
} catch problem {
print(`failed to execute ls: $problem`)
}


=={{header|Erlang}}==
os:cmd("ls").


=={{header|F_Sharp|F#}}==
System.Diagnostics.Process.Start("cmd", "/c dir")

=={{header|Factor}}==
"ls" run-process wait-for-process

=={{header|Fantom}}==

The Process class handles creating and running external processes. in/out/err streams can be redirected, but default to the usual stdin/stdout/stderr. So following program prints result of 'ls' to the command line:


class Main
{
public static Void main ()
{
p := Process (["ls"])
p.run
}
}


=={{header|Forth}}==
{{works with|gforth|0.6.2}}
s" ls" system

=={{header|Fortran}}==
{{works with|gfortran}}
The SYSTEM subroutine (and function) are a GNU extension.
program SystemTest
call system("ls")
end program SystemTest


=={{header|Free Pascal}}==
program ex01;

uses
SysUtils;

begin
ExecuteProcess('cmd', ' /c dir');
end.


=={{header|Go}}==
package main
import "fmt"
import "os/exec"

func main() {
cmd := exec.Command("ls", "-l")
output, err := cmd.Output()
if (err != nil) {
fmt.Println(err)
return
}
fmt.Print(string(output))
}


=={{header|gnuplot}}==

!ls

=={{header|GUISS}}==

Start,Programs,Accessories,MSDOS Prompt,Type:dir[enter]

=={{header|Haskell}}==
{{works with|GHC|GHCi|6.6}}
import System.Cmd

main = system "ls"


See also: the [http://www.haskell.org/ghc/docs/latest/html/libraries/process/System-Process.html System.Process] module

=={{header|HicEst}}==
SYSTEM(CoMmand='pause')
SYSTEM(CoMmand='dir & pause')


=={{header|Icon}} and {{header|Unicon}}==
The code below selects the 'ls' or 'dir' command at runtime based on the UNIX feature.

procedure main()

write("Trying command ",cmd := if &features == "UNIX" then "ls" else "dir")
system(cmd)

end


Unicon extends system to allow specification of files and a wait/nowait parameter as in the examples below.

pid := system(command_string,&input,&output,&errout,"wait")
pid := system(command_string,&input,&output,&errout,"nowait")

=={{header|IDL}}==
$ls

Will execute "ls" with output to the screen.

spawn,"ls",result

will execute it and store the result in the string array "result".

spawn,"ls",unit=unit

will execute it asynchronously and direct any output from it into the LUN "unit" from whence it can be read at any (later) time.

=={{header|Io}}==
System runCommand("ls") stdout println

=={{header|J}}==

The system command interface in J is provided by the standard "task" script:
load'task'

NB. Execute a command and wait for it to complete
shell 'dir'

NB. Execute a command but don't wait for it to complete
fork 'notepad'

NB. Execute a command and capture its stdout
stdout =: shell 'dir'

NB. Execute a command, provide it with stdin,
NB. and capture its stdout
stdin =: 'blahblahblah'
stdout =: stdin spawn 'grep blah'



=={{header|Java}}==
{{works with|Java|1.5+}}
import java.util.Scanner;
import java.io.*;

public class Program {
public static void main(String[] args) {
try {
Process p = Runtime.getRuntime().exec("cmd /C dir");//Windows command, use "ls -oa" for UNIX
Scanner sc = new Scanner(p.getInputStream());
while (sc.hasNext()) System.out.println(sc.nextLine());
}
catch (IOException e) {
System.out.println(e.getMessage());
}
}
}


{{works with|Java|1.4+}}
There are two ways to run system commands. The simple way, which will hang the JVM (I would be interested in some kind of reason). -- this happens because the the inputStream buffer fills up and blocks until it gets read. Moving your .waitFor after reading the InputStream would fix your issue (as long as your error stream doesn't fill up)
import java.io.IOException;
import java.io.InputStream;

public class MainEntry {
public static void main(String[] args) {
executeCmd("ls -oa");
}

private static void executeCmd(String string) {
InputStream pipedOut = null;
try {
Process aProcess = Runtime.getRuntime().exec(string);
aProcess.waitFor();

pipedOut = aProcess.getInputStream();
byte buffer[] = new byte[2048];
int read = pipedOut.read(buffer);
// Replace following code with your intends processing tools
while(read >= 0) {
System.out.write(buffer, 0, read);

read = pipedOut.read(buffer);
}
} catch (IOException e) {
e.printStackTrace();
} catch (InterruptedException ie) {
ie.printStackTrace();
} finally {
if(pipedOut != null) {
try {
pipedOut.close();
} catch (IOException e) {
}
}
}
}


}


And the right way, which uses threading to read the InputStream given by the process.
import java.io.IOException;
import java.io.InputStream;

public class MainEntry {
public static void main(String[] args) {
// the command to execute
executeCmd("ls -oa");
}

private static void executeCmd(String string) {
InputStream pipedOut = null;
try {
Process aProcess = Runtime.getRuntime().exec(string);

// These two thread shall stop by themself when the process end
Thread pipeThread = new Thread(new StreamGobber(aProcess.getInputStream()));
Thread errorThread = new Thread(new StreamGobber(aProcess.getErrorStream()));

pipeThread.start();
errorThread.start();

aProcess.waitFor();
} catch (IOException e) {
e.printStackTrace();
} catch (InterruptedException ie) {
ie.printStackTrace();
}
}
}

//Replace the following thread with your intends reader
class StreamGobber implements Runnable {

private InputStream Pipe;

public StreamGobber(InputStream pipe) {
if(pipe == null) {
throw new NullPointerException("bad pipe");
}
Pipe = pipe;
}

public void run() {
try {
byte buffer[] = new byte[2048];

int read = Pipe.read(buffer);
while(read >= 0) {
System.out.write(buffer, 0, read);

read = Pipe.read(buffer);
}
} catch (IOException e) {
e.printStackTrace();
} finally {
if(Pipe != null) {
try {
Pipe.close();
} catch (IOException e) {
}
}
}
}
}


=={{header|JavaScript}}==
JavaScript does not have any facilities to interact with the OS. However, host environments can provide this ability.

{{works with|JScript}}
var shell = new ActiveXObject("WScript.Shell");
shell.run("cmd /c dir & pause");


{{works with|Rhino}}
runCommand("cmd", "/c", "dir", "d:\\");
print("===");
var options = {
// can specify arguments here in the options object
args: ["/c", "dir", "d:\\"],
// capture stdout to the options.output property
output: ''
};
runCommand("cmd", options);
print(options.output);


=={{header|Joy}}==
"ls" system.

=={{header|K}}==

Execute "ls"
\ls

Execute "ls" and capture the output in the variable "r":
r: 4:"ls"

=={{header|Lang5}}==
'ls system


=={{header|Lasso}}==
local(
path = file_forceroot,
ls = sys_process('/bin/ls', (:'-l', #path)),
lswait = #ls -> wait
)
'
'
#ls -> read
'
'

total 16
drwxr-xr-x 8 _lasso staff 272 Nov 10 08:13 mydir
-rw-r--r-- 1 _lasso staff 38 Oct 29 16:05 myfile.lasso
-rw-r--r--@ 1 _lasso staff 175 Oct 29 18:18 rosetta.lasso


=={{header|Liberty BASIC}}==

drive1$ = left$(Drives$,1)
run "cmd.exe /";drive1$;" dir & pause"


=={{header|Limbo}}==

There is no equivalent to Unix's exec() in Inferno per se; commands are just modules that have at least an init() function with the correct signature, and are loaded the same way as any other module. (As a result, there's nothing in the language or OS that prevents a program from acting as both a command and a library except convention.)

This version passes its argument list through to ls:

implement Runls;

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

Runls: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
};

init(ctxt: ref Draw->Context, args: list of string)
{
sys = load Sys Sys->PATH;
ls := load Command "/dis/ls.dis";
if(ls == nil)
die("Couldn't load /dis/ls.dis");
ls->init(ctxt, "ls" :: tl args);
}

die(s: string)
{
sys->fprint(sys->fildes(2), "runls: %s: %r", s);
raise "fail:errors";
}


It's not strictly necessary to pass the graphics context to ls, but it is generally a good idea to do so when calling another program.

=={{header|Locomotive Basic}}==

The Amstrad CPC464 uses a ROM based basic interpreter, so every statement within the program is a system command. If a command without a line number is typed, whilst the computer is in a ready state, the command gets executed immediately. There is no pause command, so in this example, we use the list command (which exhibits totally different behaviour to a pause command):

LIST

=={{header|Logo}}==
{{works with|UCB Logo}}
The lines of output of the SHELL command are returned as a list.
print first butfirst shell [ls -a] ; ..

=={{header|Lua}}==
-- just executing the command
os.execute("ls")

-- to execute and capture the output, use io.popen
local f = io.popen("ls") -- store the output in a "file"
print( f:read("*a") ) -- print out the "file"'s content


=={{header|M4}}==
syscmd(ifdef(`__windows__',`dir',`ls'))

=={{header|Make}}==
make can use system command in either definition of variables or in the targets

in definition

contents=$(shell cat foo)
curdir=`pwd`


in target

mytarget:
cat foo | grep mytext


=={{header|Mathematica}}==
Run["ls"]

=={{header|MATLAB}}==
To execute system commands in MATLAB, use the "system" keyword.

Sample Usage:
>> system('PAUSE')

Press any key to continue . . .


ans =

0


=={{header|Maxima}}==
system("dir > list.txt")$

=={{header|MAXScript}}==
dosCommand "pause"

=={{header|Mercury}}==

:- module execute_sys_cmd.
:- interface.
:- import_module io.

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

:- implementation.

main(!IO) :-
io.call_system("ls", _Result, !IO).



=={{header|Modula-2}}==
MODULE tri;

FROM SYSTEM IMPORT ADR;
FROM SysLib IMPORT system;

IMPORT TextIO, InOut, ASCII;

VAR fd : TextIO.File;
ch : CHAR;

PROCEDURE SystemCommand (VAR command : ARRAY OF CHAR) : BOOLEAN;

BEGIN
IF system (ADR (command) ) = 0 THEN
RETURN TRUE
ELSE
RETURN FALSE
END
END SystemCommand;

BEGIN
IF SystemCommand ("ls -1 tri.mod | ") = TRUE THEN
InOut.WriteString ("No error reported.")
ELSE
InOut.WriteString ("Error reported!")
END;
LOOP
InOut.Read (ch);
InOut.Write (ch);
IF ch < ' ' THEN EXIT END
END;
InOut.WriteLn;
InOut.WriteBf
END tri.


=={{header|Modula-3}}==
This code requires the UNSAFE keyword because M3toC deals with C strings (which are pointers), and are implemented in Modula-3 as UNTRACED, meaning they are not garbage collected, which is why the code calls FreeCopiedS().

Also note the EVAL keyword, which ignores the return value of a function.
UNSAFE MODULE Exec EXPORTS Main;

IMPORT Unix, M3toC;

VAR command := M3toC.CopyTtoS("ls");

BEGIN
EVAL Unix.system(command);
M3toC.FreeCopiedS(command);
END Exec.

=={{header|MUMPS}}==

ANSI MUMPS doesn't allow access to the operating system except possibly through the View command and $View function, both of which are implementation specific. Intersystems' Caché does allow you to create processes with the $ZF function, and if the permissions for the Caché process allow it you can perform operating system commands.


In Caché on OpenVMS in an FILES-11 filesystem ODS-5 mode this could work:
Set X=$ZF(-1,"DIR")



In GT.M on OpenVMS, the following will work:
ZSY "DIR"


GT.M on UNIX is the same:
ZSY "ls"


Note: $ZF in GT.M is Unicode version of $F[ind].



=={{header|NetRexx}}==
{{Trans|Java}}
/* NetRexx */
options replace format comments java crossref symbols binary

import java.util.Scanner

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
parse arg command
if command = '' then command = 'ls -oa' -- for Windows change to: 'cmd /C dir'
do
say 'Executing command:' command
jprocess = Runtime.getRunTime().exec(command)
jscanner = Scanner(jprocess.getInputStream())
loop label scanning while jscanner.hasNext()
say jscanner.nextLine()
end scanning
catch ex = IOException
ex.printStackTrace()
end
return


=={{header|Objective-C}}==
{{works with|GCC}}

NSTask runs an external process with explicit path and arguments.
void runls()
{
[[NSTask launchedTaskWithLaunchPath:@"/bin/ls"
arguments:[NSArray array]] waitUntilExit];
}

If you need to run a system command, invoke the shell:
void runSystemCommand(NSString *cmd)
{
[[NSTask launchedTaskWithLaunchPath:@"/bin/sh"
arguments:[NSArray arrayWithObjects:@"-c", cmd, nil]]
waitUntilExit];
}

Complete usage example:


{{works with|Cocoa}}

{{works with|GNUstep}}
#import

void runSystemCommand(NSString *cmd)
{
[[NSTask launchedTaskWithLaunchPath:@"/bin/sh"
arguments:[NSArray arrayWithObjects:@"-c", cmd, nil]]
waitUntilExit];
}

int main(int argc, const char **argv)
{
NSAutoreleasePool *pool;

pool = [NSAutoreleasePool new];

runSystemCommand(@"ls");
[pool release];
return 0;
}

Or use the C method above.

=={{header|OCaml}}==
Just run the command:

Sys.command "ls"

To capture the output of the command:

#load "unix.cma"

let syscall cmd =
let ic, oc = Unix.open_process cmd in
let buf = Buffer.create 16 in
(try
while true do
Buffer.add_channel buf ic 1
done
with End_of_file -> ());
let _ = Unix.close_process (ic, oc) in
(Buffer.contents buf)

let listing = syscall "ls" ;;



a more complete version which also returns the contents from stderr, and checks the exit-status, and where the environment can be specified:

let check_exit_status = function
| Unix.WEXITED 0 -> ()
| Unix.WEXITED r -> Printf.eprintf "warning: the process terminated with exit code (%d)\n%!" r
| Unix.WSIGNALED n -> Printf.eprintf "warning: the process was killed by a signal (number: %d)\n%!" n
| Unix.WSTOPPED n -> Printf.eprintf "warning: the process was stopped by a signal (number: %d)\n%!" n
;;

let syscall ?(env=[| |]) cmd =
let ic, oc, ec = Unix.open_process_full cmd env in
let buf1 = Buffer.create 96
and buf2 = Buffer.create 48 in
(try
while true do Buffer.add_channel buf1 ic 1 done
with End_of_file -> ());
(try
while true do Buffer.add_channel buf2 ec 1 done
with End_of_file -> ());
let exit_status = Unix.close_process_full (ic, oc, ec) in
check_exit_status exit_status;
(Buffer.contents buf1,
Buffer.contents buf2)


val syscall : ?env:string array -> string -> string * string

=={{header|Octave}}==
system("ls");

=={{header|Oz}}==
{OS.system "ls" _}

A more sophisticated example can be found [http://www.mozart-oz.org/home/doc/op/node17.html here].

=={{header|PARI/GP}}==
system("ls")

=={{header|Pascal}}==
{{works with|Free_Pascal}} {{libheader|SysUtils}}
Program ExecuteSystemCommand;

uses
SysUtils;
begin
ExecuteProcess('/bin/ls', '-alh');
end.


=={{header|Perl}}==
my @results = qx(ls);
# runs command and returns its STDOUT as a string
my @results = `ls`;
# ditto, alternative syntax

system "ls";
# runs command and returns its exit status; its STDOUT gets output to our STDOUT

print `ls`;
#The same, but with back quotes

exec "ls";
# replace current process with another


Also see:
http://perldoc.perl.org/perlipc.html#Using-open()-for-IPC
http://perldoc.perl.org/IPC/Open3.html

=={{header|Perl 6}}==
run "ls" or die $!; # output to stdout

my @ls = qx/ls/; # output to variable

my $cmd = 'ls';
my @ls = qqx/$ls/; # same thing with interpolation


=={{header|PDP-11 Assembly}}==
PDP-11 running Unix
; Execute a file - the equivalent of system() in stdio
;
; On entry, r1=>nul-terminated command string
; On exit, VS=Couldn't fork
; VC=Forked successfully, r0=return value
;
.CLIsystem
trap 2 ; fork()
br CLIchild ; Child process returns here
bcc CLIparent ; Parent process returns here
mov (sp)+,r1
tst (sp)+
sev ; Couldn't fork, set V
rts pc
.CLIparent
mov r0,-(sp) ; Save child's PID
.CLIwait
trap 7 ; wait()
cmp r0,(sp)
beq CLIfinished
cmp r0,#&FFFF
bne CLIwait ; Loop until child finished
.CLIfinished
tst (sp)+ ; Drop child's PID
mov r1,r0 ; R0=return value
mov (sp)+,r1 ; Restore R1
tst (sp)+ ; Drop original R0
swab r0 ; Move return value to bottom byte
rts pc

; CLI child process
; -----------------
.CLIchild
clr -(sp) ; end of string array
mov r1,-(sp) ; => command string
mov #UXsh3,-(sp) ; => "-c"
mov #UXsh2,-(sp) ; => "sh"
mov #&890B,TRAP_BUF ; exec
mov #UXsh1,TRAP_BUF+2 ; => "/bin/sh"
mov sp,TRAP_BUF+4 ; => pointers to command strings
;mov SV_ENVPTR,TRAP_BUF+6 ; => "PATH=etc"
trap 0 ; indir()
EQUW TRAP_BUF ; exec(shell, parameters)
add #8,sp ; If we get back, we didn't fork, we spawned
mov (sp)+,r1 ; So, restore registers
clr (sp)+ ; and return exit value in R0
rts pc

.UXsh1 EQUS "/bin/sh",0
.UXsh2 EQUS "sh",0
.UXsh3 EQUS "-c",0
ALIGN

.TRAP_BUF
EQUW 0
EQUW 0
EQUW 0
EQUW 0

So, call with, for example:
mov #cmd_ls,r1 ; => "ls" command string
jsr pc,CLIsystem
...
.cmd_ls EQUS "ls",0


=={{header|PHP}}==
The first line execute the command and the second line display the output:
@exec($command,$output);
echo nl2br($output);

'''Note:'''The '@' is here to prevent error messages to be displayed, 'nl2br' translate '\n' chars to 'br' in HTML.

Other:
$results = `ls`;
# runs command and returns its STDOUT as a string

system("ls");
# runs command and returns its exit status; its STDOUT gets output to our STDOUT

echo `ls`;
# the same, but with back quotes

passthru("ls");
# like system() but binary-safe


See also: [http://us.php.net/manual/en/function.proc-open.php proc_open()]

=={{header|PicoLisp}}==
(call "ls")

=={{header|Pike}}==
int main(){
// Process.run was added in Pike 7.8 as a wrapper to simplify the use of Process.create_process()
mapping response = Process.run("ls -l");
// response is now a map containing 3 fields
// stderr, stdout, and exitcode. We want stdout.
write(response["stdout"] + "\n");

// with older versions of pike it's a bit more complicated:
Stdio.File stdout = Stdio.File();
Process.create_process(({"ls", "-l"}), ([ "stdout" : stdout->pipe() ]) );
write(stdout->read() + "\n");
}


=={{header|Pop11}}==
The sysobey function runs commands using a shell:

sysobey('ls');

=={{header|PowerShell}}==
Since PowerShell is a shell, running commands is the default operation.
dir
ls
Get-ChildItem

are all equivalent (the first two are aliases for the third) but they are PowerShell-native commands. If one really needs to execute dir (which is no program but rather a built-in command in cmd.exe) this can be achieved by
cmd /c dir

=={{header|Prolog}}==
{{works with|SWI Prolog}}

{{works with|GNU Prolog}}
shell('ls').
=={{header|PureBasic}}==
ImportC "msvcrt.lib"
system(str.p-ascii)
EndImport

If OpenConsole()
system("dir & pause")

Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
Input()
CloseConsole()
EndIf


=={{header|Python}}==
import os
exit_code = os.system('ls') # Just execute the command, return a success/fail code
output = os.popen('ls').read() # If you want to get the output data. Deprecated.

or

{{works with|Python|2.7 (and above)}}
import subprocess
# if the exit code was non-zero these commands raise a CalledProcessError
exit_code = subprocess.check_call(['ls', '-l']) # Python 2.5+
assert exit_code == 0
output = subprocess.check_output(['ls', '-l']) # Python 2.7+


or

{{works with|Python|2.4 (and above)}}
from subprocess import PIPE, Popen, STDOUT
p = Popen('ls', stdout=PIPE, stderr=STDOUT)
print p.communicate()[0]


'''Note:''' The latter is the preferred method for calling external processes, although cumbersome, it gives you finer control over the process.

or

{{works with|Python|2.2 (and above)}}
import commands
stat, out = commands.getstatusoutput('ls')
if not stat:
print out


=={{header|R}}==
system("ls")
output=system("ls",intern=TRUE)


=={{header|Racket}}==

#lang racket

;; simple execution of a shell command
(system "ls")

;; capture output
(string-split (with-output-to-string (λ() (system "ls"))) "\n")

;; Warning: passing random string to be run in a shell is a bad idea!
;; much safer: avoids shell parsing, arguments passed separately
(system* "/bin/ls" "-l")

;; avoid specifying the executable path
(system* (find-executable-path "/bin/ls") "-l")


=={{header|Raven}}==
Back tick string is auto executed:

`ls -la` as listing

Or specifically on any string:

'ls -la' shell as listing

=={{header|REBOL}}==
; Capture output to string variable:

x: "" call/output "dir" x
print x

; The 'console' refinement displays the command output on the REBOL command line.

call/console "dir *.r"
call/console "ls *.r"

call/console "pause"

; The 'shell' refinement may be necessary to launch some programs.

call/shell "notepad.exe"


=={{header|REXX}}==
Since REXX is a shell scripting language, it's easy to execute commands:
"dir /a:d"

=={{header|Ruby}}==
string = `ls`
# runs command and returns its STDOUT as a string
string = %x{ls}
# ditto, alternative syntax

system "ls"
# runs command and returns its exit status; its STDOUT gets output to our STDOUT

print `ls`
#The same, but with back quotes

exec "ls"
# replace current process with another

# call system command and read output asynchronously
io = IO.popen('ls')
# ... later
io.each {|line| puts line}


=={{header|Run BASIC}}==
print shell$("ls") ' prints the returned data from the OS
a$ = shell$("ls") ' holds returned data in a$


=={{header|Scala}}==
import scala.sys.process.Process
Process("ls", Seq("-oa"))!


=={{header|Scheme}}==
{{works with|Guile}}
{{works with|Chicken Scheme}}
(system "ls")

=={{header|Seed7}}==
System commands can make a program unportable.
Unix, Linux and BSD use the command ''ls'', while Windows respectively DOS use the command ''dir''.
The format written by ''ls'' respectively ''dir'' depends on operating system and locale.
The library [http://seed7.sourceforge.net/libraries/osfiles.htm osfiles.s7i] defines
the function [http://seed7.sourceforge.net/libraries/osfiles.htm#readDir%28in_string%29 readDir],
which reads the contents of a directory in a portable way. ''ReadDir'' works independend
from operating system and locale and supports also Unicode filenames.
Anyway, the task was to use a system command, so here is the example:

$ include "seed7_05.s7i";
include "shell.s7i";

const proc: main is func
begin
cmd_sh("ls");
end func;


=={{header|Slate}}==

Run a command normally through the shell:

Platform run: 'ls'.

Run a command (this way takes advantage of the 'does not understand' message for the shell object and calls the Platform run: command above with a specific command):

shell ls: '*.slate'.

=={{header|Smalltalk}}==

Smalltalk system: 'ls'.

=={{header|Standard ML}}==
Just run the command:

OS.Process.system "ls"

=={{header|Tcl}}==

puts [exec ls]

This page uses "ls" as the primary example. For what it's worth, Tcl has built-in primitives for retrieving lists of files so one would rarely ever directly exec an ls command.

It is also possible to execute a system command by "open"ing it through a pipe from whence any output of the command can be read at any (later) time. For example:

set io [open "|ls" r]

would execute "ls" and pipe the result into the channel whose name is put in the "io" variable. From there one could receive it either line by line like this:

set nextline [gets $io]

or read the whole shebang in a fell swoop:

set lsoutput [read $io]

If the command is opened "rw", it is even possible to send it user input through the same handle, though care must be taken with buffering in that case.

=={{header|Toka}}==
needs shell
" ls" system


=={{header|TUSCRIPT}}==

$$ MODE TUSCRIPT
system=SYSTEM ()
IF (system=="WIN") THEN
EXECUTE "dir"
ELSEIF (system.sw."LIN") THEN
EXECUTE "ls -l"
ENDIF


=={{header|UNIX Shell}}==
UNIX shells are designed to run system commands as a default operation.
ls

If one wishes to replace the shell process with some other command (chain into some command with no return) one can use the '''''exec''''' shell built-in command.

exec ls

===Command substitution===
One can also capture the command's standard output in a variable.

With [[Bourne Shell]]:
output=`ls`

With [[Korn Shell]] or any modern shell:
output=$(ls)

* '''Note 1:''' in `ls`, these are "backticks" rather than quotes or apostrophes.
* '''Note 2:''' the '''$(...)''' form works in all modern shells, including the [[Almquist Shell]], [[Bash]] and any POSIX shell.
* The old `backticks` can also be used in the newer shells, but their users prefer the '''$(...)''' form when discussing such things in e-mail, on USENET, or in other online forums (such as this wiki). The only reason to use `backticks` is in scripts for old Bourne Shell.

The '''`...`''' form is difficult to nest, but the '''$(...)''' form is very nestable.

output=`expr \`echo hi | wc -c\` - 1`
output=$(expr $(echo hi | wc -c) - 1)


Both forms, `backticks` and '''$(...)''', also work inside double-quoted strings. This prevents file name expansion and also prevents word splitting.

echo "Found: `grep 80/tcp /etc/services`"
echo "Found: $(grep 80/tcp /etc/services)"


==={{header|C Shell}}===
C Shell also runs system commands, and has an '''exec''' built-in command, exactly like Bourne Shell.

ls # run command, return to shell
exec ls # replace shell with command


`Backticks` are slightly different. When inside double quotes, as '''"`...`"''', C Shell splits words at newlines, like '''"line 1" "line 2" ...''', but preserves spaces and tabs.

set output=( "`grep 80/ /etc/services`" )
echo "Line 1: $output[1]"
echo "Line 2: $output[2]"


=={{header|Ursala}}==
The library function, ask, parameterized by a shell descriptor, such as bash,
spawns a process that interacts with that shell by feeding it a list of
commands, and returns a transcript of the interaction.

Note that the output from the spawned process is captured and returned only,
not sent to the standard output stream of the parent.

Here is a self-contained command line application providing a limited replacement
for the ls command.
#import std
#import cli

#executable ('parameterized','')

myls = <.file$[contents: --<''>]>@hm+ (ask bash)/0+ -[ls --color=no]-!

The color option is needed to suppress terminal escape sequences.

=={{header|Vedit macro language}}==

system("dir", DOS)

The above does not work on 64-bit Windows versions which do not have 16-bit DOS emulation.
In this case, you need to call cmd.exe explicitly:

system('cmd /k "dir"')

=={{header|Visual Basic}}==
Shelling out a sub task in Visual Basic is rather a pain if you need to wait for the task to complete, which
is probably the usual case. But it is possible.
Attribute VB_Name = "mdlShellAndWait"
Option Explicit

Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long

Private Const STATUS_PENDING = &H103&
Private Const PROCESS_QUERY_INFORMATION = &H400

'
' Little function go get exit code given processId
'
Function ProcessIsRunning( processId as Long ) as Boolean
Dim exitCode as Long
Call GetExitCodeProcess(lProcessId, exitCode)
ProcessIsRunning = (exitCode = STATUS_PENDING)
End Function

' Spawn subprocess and wait for it to complete.
' I believe that the command in the command line must be an exe or a bat file.
' Maybe, however, it can reference any file the system knows how to "Open"
'
' commandLine is an executable.
' expectedDuration - is for poping up a dialog for whatever
' infoText - text for progressDialog dialog

Public Function ShellAndWait( commandLine As String, _
expectedDuration As Integer ) As Boolean

Dim inst As Long
Dim startTime As Long
Dim expirationTime As Long
Dim pid As Long
Dim expiresSameDay As Boolean

On Error GoTo HandleError

'Deal with timeout being reset at Midnight ($hitForBrains VB folks)
startTime = CLng(Timer)
expirationTime = startTime + expectedDuration
expiresSameDay = expirationTime < 86400
If Not expiresSameDay Then
expirationTime = expirationTime - 86400
End If

inst = Shell(commandLine, vbMinimizedNoFocus)

If inst <> 0 Then
pid = OpenProcess(PROCESS_QUERY_INFORMATION, False, inst)

Do While ProcessIsRunning( pid)
DoEvents
If Timer > expirationTime And (expiresSameDay Or Timer < startTime) Then
Exit Do
End If
Loop
ShellAndWait = True
Else
MsgBox ("Couldn't execute command: " & commandLine)
ShellAndWait = False
End If

Exit Function

HandleError:
MsgBox ("Couldn't execute command: " & commandLine)
ShellAndWait = False
End Function

Sub SpawnDir()
ShellAndWait("dir", 10)
End Sub


=={{header|Wart}}==
system "ls"

=={{header|ZX Spectrum Basic}}==

The ZX Spectrum uses a ROM based basic interpreter, so every statement within the program is a system command. If a command without a line number is typed, whilst the computer is in a ready state, the command gets executed immediately:

PAUSE 100

{{omit from|Retro}}
{{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}}

Executable library

Pete: Add Limbo version


{{task}}
The general idea behind an executable library is to create a library that when used as a library does one thing; but has the ability to be run directly via command line. Thus the API comes with a CLI in the very same source code file.

'''Task detail'''

* Create a library/module/dll/shared object/... for a programming language that contains a function/method called hailstone that is a function taking a positive integer and returns the [[Hailstone sequence]] for that number.

* The library, when executed directly should satisfy the remaining requirements of the [[Hailstone sequence]] task:
:: 2. Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
:: 3. Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.

* Create a second executable to calculate the following:
** Use the library's hailstone function, in the standard manner, (or document how this use deviates from standard use of a library), together with extra code in this executable, to find the hailstone length returned most often for 1 ≤ n < 100,000.

* Explain any extra setup/run steps needed to complete the task.

'''Notes:'''
* It is assumed that for a language that overwhelmingly ships in a compiled form, such as C, the library must also be an executable and the compiled user of that library is to do so without changing the compiled library. I.e. the compile tool-chain is assumed ''not'' to be present in the runtime environment.
* Interpreters are present in the runtime environment.

=={{header|Ada}}==

In Ada, '''any parameterless procedure''' can either '''run as a (stand-alone) main program''', or can '''be called from another program''' like a library function. For the task at hand, this appears useful -- except for the following two obstacles:

1. There are neither ingoing parameters into a parameterless procedure, nor is there a return value.

2. The procedure does not know how it has been called: is it running as a main program, or has it been called from another program?

To overcome the first obstacle, we implement a very simplistic parameter passing mechanism in a package Parameter (''parameter.ads''): The global variable Parameter.X will hold the ingoing parameter, the other global variable Parameter.Y will take the return value. To overcome the second obstacle, we ensure that Parameter.X is 0 by default.

package Parameter is
X: Natural := 0;
Y: Natural;
end Parameter;


Now comes our parameterless procedure Hailstone (''hailstone.adb''). Note that we are
using the the package Hailstones (''hailstones.adb/hailstones.ads'') from
[[Hailstone sequence#Alternative method]] to perform the real computation.

with Ada.Text_IO, Parameter, Hailstones;

procedure Hailstone is
-- if Parameter.X > 0, the length of Hailstone(Parameter.X)
-- is computed and written into Parameter.Y

-- if Parameter.X = 0, Hailstone(27) and N <= 100_000 with maximal
-- Hailstone(N) are computed and printed.

procedure Show_Sequence(N: Natural) is
Seq: Hailstones.Integer_Sequence := Hailstones.Create_Sequence(N);
begin
Ada.Text_IO.Put("Hailstone(" & Integer'Image(N) & " ) = (");
if Seq'Length < 8 then
for I in Seq'First .. Seq'Last-1 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) & ",");
end loop;
else
for I in Seq'First .. Seq'First+3 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) & ",");
end loop;
Ada.Text_IO.Put(" ...,");
for I in Seq'Last-3 .. Seq'Last-1 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) &",");
end loop;
end if;
Ada.Text_IO.Put_Line(Integer'Image(Seq(Seq'Last)) & " ); Length: " &
Integer'Image(seq'Length));
end Show_Sequence;
begin
if Parameter.X>0 then
Parameter.Y := Hailstones.Create_Sequence(Parameter.X)'Length;
else
Show_Sequence(27);
declare
Longest: Natural := 0;
Longest_Length: Natural := 0;
begin
for I in 2 .. 100_000 loop
if Hailstones.Create_Sequence(I)'Length > Longest_Length then
Longest := I;
Longest_Length := Hailstones.Create_Sequence(I)'Length;
end if;
end loop;
Ada.Text_IO.Put("Longest<=100_000: ");
Show_Sequence(Longest);
end;
end if;
end Hailstone;


If we compile this and run it, we get the following output.

> ./hailstone
Hailstone( 27 ) = ( 27, 82, 41, 124, ..., 8, 4, 2, 1 ); Length: 112
Longest<=100_000: Hailstone( 77031 ) = ( 77031, 231094, 115547, 346642, ..., 8, 4, 2, 1 ); Length: 351


To use the same procedure like a library function, we need a specification (file ''hailstone.ads''),
that essentially repeats the parameter profile. As our procedure is actually parameterless, this specification is more than trivial.

procedure Hailstone;

Finally, we write another parameterless procedure (''hailstone_test.adb''), that will call the procedure Hailstone. Note that we '''must''' change the Parameter.X to a value > 0 before calling Hailstone, otherwise, Hailstone would act as if it where the main program.

with Hailstone, Parameter, Ada.Text_IO;

procedure Hailstone_Test is
Counts: array (1 .. 100_000) of Natural := (others => 0);
Max_Count: Natural := 0;
Most_Common: Positive := Counts'First;
Length: Natural renames Parameter.Y;
Sample: Natural := 0;
begin
for I in Counts'Range loop
Parameter.X := I;
Hailstone; -- compute the length of Hailstone(I)
Counts(Length) := Counts(Length)+1;
end loop;
for I in Counts'Range loop
if Counts(I) > Max_Count then
Max_Count := Counts(I);
Most_Common := I;
end if;
end loop;
Ada.Text_IO.Put_Line("Most frequent length:"
& Integer'Image(Most_Common)
& ";" & Integer'Image(Max_Count)
& " sequences of that length.");
for I in Counts'Range loop
Parameter.X := I;
Hailstone; -- compute the length of Hailstone(I)
if Length = Most_Common then
Sample := I;
exit;
end if;
end loop;
Ada.Text_IO.Put_Line("The first such sequence: Hailstone("
& Integer'Image(Sample) & " ).");
end Hailstone_Test;
.

Compiling and running this gives the following output:

> ./hailstone_test 
Most frequent length: 72; 1467 sequences of that length.
The first such sequence: Hailstone( 444 ).


Note that using global variables for parameter and return value passing works here, but is bad programming practice. Ada is a compiled language, and it is not clear how useful an executable library written in a compiled language is, anyway.

In fact, except for the constraints imposed by this task, there is no reason to ask the procedure Hailstone for the length of a Hailstone sequence -- solid software engineering practice would require to directly call the parameterized function Hailstones.Create_Sequence.

=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
First we create the library, hailstone.ahk:
#NoEnv
SetBatchLines, -1

; Check if we're executed directly:
If (A_LineFile = A_ScriptFullPath){
h27 := hailstone(27)
MsgBox % "Length of hailstone 27: " (m := h27.MaxIndex()) "`nStarts with "
. h27[1] ", " h27[2] ", " h27[3] ", " h27[4]
. "`nEnds with "
. h27[m-3] ", " h27[m-2] ", " h27[m-1] ", " h27[m]

Loop 100000
{
h := hailstone(A_Index)
If (h.MaxIndex() > m)
m := h.MaxIndex(), longest := A_Index
}
MsgBox % "Longest hailstone is that of " longest " with a length of " m "!"
}


hailstone(n){
out := [n]
Loop
n := n & 1 ? n*3+1 : n//2, out.insert(n)
until n=1
return out
}
Running this directly gives the output:
Length of hailstone 27: 112
Starts with 27, 82, 41, 124
Ends with 8, 4, 2, 1

Longest hailstone is that of 77031 with a length of 351!


Then we can create a file (test.ahk) that uses the library (note the #Include line):
#NoEnv
#Include %A_ScriptDir%\hailstone.ahk
SetBatchLines -1

col := Object(), highestCount := 0

Loop 100000
{
length := hailstone(A_Index).MaxIndex()
if not col[length]
col[length] := 0
col[length]++
}
for length, count in col
if (count > highestCount)
highestCount := count, highestN := length
MsgBox % "the most common length was " highestN "; it occurred " highestCount " times."

Running this '''does not''' trigger the output of the hailstone.ahk, instead it outputs this:
the most common length was 72; it occurred 1467 times.

[[Link title]]

=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
To meet the terms of this task the BBC BASIC run-time engine '''bbcwrun.exe''' must be installed on the target PC and the file extension '''.bbc''' must be associated with this executable. This is normally the case when ''BBC BASIC for Windows'' has been installed.
===Library===
This must be saved as the file HAILSTONE.BBC. It may be used as a library (see below) or executed directly.
seqlen% = FNhailstone(27)
PRINT "Sequence length for 27 is "; seqlen%
maxlen% = 0
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%)
IF seqlen% > maxlen% THEN
maxlen% = seqlen%
maxnum% = number%
ENDIF
NEXT
PRINT "The number with the longest hailstone sequence is " ; maxnum%
PRINT "Its sequence length is " ; maxlen%
END

DEF FNhailstone(N%)
LOCAL L%
WHILE N% <> 1
IF N% AND 1 THEN N% = 3 * N% + 1 ELSE N% DIV= 2
L% += 1
ENDWHILE
= L% + 1

'''Output:'''

Sequence length for 27 is 112
The number with the longest hailstone sequence is 77031
Its sequence length is 351

===Client===
This uses the above program as a library:
INSTALL "HAILSTONE"

DIM freq%(351)
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%)
freq%(seqlen%) += 1
NEXT
max% = 0
FOR i% = 0 TO 351
IF freq%(i%) > max% THEN
max% = freq%(i%)
mostcommon% = i%
ENDIF
NEXT

PRINT "The most common sequence length is " ; mostcommon%
PRINT "It occurs " ; max% " times"
END

'''Output:'''

The most common sequence length is 72
It occurs 1467 times


=={{header|C}}==
Solution for Linux/GCC. First, header file hailstone.h:
#ifndef HAILSTONE
#define HAILSTONE

long hailstone(long, long**);
void free_sequence(long *);

#endif/*HAILSTONE*/

Then the lib source code hailstone.c (actual name doesn't matter):
#include
#include

long hailstone(long n, long **seq)
{
long len = 0, buf_len = 4;
if (seq)
*seq = malloc(sizeof(long) * buf_len);

while (1) {
if (seq) {
if (len >= buf_len) {
buf_len *= 2;
*seq = realloc(*seq, sizeof(long) * buf_len);
}
(*seq)[len] = n;
}
len ++;
if (n == 1) break;
if (n & 1) n = 3 * n + 1;
else n >>= 1;
}
return len;
}

void free_sequence(long * s) { free(s); }

const char my_interp[] __attribute__((section(".interp"))) = "/lib/ld-linux.so.2";
/* "ld-linux.so.2" should be whatever you use on your platform */

int hail_main() /* entry point when running along, see compiler command line */
{
long i, *seq;

long len = hailstone(27, &seq);
printf("27 has %ld numbers in sequence:\n", len);
for (i = 0; i < len; i++) {
printf("%ld ", seq[i]);
}
printf("\n");
free_sequence(seq);

exit(0);
}

A program to use the lib (I call it test.c):
#include
#include "hailstone.h"

int main()
{
long i, longest, longest_i, len;

longest = 0;
for (i = 1; i < 100000; i++) {
len = hailstone(i, 0);
if (len > longest) {
longest_i = i;
longest = len;
}
}

printf("Longest sequence at %ld, length %ld\n", longest_i, longest);

return 0;
}


Building the lib: gcc -Wall -W -fPIC -shared -o libhail.so hailstone.c -lc -Wl,-e,hail_main

Building the test.c code: gcc -Wall -L. -lhail test.c -o hailtest

Running the lib:
% ./libhail.so
27 has 112 numbers in sequence:
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274....


Running the program:
% LD_LIBRARY_PATH=. ./hailtest
Longest sequence at 77031, length 351


For a serious library the libhail.so would have been put into a system lib dir, but for now we'll just leave it in the same directory, so to run the program, we need to give additional hints to tell it where to find the lib: LD_LIBRARY_PATH=. ./hailtest

=={{header|Déjà Vu}}==

The library, named hailstone.deja:
local hailstone:
swap [ over ]
while < 1 dup:
if % over 2:
#odd
++ * 3
else:
#even
/ swap 2
swap push-through rot dup
drop

if = (name) :(main):
local :h27 hailstone 27
!. = 112 len h27
!. = 27 h27! 0
!. = 82 h27! 1
!. = 41 h27! 2
!. = 124 h27! 3
!. = 8 h27! 108
!. = 4 h27! 109
!. = 2 h27! 110
!. = 1 h27! 111

local :max 0
local :maxlen 0
for i range 1 99999:
dup len hailstone i
if < maxlen:
set :maxlen
set :max i
else:
drop
!print( "number: " to-str max ", length: " to-str maxlen )
else:
@hailstone


The client:
!import!hailstone

local :counts {}
set-default counts 0
for i range 1 99999:
set-to counts swap ++ counts! dup len hailstone i

local :maxlen 0
for k in keys counts:
if < maxlen counts! k:
set :maxlen counts! k
!print( "Maximum length: " to-str maxlen )


=={{header|Factor}}==
An ''executable library'' is a vocabulary with a main entry point.

This vocabulary, ''rosetta.hailstone'', exports the word ''hailstone'', but also uses ''MAIN:'' to declare a main entry point.

! rosetta/hailstone/hailstone.factor
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
IN: rosetta.hailstone

: hailstone ( n -- seq )
[ 1vector ] keep
[ dup 1 number= ]
[
dup even? [ 2 / ] [ 3 * 1 + ] if
2dup swap push
] until
drop ;

: main ( -- )
27 hailstone dup dup
"The hailstone sequence from 27:" print
" has length " write length .
" starts with " write 4 head [ unparse ] map ", " join print
" ends with " write 4 tail* [ unparse ] map ", " join print

! Maps n => { length n }, and reduces to longest Hailstone sequence.
1 100000 [a,b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
"The hailstone sequence from " write pprint
" has length " write pprint "." print ;
PRIVATE>

MAIN: main


There are two ways to run this program:

* Inside Factor, from its listener: "rosetta.hailstone" run
* Outside Factor, from some shell: ./factor -run=rosetta.hailstone

$ ./factor -run=rosetta.hailstone
Loading resource:work/rosetta/hailstone/hailstone.factor
The hailstone sequence from 27:
has length 112
starts with 27, 82, 41, 124
ends with 8, 4, 2, 1
The hailstone sequence from 77031 has length 351.


Any other Factor program can also use ''rosetta.hailstone'' as a regular vocabulary. This program only uses the word ''hailstone'' from that vocabulary, and never calls the main entry point of ''rosetta.hailstone''.

! rosetta/hailstone/length/length.factor
USING: assocs kernel io math math.ranges prettyprint
rosetta.hailstone sequences ;
IN: rosetta.hailstone.length

: f>0 ( object/f -- object/0 )
dup [ drop 0 ] unless ;

: max-value ( pair1 pair2 -- pair )
[ [ second ] bi@ > ] most ;

: main ( -- )
H{ } clone ! Maps sequence length => count.
1 100000 [a,b) [
hailstone length ! Find sequence length.
over [ f>0 1 + ] change-at ! Add 1 to count.
] each
! Find the length-count pair with the highest count.
>alist unclip-slice [ max-value ] reduce
first2 swap
"Among Hailstone sequences from 1 <= n < 100000," print
"there are " write pprint
" sequences of length " write pprint "." print ;
PRIVATE>

MAIN: main


$ ./factor -run=rosetta.hailstone.length
Loading resource:work/rosetta/hailstone/length/length.factor
Loading resource:work/rosetta/hailstone/hailstone.factor
Among Hailstone sequences from 1 <= n < 100000,
there are 72 sequences of length 1467.


=={{header|J}}==

This is the executable library:

hailseq=: -:`(1 3&p.)@.(2&|) ^:(1 ~: ]) ^:a:"0
9!:29]1
9!:27'main 0'
main=:3 :0
smoutput 'Hailstone sequence for the number 27'
smoutput hailseq 27
smoutput ''
smoutput 'Finding number with longest hailstone sequence which is'
smoutput 'less than 100000 (and finding that sequence length):'
smoutput (I.@(= >./),>./) #@hailseq i.1e5
)


Running it might look like this:

load jpath '~temp/hailseq.ijs'
Hailstone sequence for the number 27
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 ...
Finding number with longest hailstone sequence which is
less than 100000 (and finding that sequence length):
77031 351


This is the program which uses the library part of that executable library:

require '~temp/hailseq.ijs'
9!:29]1
9!:27'main 0'
main=:3 :0
smoutput 'Finding most frequent hailstone sequence length for'
smoutput 'Hailstone sequences for whole numbers less than 100000:'
smoutput {:{.\:~ (#/.~,.~.) #@hailseq }.i.1e5
)


Running it might look like this:

load jpath '~temp/66.ijs'
Finding most frequent hailstone sequence length for
Hailstone sequences for whole numbers less than 100000
72


Notes: 9!:29]1 tells the interpeter to run a phrase. 9!:27'phrase' tells the interpeter the phrase to execute. (9!: means, in essence: standard library number 9, and 9!:29 identifies a specific entry point in that library.) In 66.ijs we can not use the presence of 9!:29]1 from hailseq.ijs because hailseq.ijs was loaded with require which means that if it had already been loaded it will not be loaded again. (And, 66 here is just an arbitrary temporary file name.)

=={{header|Limbo}}==

There's no real difference in compilation or output for libraries versus commands in Inferno; commands (by convention) are expected to define an init() function that accepts a reference to a graphical context and a list of strings (i.e., the argument list) in order to satisy the type-checker. So this task is fairly simple. First, execlib.b looks like this:

implement Execlib;

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

Execlib: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
hailstone: fn(i: big): list of big;
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;

seq := hailstone(big 27);
l := len seq;

sys->print("hailstone(27): ");
for(i := 0; i < 4; i++) {
sys->print("%bd, ", hd seq);
seq = tl seq;
}
sys->print("⋯");

while(len seq > 4)
seq = tl seq;

while(seq != nil) {
sys->print(", %bd", hd seq);
seq = tl seq;
}
sys->print(" (length %d)\n", l);

max := 1;
maxn := big 1;
for(n := big 2; n < big 100000; n++) {
cur := len hailstone(n);
if(cur > max) {
max = cur;
maxn = n;
}
}
sys->print("hailstone(%bd) has length %d\n", maxn, max);
}

hailstone(i: big): list of big
{
if(i == big 1)
return big 1 :: nil;
if(i % big 2 == big 0)
return i :: hailstone(i / big 2);
return i :: hailstone(big 3 * i + big 1);
}


And execsexeclib.b (which executes execlib) looks like this:

implement ExecsExeclib;

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

ExecsExeclib: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
};

# Usually, this would be placed into something like "execlib.m",
# but it's fine here.
Execlib: module {
hailstone: fn(i: big): list of big;
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;
# This program expects that the result of compiling Execlib is execlib.dis,
# so you'll need to adjust this line if you used a different filename.
lib := load Execlib "execlib.dis";
if(lib == nil)
die("Couldn't load execlib.dis");

counts := array[352] of { * => 0 };
for(i := 1; i < 10000; i++) {
counts[len lib->hailstone(big i)]++;
}

max := 0;
maxi := 0;
for(i = 1; i < len counts; i++) {
if(counts[i] > max) {
max = counts[i];
maxi = i;
}
}
sys->print("The most common sequence length is %d (encountered %d times)\n", maxi, max);
}

die(s: string)
{
sys->fprint(sys->fildes(2), "runls: %s: %r", s);
raise "fail:errors";
}


{{out}}


% apply {limbo $1} *execlib.b
% apply {echo Running $1; $1} *execlib.dis
Running execlib.dis
hailstone(27): 27, 82, 41, 124, ⋯, 8, 4, 2, 1 (length 112)
hailstone(77031) has length 351
Running execsexeclib.dis
The most common sequence length is 53 (encountered 190 times)



=={{header|NetRexx}}==
The NetRexx compiler can generate Java classes and in common with all Java classes, public methods within each class are available for use by other programs. Packaging a class in a JAR file effectively crates a library that can be used by any other Java program. If this file is constructed correctly it can also by delivered as an "executable JAR file" which can be launched via the -jar switch of the java command. The following command can be used to package the [[Hailstone sequence#NetRexx|NetRexx Hailstone Sequence]] sample as an executable JAR file:
$ jar cvfe RHailstoneSequence.jar RHailstoneSequence RHailstoneSequence.class 
added manifest
adding: RHailstoneSequence.class(in = 2921) (out= 1567)(deflated 46%)


Here, the e switch causes the jar program to add a Main-Class property to the generated jar manifest which now contains the following:

Manifest-Version: 1.0
Created-By: 1.7.0_15 (Oracle Corporation)
Main-Class: RHailstoneSequence


With this Main-Class property present, launching the program via java -jar will cause Java to attempt to execute the main() method of the program specified above (RHailstoneSequence):

$ java -jar RHailstoneSequence.jar
The number 27 has a hailstone sequence comprising 112 elements
its first four elements are: 27 82 41 124
and last four elements are: 8 4 2 1
The number 77031 has the longest hailstone sequence in the range 1 to 99999 with a sequence length of 351

Using this JAR file as a library, the following program can use the hailstone(N) method to complete the task:

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

import RHailstoneSequence

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
parse arg beginNum endNum .
if beginNum = '' | beginNum = '.' then beginNum = 1
if endNum = '' | endNum = '.' then endNum = 100000
if beginNum > endNum then signal IllegalArgumentException('Gronk!')

-- collect sequences
hailstones = 0
loop hn = beginNum while hn < endNum
hslist = RHailstoneSequence.hailstone(hn)
hscount = hslist.words()
hailstones[hscount] = hailstones[hscount] + 1
end hn

-- locate most common
mostOftenNum = 0
mostOftenCount = 0
loop hn = beginNum while hn < endNum
if hailstones[hn] > mostOftenCount then do
mostOftenCount = hailstones[hn]
mostOftenNum = hn
end
end hn

say 'The length of hailstone sequence that is most common in the range' beginNum '<= N <' endNum 'is' mostOftenNum'. It occurs' mostOftenCount 'times.'
return


The program can then be launched with the java command. In this sample the JAR file is included via the -cp switch:
{{out}}
$ java -cp .:RHailstoneSequence.jar RHailstoneSequenceUser
The length of hailstone sequence that is most common in the range 1 <= N < 100000 is 72. It occurs 1467 times.


=={{header|Perl}}==
Lib package in file Hailstone.pm:package Hailstone;

sub seq {
my $x = shift;
$x == 1 ? (1) : ($x & 1)? ($x, seq($x * 3 + 1))
: ($x, seq($x / 2))
}

my %cache = (1 => 1);
sub len {
my $x = shift;
$cache{$x} //= 1 + (
$x & 1 ? len($x * 3 + 1)
: len($x / 2))
}

unless (caller) {
for (1 .. 100_000) {
my $l = len($_);
($m, $len) = ($_, $l) if $l > $len;
}
print "seq of 27 - $cache{27} elements: @{[seq(27)]}\n";
print "Longest sequence is for $m: $len\n";
}

1;

Main program in file test.pl:use Hailstone;
use strict;
use warnings;

my %seqs;
for (1 .. 100_000) {
$seqs{Hailstone::len($_)}++;
}

my ($most_frequent) = sort {$seqs{$b} <=> $seqs{$a}} keys %seqs;
print "Most frequent length: $most_frequent ($seqs{$most_frequent} occurrences)\n";

Running the lib:
% perl Hailstone.pm
seq of 27 - 112 elements: 27 82 41 124 62 31 94 47 142 ... 10 5 16 8 4 2 1
Longest sequence is for 77031: 351

Running the main program:
% perl test.pl
Most frequent length: 72 (1467 occurrences)


=={{header|Perl 6}}==
The library can be written as a module:
module Hailstone {
our sub hailstone($n) is export {
$n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1
}
}

sub MAIN {
say "hailstone(27) = {.[^4]} [...] {.[*-4 .. *-1]}" given Hailstone::hailstone 27;
}


It can be run with:
$ perl6 Hailstone.pm
{{out}}
hailstone(27) = 27 82 41 124 [...] 8 4 2 1


It can then be used with a program such as:
use Hailstone;
my %score; %score{hailstone($_).elems}++ for 1 .. 100_000;
say "Most common lengh is {.key}, occuring {.value} times." given max :by(*.value), %score;


Called with a command line as:
$ PERL6LIB=. perl6 test-hailstone.p6


The environment variable PERL6LIB might be necessary if the file Hailstone.pm is not in the standard library path for Perl 6.

=={{header|Pike}}==
any Pike source file is a class and can be instantiated as an object.
to executable a Pike file it needs a main() function.

Pike modules are classes instantiated at compile time. below we demonstrate both forms:

to use the library as a class, save it as HailStone.pike
to use it as a module, save it as Hailstone.pmod

both can be used as an executable.
#!/usr/bin/env pike

int next(int n)
{
if (n==1)
return 0;
if (n%2)
return 3*n+1;
else
return n/2;
}

array(int) hailstone(int n)
{
array seq = ({ n });
while (n=next(n))
seq += ({ n });
return seq;
}

void main()
{
array(int) two = hailstone(27);
if (equal(two[0..3], ({ 27, 82, 41, 124 })) && equal(two[<3..], ({ 8,4,2,1 })))
write("sizeof(({ %{%d, %}, ... %{%d, %} }) == %d\n", two[0..3], two[<3..], sizeof(two));

mapping longest = ([ "length":0, "start":0 ]);

foreach(allocate(100000); int start; )
{
int length = sizeof(hailstone(start));
if (length > longest->length)
{
longest->length = length;
longest->start = start;
}
}
write("longest sequence starting at %d has %d elements\n", longest->start, longest->length);
}


if run directly we get:
$ pike hailstone.pike
sizeof(({ 27, 82, 41, 124, , ... 8, 4, 2, 1, }) == 112
longest sequence starting at 77031 has 351 elements

to use it as a class we need to instantiate an object.
note that the . in .HailStone only signifies calling a class or module from the current directory.
the analyze function is identical in both examples:
void main()
{
.HailStone HailStone = .HailStone();

mapping long = ([]);

foreach (allocate(100000); int start; )
long[sizeof(HailStone->hailstone(start))]++;

analyze(long);
}

void analyze(mapping long)
{
mapping max = ([ "count":0, "length":0 ]);
foreach (long; int length; int count)
{
if (count > max->count)
{
max->length = length;
max->count = count;
}
}
write("most common length %d appears %d times\n", max->length, max->count);
}


a module is already instantiated so we can use it directly.
like above the initial . in .Hailstone.hailstone only signifies the current directory, the second . is a member reference resolved at compile time.
void main()
{
mapping long = ([]);

foreach (allocate(100000); int start; )
long[sizeof(.Hailstone.hailstone(start))]++;

analyze(long);
}

void analyze(mapping long)
{
mapping max = ([ "count":0, "length":0 ]);
foreach (long; int length; int count)
{
if (count > max->count)
{
max->length = length;
max->count = count;
}
}
write("most common length %d appears %d times\n", max->length, max->count);
}


Output for both examples:
most common length 72 appears 1467 times

=={{header|PicoLisp}}==
There is no formal difference between libraries and other executable files in PicoLisp. Any function in a library can be called from the command line by prefixing it with '-'. Create an executable file (chmod +x) "hailstone.l":
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(de hailstone (N)
(make
(until (= 1 (link N))
(setq N
(if (bit? 1 N)
(inc (* N 3))
(/ N 2) ) ) ) ) )

(de hailtest ()
(let L (hailstone 27)
(test 112 (length L))
(test (27 82 41 124) (head 4 L))
(test (8 4 2 1) (tail 4 L)) )
(let N (maxi '((N) (length (hailstone N))) (range 1 100000))
(test 77031 N)
(test 351 (length (hailstone N))) )
(println 'OK)
(bye) )

and an executable file (chmod +x) "test.l":
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(load "hailstone.l")

(let Len NIL
(for N 100000
(accu 'Len (length (hailstone N)) 1) )
(let M (maxi cdr Len)
(prinl "The hailstone length returned most often is " (car M))
(prinl "It is returned " (cdr M) " times") ) )
(bye)

Test:
$ ./hailstone.l -hailtest
OK

$ ./test.l
The hailstone length returned most often is 72
It is returned 1467 times


=={{header|Python}}==
Executable libraries are common in Python. The [[Hailstone sequence#Python|Python]] entry for Hailstone sequence is already written in the correct manner.

The entry is copied below and, for this task needs to be in a file called hailstone.py:
def hailstone(n):
seq = [n]
while n>1:
n = 3*n + 1 if n & 1 else n//2
seq.append(n)
return seq

if __name__ == '__main__':
h = hailstone(27)
assert len(h)==112 and h[:4]==[27, 82, 41, 124] and h[-4:]==[8, 4, 2, 1]
print("Maximum length %i was found for hailstone(%i) for numbers <100,000" %
max((len(hailstone(i)), i) for i in range(1,100000)))


In the case of the Python language the interpreter maintains a module level variable called __name__. If the file hailstone.py is ''imported'' (as import hailstone), then the __name__ variable is set to the import name of 'hailstone' and the if __name__ == '__main__' expression would then be false, and only the hailstone function is available to the importer.

If the same file hailstone.py is ''run'', (as maybe python hailstone.py; or maybe double-clicking the hailstone.py file), then the __name__ variable is set to the special name of '__main__' and the if __name__ == '__main__' expression would then be true causing its block of code to be executed.

'''Library importing executable'''

The second executable is the file common_hailstone_length.py with this content:
from collections import Counter

def function_length_frequency(func, hrange):
return Counter(len(func(n)) for n in hrange).most_common()

if __name__ == '__main__':
from executable_hailstone_library import hailstone

upto = 100000
hlen, freq = function_length_frequency(hailstone, range(1, upto))[0]
print("The length of hailstone sequence that is most common for\n"
"hailstone(n) where 1<=n<%i, is %i. It occurs %i times."
% (upto, hlen, freq))


Both files could be in the same directory. (That is the easiest way to make the library known to its importer for this example)

'''Sample output'''

On executing the file common_hailstone_length.py it loads the library and produces the following result:
The length of hailstone sequence that is most common for
hailstone(n) where 1<=n<100000, is 72. It occurs 1467 times


Note that the file common_hailstone_length.py is itself written as an executable library. When imported it makes function_length_frequency available to the importer.

===Other examples===
* The Python Prime decomposition entry of [[Least common multiple]] employs [[Prime decomposition#Python]] as an executable library.
* [[Names_to_numbers#Python]] uses [[Number_names#Python]] as an executable library.

=={{header|Racket}}==

When Racket runs a file (with racket some-file) it executes its
toplevel expressions, and then it runs a submodule named main if there
is one. When a file is used as a library (with require), the toplevel
expressions are executed as well, but the main is not
executed. The idea is that toplevel expressions might be used to initialize
state that the library needs -- a good example here is the initialization of
the memoization hash table. (Note that this is better than the common hacks of
check-the-loaded-script-name, since it is robust against failures due to
symlinks, case normalization, etc etc.)

We start with a "hs.rkt" file that has the exact code from the
[[Hailstone sequence#Racket]] solution, except that the hailstone
function is now provided, and the demonstration printout is pushed into a
main submodule:

#lang racket

(provide hailstone)
(define hailstone
(let ([t (make-hasheq)])
(hash-set! t 1 '(1))
(λ(n) (hash-ref! t n
(λ() (cons n (hailstone (if (even? n) (/ n 2) (+ (* 3 n) 1)))))))))

(module+ main
(define h27 (hailstone 27))
(printf "h(27) = ~s, ~s items\n"
`(,@(take h27 4) ... ,@(take-right h27 4))
(length h27))
(define N 100000)
(define longest
(for/fold ([m #f]) ([i (in-range 1 (add1 N))])
(define h (hailstone i))
(if (and m (> (cdr m) (length h))) m (cons i (length h)))))
(printf "for x<=~s, ~s has the longest sequence with ~s items\n"
N (car longest) (cdr longest)))

Running it directly produces the same output as [[Hailstone sequence#Racket]]:

$ racket hs.rkt
first 4 elements of h(27): '(27 82 41 124)
last 4 elements of h(27): '(8 4 2 1)
x < 10000 such that h(x) gives the longest sequence: 351


And now this can be used from a second source file, "hsfreq.rkt" as a
library:

#lang racket
(require "hs.rkt")
(define N 100000)
(define t (make-hasheq))
(define best
(for/fold ([best #f]) ([i (in-range 1 (add1 N))])
(define len (length (hailstone i)))
(define freq (add1 (hash-ref t len 0)))
(hash-set! t len freq)
(if (and best (> (car best) freq)) best (cons freq len))))
(printf "Most frequent sequence length for x<=~s: ~s, appearing ~s times\n" N
(cdr best) (car best))



$ racket hsfreq.rkt
Most frequent sequence length for x<=100000: 72, appearing 1467 times


=={{header|REXX}}==
===task 1===
The following REXX subroutine (or function, as it returns a value) is normally stored in a folder that the REXX interpreter searches first for subroutine/function call/invokes.

If not there, the REXX interpreter normally checks the current drive (or default disk), and then through some sort of heirarchy --- depending upon the particular REXX interpreter and operating system.


On Microsoft Windows systems using Regina, PC/REXX, Personal REXX, R4, or ROO, the program name is normally the function name with a file extension of '''REX''   (but that isn't a strict requirement or rule, each REXX interpreter has multiple file extensions that are supported).

On VM/CMS systems, the filetype (the file extension) is normally   '''EXEC'''.   If however, the REXX program was previously '''EXECLOAD'''ed, it may have a different name (identity) assigned to it.

The following program (function) is named:   '''HAILSTONE.REX'''   (the case doesn't matter for Microsoft Windows systems).

All REXX interpreters support subroutines/functions being on the current drive ('''CD'''), default disk (or MDISK in the case of CMS), or the equivalent.
/*REXX program returns the hailstone (Collatz) sequence for any integer.*/
numeric digits 20 /*ensure enough digits for mult. */
parse arg n 1 s /*N & S assigned to the first arg*/
do while n\==1 /*loop while N isn't unity. */
if n//2 then n=n*3+1 /*if N is odd, calc: 3*n +1 */
else n=n%2 /* " " " even, perform fast ÷ */
s=s n /*build a sequence list (append).*/
end /*while*/
return s

===task 2, 3===
The following program is named:  : '''HAIL_PGM.REX'''   and is stored in the current directory.
/*REXX pgm tests a number and a range for hailstone (Collatz) sequences.*/
parse arg x .; if x=='' then x=27 /*get the optional first argument*/

$=hailstone(x) /*═════════════task 2════════════*/
#=words($) /*number of numbers in sequence. */
say x 'has a hailstone sequence of' # 'and starts with: ' subword($,1,4),
' and ends with:' subword($,#-3)
say
w=0; do j=1 for 99999 /*═════════════task 3════════════*/
$=hailstone(j); #=words($) /*obtain the hailstone sequence. */
if #<=w then iterate /*Not big 'nuff? Then keep going.*/
bigJ=j; w=# /*remember what # has biggest HS.*/
end /*j*/

say '(between 1──►99,999) ' bigJ 'has the longest hailstone sequence:' w
/*stick a fork in it, we're done.*/

'''output'''

27 has a hailstone sequence of 112 and starts with: 27 82 41 124 and ends with: 8 4 2 1

(between 1──►99,999) 77031 has the longest hailstone sequence: 351

===task 4===
The following program is named:   '''MAIL_POP.REX'''   and is stored in the current directory.
/*REXX pgm finds the most common (popular) hailstone sequence length. */
parse arg z .; if z=='' then z=99999 /*get the optional first argument*/
!.=0
w=0; do j=1 for z /*═════════════task 4════════════*/
#=words(hailstone(j)) /*obtain hailstone sequence count*/
!.# = !.# + 1 /*add unity to popularity count. */
end /*j*/
occ=0; p=0
do k=1 for z
if !.k>occ then do; occ=!.k; p=k; end
end /*p*/

say '(between 1──►'z") " p,
' is the most common hailstone sequence length (with' occ "occurrences)."
/*stick a fork in it, we're done.*/

'''output'''

(between 1──►99999) 72 is the most common hailstone sequence length (with 1467 occurrences).

===task 5===
To run a REXX program, it depends on the REXX interpretor and which operating system is being used   (and what options where used when the REXX interpreter was installed/set up).


On a VM/CMS system, you could enter:
*             HAILSTONE
* EXEC HAILSTONE
to execute the   '''HAILSTONE EXEC A'''   program   (there are also other ways to invoke it).


On a Microsoft Windows system, you could enter:
*       HAILSTONE.REX
*       HAILSTONE
* xxx HAILSTONE.REX
* xxx HAILSTONE
where   '''xxx'''   is the name of the REXX interpreter, and if installed under a Microsoft Windows (Next family), the file extension and/or the REXX interpreter can be omitted.




=={{header|Ruby}}==
An executable library checks ''__FILE__ == $0''. Here, ''__FILE__'' is the path of the current source file, and ''$0'' is the path of the current executable. If ''__FILE__ == $0'', then the current source file is the executable, else the current source file is a library for some other executable.

* ''__FILE__ == $0'' also works with older versions of Ruby, but this Hailstone example calls new methods in Ruby 1.8.7.

This is ''hailstone.rb'', a modification of [[Hailstone sequence#Ruby]] as an executable library.

{{works with|Ruby|1.8.7}}

# hailstone.rb
module Hailstone
module_function
def hailstone n
seq = [n]
until n == 1
n = (n.even?) ? (n / 2) : (3 * n + 1)
seq << n
end
seq
end
end

if __FILE__ == $0
include Hailstone

# for n = 27, show sequence length and first and last 4 elements
hs27 = hailstone 27
p [hs27.length, hs27[0..3], hs27[-4..-1]]

# find the longest sequence among n less than 100,000
n, len = (1 ... 100_000) .collect {|n|
[n, hailstone(n).length]} .max_by {|n, len| len}
puts "#{n} has a hailstone sequence length of #{len}"
puts "the largest number in that sequence is #{hailstone(n).max}"
end


It runs like any Ruby program:

$ ruby scratch.rb                                                              
[112, [27, 82, 41, 124], [8, 4, 2, 1]]
77031 has a hailstone sequence length of 351
the largest number in that sequence is 21933016


This is ''hsfreq.rb'', which requires ''hailstone.rb'' as a library.

# hsfreq.rb
require 'hailstone'

h = Hash.new(0)
last = 99_999
(1..last).each {|n| h[Hailstone.hailstone(n).length] += 1}
length, count = h.max_by {|length, count| count}

puts "Given the hailstone sequences from 1 to #{last},"
puts "the most common sequence length is #{length},"
puts "with #{count} such sequences."


As with any library, ''hailstone.rb'' must be in $:, the search path for libraries. One way is to leave ''hailstone.rb'' in the current directory and run ruby -I. hsfreq.rb. (Ruby older than 1.9.2 also searches the current directory by default.)

$ ruby -I. hsfreq.rb
Given the hailstone sequences from 1 to 99999,
the most common sequence length is 72,
with 1467 such sequences.


=={{header|Scala}}==
[[Category:Scala Implementations]]
{{libheader|Scala}}
In Scala it is possible to combine several "main"s (mixed-in by the App trait) in one file (e.g. HailstoneSequence.scala):
object HailstoneSequence extends App { // Show it all, default number is 27.
def hailstone(n: Int): Stream[Int] =
n #:: (if (n == 1) Stream.empty else hailstone(if (n % 2 == 0) n / 2 else n * 3 + 1))

Hailstone.details(args.headOption.map(_.toInt).getOrElse(27))
HailTest.main(Array())
}

object Hailstone extends App { // Compute a given or default number to Hailstone sequence
def details(nr: Int) = {
val collatz = HailstoneSequence.hailstone(nr)

println(s"Use the routine to show that the hailstone sequence for the number: $nr.")
println(collatz.toList)
println(s"It has ${collatz.length} elements.")
}
details(args.headOption.map(_.toInt).getOrElse(27))
}

object HailTest extends App { // Compute only the < 100000 test
println(
"Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.")
val (n, len) = (1 until 100000).map(n => (n, HailstoneSequence.hailstone(n).length)).maxBy(_._2)
println(s"Longest hailstone sequence length= $len occurring with number $n.")
}


Steps:

1. First let the compiler process the source file:
C:\Users\FransAdm\Documents>scalac HailstoneSequence.scala

2. Run the Hailstone function with a parameter:
C:\Users\FransAdm\Documents>scala Hailstone 42
Use the routine to show that the hailstone sequence for the number: 42.
List(42, 21, 64, 32, 16, 8, 4, 2, 1)
It has 9 elements.
3. Run the combined function and < 100000 test:
C:\Users\FransAdm\Documents>scala HailstoneSequence 27
Use the routine to show that the hailstone sequence for the number: 27.
List(27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155,
466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850,
425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154,
3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80
, 40, 20, 10, 5, 16, 8, 4, 2, 1)
It has 112 elements.
Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.

4. Finally do only the callable < 100000 test
C:\Users\FransAdm\Documents>scala HailTest
Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.

C:\Users\FransAdm\Documents>

=={{header|Tcl}}==
The standard idiom for detecting whether a script is being loaded as a library or run directly is to compare the result of info script (which describes the name of the currently sourced script file) and the global argv0 variable (which holds the name of the main script).
### In the file hailstone.tcl ###
package provide hailstone 1.0

proc hailstone n {
while 1 {
lappend seq $n
if {$n == 1} {return $seq}
set n [expr {$n & 1 ? $n*3+1 : $n/2}]
}
}

# If directly executed, run demo code
if {[info script] eq $::argv0} {
set h27 [hailstone 27]
puts "h27 len=[llength $h27]"
puts "head4 = [lrange $h27 0 3]"
puts "tail4 = [lrange $h27 end-3 end]"

set maxlen [set max 0]
for {set i 1} {$i<100000} {incr i} {
set l [llength [hailstone $i]]
if {$l>$maxlen} {set maxlen $l;set max $i}
}
puts "max is $max, with length $maxlen"
}


To make the package locatable, run this Tcl script in the same directory which builds the index file:
pkg_mkIndex .

Using the above code as a library then just requires that we tell the script the location of the additional library directory by adding it to the global auto_path variable; it is unnecessary if the script is installed in one of the standard locations (a fairly long list that depends on the installation):
#!/usr/bin/tclsh8.6
package require Tcl 8.6 ;# For [lsort -stride] option
lappend auto_path . ;# Or wherever it is located
package require hailstone 1.0

# Construct a histogram of length frequencies
set histogram {}
for {set n 1} {$n < 100000} {incr n} {
dict incr histogram [llength [hailstone $n]]
}

# Identify the most common length by sorting...
set sortedHist [lsort -decreasing -stride 2 -index 1 $histogram]
lassign $sortedHist mostCommonLength freq

puts "most common length is $mostCommonLength, with frequency $freq"


{{omit from|Go}}
{{omit from|GUISS}}
{{omit from|Maxima}}

Executable library

Pete: /* {{header|Limbo}} */ Add code tags.


{{task}}
The general idea behind an executable library is to create a library that when used as a library does one thing; but has the ability to be run directly via command line. Thus the API comes with a CLI in the very same source code file.

'''Task detail'''

* Create a library/module/dll/shared object/... for a programming language that contains a function/method called hailstone that is a function taking a positive integer and returns the [[Hailstone sequence]] for that number.

* The library, when executed directly should satisfy the remaining requirements of the [[Hailstone sequence]] task:
:: 2. Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
:: 3. Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.

* Create a second executable to calculate the following:
** Use the library's hailstone function, in the standard manner, (or document how this use deviates from standard use of a library), together with extra code in this executable, to find the hailstone length returned most often for 1 ≤ n < 100,000.

* Explain any extra setup/run steps needed to complete the task.

'''Notes:'''
* It is assumed that for a language that overwhelmingly ships in a compiled form, such as C, the library must also be an executable and the compiled user of that library is to do so without changing the compiled library. I.e. the compile tool-chain is assumed ''not'' to be present in the runtime environment.
* Interpreters are present in the runtime environment.

=={{header|Ada}}==

In Ada, '''any parameterless procedure''' can either '''run as a (stand-alone) main program''', or can '''be called from another program''' like a library function. For the task at hand, this appears useful -- except for the following two obstacles:

1. There are neither ingoing parameters into a parameterless procedure, nor is there a return value.

2. The procedure does not know how it has been called: is it running as a main program, or has it been called from another program?

To overcome the first obstacle, we implement a very simplistic parameter passing mechanism in a package Parameter (''parameter.ads''): The global variable Parameter.X will hold the ingoing parameter, the other global variable Parameter.Y will take the return value. To overcome the second obstacle, we ensure that Parameter.X is 0 by default.

package Parameter is
X: Natural := 0;
Y: Natural;
end Parameter;


Now comes our parameterless procedure Hailstone (''hailstone.adb''). Note that we are
using the the package Hailstones (''hailstones.adb/hailstones.ads'') from
[[Hailstone sequence#Alternative method]] to perform the real computation.

with Ada.Text_IO, Parameter, Hailstones;

procedure Hailstone is
-- if Parameter.X > 0, the length of Hailstone(Parameter.X)
-- is computed and written into Parameter.Y

-- if Parameter.X = 0, Hailstone(27) and N <= 100_000 with maximal
-- Hailstone(N) are computed and printed.

procedure Show_Sequence(N: Natural) is
Seq: Hailstones.Integer_Sequence := Hailstones.Create_Sequence(N);
begin
Ada.Text_IO.Put("Hailstone(" & Integer'Image(N) & " ) = (");
if Seq'Length < 8 then
for I in Seq'First .. Seq'Last-1 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) & ",");
end loop;
else
for I in Seq'First .. Seq'First+3 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) & ",");
end loop;
Ada.Text_IO.Put(" ...,");
for I in Seq'Last-3 .. Seq'Last-1 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) &",");
end loop;
end if;
Ada.Text_IO.Put_Line(Integer'Image(Seq(Seq'Last)) & " ); Length: " &
Integer'Image(seq'Length));
end Show_Sequence;
begin
if Parameter.X>0 then
Parameter.Y := Hailstones.Create_Sequence(Parameter.X)'Length;
else
Show_Sequence(27);
declare
Longest: Natural := 0;
Longest_Length: Natural := 0;
begin
for I in 2 .. 100_000 loop
if Hailstones.Create_Sequence(I)'Length > Longest_Length then
Longest := I;
Longest_Length := Hailstones.Create_Sequence(I)'Length;
end if;
end loop;
Ada.Text_IO.Put("Longest<=100_000: ");
Show_Sequence(Longest);
end;
end if;
end Hailstone;


If we compile this and run it, we get the following output.

> ./hailstone
Hailstone( 27 ) = ( 27, 82, 41, 124, ..., 8, 4, 2, 1 ); Length: 112
Longest<=100_000: Hailstone( 77031 ) = ( 77031, 231094, 115547, 346642, ..., 8, 4, 2, 1 ); Length: 351


To use the same procedure like a library function, we need a specification (file ''hailstone.ads''),
that essentially repeats the parameter profile. As our procedure is actually parameterless, this specification is more than trivial.

procedure Hailstone;

Finally, we write another parameterless procedure (''hailstone_test.adb''), that will call the procedure Hailstone. Note that we '''must''' change the Parameter.X to a value > 0 before calling Hailstone, otherwise, Hailstone would act as if it where the main program.

with Hailstone, Parameter, Ada.Text_IO;

procedure Hailstone_Test is
Counts: array (1 .. 100_000) of Natural := (others => 0);
Max_Count: Natural := 0;
Most_Common: Positive := Counts'First;
Length: Natural renames Parameter.Y;
Sample: Natural := 0;
begin
for I in Counts'Range loop
Parameter.X := I;
Hailstone; -- compute the length of Hailstone(I)
Counts(Length) := Counts(Length)+1;
end loop;
for I in Counts'Range loop
if Counts(I) > Max_Count then
Max_Count := Counts(I);
Most_Common := I;
end if;
end loop;
Ada.Text_IO.Put_Line("Most frequent length:"
& Integer'Image(Most_Common)
& ";" & Integer'Image(Max_Count)
& " sequences of that length.");
for I in Counts'Range loop
Parameter.X := I;
Hailstone; -- compute the length of Hailstone(I)
if Length = Most_Common then
Sample := I;
exit;
end if;
end loop;
Ada.Text_IO.Put_Line("The first such sequence: Hailstone("
& Integer'Image(Sample) & " ).");
end Hailstone_Test;
.

Compiling and running this gives the following output:

> ./hailstone_test 
Most frequent length: 72; 1467 sequences of that length.
The first such sequence: Hailstone( 444 ).


Note that using global variables for parameter and return value passing works here, but is bad programming practice. Ada is a compiled language, and it is not clear how useful an executable library written in a compiled language is, anyway.

In fact, except for the constraints imposed by this task, there is no reason to ask the procedure Hailstone for the length of a Hailstone sequence -- solid software engineering practice would require to directly call the parameterized function Hailstones.Create_Sequence.

=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
First we create the library, hailstone.ahk:
#NoEnv
SetBatchLines, -1

; Check if we're executed directly:
If (A_LineFile = A_ScriptFullPath){
h27 := hailstone(27)
MsgBox % "Length of hailstone 27: " (m := h27.MaxIndex()) "`nStarts with "
. h27[1] ", " h27[2] ", " h27[3] ", " h27[4]
. "`nEnds with "
. h27[m-3] ", " h27[m-2] ", " h27[m-1] ", " h27[m]

Loop 100000
{
h := hailstone(A_Index)
If (h.MaxIndex() > m)
m := h.MaxIndex(), longest := A_Index
}
MsgBox % "Longest hailstone is that of " longest " with a length of " m "!"
}


hailstone(n){
out := [n]
Loop
n := n & 1 ? n*3+1 : n//2, out.insert(n)
until n=1
return out
}
Running this directly gives the output:
Length of hailstone 27: 112
Starts with 27, 82, 41, 124
Ends with 8, 4, 2, 1

Longest hailstone is that of 77031 with a length of 351!


Then we can create a file (test.ahk) that uses the library (note the #Include line):
#NoEnv
#Include %A_ScriptDir%\hailstone.ahk
SetBatchLines -1

col := Object(), highestCount := 0

Loop 100000
{
length := hailstone(A_Index).MaxIndex()
if not col[length]
col[length] := 0
col[length]++
}
for length, count in col
if (count > highestCount)
highestCount := count, highestN := length
MsgBox % "the most common length was " highestN "; it occurred " highestCount " times."

Running this '''does not''' trigger the output of the hailstone.ahk, instead it outputs this:
the most common length was 72; it occurred 1467 times.

[[Link title]]

=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
To meet the terms of this task the BBC BASIC run-time engine '''bbcwrun.exe''' must be installed on the target PC and the file extension '''.bbc''' must be associated with this executable. This is normally the case when ''BBC BASIC for Windows'' has been installed.
===Library===
This must be saved as the file HAILSTONE.BBC. It may be used as a library (see below) or executed directly.
seqlen% = FNhailstone(27)
PRINT "Sequence length for 27 is "; seqlen%
maxlen% = 0
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%)
IF seqlen% > maxlen% THEN
maxlen% = seqlen%
maxnum% = number%
ENDIF
NEXT
PRINT "The number with the longest hailstone sequence is " ; maxnum%
PRINT "Its sequence length is " ; maxlen%
END

DEF FNhailstone(N%)
LOCAL L%
WHILE N% <> 1
IF N% AND 1 THEN N% = 3 * N% + 1 ELSE N% DIV= 2
L% += 1
ENDWHILE
= L% + 1

'''Output:'''

Sequence length for 27 is 112
The number with the longest hailstone sequence is 77031
Its sequence length is 351

===Client===
This uses the above program as a library:
INSTALL "HAILSTONE"

DIM freq%(351)
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%)
freq%(seqlen%) += 1
NEXT
max% = 0
FOR i% = 0 TO 351
IF freq%(i%) > max% THEN
max% = freq%(i%)
mostcommon% = i%
ENDIF
NEXT

PRINT "The most common sequence length is " ; mostcommon%
PRINT "It occurs " ; max% " times"
END

'''Output:'''

The most common sequence length is 72
It occurs 1467 times


=={{header|C}}==
Solution for Linux/GCC. First, header file hailstone.h:
#ifndef HAILSTONE
#define HAILSTONE

long hailstone(long, long**);
void free_sequence(long *);

#endif/*HAILSTONE*/

Then the lib source code hailstone.c (actual name doesn't matter):
#include
#include

long hailstone(long n, long **seq)
{
long len = 0, buf_len = 4;
if (seq)
*seq = malloc(sizeof(long) * buf_len);

while (1) {
if (seq) {
if (len >= buf_len) {
buf_len *= 2;
*seq = realloc(*seq, sizeof(long) * buf_len);
}
(*seq)[len] = n;
}
len ++;
if (n == 1) break;
if (n & 1) n = 3 * n + 1;
else n >>= 1;
}
return len;
}

void free_sequence(long * s) { free(s); }

const char my_interp[] __attribute__((section(".interp"))) = "/lib/ld-linux.so.2";
/* "ld-linux.so.2" should be whatever you use on your platform */

int hail_main() /* entry point when running along, see compiler command line */
{
long i, *seq;

long len = hailstone(27, &seq);
printf("27 has %ld numbers in sequence:\n", len);
for (i = 0; i < len; i++) {
printf("%ld ", seq[i]);
}
printf("\n");
free_sequence(seq);

exit(0);
}

A program to use the lib (I call it test.c):
#include
#include "hailstone.h"

int main()
{
long i, longest, longest_i, len;

longest = 0;
for (i = 1; i < 100000; i++) {
len = hailstone(i, 0);
if (len > longest) {
longest_i = i;
longest = len;
}
}

printf("Longest sequence at %ld, length %ld\n", longest_i, longest);

return 0;
}


Building the lib: gcc -Wall -W -fPIC -shared -o libhail.so hailstone.c -lc -Wl,-e,hail_main

Building the test.c code: gcc -Wall -L. -lhail test.c -o hailtest

Running the lib:
% ./libhail.so
27 has 112 numbers in sequence:
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274....


Running the program:
% LD_LIBRARY_PATH=. ./hailtest
Longest sequence at 77031, length 351


For a serious library the libhail.so would have been put into a system lib dir, but for now we'll just leave it in the same directory, so to run the program, we need to give additional hints to tell it where to find the lib: LD_LIBRARY_PATH=. ./hailtest

=={{header|Déjà Vu}}==

The library, named hailstone.deja:
local hailstone:
swap [ over ]
while < 1 dup:
if % over 2:
#odd
++ * 3
else:
#even
/ swap 2
swap push-through rot dup
drop

if = (name) :(main):
local :h27 hailstone 27
!. = 112 len h27
!. = 27 h27! 0
!. = 82 h27! 1
!. = 41 h27! 2
!. = 124 h27! 3
!. = 8 h27! 108
!. = 4 h27! 109
!. = 2 h27! 110
!. = 1 h27! 111

local :max 0
local :maxlen 0
for i range 1 99999:
dup len hailstone i
if < maxlen:
set :maxlen
set :max i
else:
drop
!print( "number: " to-str max ", length: " to-str maxlen )
else:
@hailstone


The client:
!import!hailstone

local :counts {}
set-default counts 0
for i range 1 99999:
set-to counts swap ++ counts! dup len hailstone i

local :maxlen 0
for k in keys counts:
if < maxlen counts! k:
set :maxlen counts! k
!print( "Maximum length: " to-str maxlen )


=={{header|Factor}}==
An ''executable library'' is a vocabulary with a main entry point.

This vocabulary, ''rosetta.hailstone'', exports the word ''hailstone'', but also uses ''MAIN:'' to declare a main entry point.

! rosetta/hailstone/hailstone.factor
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
IN: rosetta.hailstone

: hailstone ( n -- seq )
[ 1vector ] keep
[ dup 1 number= ]
[
dup even? [ 2 / ] [ 3 * 1 + ] if
2dup swap push
] until
drop ;

: main ( -- )
27 hailstone dup dup
"The hailstone sequence from 27:" print
" has length " write length .
" starts with " write 4 head [ unparse ] map ", " join print
" ends with " write 4 tail* [ unparse ] map ", " join print

! Maps n => { length n }, and reduces to longest Hailstone sequence.
1 100000 [a,b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
"The hailstone sequence from " write pprint
" has length " write pprint "." print ;
PRIVATE>

MAIN: main


There are two ways to run this program:

* Inside Factor, from its listener: "rosetta.hailstone" run
* Outside Factor, from some shell: ./factor -run=rosetta.hailstone

$ ./factor -run=rosetta.hailstone
Loading resource:work/rosetta/hailstone/hailstone.factor
The hailstone sequence from 27:
has length 112
starts with 27, 82, 41, 124
ends with 8, 4, 2, 1
The hailstone sequence from 77031 has length 351.


Any other Factor program can also use ''rosetta.hailstone'' as a regular vocabulary. This program only uses the word ''hailstone'' from that vocabulary, and never calls the main entry point of ''rosetta.hailstone''.

! rosetta/hailstone/length/length.factor
USING: assocs kernel io math math.ranges prettyprint
rosetta.hailstone sequences ;
IN: rosetta.hailstone.length

: f>0 ( object/f -- object/0 )
dup [ drop 0 ] unless ;

: max-value ( pair1 pair2 -- pair )
[ [ second ] bi@ > ] most ;

: main ( -- )
H{ } clone ! Maps sequence length => count.
1 100000 [a,b) [
hailstone length ! Find sequence length.
over [ f>0 1 + ] change-at ! Add 1 to count.
] each
! Find the length-count pair with the highest count.
>alist unclip-slice [ max-value ] reduce
first2 swap
"Among Hailstone sequences from 1 <= n < 100000," print
"there are " write pprint
" sequences of length " write pprint "." print ;
PRIVATE>

MAIN: main


$ ./factor -run=rosetta.hailstone.length
Loading resource:work/rosetta/hailstone/length/length.factor
Loading resource:work/rosetta/hailstone/hailstone.factor
Among Hailstone sequences from 1 <= n < 100000,
there are 72 sequences of length 1467.


=={{header|J}}==

This is the executable library:

hailseq=: -:`(1 3&p.)@.(2&|) ^:(1 ~: ]) ^:a:"0
9!:29]1
9!:27'main 0'
main=:3 :0
smoutput 'Hailstone sequence for the number 27'
smoutput hailseq 27
smoutput ''
smoutput 'Finding number with longest hailstone sequence which is'
smoutput 'less than 100000 (and finding that sequence length):'
smoutput (I.@(= >./),>./) #@hailseq i.1e5
)


Running it might look like this:

load jpath '~temp/hailseq.ijs'
Hailstone sequence for the number 27
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 ...
Finding number with longest hailstone sequence which is
less than 100000 (and finding that sequence length):
77031 351


This is the program which uses the library part of that executable library:

require '~temp/hailseq.ijs'
9!:29]1
9!:27'main 0'
main=:3 :0
smoutput 'Finding most frequent hailstone sequence length for'
smoutput 'Hailstone sequences for whole numbers less than 100000:'
smoutput {:{.\:~ (#/.~,.~.) #@hailseq }.i.1e5
)


Running it might look like this:

load jpath '~temp/66.ijs'
Finding most frequent hailstone sequence length for
Hailstone sequences for whole numbers less than 100000
72


Notes: 9!:29]1 tells the interpeter to run a phrase. 9!:27'phrase' tells the interpeter the phrase to execute. (9!: means, in essence: standard library number 9, and 9!:29 identifies a specific entry point in that library.) In 66.ijs we can not use the presence of 9!:29]1 from hailseq.ijs because hailseq.ijs was loaded with require which means that if it had already been loaded it will not be loaded again. (And, 66 here is just an arbitrary temporary file name.)

=={{header|Limbo}}==

There's no real difference in compilation or output for libraries versus commands in Inferno; commands (by convention) are expected to define an init() function that accepts a reference to a graphical context and a list of strings (i.e., the argument list) in order to satisy the type-checker. So this task is fairly simple. First, execlib.b looks like this:

implement Execlib;

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

Execlib: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
hailstone: fn(i: big): list of big;
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;

seq := hailstone(big 27);
l := len seq;

sys->print("hailstone(27): ");
for(i := 0; i < 4; i++) {
sys->print("%bd, ", hd seq);
seq = tl seq;
}
sys->print("⋯");

while(len seq > 4)
seq = tl seq;

while(seq != nil) {
sys->print(", %bd", hd seq);
seq = tl seq;
}
sys->print(" (length %d)\n", l);

max := 1;
maxn := big 1;
for(n := big 2; n < big 100000; n++) {
cur := len hailstone(n);
if(cur > max) {
max = cur;
maxn = n;
}
}
sys->print("hailstone(%bd) has length %d\n", maxn, max);
}

hailstone(i: big): list of big
{
if(i == big 1)
return big 1 :: nil;
if(i % big 2 == big 0)
return i :: hailstone(i / big 2);
return i :: hailstone(big 3 * i + big 1);
}


And execsexeclib.b (which executes execlib) looks like this:

implement ExecsExeclib;

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

ExecsExeclib: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
};

# Usually, this would be placed into something like "execlib.m",
# but it's fine here.
Execlib: module {
hailstone: fn(i: big): list of big;
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;
# This program expects that the result of compiling Execlib is execlib.dis,
# so you'll need to adjust this line if you used a different filename.
lib := load Execlib "execlib.dis";
if(lib == nil)
die("Couldn't load execlib.dis");

counts := array[352] of { * => 0 };
for(i := 1; i < 10000; i++) {
counts[len lib->hailstone(big i)]++;
}

max := 0;
maxi := 0;
for(i = 1; i < len counts; i++) {
if(counts[i] > max) {
max = counts[i];
maxi = i;
}
}
sys->print("The most common sequence length is %d (encountered %d times)\n", maxi, max);
}

die(s: string)
{
sys->fprint(sys->fildes(2), "runls: %s: %r", s);
raise "fail:errors";
}


{{out}}


% apply {limbo $1} *execlib.b
% apply {echo Running $1; $1} *execlib.dis
Running execlib.dis
hailstone(27): 27, 82, 41, 124, ⋯, 8, 4, 2, 1 (length 112)
hailstone(77031) has length 351
Running execsexeclib.dis
The most common sequence length is 53 (encountered 190 times)


=={{header|NetRexx}}==
The NetRexx compiler can generate Java classes and in common with all Java classes, public methods within each class are available for use by other programs. Packaging a class in a JAR file effectively crates a library that can be used by any other Java program. If this file is constructed correctly it can also by delivered as an "executable JAR file" which can be launched via the -jar switch of the java command. The following command can be used to package the [[Hailstone sequence#NetRexx|NetRexx Hailstone Sequence]] sample as an executable JAR file:
$ jar cvfe RHailstoneSequence.jar RHailstoneSequence RHailstoneSequence.class 
added manifest
adding: RHailstoneSequence.class(in = 2921) (out= 1567)(deflated 46%)


Here, the e switch causes the jar program to add a Main-Class property to the generated jar manifest which now contains the following:

Manifest-Version: 1.0
Created-By: 1.7.0_15 (Oracle Corporation)
Main-Class: RHailstoneSequence


With this Main-Class property present, launching the program via java -jar will cause Java to attempt to execute the main() method of the program specified above (RHailstoneSequence):

$ java -jar RHailstoneSequence.jar
The number 27 has a hailstone sequence comprising 112 elements
its first four elements are: 27 82 41 124
and last four elements are: 8 4 2 1
The number 77031 has the longest hailstone sequence in the range 1 to 99999 with a sequence length of 351

Using this JAR file as a library, the following program can use the hailstone(N) method to complete the task:

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

import RHailstoneSequence

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
parse arg beginNum endNum .
if beginNum = '' | beginNum = '.' then beginNum = 1
if endNum = '' | endNum = '.' then endNum = 100000
if beginNum > endNum then signal IllegalArgumentException('Gronk!')

-- collect sequences
hailstones = 0
loop hn = beginNum while hn < endNum
hslist = RHailstoneSequence.hailstone(hn)
hscount = hslist.words()
hailstones[hscount] = hailstones[hscount] + 1
end hn

-- locate most common
mostOftenNum = 0
mostOftenCount = 0
loop hn = beginNum while hn < endNum
if hailstones[hn] > mostOftenCount then do
mostOftenCount = hailstones[hn]
mostOftenNum = hn
end
end hn

say 'The length of hailstone sequence that is most common in the range' beginNum '<= N <' endNum 'is' mostOftenNum'. It occurs' mostOftenCount 'times.'
return


The program can then be launched with the java command. In this sample the JAR file is included via the -cp switch:
{{out}}
$ java -cp .:RHailstoneSequence.jar RHailstoneSequenceUser
The length of hailstone sequence that is most common in the range 1 <= N < 100000 is 72. It occurs 1467 times.


=={{header|Perl}}==
Lib package in file Hailstone.pm:package Hailstone;

sub seq {
my $x = shift;
$x == 1 ? (1) : ($x & 1)? ($x, seq($x * 3 + 1))
: ($x, seq($x / 2))
}

my %cache = (1 => 1);
sub len {
my $x = shift;
$cache{$x} //= 1 + (
$x & 1 ? len($x * 3 + 1)
: len($x / 2))
}

unless (caller) {
for (1 .. 100_000) {
my $l = len($_);
($m, $len) = ($_, $l) if $l > $len;
}
print "seq of 27 - $cache{27} elements: @{[seq(27)]}\n";
print "Longest sequence is for $m: $len\n";
}

1;

Main program in file test.pl:use Hailstone;
use strict;
use warnings;

my %seqs;
for (1 .. 100_000) {
$seqs{Hailstone::len($_)}++;
}

my ($most_frequent) = sort {$seqs{$b} <=> $seqs{$a}} keys %seqs;
print "Most frequent length: $most_frequent ($seqs{$most_frequent} occurrences)\n";

Running the lib:
% perl Hailstone.pm
seq of 27 - 112 elements: 27 82 41 124 62 31 94 47 142 ... 10 5 16 8 4 2 1
Longest sequence is for 77031: 351

Running the main program:
% perl test.pl
Most frequent length: 72 (1467 occurrences)


=={{header|Perl 6}}==
The library can be written as a module:
module Hailstone {
our sub hailstone($n) is export {
$n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1
}
}

sub MAIN {
say "hailstone(27) = {.[^4]} [...] {.[*-4 .. *-1]}" given Hailstone::hailstone 27;
}


It can be run with:
$ perl6 Hailstone.pm
{{out}}
hailstone(27) = 27 82 41 124 [...] 8 4 2 1


It can then be used with a program such as:
use Hailstone;
my %score; %score{hailstone($_).elems}++ for 1 .. 100_000;
say "Most common lengh is {.key}, occuring {.value} times." given max :by(*.value), %score;


Called with a command line as:
$ PERL6LIB=. perl6 test-hailstone.p6


The environment variable PERL6LIB might be necessary if the file Hailstone.pm is not in the standard library path for Perl 6.

=={{header|Pike}}==
any Pike source file is a class and can be instantiated as an object.
to executable a Pike file it needs a main() function.

Pike modules are classes instantiated at compile time. below we demonstrate both forms:

to use the library as a class, save it as HailStone.pike
to use it as a module, save it as Hailstone.pmod

both can be used as an executable.
#!/usr/bin/env pike

int next(int n)
{
if (n==1)
return 0;
if (n%2)
return 3*n+1;
else
return n/2;
}

array(int) hailstone(int n)
{
array seq = ({ n });
while (n=next(n))
seq += ({ n });
return seq;
}

void main()
{
array(int) two = hailstone(27);
if (equal(two[0..3], ({ 27, 82, 41, 124 })) && equal(two[<3..], ({ 8,4,2,1 })))
write("sizeof(({ %{%d, %}, ... %{%d, %} }) == %d\n", two[0..3], two[<3..], sizeof(two));

mapping longest = ([ "length":0, "start":0 ]);

foreach(allocate(100000); int start; )
{
int length = sizeof(hailstone(start));
if (length > longest->length)
{
longest->length = length;
longest->start = start;
}
}
write("longest sequence starting at %d has %d elements\n", longest->start, longest->length);
}


if run directly we get:
$ pike hailstone.pike
sizeof(({ 27, 82, 41, 124, , ... 8, 4, 2, 1, }) == 112
longest sequence starting at 77031 has 351 elements

to use it as a class we need to instantiate an object.
note that the . in .HailStone only signifies calling a class or module from the current directory.
the analyze function is identical in both examples:
void main()
{
.HailStone HailStone = .HailStone();

mapping long = ([]);

foreach (allocate(100000); int start; )
long[sizeof(HailStone->hailstone(start))]++;

analyze(long);
}

void analyze(mapping long)
{
mapping max = ([ "count":0, "length":0 ]);
foreach (long; int length; int count)
{
if (count > max->count)
{
max->length = length;
max->count = count;
}
}
write("most common length %d appears %d times\n", max->length, max->count);
}


a module is already instantiated so we can use it directly.
like above the initial . in .Hailstone.hailstone only signifies the current directory, the second . is a member reference resolved at compile time.
void main()
{
mapping long = ([]);

foreach (allocate(100000); int start; )
long[sizeof(.Hailstone.hailstone(start))]++;

analyze(long);
}

void analyze(mapping long)
{
mapping max = ([ "count":0, "length":0 ]);
foreach (long; int length; int count)
{
if (count > max->count)
{
max->length = length;
max->count = count;
}
}
write("most common length %d appears %d times\n", max->length, max->count);
}


Output for both examples:
most common length 72 appears 1467 times

=={{header|PicoLisp}}==
There is no formal difference between libraries and other executable files in PicoLisp. Any function in a library can be called from the command line by prefixing it with '-'. Create an executable file (chmod +x) "hailstone.l":
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(de hailstone (N)
(make
(until (= 1 (link N))
(setq N
(if (bit? 1 N)
(inc (* N 3))
(/ N 2) ) ) ) ) )

(de hailtest ()
(let L (hailstone 27)
(test 112 (length L))
(test (27 82 41 124) (head 4 L))
(test (8 4 2 1) (tail 4 L)) )
(let N (maxi '((N) (length (hailstone N))) (range 1 100000))
(test 77031 N)
(test 351 (length (hailstone N))) )
(println 'OK)
(bye) )

and an executable file (chmod +x) "test.l":
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(load "hailstone.l")

(let Len NIL
(for N 100000
(accu 'Len (length (hailstone N)) 1) )
(let M (maxi cdr Len)
(prinl "The hailstone length returned most often is " (car M))
(prinl "It is returned " (cdr M) " times") ) )
(bye)

Test:
$ ./hailstone.l -hailtest
OK

$ ./test.l
The hailstone length returned most often is 72
It is returned 1467 times


=={{header|Python}}==
Executable libraries are common in Python. The [[Hailstone sequence#Python|Python]] entry for Hailstone sequence is already written in the correct manner.

The entry is copied below and, for this task needs to be in a file called hailstone.py:
def hailstone(n):
seq = [n]
while n>1:
n = 3*n + 1 if n & 1 else n//2
seq.append(n)
return seq

if __name__ == '__main__':
h = hailstone(27)
assert len(h)==112 and h[:4]==[27, 82, 41, 124] and h[-4:]==[8, 4, 2, 1]
print("Maximum length %i was found for hailstone(%i) for numbers <100,000" %
max((len(hailstone(i)), i) for i in range(1,100000)))


In the case of the Python language the interpreter maintains a module level variable called __name__. If the file hailstone.py is ''imported'' (as import hailstone), then the __name__ variable is set to the import name of 'hailstone' and the if __name__ == '__main__' expression would then be false, and only the hailstone function is available to the importer.

If the same file hailstone.py is ''run'', (as maybe python hailstone.py; or maybe double-clicking the hailstone.py file), then the __name__ variable is set to the special name of '__main__' and the if __name__ == '__main__' expression would then be true causing its block of code to be executed.

'''Library importing executable'''

The second executable is the file common_hailstone_length.py with this content:
from collections import Counter

def function_length_frequency(func, hrange):
return Counter(len(func(n)) for n in hrange).most_common()

if __name__ == '__main__':
from executable_hailstone_library import hailstone

upto = 100000
hlen, freq = function_length_frequency(hailstone, range(1, upto))[0]
print("The length of hailstone sequence that is most common for\n"
"hailstone(n) where 1<=n<%i, is %i. It occurs %i times."
% (upto, hlen, freq))


Both files could be in the same directory. (That is the easiest way to make the library known to its importer for this example)

'''Sample output'''

On executing the file common_hailstone_length.py it loads the library and produces the following result:
The length of hailstone sequence that is most common for
hailstone(n) where 1<=n<100000, is 72. It occurs 1467 times


Note that the file common_hailstone_length.py is itself written as an executable library. When imported it makes function_length_frequency available to the importer.

===Other examples===
* The Python Prime decomposition entry of [[Least common multiple]] employs [[Prime decomposition#Python]] as an executable library.
* [[Names_to_numbers#Python]] uses [[Number_names#Python]] as an executable library.

=={{header|Racket}}==

When Racket runs a file (with racket some-file) it executes its
toplevel expressions, and then it runs a submodule named main if there
is one. When a file is used as a library (with require), the toplevel
expressions are executed as well, but the main is not
executed. The idea is that toplevel expressions might be used to initialize
state that the library needs -- a good example here is the initialization of
the memoization hash table. (Note that this is better than the common hacks of
check-the-loaded-script-name, since it is robust against failures due to
symlinks, case normalization, etc etc.)

We start with a "hs.rkt" file that has the exact code from the
[[Hailstone sequence#Racket]] solution, except that the hailstone
function is now provided, and the demonstration printout is pushed into a
main submodule:

#lang racket

(provide hailstone)
(define hailstone
(let ([t (make-hasheq)])
(hash-set! t 1 '(1))
(λ(n) (hash-ref! t n
(λ() (cons n (hailstone (if (even? n) (/ n 2) (+ (* 3 n) 1)))))))))

(module+ main
(define h27 (hailstone 27))
(printf "h(27) = ~s, ~s items\n"
`(,@(take h27 4) ... ,@(take-right h27 4))
(length h27))
(define N 100000)
(define longest
(for/fold ([m #f]) ([i (in-range 1 (add1 N))])
(define h (hailstone i))
(if (and m (> (cdr m) (length h))) m (cons i (length h)))))
(printf "for x<=~s, ~s has the longest sequence with ~s items\n"
N (car longest) (cdr longest)))

Running it directly produces the same output as [[Hailstone sequence#Racket]]:

$ racket hs.rkt
first 4 elements of h(27): '(27 82 41 124)
last 4 elements of h(27): '(8 4 2 1)
x < 10000 such that h(x) gives the longest sequence: 351


And now this can be used from a second source file, "hsfreq.rkt" as a
library:

#lang racket
(require "hs.rkt")
(define N 100000)
(define t (make-hasheq))
(define best
(for/fold ([best #f]) ([i (in-range 1 (add1 N))])
(define len (length (hailstone i)))
(define freq (add1 (hash-ref t len 0)))
(hash-set! t len freq)
(if (and best (> (car best) freq)) best (cons freq len))))
(printf "Most frequent sequence length for x<=~s: ~s, appearing ~s times\n" N
(cdr best) (car best))



$ racket hsfreq.rkt
Most frequent sequence length for x<=100000: 72, appearing 1467 times


=={{header|REXX}}==
===task 1===
The following REXX subroutine (or function, as it returns a value) is normally stored in a folder that the REXX interpreter searches first for subroutine/function call/invokes.

If not there, the REXX interpreter normally checks the current drive (or default disk), and then through some sort of heirarchy --- depending upon the particular REXX interpreter and operating system.


On Microsoft Windows systems using Regina, PC/REXX, Personal REXX, R4, or ROO, the program name is normally the function name with a file extension of '''REX''   (but that isn't a strict requirement or rule, each REXX interpreter has multiple file extensions that are supported).

On VM/CMS systems, the filetype (the file extension) is normally   '''EXEC'''.   If however, the REXX program was previously '''EXECLOAD'''ed, it may have a different name (identity) assigned to it.

The following program (function) is named:   '''HAILSTONE.REX'''   (the case doesn't matter for Microsoft Windows systems).

All REXX interpreters support subroutines/functions being on the current drive ('''CD'''), default disk (or MDISK in the case of CMS), or the equivalent.
/*REXX program returns the hailstone (Collatz) sequence for any integer.*/
numeric digits 20 /*ensure enough digits for mult. */
parse arg n 1 s /*N & S assigned to the first arg*/
do while n\==1 /*loop while N isn't unity. */
if n//2 then n=n*3+1 /*if N is odd, calc: 3*n +1 */
else n=n%2 /* " " " even, perform fast ÷ */
s=s n /*build a sequence list (append).*/
end /*while*/
return s

===task 2, 3===
The following program is named:  : '''HAIL_PGM.REX'''   and is stored in the current directory.
/*REXX pgm tests a number and a range for hailstone (Collatz) sequences.*/
parse arg x .; if x=='' then x=27 /*get the optional first argument*/

$=hailstone(x) /*═════════════task 2════════════*/
#=words($) /*number of numbers in sequence. */
say x 'has a hailstone sequence of' # 'and starts with: ' subword($,1,4),
' and ends with:' subword($,#-3)
say
w=0; do j=1 for 99999 /*═════════════task 3════════════*/
$=hailstone(j); #=words($) /*obtain the hailstone sequence. */
if #<=w then iterate /*Not big 'nuff? Then keep going.*/
bigJ=j; w=# /*remember what # has biggest HS.*/
end /*j*/

say '(between 1──►99,999) ' bigJ 'has the longest hailstone sequence:' w
/*stick a fork in it, we're done.*/

'''output'''

27 has a hailstone sequence of 112 and starts with: 27 82 41 124 and ends with: 8 4 2 1

(between 1──►99,999) 77031 has the longest hailstone sequence: 351

===task 4===
The following program is named:   '''MAIL_POP.REX'''   and is stored in the current directory.
/*REXX pgm finds the most common (popular) hailstone sequence length. */
parse arg z .; if z=='' then z=99999 /*get the optional first argument*/
!.=0
w=0; do j=1 for z /*═════════════task 4════════════*/
#=words(hailstone(j)) /*obtain hailstone sequence count*/
!.# = !.# + 1 /*add unity to popularity count. */
end /*j*/
occ=0; p=0
do k=1 for z
if !.k>occ then do; occ=!.k; p=k; end
end /*p*/

say '(between 1──►'z") " p,
' is the most common hailstone sequence length (with' occ "occurrences)."
/*stick a fork in it, we're done.*/

'''output'''

(between 1──►99999) 72 is the most common hailstone sequence length (with 1467 occurrences).

===task 5===
To run a REXX program, it depends on the REXX interpretor and which operating system is being used   (and what options where used when the REXX interpreter was installed/set up).


On a VM/CMS system, you could enter:
*             HAILSTONE
* EXEC HAILSTONE
to execute the   '''HAILSTONE EXEC A'''   program   (there are also other ways to invoke it).


On a Microsoft Windows system, you could enter:
*       HAILSTONE.REX
*       HAILSTONE
* xxx HAILSTONE.REX
* xxx HAILSTONE
where   '''xxx'''   is the name of the REXX interpreter, and if installed under a Microsoft Windows (Next family), the file extension and/or the REXX interpreter can be omitted.




=={{header|Ruby}}==
An executable library checks ''__FILE__ == $0''. Here, ''__FILE__'' is the path of the current source file, and ''$0'' is the path of the current executable. If ''__FILE__ == $0'', then the current source file is the executable, else the current source file is a library for some other executable.

* ''__FILE__ == $0'' also works with older versions of Ruby, but this Hailstone example calls new methods in Ruby 1.8.7.

This is ''hailstone.rb'', a modification of [[Hailstone sequence#Ruby]] as an executable library.

{{works with|Ruby|1.8.7}}

# hailstone.rb
module Hailstone
module_function
def hailstone n
seq = [n]
until n == 1
n = (n.even?) ? (n / 2) : (3 * n + 1)
seq << n
end
seq
end
end

if __FILE__ == $0
include Hailstone

# for n = 27, show sequence length and first and last 4 elements
hs27 = hailstone 27
p [hs27.length, hs27[0..3], hs27[-4..-1]]

# find the longest sequence among n less than 100,000
n, len = (1 ... 100_000) .collect {|n|
[n, hailstone(n).length]} .max_by {|n, len| len}
puts "#{n} has a hailstone sequence length of #{len}"
puts "the largest number in that sequence is #{hailstone(n).max}"
end


It runs like any Ruby program:

$ ruby scratch.rb                                                              
[112, [27, 82, 41, 124], [8, 4, 2, 1]]
77031 has a hailstone sequence length of 351
the largest number in that sequence is 21933016


This is ''hsfreq.rb'', which requires ''hailstone.rb'' as a library.

# hsfreq.rb
require 'hailstone'

h = Hash.new(0)
last = 99_999
(1..last).each {|n| h[Hailstone.hailstone(n).length] += 1}
length, count = h.max_by {|length, count| count}

puts "Given the hailstone sequences from 1 to #{last},"
puts "the most common sequence length is #{length},"
puts "with #{count} such sequences."


As with any library, ''hailstone.rb'' must be in $:, the search path for libraries. One way is to leave ''hailstone.rb'' in the current directory and run ruby -I. hsfreq.rb. (Ruby older than 1.9.2 also searches the current directory by default.)

$ ruby -I. hsfreq.rb
Given the hailstone sequences from 1 to 99999,
the most common sequence length is 72,
with 1467 such sequences.


=={{header|Scala}}==
[[Category:Scala Implementations]]
{{libheader|Scala}}
In Scala it is possible to combine several "main"s (mixed-in by the App trait) in one file (e.g. HailstoneSequence.scala):
object HailstoneSequence extends App { // Show it all, default number is 27.
def hailstone(n: Int): Stream[Int] =
n #:: (if (n == 1) Stream.empty else hailstone(if (n % 2 == 0) n / 2 else n * 3 + 1))

Hailstone.details(args.headOption.map(_.toInt).getOrElse(27))
HailTest.main(Array())
}

object Hailstone extends App { // Compute a given or default number to Hailstone sequence
def details(nr: Int) = {
val collatz = HailstoneSequence.hailstone(nr)

println(s"Use the routine to show that the hailstone sequence for the number: $nr.")
println(collatz.toList)
println(s"It has ${collatz.length} elements.")
}
details(args.headOption.map(_.toInt).getOrElse(27))
}

object HailTest extends App { // Compute only the < 100000 test
println(
"Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.")
val (n, len) = (1 until 100000).map(n => (n, HailstoneSequence.hailstone(n).length)).maxBy(_._2)
println(s"Longest hailstone sequence length= $len occurring with number $n.")
}


Steps:

1. First let the compiler process the source file:
C:\Users\FransAdm\Documents>scalac HailstoneSequence.scala

2. Run the Hailstone function with a parameter:
C:\Users\FransAdm\Documents>scala Hailstone 42
Use the routine to show that the hailstone sequence for the number: 42.
List(42, 21, 64, 32, 16, 8, 4, 2, 1)
It has 9 elements.
3. Run the combined function and < 100000 test:
C:\Users\FransAdm\Documents>scala HailstoneSequence 27
Use the routine to show that the hailstone sequence for the number: 27.
List(27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155,
466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850,
425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154,
3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80
, 40, 20, 10, 5, 16, 8, 4, 2, 1)
It has 112 elements.
Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.

4. Finally do only the callable < 100000 test
C:\Users\FransAdm\Documents>scala HailTest
Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.

C:\Users\FransAdm\Documents>

=={{header|Tcl}}==
The standard idiom for detecting whether a script is being loaded as a library or run directly is to compare the result of info script (which describes the name of the currently sourced script file) and the global argv0 variable (which holds the name of the main script).
### In the file hailstone.tcl ###
package provide hailstone 1.0

proc hailstone n {
while 1 {
lappend seq $n
if {$n == 1} {return $seq}
set n [expr {$n & 1 ? $n*3+1 : $n/2}]
}
}

# If directly executed, run demo code
if {[info script] eq $::argv0} {
set h27 [hailstone 27]
puts "h27 len=[llength $h27]"
puts "head4 = [lrange $h27 0 3]"
puts "tail4 = [lrange $h27 end-3 end]"

set maxlen [set max 0]
for {set i 1} {$i<100000} {incr i} {
set l [llength [hailstone $i]]
if {$l>$maxlen} {set maxlen $l;set max $i}
}
puts "max is $max, with length $maxlen"
}


To make the package locatable, run this Tcl script in the same directory which builds the index file:
pkg_mkIndex .

Using the above code as a library then just requires that we tell the script the location of the additional library directory by adding it to the global auto_path variable; it is unnecessary if the script is installed in one of the standard locations (a fairly long list that depends on the installation):
#!/usr/bin/tclsh8.6
package require Tcl 8.6 ;# For [lsort -stride] option
lappend auto_path . ;# Or wherever it is located
package require hailstone 1.0

# Construct a histogram of length frequencies
set histogram {}
for {set n 1} {$n < 100000} {incr n} {
dict incr histogram [llength [hailstone $n]]
}

# Identify the most common length by sorting...
set sortedHist [lsort -decreasing -stride 2 -index 1 $histogram]
lassign $sortedHist mostCommonLength freq

puts "most common length is $mostCommonLength, with frequency $freq"


{{omit from|Go}}
{{omit from|GUISS}}
{{omit from|Maxima}}

Executable library

Pete: /* {{header|Limbo}} */ I skipped a zero. :P


{{task}}
The general idea behind an executable library is to create a library that when used as a library does one thing; but has the ability to be run directly via command line. Thus the API comes with a CLI in the very same source code file.

'''Task detail'''

* Create a library/module/dll/shared object/... for a programming language that contains a function/method called hailstone that is a function taking a positive integer and returns the [[Hailstone sequence]] for that number.

* The library, when executed directly should satisfy the remaining requirements of the [[Hailstone sequence]] task:
:: 2. Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
:: 3. Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.

* Create a second executable to calculate the following:
** Use the library's hailstone function, in the standard manner, (or document how this use deviates from standard use of a library), together with extra code in this executable, to find the hailstone length returned most often for 1 ≤ n < 100,000.

* Explain any extra setup/run steps needed to complete the task.

'''Notes:'''
* It is assumed that for a language that overwhelmingly ships in a compiled form, such as C, the library must also be an executable and the compiled user of that library is to do so without changing the compiled library. I.e. the compile tool-chain is assumed ''not'' to be present in the runtime environment.
* Interpreters are present in the runtime environment.

=={{header|Ada}}==

In Ada, '''any parameterless procedure''' can either '''run as a (stand-alone) main program''', or can '''be called from another program''' like a library function. For the task at hand, this appears useful -- except for the following two obstacles:

1. There are neither ingoing parameters into a parameterless procedure, nor is there a return value.

2. The procedure does not know how it has been called: is it running as a main program, or has it been called from another program?

To overcome the first obstacle, we implement a very simplistic parameter passing mechanism in a package Parameter (''parameter.ads''): The global variable Parameter.X will hold the ingoing parameter, the other global variable Parameter.Y will take the return value. To overcome the second obstacle, we ensure that Parameter.X is 0 by default.

package Parameter is
X: Natural := 0;
Y: Natural;
end Parameter;


Now comes our parameterless procedure Hailstone (''hailstone.adb''). Note that we are
using the the package Hailstones (''hailstones.adb/hailstones.ads'') from
[[Hailstone sequence#Alternative method]] to perform the real computation.

with Ada.Text_IO, Parameter, Hailstones;

procedure Hailstone is
-- if Parameter.X > 0, the length of Hailstone(Parameter.X)
-- is computed and written into Parameter.Y

-- if Parameter.X = 0, Hailstone(27) and N <= 100_000 with maximal
-- Hailstone(N) are computed and printed.

procedure Show_Sequence(N: Natural) is
Seq: Hailstones.Integer_Sequence := Hailstones.Create_Sequence(N);
begin
Ada.Text_IO.Put("Hailstone(" & Integer'Image(N) & " ) = (");
if Seq'Length < 8 then
for I in Seq'First .. Seq'Last-1 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) & ",");
end loop;
else
for I in Seq'First .. Seq'First+3 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) & ",");
end loop;
Ada.Text_IO.Put(" ...,");
for I in Seq'Last-3 .. Seq'Last-1 loop
Ada.Text_IO.Put(Integer'Image(Seq(I)) &",");
end loop;
end if;
Ada.Text_IO.Put_Line(Integer'Image(Seq(Seq'Last)) & " ); Length: " &
Integer'Image(seq'Length));
end Show_Sequence;
begin
if Parameter.X>0 then
Parameter.Y := Hailstones.Create_Sequence(Parameter.X)'Length;
else
Show_Sequence(27);
declare
Longest: Natural := 0;
Longest_Length: Natural := 0;
begin
for I in 2 .. 100_000 loop
if Hailstones.Create_Sequence(I)'Length > Longest_Length then
Longest := I;
Longest_Length := Hailstones.Create_Sequence(I)'Length;
end if;
end loop;
Ada.Text_IO.Put("Longest<=100_000: ");
Show_Sequence(Longest);
end;
end if;
end Hailstone;


If we compile this and run it, we get the following output.

> ./hailstone
Hailstone( 27 ) = ( 27, 82, 41, 124, ..., 8, 4, 2, 1 ); Length: 112
Longest<=100_000: Hailstone( 77031 ) = ( 77031, 231094, 115547, 346642, ..., 8, 4, 2, 1 ); Length: 351


To use the same procedure like a library function, we need a specification (file ''hailstone.ads''),
that essentially repeats the parameter profile. As our procedure is actually parameterless, this specification is more than trivial.

procedure Hailstone;

Finally, we write another parameterless procedure (''hailstone_test.adb''), that will call the procedure Hailstone. Note that we '''must''' change the Parameter.X to a value > 0 before calling Hailstone, otherwise, Hailstone would act as if it where the main program.

with Hailstone, Parameter, Ada.Text_IO;

procedure Hailstone_Test is
Counts: array (1 .. 100_000) of Natural := (others => 0);
Max_Count: Natural := 0;
Most_Common: Positive := Counts'First;
Length: Natural renames Parameter.Y;
Sample: Natural := 0;
begin
for I in Counts'Range loop
Parameter.X := I;
Hailstone; -- compute the length of Hailstone(I)
Counts(Length) := Counts(Length)+1;
end loop;
for I in Counts'Range loop
if Counts(I) > Max_Count then
Max_Count := Counts(I);
Most_Common := I;
end if;
end loop;
Ada.Text_IO.Put_Line("Most frequent length:"
& Integer'Image(Most_Common)
& ";" & Integer'Image(Max_Count)
& " sequences of that length.");
for I in Counts'Range loop
Parameter.X := I;
Hailstone; -- compute the length of Hailstone(I)
if Length = Most_Common then
Sample := I;
exit;
end if;
end loop;
Ada.Text_IO.Put_Line("The first such sequence: Hailstone("
& Integer'Image(Sample) & " ).");
end Hailstone_Test;
.

Compiling and running this gives the following output:

> ./hailstone_test 
Most frequent length: 72; 1467 sequences of that length.
The first such sequence: Hailstone( 444 ).


Note that using global variables for parameter and return value passing works here, but is bad programming practice. Ada is a compiled language, and it is not clear how useful an executable library written in a compiled language is, anyway.

In fact, except for the constraints imposed by this task, there is no reason to ask the procedure Hailstone for the length of a Hailstone sequence -- solid software engineering practice would require to directly call the parameterized function Hailstones.Create_Sequence.

=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
First we create the library, hailstone.ahk:
#NoEnv
SetBatchLines, -1

; Check if we're executed directly:
If (A_LineFile = A_ScriptFullPath){
h27 := hailstone(27)
MsgBox % "Length of hailstone 27: " (m := h27.MaxIndex()) "`nStarts with "
. h27[1] ", " h27[2] ", " h27[3] ", " h27[4]
. "`nEnds with "
. h27[m-3] ", " h27[m-2] ", " h27[m-1] ", " h27[m]

Loop 100000
{
h := hailstone(A_Index)
If (h.MaxIndex() > m)
m := h.MaxIndex(), longest := A_Index
}
MsgBox % "Longest hailstone is that of " longest " with a length of " m "!"
}


hailstone(n){
out := [n]
Loop
n := n & 1 ? n*3+1 : n//2, out.insert(n)
until n=1
return out
}
Running this directly gives the output:
Length of hailstone 27: 112
Starts with 27, 82, 41, 124
Ends with 8, 4, 2, 1

Longest hailstone is that of 77031 with a length of 351!


Then we can create a file (test.ahk) that uses the library (note the #Include line):
#NoEnv
#Include %A_ScriptDir%\hailstone.ahk
SetBatchLines -1

col := Object(), highestCount := 0

Loop 100000
{
length := hailstone(A_Index).MaxIndex()
if not col[length]
col[length] := 0
col[length]++
}
for length, count in col
if (count > highestCount)
highestCount := count, highestN := length
MsgBox % "the most common length was " highestN "; it occurred " highestCount " times."

Running this '''does not''' trigger the output of the hailstone.ahk, instead it outputs this:
the most common length was 72; it occurred 1467 times.

[[Link title]]

=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
To meet the terms of this task the BBC BASIC run-time engine '''bbcwrun.exe''' must be installed on the target PC and the file extension '''.bbc''' must be associated with this executable. This is normally the case when ''BBC BASIC for Windows'' has been installed.
===Library===
This must be saved as the file HAILSTONE.BBC. It may be used as a library (see below) or executed directly.
seqlen% = FNhailstone(27)
PRINT "Sequence length for 27 is "; seqlen%
maxlen% = 0
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%)
IF seqlen% > maxlen% THEN
maxlen% = seqlen%
maxnum% = number%
ENDIF
NEXT
PRINT "The number with the longest hailstone sequence is " ; maxnum%
PRINT "Its sequence length is " ; maxlen%
END

DEF FNhailstone(N%)
LOCAL L%
WHILE N% <> 1
IF N% AND 1 THEN N% = 3 * N% + 1 ELSE N% DIV= 2
L% += 1
ENDWHILE
= L% + 1

'''Output:'''

Sequence length for 27 is 112
The number with the longest hailstone sequence is 77031
Its sequence length is 351

===Client===
This uses the above program as a library:
INSTALL "HAILSTONE"

DIM freq%(351)
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%)
freq%(seqlen%) += 1
NEXT
max% = 0
FOR i% = 0 TO 351
IF freq%(i%) > max% THEN
max% = freq%(i%)
mostcommon% = i%
ENDIF
NEXT

PRINT "The most common sequence length is " ; mostcommon%
PRINT "It occurs " ; max% " times"
END

'''Output:'''

The most common sequence length is 72
It occurs 1467 times


=={{header|C}}==
Solution for Linux/GCC. First, header file hailstone.h:
#ifndef HAILSTONE
#define HAILSTONE

long hailstone(long, long**);
void free_sequence(long *);

#endif/*HAILSTONE*/

Then the lib source code hailstone.c (actual name doesn't matter):
#include
#include

long hailstone(long n, long **seq)
{
long len = 0, buf_len = 4;
if (seq)
*seq = malloc(sizeof(long) * buf_len);

while (1) {
if (seq) {
if (len >= buf_len) {
buf_len *= 2;
*seq = realloc(*seq, sizeof(long) * buf_len);
}
(*seq)[len] = n;
}
len ++;
if (n == 1) break;
if (n & 1) n = 3 * n + 1;
else n >>= 1;
}
return len;
}

void free_sequence(long * s) { free(s); }

const char my_interp[] __attribute__((section(".interp"))) = "/lib/ld-linux.so.2";
/* "ld-linux.so.2" should be whatever you use on your platform */

int hail_main() /* entry point when running along, see compiler command line */
{
long i, *seq;

long len = hailstone(27, &seq);
printf("27 has %ld numbers in sequence:\n", len);
for (i = 0; i < len; i++) {
printf("%ld ", seq[i]);
}
printf("\n");
free_sequence(seq);

exit(0);
}

A program to use the lib (I call it test.c):
#include
#include "hailstone.h"

int main()
{
long i, longest, longest_i, len;

longest = 0;
for (i = 1; i < 100000; i++) {
len = hailstone(i, 0);
if (len > longest) {
longest_i = i;
longest = len;
}
}

printf("Longest sequence at %ld, length %ld\n", longest_i, longest);

return 0;
}


Building the lib: gcc -Wall -W -fPIC -shared -o libhail.so hailstone.c -lc -Wl,-e,hail_main

Building the test.c code: gcc -Wall -L. -lhail test.c -o hailtest

Running the lib:
% ./libhail.so
27 has 112 numbers in sequence:
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274....


Running the program:
% LD_LIBRARY_PATH=. ./hailtest
Longest sequence at 77031, length 351


For a serious library the libhail.so would have been put into a system lib dir, but for now we'll just leave it in the same directory, so to run the program, we need to give additional hints to tell it where to find the lib: LD_LIBRARY_PATH=. ./hailtest

=={{header|Déjà Vu}}==

The library, named hailstone.deja:
local hailstone:
swap [ over ]
while < 1 dup:
if % over 2:
#odd
++ * 3
else:
#even
/ swap 2
swap push-through rot dup
drop

if = (name) :(main):
local :h27 hailstone 27
!. = 112 len h27
!. = 27 h27! 0
!. = 82 h27! 1
!. = 41 h27! 2
!. = 124 h27! 3
!. = 8 h27! 108
!. = 4 h27! 109
!. = 2 h27! 110
!. = 1 h27! 111

local :max 0
local :maxlen 0
for i range 1 99999:
dup len hailstone i
if < maxlen:
set :maxlen
set :max i
else:
drop
!print( "number: " to-str max ", length: " to-str maxlen )
else:
@hailstone


The client:
!import!hailstone

local :counts {}
set-default counts 0
for i range 1 99999:
set-to counts swap ++ counts! dup len hailstone i

local :maxlen 0
for k in keys counts:
if < maxlen counts! k:
set :maxlen counts! k
!print( "Maximum length: " to-str maxlen )


=={{header|Factor}}==
An ''executable library'' is a vocabulary with a main entry point.

This vocabulary, ''rosetta.hailstone'', exports the word ''hailstone'', but also uses ''MAIN:'' to declare a main entry point.

! rosetta/hailstone/hailstone.factor
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
IN: rosetta.hailstone

: hailstone ( n -- seq )
[ 1vector ] keep
[ dup 1 number= ]
[
dup even? [ 2 / ] [ 3 * 1 + ] if
2dup swap push
] until
drop ;

: main ( -- )
27 hailstone dup dup
"The hailstone sequence from 27:" print
" has length " write length .
" starts with " write 4 head [ unparse ] map ", " join print
" ends with " write 4 tail* [ unparse ] map ", " join print

! Maps n => { length n }, and reduces to longest Hailstone sequence.
1 100000 [a,b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
"The hailstone sequence from " write pprint
" has length " write pprint "." print ;
PRIVATE>

MAIN: main


There are two ways to run this program:

* Inside Factor, from its listener: "rosetta.hailstone" run
* Outside Factor, from some shell: ./factor -run=rosetta.hailstone

$ ./factor -run=rosetta.hailstone
Loading resource:work/rosetta/hailstone/hailstone.factor
The hailstone sequence from 27:
has length 112
starts with 27, 82, 41, 124
ends with 8, 4, 2, 1
The hailstone sequence from 77031 has length 351.


Any other Factor program can also use ''rosetta.hailstone'' as a regular vocabulary. This program only uses the word ''hailstone'' from that vocabulary, and never calls the main entry point of ''rosetta.hailstone''.

! rosetta/hailstone/length/length.factor
USING: assocs kernel io math math.ranges prettyprint
rosetta.hailstone sequences ;
IN: rosetta.hailstone.length

: f>0 ( object/f -- object/0 )
dup [ drop 0 ] unless ;

: max-value ( pair1 pair2 -- pair )
[ [ second ] bi@ > ] most ;

: main ( -- )
H{ } clone ! Maps sequence length => count.
1 100000 [a,b) [
hailstone length ! Find sequence length.
over [ f>0 1 + ] change-at ! Add 1 to count.
] each
! Find the length-count pair with the highest count.
>alist unclip-slice [ max-value ] reduce
first2 swap
"Among Hailstone sequences from 1 <= n < 100000," print
"there are " write pprint
" sequences of length " write pprint "." print ;
PRIVATE>

MAIN: main


$ ./factor -run=rosetta.hailstone.length
Loading resource:work/rosetta/hailstone/length/length.factor
Loading resource:work/rosetta/hailstone/hailstone.factor
Among Hailstone sequences from 1 <= n < 100000,
there are 72 sequences of length 1467.


=={{header|J}}==

This is the executable library:

hailseq=: -:`(1 3&p.)@.(2&|) ^:(1 ~: ]) ^:a:"0
9!:29]1
9!:27'main 0'
main=:3 :0
smoutput 'Hailstone sequence for the number 27'
smoutput hailseq 27
smoutput ''
smoutput 'Finding number with longest hailstone sequence which is'
smoutput 'less than 100000 (and finding that sequence length):'
smoutput (I.@(= >./),>./) #@hailseq i.1e5
)


Running it might look like this:

load jpath '~temp/hailseq.ijs'
Hailstone sequence for the number 27
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 ...
Finding number with longest hailstone sequence which is
less than 100000 (and finding that sequence length):
77031 351


This is the program which uses the library part of that executable library:

require '~temp/hailseq.ijs'
9!:29]1
9!:27'main 0'
main=:3 :0
smoutput 'Finding most frequent hailstone sequence length for'
smoutput 'Hailstone sequences for whole numbers less than 100000:'
smoutput {:{.\:~ (#/.~,.~.) #@hailseq }.i.1e5
)


Running it might look like this:

load jpath '~temp/66.ijs'
Finding most frequent hailstone sequence length for
Hailstone sequences for whole numbers less than 100000
72


Notes: 9!:29]1 tells the interpeter to run a phrase. 9!:27'phrase' tells the interpeter the phrase to execute. (9!: means, in essence: standard library number 9, and 9!:29 identifies a specific entry point in that library.) In 66.ijs we can not use the presence of 9!:29]1 from hailseq.ijs because hailseq.ijs was loaded with require which means that if it had already been loaded it will not be loaded again. (And, 66 here is just an arbitrary temporary file name.)

=={{header|Limbo}}==

There's no real difference in compilation or output for libraries versus commands in Inferno; commands (by convention) are expected to define an init() function that accepts a reference to a graphical context and a list of strings (i.e., the argument list) in order to satisy the type-checker. So this task is fairly simple. First, execlib.b looks like this:

implement Execlib;

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

Execlib: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
hailstone: fn(i: big): list of big;
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;

seq := hailstone(big 27);
l := len seq;

sys->print("hailstone(27): ");
for(i := 0; i < 4; i++) {
sys->print("%bd, ", hd seq);
seq = tl seq;
}
sys->print("⋯");

while(len seq > 4)
seq = tl seq;

while(seq != nil) {
sys->print(", %bd", hd seq);
seq = tl seq;
}
sys->print(" (length %d)\n", l);

max := 1;
maxn := big 1;
for(n := big 2; n < big 100000; n++) {
cur := len hailstone(n);
if(cur > max) {
max = cur;
maxn = n;
}
}
sys->print("hailstone(%bd) has length %d\n", maxn, max);
}

hailstone(i: big): list of big
{
if(i == big 1)
return big 1 :: nil;
if(i % big 2 == big 0)
return i :: hailstone(i / big 2);
return i :: hailstone(big 3 * i + big 1);
}


And execsexeclib.b (which executes execlib) looks like this:

implement ExecsExeclib;

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

ExecsExeclib: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
};

# Usually, this would be placed into something like "execlib.m",
# but it's fine here.
Execlib: module {
hailstone: fn(i: big): list of big;
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;
# This program expects that the result of compiling Execlib is execlib.dis,
# so you'll need to adjust this line if you used a different filename.
lib := load Execlib "execlib.dis";
if(lib == nil)
die("Couldn't load execlib.dis");

counts := array[352] of { * => 0 };
for(i := 1; i < 100000; i++) {
counts[len lib->hailstone(big i)]++;
}

max := 0;
maxi := 0;
for(i = 1; i < len counts; i++) {
if(counts[i] > max) {
max = counts[i];
maxi = i;
}
}
sys->print("The most common sequence length is %d (encountered %d times)\n", maxi, max);
}

die(s: string)
{
sys->fprint(sys->fildes(2), "runls: %s: %r", s);
raise "fail:errors";
}


{{out}}


% apply {limbo $1} *execlib.b
% apply {echo Running $1; $1} *execlib.dis
Running execlib.dis
hailstone(27): 27, 82, 41, 124, ⋯, 8, 4, 2, 1 (length 112)
hailstone(77031) has length 351
Running execsexeclib.dis
The most common sequence length is 72 (encountered 1467 times)


=={{header|NetRexx}}==
The NetRexx compiler can generate Java classes and in common with all Java classes, public methods within each class are available for use by other programs. Packaging a class in a JAR file effectively crates a library that can be used by any other Java program. If this file is constructed correctly it can also by delivered as an "executable JAR file" which can be launched via the -jar switch of the java command. The following command can be used to package the [[Hailstone sequence#NetRexx|NetRexx Hailstone Sequence]] sample as an executable JAR file:
$ jar cvfe RHailstoneSequence.jar RHailstoneSequence RHailstoneSequence.class 
added manifest
adding: RHailstoneSequence.class(in = 2921) (out= 1567)(deflated 46%)


Here, the e switch causes the jar program to add a Main-Class property to the generated jar manifest which now contains the following:

Manifest-Version: 1.0
Created-By: 1.7.0_15 (Oracle Corporation)
Main-Class: RHailstoneSequence


With this Main-Class property present, launching the program via java -jar will cause Java to attempt to execute the main() method of the program specified above (RHailstoneSequence):

$ java -jar RHailstoneSequence.jar
The number 27 has a hailstone sequence comprising 112 elements
its first four elements are: 27 82 41 124
and last four elements are: 8 4 2 1
The number 77031 has the longest hailstone sequence in the range 1 to 99999 with a sequence length of 351

Using this JAR file as a library, the following program can use the hailstone(N) method to complete the task:

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

import RHailstoneSequence

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
parse arg beginNum endNum .
if beginNum = '' | beginNum = '.' then beginNum = 1
if endNum = '' | endNum = '.' then endNum = 100000
if beginNum > endNum then signal IllegalArgumentException('Gronk!')

-- collect sequences
hailstones = 0
loop hn = beginNum while hn < endNum
hslist = RHailstoneSequence.hailstone(hn)
hscount = hslist.words()
hailstones[hscount] = hailstones[hscount] + 1
end hn

-- locate most common
mostOftenNum = 0
mostOftenCount = 0
loop hn = beginNum while hn < endNum
if hailstones[hn] > mostOftenCount then do
mostOftenCount = hailstones[hn]
mostOftenNum = hn
end
end hn

say 'The length of hailstone sequence that is most common in the range' beginNum '<= N <' endNum 'is' mostOftenNum'. It occurs' mostOftenCount 'times.'
return


The program can then be launched with the java command. In this sample the JAR file is included via the -cp switch:
{{out}}
$ java -cp .:RHailstoneSequence.jar RHailstoneSequenceUser
The length of hailstone sequence that is most common in the range 1 <= N < 100000 is 72. It occurs 1467 times.


=={{header|Perl}}==
Lib package in file Hailstone.pm:package Hailstone;

sub seq {
my $x = shift;
$x == 1 ? (1) : ($x & 1)? ($x, seq($x * 3 + 1))
: ($x, seq($x / 2))
}

my %cache = (1 => 1);
sub len {
my $x = shift;
$cache{$x} //= 1 + (
$x & 1 ? len($x * 3 + 1)
: len($x / 2))
}

unless (caller) {
for (1 .. 100_000) {
my $l = len($_);
($m, $len) = ($_, $l) if $l > $len;
}
print "seq of 27 - $cache{27} elements: @{[seq(27)]}\n";
print "Longest sequence is for $m: $len\n";
}

1;

Main program in file test.pl:use Hailstone;
use strict;
use warnings;

my %seqs;
for (1 .. 100_000) {
$seqs{Hailstone::len($_)}++;
}

my ($most_frequent) = sort {$seqs{$b} <=> $seqs{$a}} keys %seqs;
print "Most frequent length: $most_frequent ($seqs{$most_frequent} occurrences)\n";

Running the lib:
% perl Hailstone.pm
seq of 27 - 112 elements: 27 82 41 124 62 31 94 47 142 ... 10 5 16 8 4 2 1
Longest sequence is for 77031: 351

Running the main program:
% perl test.pl
Most frequent length: 72 (1467 occurrences)


=={{header|Perl 6}}==
The library can be written as a module:
module Hailstone {
our sub hailstone($n) is export {
$n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1
}
}

sub MAIN {
say "hailstone(27) = {.[^4]} [...] {.[*-4 .. *-1]}" given Hailstone::hailstone 27;
}


It can be run with:
$ perl6 Hailstone.pm
{{out}}
hailstone(27) = 27 82 41 124 [...] 8 4 2 1


It can then be used with a program such as:
use Hailstone;
my %score; %score{hailstone($_).elems}++ for 1 .. 100_000;
say "Most common lengh is {.key}, occuring {.value} times." given max :by(*.value), %score;


Called with a command line as:
$ PERL6LIB=. perl6 test-hailstone.p6


The environment variable PERL6LIB might be necessary if the file Hailstone.pm is not in the standard library path for Perl 6.

=={{header|Pike}}==
any Pike source file is a class and can be instantiated as an object.
to executable a Pike file it needs a main() function.

Pike modules are classes instantiated at compile time. below we demonstrate both forms:

to use the library as a class, save it as HailStone.pike
to use it as a module, save it as Hailstone.pmod

both can be used as an executable.
#!/usr/bin/env pike

int next(int n)
{
if (n==1)
return 0;
if (n%2)
return 3*n+1;
else
return n/2;
}

array(int) hailstone(int n)
{
array seq = ({ n });
while (n=next(n))
seq += ({ n });
return seq;
}

void main()
{
array(int) two = hailstone(27);
if (equal(two[0..3], ({ 27, 82, 41, 124 })) && equal(two[<3..], ({ 8,4,2,1 })))
write("sizeof(({ %{%d, %}, ... %{%d, %} }) == %d\n", two[0..3], two[<3..], sizeof(two));

mapping longest = ([ "length":0, "start":0 ]);

foreach(allocate(100000); int start; )
{
int length = sizeof(hailstone(start));
if (length > longest->length)
{
longest->length = length;
longest->start = start;
}
}
write("longest sequence starting at %d has %d elements\n", longest->start, longest->length);
}


if run directly we get:
$ pike hailstone.pike
sizeof(({ 27, 82, 41, 124, , ... 8, 4, 2, 1, }) == 112
longest sequence starting at 77031 has 351 elements

to use it as a class we need to instantiate an object.
note that the . in .HailStone only signifies calling a class or module from the current directory.
the analyze function is identical in both examples:
void main()
{
.HailStone HailStone = .HailStone();

mapping long = ([]);

foreach (allocate(100000); int start; )
long[sizeof(HailStone->hailstone(start))]++;

analyze(long);
}

void analyze(mapping long)
{
mapping max = ([ "count":0, "length":0 ]);
foreach (long; int length; int count)
{
if (count > max->count)
{
max->length = length;
max->count = count;
}
}
write("most common length %d appears %d times\n", max->length, max->count);
}


a module is already instantiated so we can use it directly.
like above the initial . in .Hailstone.hailstone only signifies the current directory, the second . is a member reference resolved at compile time.
void main()
{
mapping long = ([]);

foreach (allocate(100000); int start; )
long[sizeof(.Hailstone.hailstone(start))]++;

analyze(long);
}

void analyze(mapping long)
{
mapping max = ([ "count":0, "length":0 ]);
foreach (long; int length; int count)
{
if (count > max->count)
{
max->length = length;
max->count = count;
}
}
write("most common length %d appears %d times\n", max->length, max->count);
}


Output for both examples:
most common length 72 appears 1467 times

=={{header|PicoLisp}}==
There is no formal difference between libraries and other executable files in PicoLisp. Any function in a library can be called from the command line by prefixing it with '-'. Create an executable file (chmod +x) "hailstone.l":
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(de hailstone (N)
(make
(until (= 1 (link N))
(setq N
(if (bit? 1 N)
(inc (* N 3))
(/ N 2) ) ) ) ) )

(de hailtest ()
(let L (hailstone 27)
(test 112 (length L))
(test (27 82 41 124) (head 4 L))
(test (8 4 2 1) (tail 4 L)) )
(let N (maxi '((N) (length (hailstone N))) (range 1 100000))
(test 77031 N)
(test 351 (length (hailstone N))) )
(println 'OK)
(bye) )

and an executable file (chmod +x) "test.l":
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l

(load "hailstone.l")

(let Len NIL
(for N 100000
(accu 'Len (length (hailstone N)) 1) )
(let M (maxi cdr Len)
(prinl "The hailstone length returned most often is " (car M))
(prinl "It is returned " (cdr M) " times") ) )
(bye)

Test:
$ ./hailstone.l -hailtest
OK

$ ./test.l
The hailstone length returned most often is 72
It is returned 1467 times


=={{header|Python}}==
Executable libraries are common in Python. The [[Hailstone sequence#Python|Python]] entry for Hailstone sequence is already written in the correct manner.

The entry is copied below and, for this task needs to be in a file called hailstone.py:
def hailstone(n):
seq = [n]
while n>1:
n = 3*n + 1 if n & 1 else n//2
seq.append(n)
return seq

if __name__ == '__main__':
h = hailstone(27)
assert len(h)==112 and h[:4]==[27, 82, 41, 124] and h[-4:]==[8, 4, 2, 1]
print("Maximum length %i was found for hailstone(%i) for numbers <100,000" %
max((len(hailstone(i)), i) for i in range(1,100000)))


In the case of the Python language the interpreter maintains a module level variable called __name__. If the file hailstone.py is ''imported'' (as import hailstone), then the __name__ variable is set to the import name of 'hailstone' and the if __name__ == '__main__' expression would then be false, and only the hailstone function is available to the importer.

If the same file hailstone.py is ''run'', (as maybe python hailstone.py; or maybe double-clicking the hailstone.py file), then the __name__ variable is set to the special name of '__main__' and the if __name__ == '__main__' expression would then be true causing its block of code to be executed.

'''Library importing executable'''

The second executable is the file common_hailstone_length.py with this content:
from collections import Counter

def function_length_frequency(func, hrange):
return Counter(len(func(n)) for n in hrange).most_common()

if __name__ == '__main__':
from executable_hailstone_library import hailstone

upto = 100000
hlen, freq = function_length_frequency(hailstone, range(1, upto))[0]
print("The length of hailstone sequence that is most common for\n"
"hailstone(n) where 1<=n<%i, is %i. It occurs %i times."
% (upto, hlen, freq))


Both files could be in the same directory. (That is the easiest way to make the library known to its importer for this example)

'''Sample output'''

On executing the file common_hailstone_length.py it loads the library and produces the following result:
The length of hailstone sequence that is most common for
hailstone(n) where 1<=n<100000, is 72. It occurs 1467 times


Note that the file common_hailstone_length.py is itself written as an executable library. When imported it makes function_length_frequency available to the importer.

===Other examples===
* The Python Prime decomposition entry of [[Least common multiple]] employs [[Prime decomposition#Python]] as an executable library.
* [[Names_to_numbers#Python]] uses [[Number_names#Python]] as an executable library.

=={{header|Racket}}==

When Racket runs a file (with racket some-file) it executes its
toplevel expressions, and then it runs a submodule named main if there
is one. When a file is used as a library (with require), the toplevel
expressions are executed as well, but the main is not
executed. The idea is that toplevel expressions might be used to initialize
state that the library needs -- a good example here is the initialization of
the memoization hash table. (Note that this is better than the common hacks of
check-the-loaded-script-name, since it is robust against failures due to
symlinks, case normalization, etc etc.)

We start with a "hs.rkt" file that has the exact code from the
[[Hailstone sequence#Racket]] solution, except that the hailstone
function is now provided, and the demonstration printout is pushed into a
main submodule:

#lang racket

(provide hailstone)
(define hailstone
(let ([t (make-hasheq)])
(hash-set! t 1 '(1))
(λ(n) (hash-ref! t n
(λ() (cons n (hailstone (if (even? n) (/ n 2) (+ (* 3 n) 1)))))))))

(module+ main
(define h27 (hailstone 27))
(printf "h(27) = ~s, ~s items\n"
`(,@(take h27 4) ... ,@(take-right h27 4))
(length h27))
(define N 100000)
(define longest
(for/fold ([m #f]) ([i (in-range 1 (add1 N))])
(define h (hailstone i))
(if (and m (> (cdr m) (length h))) m (cons i (length h)))))
(printf "for x<=~s, ~s has the longest sequence with ~s items\n"
N (car longest) (cdr longest)))

Running it directly produces the same output as [[Hailstone sequence#Racket]]:

$ racket hs.rkt
first 4 elements of h(27): '(27 82 41 124)
last 4 elements of h(27): '(8 4 2 1)
x < 10000 such that h(x) gives the longest sequence: 351


And now this can be used from a second source file, "hsfreq.rkt" as a
library:

#lang racket
(require "hs.rkt")
(define N 100000)
(define t (make-hasheq))
(define best
(for/fold ([best #f]) ([i (in-range 1 (add1 N))])
(define len (length (hailstone i)))
(define freq (add1 (hash-ref t len 0)))
(hash-set! t len freq)
(if (and best (> (car best) freq)) best (cons freq len))))
(printf "Most frequent sequence length for x<=~s: ~s, appearing ~s times\n" N
(cdr best) (car best))



$ racket hsfreq.rkt
Most frequent sequence length for x<=100000: 72, appearing 1467 times


=={{header|REXX}}==
===task 1===
The following REXX subroutine (or function, as it returns a value) is normally stored in a folder that the REXX interpreter searches first for subroutine/function call/invokes.

If not there, the REXX interpreter normally checks the current drive (or default disk), and then through some sort of heirarchy --- depending upon the particular REXX interpreter and operating system.


On Microsoft Windows systems using Regina, PC/REXX, Personal REXX, R4, or ROO, the program name is normally the function name with a file extension of '''REX''   (but that isn't a strict requirement or rule, each REXX interpreter has multiple file extensions that are supported).

On VM/CMS systems, the filetype (the file extension) is normally   '''EXEC'''.   If however, the REXX program was previously '''EXECLOAD'''ed, it may have a different name (identity) assigned to it.

The following program (function) is named:   '''HAILSTONE.REX'''   (the case doesn't matter for Microsoft Windows systems).

All REXX interpreters support subroutines/functions being on the current drive ('''CD'''), default disk (or MDISK in the case of CMS), or the equivalent.
/*REXX program returns the hailstone (Collatz) sequence for any integer.*/
numeric digits 20 /*ensure enough digits for mult. */
parse arg n 1 s /*N & S assigned to the first arg*/
do while n\==1 /*loop while N isn't unity. */
if n//2 then n=n*3+1 /*if N is odd, calc: 3*n +1 */
else n=n%2 /* " " " even, perform fast ÷ */
s=s n /*build a sequence list (append).*/
end /*while*/
return s

===task 2, 3===
The following program is named:  : '''HAIL_PGM.REX'''   and is stored in the current directory.
/*REXX pgm tests a number and a range for hailstone (Collatz) sequences.*/
parse arg x .; if x=='' then x=27 /*get the optional first argument*/

$=hailstone(x) /*═════════════task 2════════════*/
#=words($) /*number of numbers in sequence. */
say x 'has a hailstone sequence of' # 'and starts with: ' subword($,1,4),
' and ends with:' subword($,#-3)
say
w=0; do j=1 for 99999 /*═════════════task 3════════════*/
$=hailstone(j); #=words($) /*obtain the hailstone sequence. */
if #<=w then iterate /*Not big 'nuff? Then keep going.*/
bigJ=j; w=# /*remember what # has biggest HS.*/
end /*j*/

say '(between 1──►99,999) ' bigJ 'has the longest hailstone sequence:' w
/*stick a fork in it, we're done.*/

'''output'''

27 has a hailstone sequence of 112 and starts with: 27 82 41 124 and ends with: 8 4 2 1

(between 1──►99,999) 77031 has the longest hailstone sequence: 351

===task 4===
The following program is named:   '''MAIL_POP.REX'''   and is stored in the current directory.
/*REXX pgm finds the most common (popular) hailstone sequence length. */
parse arg z .; if z=='' then z=99999 /*get the optional first argument*/
!.=0
w=0; do j=1 for z /*═════════════task 4════════════*/
#=words(hailstone(j)) /*obtain hailstone sequence count*/
!.# = !.# + 1 /*add unity to popularity count. */
end /*j*/
occ=0; p=0
do k=1 for z
if !.k>occ then do; occ=!.k; p=k; end
end /*p*/

say '(between 1──►'z") " p,
' is the most common hailstone sequence length (with' occ "occurrences)."
/*stick a fork in it, we're done.*/

'''output'''

(between 1──►99999) 72 is the most common hailstone sequence length (with 1467 occurrences).

===task 5===
To run a REXX program, it depends on the REXX interpretor and which operating system is being used   (and what options where used when the REXX interpreter was installed/set up).


On a VM/CMS system, you could enter:
*             HAILSTONE
* EXEC HAILSTONE
to execute the   '''HAILSTONE EXEC A'''   program   (there are also other ways to invoke it).


On a Microsoft Windows system, you could enter:
*       HAILSTONE.REX
*       HAILSTONE
* xxx HAILSTONE.REX
* xxx HAILSTONE
where   '''xxx'''   is the name of the REXX interpreter, and if installed under a Microsoft Windows (Next family), the file extension and/or the REXX interpreter can be omitted.




=={{header|Ruby}}==
An executable library checks ''__FILE__ == $0''. Here, ''__FILE__'' is the path of the current source file, and ''$0'' is the path of the current executable. If ''__FILE__ == $0'', then the current source file is the executable, else the current source file is a library for some other executable.

* ''__FILE__ == $0'' also works with older versions of Ruby, but this Hailstone example calls new methods in Ruby 1.8.7.

This is ''hailstone.rb'', a modification of [[Hailstone sequence#Ruby]] as an executable library.

{{works with|Ruby|1.8.7}}

# hailstone.rb
module Hailstone
module_function
def hailstone n
seq = [n]
until n == 1
n = (n.even?) ? (n / 2) : (3 * n + 1)
seq << n
end
seq
end
end

if __FILE__ == $0
include Hailstone

# for n = 27, show sequence length and first and last 4 elements
hs27 = hailstone 27
p [hs27.length, hs27[0..3], hs27[-4..-1]]

# find the longest sequence among n less than 100,000
n, len = (1 ... 100_000) .collect {|n|
[n, hailstone(n).length]} .max_by {|n, len| len}
puts "#{n} has a hailstone sequence length of #{len}"
puts "the largest number in that sequence is #{hailstone(n).max}"
end


It runs like any Ruby program:

$ ruby scratch.rb                                                              
[112, [27, 82, 41, 124], [8, 4, 2, 1]]
77031 has a hailstone sequence length of 351
the largest number in that sequence is 21933016


This is ''hsfreq.rb'', which requires ''hailstone.rb'' as a library.

# hsfreq.rb
require 'hailstone'

h = Hash.new(0)
last = 99_999
(1..last).each {|n| h[Hailstone.hailstone(n).length] += 1}
length, count = h.max_by {|length, count| count}

puts "Given the hailstone sequences from 1 to #{last},"
puts "the most common sequence length is #{length},"
puts "with #{count} such sequences."


As with any library, ''hailstone.rb'' must be in $:, the search path for libraries. One way is to leave ''hailstone.rb'' in the current directory and run ruby -I. hsfreq.rb. (Ruby older than 1.9.2 also searches the current directory by default.)

$ ruby -I. hsfreq.rb
Given the hailstone sequences from 1 to 99999,
the most common sequence length is 72,
with 1467 such sequences.


=={{header|Scala}}==
[[Category:Scala Implementations]]
{{libheader|Scala}}
In Scala it is possible to combine several "main"s (mixed-in by the App trait) in one file (e.g. HailstoneSequence.scala):
object HailstoneSequence extends App { // Show it all, default number is 27.
def hailstone(n: Int): Stream[Int] =
n #:: (if (n == 1) Stream.empty else hailstone(if (n % 2 == 0) n / 2 else n * 3 + 1))

Hailstone.details(args.headOption.map(_.toInt).getOrElse(27))
HailTest.main(Array())
}

object Hailstone extends App { // Compute a given or default number to Hailstone sequence
def details(nr: Int) = {
val collatz = HailstoneSequence.hailstone(nr)

println(s"Use the routine to show that the hailstone sequence for the number: $nr.")
println(collatz.toList)
println(s"It has ${collatz.length} elements.")
}
details(args.headOption.map(_.toInt).getOrElse(27))
}

object HailTest extends App { // Compute only the < 100000 test
println(
"Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.")
val (n, len) = (1 until 100000).map(n => (n, HailstoneSequence.hailstone(n).length)).maxBy(_._2)
println(s"Longest hailstone sequence length= $len occurring with number $n.")
}


Steps:

1. First let the compiler process the source file:
C:\Users\FransAdm\Documents>scalac HailstoneSequence.scala

2. Run the Hailstone function with a parameter:
C:\Users\FransAdm\Documents>scala Hailstone 42
Use the routine to show that the hailstone sequence for the number: 42.
List(42, 21, 64, 32, 16, 8, 4, 2, 1)
It has 9 elements.
3. Run the combined function and < 100000 test:
C:\Users\FransAdm\Documents>scala HailstoneSequence 27
Use the routine to show that the hailstone sequence for the number: 27.
List(27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155,
466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850,
425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154,
3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80
, 40, 20, 10, 5, 16, 8, 4, 2, 1)
It has 112 elements.
Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.

4. Finally do only the callable < 100000 test
C:\Users\FransAdm\Documents>scala HailTest
Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.

C:\Users\FransAdm\Documents>

=={{header|Tcl}}==
The standard idiom for detecting whether a script is being loaded as a library or run directly is to compare the result of info script (which describes the name of the currently sourced script file) and the global argv0 variable (which holds the name of the main script).
### In the file hailstone.tcl ###
package provide hailstone 1.0

proc hailstone n {
while 1 {
lappend seq $n
if {$n == 1} {return $seq}
set n [expr {$n & 1 ? $n*3+1 : $n/2}]
}
}

# If directly executed, run demo code
if {[info script] eq $::argv0} {
set h27 [hailstone 27]
puts "h27 len=[llength $h27]"
puts "head4 = [lrange $h27 0 3]"
puts "tail4 = [lrange $h27 end-3 end]"

set maxlen [set max 0]
for {set i 1} {$i<100000} {incr i} {
set l [llength [hailstone $i]]
if {$l>$maxlen} {set maxlen $l;set max $i}
}
puts "max is $max, with length $maxlen"
}


To make the package locatable, run this Tcl script in the same directory which builds the index file:
pkg_mkIndex .

Using the above code as a library then just requires that we tell the script the location of the additional library directory by adding it to the global auto_path variable; it is unnecessary if the script is installed in one of the standard locations (a fairly long list that depends on the installation):
#!/usr/bin/tclsh8.6
package require Tcl 8.6 ;# For [lsort -stride] option
lappend auto_path . ;# Or wherever it is located
package require hailstone 1.0

# Construct a histogram of length frequencies
set histogram {}
for {set n 1} {$n < 100000} {incr n} {
dict incr histogram [llength [hailstone $n]]
}

# Identify the most common length by sorting...
set sortedHist [lsort -decreasing -stride 2 -index 1 $histogram]
lassign $sortedHist mostCommonLength freq

puts "most common length is $mostCommonLength, with frequency $freq"


{{omit from|Go}}
{{omit from|GUISS}}
{{omit from|Maxima}}

Hailstone sequence

Pete: Add Limbo by means of copypasta from the Executable Library task.


{{task}}
The Hailstone sequence of numbers can be generated from a starting positive integer, n by:
* If n is 1 then the sequence ends.
* If n is even then the next n of the sequence = n/2
* If n is odd then the next n of the sequence = (3 * n) + 1

The (unproven), [[wp:Collatz conjecture|Collatz conjecture]] is that the hailstone sequence for any starting number always terminates.

'''Task Description:'''
# Create a routine to generate the hailstone sequence for a number.
# Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
# Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.
(But don't show the actual sequence!)

'''See Also:'''

* [http://xkcd.com/710 xkcd] (humourous).

=={{header|ACL2}}==
(defun hailstone (len)
(loop for x = len
then (if (evenp x)
(/ x 2)
(+ 1 (* 3 x)))
collect x until (= x 1)))

;; Must be tail recursive
(defun max-hailstone-start (limit mx curr)
(declare (xargs :mode :program))
(if (zp limit)
(mv mx curr)
(let ((new-mx (len (hailstone limit))))
(if (> new-mx mx)
(max-hailstone-start (1- limit) new-mx limit)
(max-hailstone-start (1- limit) mx curr)))))


Output:
> (take 4 (hailstone 27))
(27 82 41 124)
> (nthcdr 108 (hailstone 27))
(8 4 2 1)
> (len (hailstone 27))
112
> (max-hailstone-start 100000 0 0)
(351 77031)


=={{header|Ada}}==
Similar to [[#C|C method]]:
with Ada.Text_IO; use Ada.Text_IO;
procedure hailstone is
type int_arr is array(Positive range <>) of Integer;
type int_arr_pt is access all int_arr;

function hailstones(num:Integer; pt:int_arr_pt) return Integer is
stones : Integer := 1;
n : Integer := num;
begin
if pt /= null then pt(1) := num; end if;
while (n/=1) loop
stones := stones + 1;
if n mod 2 = 0 then n := n/2;
else n := (3*n)+1;
end if;
if pt /= null then pt(stones) := n; end if;
end loop;
return stones;
end hailstones;

nmax,stonemax,stones : Integer := 0;
list : int_arr_pt;
begin
stones := hailstones(27,null);
list := new int_arr(1..stones);
stones := hailstones(27,list);
put(" 27: "&Integer'Image(stones)); new_line;
for n in 1..4 loop put(Integer'Image(list(n))); end loop;
put(" .... ");
for n in stones-3..stones loop put(Integer'Image(list(n))); end loop;
new_line;
for n in 1..100000 loop
stones := hailstones(n,null);
if stones>stonemax then
nmax := n; stonemax := stones;
end if;
end loop;
put_line(Integer'Image(nmax)&" max @ n= "&Integer'Image(stonemax));
end hailstone;

Output:

27: 112
27 82 41 124 .... 8 4 2 1
77031 max @ n= 351


===Alternative method===
A method without pointers or dynamic memory allocation, but slower for simply counting. This is also used for the "executable library" task [[Executable library#Ada]].

hailstones.ads:
package Hailstones is
type Integer_Sequence is array(Positive range <>) of Integer;
function Create_Sequence (N : Positive) return Integer_Sequence;
end Hailstones;

hailstones.adb:
package body Hailstones is
function Create_Sequence (N : Positive) return Integer_Sequence is
begin
if N = 1 then
-- terminate
return (1 => N);
elsif N mod 2 = 0 then
-- even
return (1 => N) & Create_Sequence (N / 2);
else
-- odd
return (1 => N) & Create_Sequence (3 * N + 1);
end if;
end Create_Sequence;
end Hailstones;

example main.adb:
with Ada.Text_IO;
with Hailstones;

procedure Main is
package Integer_IO is new Ada.Text_IO.Integer_IO (Integer);

procedure Print_Sequence (X : Hailstones.Integer_Sequence) is
begin
for I in X'Range loop
Integer_IO.Put (Item => X (I), Width => 0);
if I < X'Last then
Ada.Text_IO.Put (", ");
end if;
end loop;
Ada.Text_IO.New_Line;
end Print_Sequence;

Hailstone_27 : constant Hailstones.Integer_Sequence :=
Hailstones.Create_Sequence (N => 27);

begin
Ada.Text_IO.Put_Line ("Length of 27:" & Integer'Image (Hailstone_27'Length));
Ada.Text_IO.Put ("First four: ");
Print_Sequence (Hailstone_27 (Hailstone_27'First .. Hailstone_27'First + 3));
Ada.Text_IO.Put ("Last four: ");
Print_Sequence (Hailstone_27 (Hailstone_27'Last - 3 .. Hailstone_27'Last));

declare
Longest_Length : Natural := 0;
Longest_N : Positive;
Length : Natural;
begin
for I in 1 .. 99_999 loop
Length := Hailstones.Create_Sequence (N => I)'Length;
if Length > Longest_Length then
Longest_Length := Length;
Longest_N := I;
end if;
end loop;
Ada.Text_IO.Put_Line ("Longest length is" & Integer'Image (Longest_Length));
Ada.Text_IO.Put_Line ("with N =" & Integer'Image (Longest_N));
end;
end Main;

output:
Length of 27: 112
First four: 27, 82, 41, 124
Last four: 8, 4, 2, 1
Longest length is 351
with N = 77031


=={{header|ALGOL 68}}==
{{trans|C}} - note: This specimen retains the original C coding style.
{{works with|ALGOL 68|Standard - no extensions to language used}}
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}}
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - using the ''print'' routine rather than ''printf''}}
MODE LINT = # LONG ... # INT;

PROC hailstone = (INT in n, REF[]LINT array)INT:
(
INT hs := 1;
INT index := 0;
LINT n := in n;

WHILE n /= 1 DO
hs +:= 1;
IF array ISNT REF[]LINT(NIL) THEN array[index +:= 1] := n FI;
n := IF ODD n THEN 3*n+1 ELSE n OVER 2 FI
OD;
IF array ISNT REF[]LINT(NIL) THEN array[index +:= 1] := n FI;
hs
);

main:
(
INT j, hmax := 0;
INT jatmax, n;
INT border = 4;

FOR j TO 100000-1 DO
n := hailstone(j, NIL);
IF hmax < n THEN
hmax := n;
jatmax := j
FI
OD;

[2]INT test := (27, jatmax);
FOR key TO UPB test DO
INT val = test[key];
n := hailstone(val, NIL);
[n]LINT array;
n := hailstone(val, array);

printf(($"[ "n(border)(g(0)", ")" ..."n(border)(", "g(0))"] len="g(0)l$,
array[:border], array[n-border+1:], n))
#;free(array) #
OD;
printf(($"Max "g(0)" at j="g(0)l$, hmax, jatmax))
# ELLA Algol68RS:
print(("Max",hmax," at j=",jatmax, new line))
#
)

Output:

[ 27, 82, 41, 124, ..., 8, 4, 2, 1] len=112
[ 77031, 231094, 115547, 346642, ..., 8, 4, 2, 1] len=351
Max 351 at j=77031


=={{header|APL}}==
{{works with|Dyalog APL}}
seq←hailstone n;next
⍝ Returns the hailstone sequence for a given number

seq←n ⍝ Init the sequence
:While n≠1
next←(n÷2) (1+3×n) ⍝ Compute both possibilities
n←next[1+2|n] ⍝ Pick the appropriate next step
seq,←n ⍝ Append that to the sequence
:EndWhile

Output:
5↑hailstone 27
27 82 41 124 62
¯5↑hailstone 27
16 8 4 2 1
⍴hailstone 27
112
1↑{⍵[⍒↑(⍴∘hailstone)¨⍵]}⍳100000
77031


=={{header|AutoHotkey}}==
; Submitted by MasterFocus --- http://tiny.cc/iTunis

; [1] Generate the Hailstone Seq. for a number

List := varNum := 7 ; starting number is 7, not counting elements
While ( varNum > 1 )
List .= ", " ( varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 ) )
MsgBox % List

; [2] Seq. for starting number 27 has 112 elements

Count := 1, List := varNum := 27 ; starting number is 27, counting elements
While ( varNum > 1 )
Count++ , List .= ", " ( varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 ) )
MsgBox % "Sequence:`n" List "`n`nCount: " Count

; [3] Find number<100000 with longest seq. and show both values

MaxNum := Max := 0 ; reset the Maximum variables
TimesToLoop := 100000 ; limit number here is 100000
Offset := 70000 ; offset - use 0 to process from 0 to 100000
Loop, %TimesToLoop%
{
If ( TimesToLoop < ( varNum := Index := A_Index+Offset ) )
Break
text := "Processing...`n-------------------`n"
text .= "Current starting number: " Index "`n"
text .= "Current sequence count: " Count
text .= "`n-------------------`n"
text .= "Maximum starting number: " MaxNum "`n"
text .= "Maximum sequence count: " Max " <<" ; text split to avoid long code lines
ToolTip, %text%
Count := 1 ; going to count the elements, but no "List" required
While ( varNum > 1 )
Count++ , varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 )
If ( Count > Max )
Max := Count , MaxNum := Index ; set the new maximum values, if necessary
}
ToolTip
MsgBox % "Number: " MaxNum "`nCount: " Max

=={{header|AutoIt}}==



$Hail = Hailstone(27)
ConsoleWrite("Sequence-Lenght: "&$Hail&@CRLF)
$Big = -1
$Sequenzlenght = -1
For $I = 1 To 100000
$Hail = Hailstone($i, False)
If Number($Hail) > $Sequenzlenght Then
$Sequenzlenght = Number($Hail)
$Big = $i
EndIf
Next
ConsoleWrite("Longest Sequence : "&$Sequenzlenght&" from number "&$Big&@CRLF)
Func Hailstone($int, $sequence = True)
$Counter = 0
While True
$Counter += 1
If $sequence = True Then ConsoleWrite($int & ",")
If $int = 1 Then ExitLoop
If Not Mod($int, 2) Then
$int = $int / 2
Else
$int = 3 * $int + 1
EndIf
If Not Mod($Counter, 25) AND $sequence = True Then ConsoleWrite(@CRLF)
WEnd
If $sequence = True Then ConsoleWrite(@CRLF)
Return $Counter
EndFunc ;==>Hailstone

Output:
27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,91,274,137,412,206,103,
310,155,466,233,700,350,175,526,263,790,395,1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132,
566,283,850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,7288,3644,1822,911,2734,1367,4102,2051,
6154,3077,9232,4616,2308,1154,577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,106,
53,160,80,40,20,10,5,16,8,4,2,1,
Sequence-Lenght: 112
Longest Sequence : 351 from number 77031


=={{header|AWK}}==

#!/usr/bin/awk -f
function hailstone(v, verbose) {
n = 1;
u = v;
while (1) {
if (verbose) printf " "u;
if (u==1) return(n);
n++;
if (u%2 > 0 )
u = 3*u+1;
else
u = u/2;
}
}

BEGIN {
i = 27;
printf("hailstone(%i) has %i elements\n",i,hailstone(i,1));
ix=0;
m=0;
for (i=1; i<100000; i++) {
n = hailstone(i,0);
if (m m=n;
ix=i;
}
}
printf("longest hailstone sequence is %i and has %i elements\n",ix,m);
}

Output:

27 82 41 124 ....... 8 4 2 1
hailstone(27) has 112 elements
longest hailstone sequence is 77031 and has 351 elements


=={{header|BASIC}}==
==={{header|Applesoft BASIC}}===
10 HOME

100 N = 27
110 GOSUB 400"HAILSTONE
120 DEF FN L(I) = E(I + 4 * (I < 0))
130IFL=112AND(S(0)=27ANDS(1)=82ANDS(2)=41ANDS(3)=124)AND(FNL(M-3)=8ANDFNL(M-2)=4ANDFNL(M-1)=2ANDFNL(M)=1)THENPRINT"THE HAILSTONE SEQUENCE FOR THE NUMBER 27 HAS 112 ELEMENTS STARTING WITH 27, 82, 41, 124 AND ENDING WITH 8, 4, 2, 1"
140 PRINT
150 V = PEEK(37) + 1

200 N = 1
210 GOSUB 400"HAILSTONE
220 MN = 1
230 ML = L
240 FOR I = 2 TO 99999
250 N = I
260 GOSUB 400"HAILSTONE
270 IFL>MLTHENMN=I:ML=L:VTABV:HTAB1:PRINT "THE NUMBER " MN " HAS A HAILSTONE SEQUENCE LENGTH OF "L" WHICH IS THE LONGEST HAILSTONE SEQUENCE OF NUMBERS LESS THAN ";:Y=PEEK(37)+1:X=PEEK(36)+1
280 IF Y THEN VTAB Y : HTAB X : PRINTI+1;
290 NEXT I

300 END

400 M = 0
410 FOR L = 1 TO 1E38
420 IF L < 5 THEN S(L-1) = N
430 M = (M + 1) * (M < 3)
440 E(M) = N
450 IF N = 1 THEN RETURN
460 EVEN = INT(N/2)=N/2
470 IF EVEN THEN N=N/2
480 IF NOT EVEN THEN N = (3 * N) + 1
490 NEXT L : STOP


==={{header|BBC BASIC}}===
seqlen% = FNhailstone(27, TRUE)
PRINT '"Sequence length = "; seqlen%
maxlen% = 0
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%, FALSE)
IF seqlen% > maxlen% THEN
maxlen% = seqlen%
maxnum% = number%
ENDIF
NEXT
PRINT "The number with the longest hailstone sequence is " ; maxnum%
PRINT "Its sequence length is " ; maxlen%
END

DEF FNhailstone(N%, S%)
LOCAL L%
IF S% THEN PRINT N%;
WHILE N% <> 1
IF N% AND 1 THEN N% = 3 * N% + 1 ELSE N% DIV= 2
IF S% THEN PRINT N%;
L% += 1
ENDWHILE
= L% + 1

'''Output:'''

27 82 41 124 62 31 94 47
142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206
103 310 155 466 233 700 350 175
526 263 790 395 1186 593 1780 890
445 1336 668 334 167 502 251 754
377 1132 566 283 850 425 1276 638
319 958 479 1438 719 2158 1079 3238
1619 4858 2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232 4616 2308
1154 577 1732 866 433 1300 650 325
976 488 244 122 61 184 92 46
23 70 35 106 53 160 80 40
20 10 5 16 8 4 2 1

Sequence length = 112
The number with the longest hailstone sequence is 77031
Its sequence length is 351


==={{header|Liberty BASIC}}===
print "Part 1: Create a routine to generate the hailstone sequence for a number."
print ""
while hailstone < 1 or hailstone <> int(hailstone)
input "Please enter a positive integer: "; hailstone
wend
print ""
print "The following is the 'Hailstone Sequence' for your number..."
print ""
print hailstone
while hailstone <> 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
print hailstone
wend
print ""
input "Hit 'Enter' to continue to part 2...";dummy$
cls
print "Part 2: Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1."
print ""
print "No. in Seq.","Hailstone Sequence Number for 27"
print ""
c = 1: hailstone = 27
print c, hailstone
while hailstone <> 1
c = c + 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
print c, hailstone
wend
print ""
input "Hit 'Enter' to continue to part 3...";dummy$
cls
print "Part 3: Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.(But don't show the actual sequence)!"
print ""
print "Calculating result... Please wait... This could take a little while..."
print ""
print "Percent Done", "Start Number", "Seq. Length", "Maximum Sequence So Far"
print ""
for cc = 1 to 99999
hailstone = cc: c = 1
while hailstone <> 1
c = c + 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
wend
if c > max then max = c: largesthailstone = cc
locate 1, 7
print " "
locate 1, 7
print using("###.###", cc / 99999 * 100);"%", cc, c, max
scan
next cc
print ""
print "The number less than 100,000 with the longest 'Hailstone Sequence' is "; largesthailstone;". It's sequence length is "; max;"."
end


==={{header|OxygenBasic}}===


function Hailstone(sys *n)
'=========================
if n and 1
n=n*3+1
else
n=n>>1
end if
end function

function HailstoneSequence(sys n) as sys
'=======================================
count=1
do
Hailstone n
Count++
if n=1 then exit do
end do
return count
end function

'MAIN
'====

maxc=0
maxn=0
e=100000
for n=1 to e
c=HailstoneSequence n
if c>maxc
maxc=c
maxn=n
end if
next

print e ", " maxn ", " maxc

'result 100000, 77031, 351


==={{header|PureBasic}}===
NewList Hailstones.i() ; Make a linked list to use as we do not know the numbers of elements needed for an Array

Procedure.i FillHailstones(n) ; Fills the list & returns the amount of elements in the list
Shared Hailstones() ; Get access to the Hailstones-List
ClearList(Hailstones()) ; Remove old data
Repeat
AddElement(Hailstones()) ; Add an element to the list
Hailstones()=n ; Fill current value in the new list element
If n=1
ProcedureReturn ListSize(Hailstones())
ElseIf n%2=0
n/2
Else
n=(3*n)+1
EndIf
ForEver
EndProcedure

If OpenConsole()
Define i, l, maxl, maxi
l=FillHailstones(27)
Print("#27 has "+Str(l)+" elements and the sequence is: "+#CRLF$)
ForEach Hailstones()
If i=6
Print(#CRLF$)
i=0
EndIf
i+1
Print(RSet(Str(Hailstones()),5))
If Hailstones()<>1
Print(", ")
EndIf
Next

i=1
Repeat
l=FillHailstones(i)
If l>maxl
maxl=l
maxi=i
EndIf
i+1
Until i>=100000
Print(#CRLF$+#CRLF$+"The longest sequence below 100000 is #"+Str(maxi)+", and it has "+Str(maxl)+" elements.")

Print(#CRLF$+#CRLF$+"Press ENTER to exit."): Input()
CloseConsole()
EndIf


'''Output'''
#27 has 112 elements and the sequence is:
27, 82, 41, 124, 62, 31,
94, 47, 142, 71, 214, 107,
322, 161, 484, 242, 121, 364,
182, 91, 274, 137, 412, 206,
103, 310, 155, 466, 233, 700,
350, 175, 526, 263, 790, 395,
1186, 593, 1780, 890, 445, 1336,
668, 334, 167, 502, 251, 754,
377, 1132, 566, 283, 850, 425,
1276, 638, 319, 958, 479, 1438,
719, 2158, 1079, 3238, 1619, 4858,
2429, 7288, 3644, 1822, 911, 2734,
1367, 4102, 2051, 6154, 3077, 9232,
4616, 2308, 1154, 577, 1732, 866,
433, 1300, 650, 325, 976, 488,
244, 122, 61, 184, 92, 46,
23, 70, 35, 106, 53, 160,
80, 40, 20, 10, 5, 16,
8, 4, 2, 1

The longest sequence found up to 100000 is #77031 which has 351 elements.

Press ENTER to exit.

==={{header|Run BASIC}}===
print "Part 1: Create a routine to generate the hailstone sequence for a number."
print ""

while hailstone < 1 or hailstone <> int(hailstone)
input "Please enter a positive integer: "; hailstone
wend
count = doHailstone(hailstone,"Y")

print: print "Part 2: Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1."
count = doHailstone(27,"Y")

print: print "Part 3: Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.(But don't show the actual sequence)!"
print "Calculating result... Please wait... This could take a little while..."
print "Stone Percent Count"
for i = 1 to 99999
count = doHailstone(i,"N")
if count > maxCount then
theBigStone = i
maxCount = count
print using("#####",i);" ";using("###.#", i / 99999 * 100);"% ";using("####",count)
end if
next i
end

'---------------------------------------------
' pass number and print (Y/N)
FUNCTION doHailstone(hailstone,prnt$)
if prnt$ = "Y" then
print
print "The following is the 'Hailstone Sequence' for number:";hailstone
end if
while hailstone <> 1
if (hailstone and 1) then hailstone = (hailstone * 3) + 1 else hailstone = hailstone / 2
doHailstone = doHailstone + 1
if prnt$ = "Y" then
print hailstone;chr$(9);
if (doHailstone mod 10) = 0 then print
end if
wend
END FUNCTION


==={{header|Visual Basic .NET}}===
{{works with|Visual Basic .NET|2005+}}
Module HailstoneSequence
Sub Main()
' Checking sequence of 27.

Dim l As List(Of Long) = HailstoneSequence(27)
Console.WriteLine("27 has {0} elements in sequence:", l.Count())

For i As Integer = 0 To 3 : Console.Write("{0}, ", l(i)) : Next
Console.Write("... ")
For i As Integer = l.Count - 4 To l.Count - 1 : Console.Write(", {0}", l(i)) : Next

Console.WriteLine()

' Finding longest sequence for numbers below 100000.

Dim max As Integer = 0
Dim maxCount As Integer = 0

For i = 1 To 99999
l = HailstoneSequence(i)
If l.Count > maxCount Then
max = i
maxCount = l.Count
End If
Next
Console.WriteLine("Max elements in sequence for number below 100k: {0} with {1} elements.", max, maxCount)
Console.ReadLine()
End Sub

Private Function HailstoneSequence(ByVal n As Long) As List(Of Long)
Dim valList As New List(Of Long)()
valList.Add(n)

Do Until n = 1
n = IIf(n Mod 2 = 0, n / 2, (3 * n) + 1)
valList.Add(n)
Loop

Return valList
End Function

End Module


Output:
27 has 112 elements in sequence:
27, 82, 41, 124, ... , 8, 4, 2, 1
Max elements in sequence for number below 100k: 77031 with 351 elements.


=={{header|Batch File}}==
''1. Create a routine to generate the hailstone sequence for a number. ''
@echo off
setlocal enabledelayedexpansion
if "%1" equ "" goto :eof
call :hailstone %1 seq cnt
echo %seq%
goto :eof

:hailstone
set num=%1
set %2=%1

:loop
if %num% equ 1 goto :eof
call :iseven %num% res
if %res% equ T goto divideby2
set /a num = (3 * num) + 1
set %2=!%2! %num%
goto loop
:divideby2
set /a num = num / 2
set %2=!%2! %num%
goto loop

:iseven
set /a tmp = %1 %% 2
if %tmp% equ 1 (
set %2=F
) else (
set %2=T
)
goto :eof

''Demonstration''
>hailstone.cmd 20
20 10 5 16 8 4 2 1


=={{header|Befunge}}==
{{needs-review|Befunge|Calculates the Hailstone sequence but might not complete everything from task description.}}
&>:.:1-|
>3*^ @
|%2: <
v>2/>+


=={{header|Bracmat}}==
(
( hailstone
= L len
. !arg:?L
& whl
' ( !arg:~1
& (!arg*1/2:~/|3*!arg+1):?arg
& !arg !L:?L
)
& (!L:? [?len&!len.!L)
)
& ( reverse
= L e
. :?L
& whl'(!arg:%?e ?arg&!e !L:?L)
& !L
)
& hailstone$27:(?len.?list)
& reverse$!list:?first4 [4 ? [-5 ?last4
& put$"Hailstone sequence starting with "
& put$!first4
& put$(str$(" has " !len " elements and ends with "))
& put$(!last4 \n)
& 1:?N
& 0:?max:?Nmax
& whl
' ( !N+1:<100000:?N
& hailstone$!N
: ( >!max:?max&!N:?Nmax
| ?
. ?
)
)
& out
$ ( str
$ ( "The number <100000 with the longest hailstone sequence is "
!Nmax
" with "
!max
" elements."
)
)
);


=={{header|Brainf***}}==
{{incomplete}}
Prints the number of terms required to map the input to 1. Does not count the first term of the sequence.
>,[
[
----------[
>>>[>>>>]+[[-]+<[->>>>++>>>>+[>>>>]++[->+<<<<<]]<<<]
++++++[>------<-]>--[>>[->>>>]+>+[<<<<]>-],<
]>
]>>>++>+>>[
<<[>>>>[-]+++++++++<[>-<-]+++++++++>[-[<->-]+[<<<<]]<[>+<-]>]
>[>[>>>>]+[[-]<[+[->>>>]>+<]>[<+>[<<<<]]+<<<<]>>>[->>>>]+>+[<<<<]]
>[[>+>>[<<<<+>>>>-]>]<<<<[-]>[-<<<<]]>>>>>>>
]>>+[[-]++++++>>>>]<<<<[[<++++++++>-]<.[-]<[-]<[-]<]<,
]

27
111


=={{header|Brat}}==
hailstone = { num |
sequence = [num]
while { num != 1 }
{ true? num % 2 == 0
{ num = num / 2 }
{ num = num * 3 + 1 }
sequence << num
}

sequence
}

#Check sequence for 27
seq = hailstone 27
true? (seq[0,3] == [27 82 41 124] && seq[-1, -4] == [8 4 2 1])
{ p "Sequence for 27 is correct" }
{ p "Sequence for 27 is not correct!" }

#Find longest sequence for numbers < 100,000
longest = [number: 0 length: 0]

1.to 99999 { index |
seq = hailstone index
true? seq.length > longest[:length]
{ longest[:length] = seq.length
longest[:number] = index
p "Longest so far: #{index} @ #{longest[:length]} elements"
}

index = index + 1
}

p "Longest was starting from #{longest[:number]} and was of length #{longest[:length]}"

Output:
Sequence for 27 is correct
Longest so far: 1 @ 1 elements
Longest so far: 2 @ 2 elements
Longest so far: 3 @ 8 elements
...
Longest so far: 52527 @ 340 elements
Longest so far: 77031 @ 351 elements
Longest was starting from 77031 and was of length 351


=={{header|Burlesque}}==


blsq ) 27{^^^^2.%{3.*1.+}\/{2./}\/ie}{1!=}w!bx{\/+]}{\/isn!}w!L[
112


=={{header|C}}==
#include
#include

int hailstone(int n, int *arry)
{
int hs = 1;

while (n!=1) {
hs++;
if (arry) *arry++ = n;
n = (n&1) ? (3*n+1) : (n/2);
}
if (arry) *arry++ = n;
return hs;
}

int main()
{
int j, hmax = 0;
int jatmax, n;
int *arry;

for (j=1; j<100000; j++) {
n = hailstone(j, NULL);
if (hmax < n) {
hmax = n;
jatmax = j;
}
}
n = hailstone(27, NULL);
arry = malloc(n*sizeof(int));
n = hailstone(27, arry);

printf("[ %d, %d, %d, %d, ...., %d, %d, %d, %d] len=%d\n",
arry[0],arry[1],arry[2],arry[3],
arry[n-4], arry[n-3], arry[n-2], arry[n-1], n);
printf("Max %d at j= %d\n", hmax, jatmax);
free(arry);

return 0;
}

Output
[ 27, 82, 41, 124, ...., 8, 4, 2, 1] len= 112
Max 351 at j= 77031


===With caching===
Much faster if you want to go over a million or so.
#include

#define N 10000000
#define CS N /* cache size */

typedef unsigned long ulong;
ulong cache[CS] = {0};

ulong hailstone(ulong n)
{
int x;
if (n == 1) return 1;
if (n < CS && cache[n]) return cache[n];

x = 1 + hailstone((n & 1) ? 3 * n + 1 : n / 2);
if (n < CS) cache[n] = x;
return x;
}

int main()
{
int i, l, max = 0, mi;
for (i = 1; i < N; i++) {
if ((l = hailstone(i)) > max) {
max = l;
mi = i;
}
}
printf("max below %d: %d, length %d\n", N, mi, max);
return 0;
}


=={{header|C sharp|C#}}==
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;

namespace Hailstone
{
class Program
{
public static List hs(int n,List seq)
{
List sequence = seq;
sequence.Add(n);
if (n == 1)
{
return sequence;
}else{
int newn = (n % 2 == 0) ? n / 2 : (3 * n) + 1;
return hs(newn, sequence);
}
}

static void Main(string[] args)
{
int n = 27;
List sequence = hs(n,new List());
Console.WriteLine(sequence.Count + " Elements");
List start = sequence.GetRange(0, 4);
List end = sequence.GetRange(sequence.Count - 4, 4);
Console.WriteLine("Starting with : " + string.Join(",", start) + " and ending with : " + string.Join(",", end));
int number = 0, longest = 0;
for (int i = 1; i < 100000; i++)
{
int count = (hs(i, new List())).Count;
if (count > longest)
{
longest = count;
number = i;
}
}
Console.WriteLine("Number < 100000 with longest Hailstone seq.: " + number + " with length of " + longest);
}
}
}


112 Elements
Starting with : 27,82,41,124 and ending with : 8,4,2,1
Number < 100000 with longest Hailstone seq.: 77031 with length of 351


===With caching===
As with the [[#C|C example]], much faster if you want to go over a million or so.
using System;
using System.Collections.Generic;

namespace ConsoleApplication1
{
class Program
{
public static void Main()
{
int longestChain = 0, longestNumber = 0;

var recursiveLengths = new Dictionary();

const int maxNumber = 100000;

for (var i = 1; i <= maxNumber; i++)
{
var chainLength = Hailstone(i, recursiveLengths);
if (longestChain >= chainLength)
continue;

longestChain = chainLength;
longestNumber = i;
}
Console.WriteLine("max below {0}: {1} ({2} steps)", maxNumber, longestNumber, longestChain);
}

private static int Hailstone(int num, Dictionary lengths)
{
if (num == 1)
return 1;

while (true)
{
if (lengths.ContainsKey(num))
return lengths[num];

lengths[num] = 1 + ((num%2 == 0) ? Hailstone(num/2, lengths) : Hailstone((3*num) + 1, lengths));
}
}
}
}


max below 100000: 77031 (351 steps)


=={{header|C++}}==
#include
#include
#include

std::vector hailstone(int i)
{
std::vector v;
while(true){
v.push_back(i);
if (1 == i) break;
i = (i % 2) ? (3 * i + 1) : (i / 2);
}
return v;
}

std::pair find_longest_hailstone_seq(int n)
{
std::pair maxseq(0, 0);
int l;
for(int i = 1; i < n; ++i){
l = hailstone(i).size();
if (l > maxseq.second) maxseq = std::make_pair(i, l);
}
return maxseq;
}

int main () {

// Use the routine to show that the hailstone sequence for the number 27
std::vector h27;
h27 = hailstone(27);
// has 112 elements
int l = h27.size();
std::cout << "length of hailstone(27) is " << l;
// starting with 27, 82, 41, 124 and
std::cout << " first four elements of hailstone(27) are ";
std::cout << h27[0] << " " << h27[1] << " "
<< h27[2] << " " << h27[3] << std::endl;
// ending with 8, 4, 2, 1
std::cout << " last four elements of hailstone(27) are "
<< h27[l-4] << " " << h27[l-3] << " "
<< h27[l-2] << " " << h27[l-1] << std::endl;

std::pair m = find_longest_hailstone_seq(100000);

std::cout << "the longest hailstone sequence under 100,000 is " << m.first
<< " with " << m.second << " elements." <
return 0;
}


output:

length of hailstone(27) is 112 first four elements of hailstone(27) are 27 82 41 124
last four elements of hailstone(27) are 8 4 2 1
the longest hailstone sequence under 100,000 is 77031 with 351 elements.

=={{header|CLIPS}}==
(deftemplate longest
(slot bound) ; upper bound for the range of values to check
(slot next (default 2)) ; next value that needs to be checked
(slot start (default 1)) ; starting value of longest sequence
(slot len (default 1)) ; length of longest sequence
)

(deffacts startup
(query 27)
(longest (bound 100000))
)

(deffunction hailstone-next
(?n)
(if (evenp ?n)
then (div ?n 2)
else (+ (* 3 ?n) 1)
)
)

(defrule extend-sequence
?hail <- (hailstone $?sequence ?tail&:(> ?tail 1))
=>
(retract ?hail)
(assert (hailstone ?sequence ?tail (hailstone-next ?tail)))
)

(defrule start-query
(query ?num)
=>
(assert (hailstone ?num))
)

(defrule result-query
(query ?num)
(hailstone ?num $?sequence 1)
=>
(bind ?sequence (create$ ?num ?sequence 1))
(printout t "Hailstone sequence starting with " ?num ":" crlf)
(bind ?len (length ?sequence))
(printout t " Length: " ?len crlf)
(printout t " First four: " (implode$ (subseq$ ?sequence 1 4)) crlf)
(printout t " Last four: " (implode$ (subseq$ ?sequence (- ?len 3) ?len)) crlf)
(printout t crlf)
)

(defrule longest-create-next-hailstone
(longest (bound ?bound) (next ?next))
(test (<= ?next ?bound))
(not (hailstone ?next $?))
=>
(assert (hailstone ?next))
)

(defrule longest-check-next-hailstone
?longest <- (longest (bound ?bound) (next ?next) (start ?start) (len ?len))
(test (<= ?next ?bound))
?hailstone <- (hailstone ?next $?sequence 1)
=>
(retract ?hailstone)
(bind ?thislen (+ 2 (length ?sequence)))
(if (> ?thislen ?len) then
(modify ?longest (start ?next) (len ?thislen) (next (+ ?next 1)))
else
(modify ?longest (next (+ ?next 1)))
)
)

(defrule longest-finished
(longest (bound ?bound) (next ?next) (start ?start) (len ?len))
(test (> ?next ?bound))
=>
(printout t "The number less than " ?bound " that has the largest hailstone" crlf)
(printout t "sequence is " ?start " with a length of " ?len "." crlf)
(printout t crlf)
)


Output:
The number less than 100000 that has the largest hailstone
sequence is 77031 with a length of 351.

Hailstone sequence starting with 27:
Length: 112
First four: 27 82 41 124
Last four: 8 4 2 1


=={{header|Clojure}}==
(defn hailstone-seq [n]
(:pre [(pos? n)])
(lazy-seq
(cond (= n 1) '(1)
(even? n) (cons n (hailstone-seq (/ n 2)))
:else (cons n (hailstone-seq (+ (* n 3) 1))))))

(def hseq27 (hailstone-seq 27))
(assert (= (count hseq27) 112))
(assert (= (take 4 hseq27) [27 82 41 124]))
(assert (= (drop 108 hseq27) [8 4 2 1]))

(let [{max-i :num, max-len :len}
(reduce #(max-key :len %1 %2)
(for [i (range 1 100000)]
{:num i, :len (count (hailstone-seq i))}))]
(println "Maximum length" max-len "was found for hailstone(" max-i ")."))


=={{header|CoffeeScript}}==
Recursive version:
hailstone = (n) ->
if n is 1
[n]

else if n % 2 is 0
[n].concat hailstone n/2

else
[n].concat hailstone (3*n) + 1

h27 = hailstone 27
console.log "hailstone(27) = #{h27[0..3]} ... #{h27[-4..]} (length: #{h27.length})"

maxlength = 0
maxnums = []

for i in [1..100000]
seq = hailstone i

if seq.length is maxlength
maxnums.push i
else if seq.length > maxlength
maxlength = seq.length
maxnums = [i]

console.log "Max length: #{maxlength}; numbers generating sequences of this length: #{maxnums}"

hailstone(27) = 27,82,41,124 ... 8,4,2,1 (length: 112)
Max length: 351; numbers generating sequences of this length: 77031


=={{header|Common Lisp}}==
(defun hailstone (n)
(cond ((= n 1) '(1))
((evenp n) (cons n (hailstone (/ n 2))))
(t (cons n (hailstone (+ (* 3 n) 1))))))

(defun longest (n)
(let ((k 0) (l 0))
(loop for i from 1 below n do
(let ((len (length (hailstone i))))
(when (> len l) (setq l len k i)))
finally (format t "Longest hailstone sequence under ~A for ~A, having length ~A." n k l))))

Sample session:
ROSETTA> (length (hailstone 27))
112
ROSETTA> (subseq (hailstone 27) 0 4)
(27 82 41 124)
ROSETTA> (last (hailstone 27) 4)
(8 4 2 1)
ROSETTA> (longest-hailstone 100000)
Longest hailstone sequence under 100000 for 77031, having length 351.
NIL


=={{header|D}}==
===Basic Version===
import std.stdio, std.algorithm, std.range, std.typecons;

auto hailstone(uint n) pure nothrow {
auto result = [n];
while (n != 1) {
n = n & 1 ? n*3 + 1 : n/2;
result ~= n;
}
return result;
}

void main() {
enum M = 27;
immutable h = M.hailstone;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);

enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.hailstone.length, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

{{out}}
hailstone(27)= [27, 82, 41, 124] ... [8, 4, 2, 1]
Length hailstone(27)= 112
Longest sequence in [1,100000]= 77031 with len 351

===Faster Lazy Version===
Same output.
import std.stdio, std.algorithm, std.range, std.typecons;

struct Hailstone {
uint n;
bool empty() const pure nothrow { return n == 0; }
uint front() const pure nothrow { return n; }
void popFront() pure nothrow {
n = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
}
}

void main() {
enum M = 27;
immutable h = M.Hailstone.array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);

enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.Hailstone.walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}


===Lazy Version With Caching===
Faster, same output.
import std.stdio, std.algorithm, std.range, std.typecons;

struct Hailstone(size_t cacheSize = 500_000) {
size_t n;
__gshared static size_t[cacheSize] cache;

bool empty() const pure nothrow { return n == 0; }
size_t front() const pure nothrow { return n; }

void popFront() nothrow {
if (n >= cacheSize) {
n = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
} else if (cache[n]) {
n = cache[n];
} else {
immutable n2 = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
n = cache[n] = n2;
}
}
}

void main() {
enum M = 27;
const h = M.Hailstone!().array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);

enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.Hailstone!().walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

=={{header|Déjà Vu}}==
local hailstone:
swap [ over ]
while < 1 dup:
if % over 2:
#odd
++ * 3
else:
#even
/ swap 2
swap push-through rot dup
drop

if = (name) :(main):
local :h27 hailstone 27
!. = 112 len h27
!. = 27 h27! 0
!. = 82 h27! 1
!. = 41 h27! 2
!. = 124 h27! 3
!. = 8 h27! 108
!. = 4 h27! 109
!. = 2 h27! 110
!. = 1 h27! 111

local :max 0
local :maxlen 0
for i range 1 99999:
dup len hailstone i
if < maxlen:
set :maxlen
set :max i
else:
drop
!print( "number: " to-str max ", length: " to-str maxlen )
else:
@hailstone

{{out}}
true
true
true
true
true
true
true
true
true
number: 77031, length: 351


=={{header|Dart}}==
List hailstone(int n) {
if(n<=0) {
throw new IllegalArgumentException("start value must be >=1)");
}
Queue seq=new Queue();
seq.add(n);
while(n!=1) {
n=n%2==0?(n/2).toInt():3*n+1;
seq.add(n);
}
return new List.from(seq);
}

// apparently List is missing toString()
String iterableToString(Iterable seq) {
String str="[";
Iterator i=seq.iterator();
while(i.hasNext()) {
str+=i.next();
if(i.hasNext()) {
str+=",";
}
}
return str+"]";
}

main() {
for(int i=1;i<=10;i++) {
print("h($i)="+iterableToString(hailstone(i)));
}
List h27=hailstone(27);
List first4=h27.getRange(0,4);
print("first 4 elements of h(27): "+iterableToString(first4));
Expect.listEquals([27,82,41,124],first4);

List last4=h27.getRange(h27.length-4,4);
print("last 4 elements of h(27): "+iterableToString(last4));
Expect.listEquals([8,4,2,1],last4);

print("length of sequence h(27): "+h27.length);
Expect.equals(112,h27.length);

int seq,max=0;
for(int i=1;i<=100000;i++) {
List h=hailstone(i);
if(h.length>max) {
max=h.length;
seq=i;
}
}
print("up to 100000 the sequence h($seq) has the largest length ($max)");
}

Output
h(1)=[1]
h(2)=[2,1]
h(3)=[3,10,5,16,8,4,2,1]
h(4)=[4,2,1]
h(5)=[5,16,8,4,2,1]
h(6)=[6,3,10,5,16,8,4,2,1]
h(7)=[7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
h(8)=[8,4,2,1]
h(9)=[9,28,14,7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
h(10)=[10,5,16,8,4,2,1]
first 4 elements of h(27): [27,82,41,124]
last 4 elements of h(27): [8,4,2,1]
length of sequence h(27): 112
up to 100000 the sequence h(77031) has the largest length (351)


=={{header|Dc}}==
Firstly, this code takes the value from the stack, computes and prints the corresponding Hailstone sequence, and the length of the sequence.
The q procedure is for counting the length of the sequence.
The e and o procedure is for even and odd number respectively.
The x procedure is for overall control.
27
[[--: ]nzpq]sq
[d 2/ p]se
[d 3*1+ p]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx

Output

82
41
124
62
(omitted)
8
4
2
1
--: 112


Then we could wrap the procedure x with a new procedure s, and call it with l which is loops the value of t from 1 to 100000, and cleaning up the stack after each time we finish up with a number.
Register L for the length of the longest sequence and T for the corresponding number.
Also, procedure q is slightly modified for storing L and T if needed, and all printouts in procedure e and o are muted.
0dsLsT1st
[dsLltsT]sM
[[zdlL [d 2/]se
[d 3*1+ ]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx]ss
[lt1+dstlsxc lt100000>l]dslx
lTn[:]nlLp

Output (Takes quite some time on a decent machine)
77031:351


=={{header|Delphi}}==
program ShowHailstoneSequence;

{$APPTYPE CONSOLE}

uses SysUtils, Generics.Collections;

procedure GetHailstoneSequence(aStartingNumber: Integer; aHailstoneList: TList);
var
n: Integer;
begin
aHailstoneList.Clear;
aHailstoneList.Add(aStartingNumber);
n := aStartingNumber;

while n <> 1 do
begin
if Odd(n) then
n := (3 * n) + 1
else
n := n div 2;
aHailstoneList.Add(n);
end;
end;

var
i: Integer;
lList: TList;
lMaxSequence: Integer;
lMaxLength: Integer;
begin
lList := TList.Create;
try
GetHailstoneSequence(27, lList);
Writeln(Format('27: %d elements', [lList.Count]));
Writeln(Format('[%d,%d,%d,%d ... %d,%d,%d,%d]',
[lList[0], lList[1], lList[2], lList[3],
lList[lList.Count - 4], lList[lList.Count - 3], lList[lList.Count - 2], lList[lList.Count - 1]]));
Writeln;

lMaxSequence := 0;
lMaxLength := 0;
for i := 1 to 100000 do
begin
GetHailstoneSequence(i, lList);
if lList.Count > lMaxLength then
begin
lMaxSequence := i;
lMaxLength := lList.Count;
end;
end;
Writeln(Format('Longest sequence under 100,000: %d with %d elements', [lMaxSequence, lMaxLength]));
finally
lList.Free;
end;

Readln;
end.

Output:
27: 112 elements
[27 82 41 124 ... 8 4 2 1]

Longest sequence under 100,000: 77031 with 351 elements


=={{header|Elixir}}==
defmodule Hailstone do
def step(1), do: 0
def step(n) when Integer.even?(n), do: div(n,2)
def step(n) when Integer.odd?(n), do: n*3 + 1
def sequence(n) do
Enum.to_list(Stream.take_while(Stream.iterate(n, &step/1), &(&1 > 0)))
end

def run do
seq27 = Hailstone.sequence(27)
len27 = length(seq27)
repr = String.replace(inspect(seq27, limit: 4), "]",
String.replace(inspect(Enum.drop(seq27,len27-4)), "[", ", "))
IO.puts("Hailstone(27) has #{len27} elements: #{repr}")

{start, len} = Enum.max_by( Enum.map(1..100_000, fn(n) -> {n, length(Hailstone.sequence(n))} end),
fn({_,len}) -> len end )
IO.puts("Longest sequence starting under 100000 begins with #{start} and has #{len} elements.")
end
end

Hailstone.run


{{out}}
Hailstone(27) has 112 elements: [27, 82, 41, 124, ..., 8, 4, 2, 1]
Longest sequence starting under 100000 begins with 77031 and has 351 elements.


=={{header|Erlang}}==
-module(hailstone).
-import(io).
-export([main/0]).

hailstone(1) -> [1];
hailstone(N) when N band 1 == 1 -> [N|hailstone(N * 3 + 1)];
hailstone(N) when N band 1 == 0 -> [N|hailstone(N div 2)].

max_length(Start, Stop) ->
F = fun (N) -> {length(hailstone(N)), N} end,
Lengths = lists:map(F, lists:seq(Start, Stop)),
lists:max(Lengths).

main() ->
io:format("hailstone(4): ~w~n", [hailstone(4)]),
Seq27 = hailstone(27),
io:format("hailstone(27) length: ~B~n", [length(Seq27)]),
io:format("hailstone(27) first 4: ~w~n",
[lists:sublist(Seq27, 4)]),
io:format("hailstone(27) last 4: ~w~n",
[lists:nthtail(length(Seq27) - 4, Seq27)]),
io:format("finding maximum hailstone(N) length for 1 <= N <= 100000..."),
{Length, N} = max_length(1, 100000),
io:format(" done.~nhailstone(~B) length: ~B~n", [N, Length]).

Output:
Eshell V5.8.4  (abort with ^G)
1> c(hailstone).
{ok,hailstone}
2> hailstone:main().
hailstone(4): [4,2,1]
hailstone(27) length: 112
hailstone(27) first 4: [27,82,41,124]
hailstone(27) last 4: [8,4,2,1]
finding maximum hailstone(N) length for 1 <= N <= 100000... done.
hailstone(77031) length: 351
ok


=={{header|Euler Math Toolbox}}==


>function hailstone (n) ...
$ v=[n];
$ repeat
$ if mod(n,2) then n=3*n+1;
$ else n=n/2;
$ endif;
$ v=v|n;
$ until n==1;
$ end;
$ return v;
$ endfunction
>hailstone(27), length(%)
[ 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206 103 310 155 466 233 700
350 175 526 263 790 395 1186 593 1780 890 445 1336 668
334 167 502 251 754 377 1132 566 283 850 425 1276 638 319
958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644
1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154
577 1732 866 433 1300 650 325 976 488 244 122 61 184 92
46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1 ]
112
>function hailstonelength (n) ...
$ v=zeros(1,n);
$ v[1]=4; v[2]=2;
$ loop 3 to n;
$ count=1;
$ n=#;
$ repeat
$ if mod(n,2) then n=3*n+1;
$ else n=n/2;
$ endif;
$ if n<=cols(v) and v[n] then
$ v[#]=v[n]+count;
$ break;
$ endif;
$ count=count+1;
$ end;
$ end;
$ return v;
$ endfunction
>h=hailstonelength(100000);
>ex=extrema(h); ex[3], ex[4]
351
77031


=={{header|Euphoria}}==
function hailstone(atom n)
sequence s
s = {n}
while n != 1 do
if remainder(n,2)=0 then
n /= 2
else
n = 3*n + 1
end if
s &= n
end while
return s
end function

function hailstone_count(atom n)
integer count
count = 1
while n != 1 do
if remainder(n,2)=0 then
n /= 2
else
n = 3*n + 1
end if
count += 1
end while
return count
end function

sequence s
s = hailstone(27)
puts(1,"hailstone(27) =\n")
? s
printf(1,"len = %d\n\n",length(s))

integer max,imax,count
max = 0
for i = 2 to 1e5-1 do
count = hailstone_count(i)
if count > max then
max = count
imax = i
end if
end for

printf(1,"The longest hailstone sequence under 100,000 is %d with %d elements.\n",
{imax,max})

Output:
hailstone(27) =
{27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,
91,274,137,412,206,103,310,155,466,233,700,350,175,526,263,790,395,
1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132,566,283,
850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,
7288,3644,1822,911,2734,1367,4102,2051,6154,3077,9232,4616,2308,1154,
577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,
106,53,160,80,40,20,10,5,16,8,4,2,1}
len = 112

The longest hailstone sequence under 100,000 is 77031 with 351 elements.


=={{header|Excel}}==
{{needs-review|Excel|Calculates the Hailstone sequence but might not complete everything from task description.}}

In cell '''A1''', place the starting number.
In cell '''A2''' enter this formula '''=IF(MOD(A1,2)=0,A1/2,A1*3+1)'''
Drag and copy the formula down until 4, 2, 1
=={{header|Ezhil}}==
Ezhil is a Tamil programming language, see [http://en.wikipedia.org/wiki/Ezhil_%28programming_language%29 | Wikipedia] entry.


நிரல்பாகம் hailstone ( எண் )
பதிப்பி "=> ",எண் #hailstone seq
@( எண் == 1 ) ஆனால்
பின்கொடு எண்
முடி

@( (எண்%2) == 1 ) ஆனால்
hailstone( 3*எண் + 1)
இல்லை
hailstone( எண்/2 )
முடி
முடி


எண்கள் = [5,17,19,23,37]
@(எண்கள் இல் இவ்வெண்) ஒவ்வொன்றாக
பதிப்பி "****** calculating hailstone seq for ",இவ்வெண்," *********"
hailstone( இவ்வெண் )
பதிப்பி "**********************************************"
முடி


=={{header|Factor}}==
! rosetta/hailstone/hailstone.factor
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
IN: rosetta.hailstone

: hailstone ( n -- seq )
[ 1vector ] keep
[ dup 1 number= ]
[
dup even? [ 2 / ] [ 3 * 1 + ] if
2dup swap push
] until
drop ;

: main ( -- )
27 hailstone dup dup
"The hailstone sequence from 27:" print
" has length " write length .
" starts with " write 4 head [ unparse ] map ", " join print
" ends with " write 4 tail* [ unparse ] map ", " join print

! Maps n => { length n }, and reduces to longest Hailstone sequence.
1 100000 [a,b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
"The hailstone sequence from " write pprint
" has length " write pprint "." print ;
PRIVATE>

MAIN: main

Output:
$ ./factor -run=rosetta.hailstone
Loading resource:work/rosetta/hailstone/hailstone.factor
The hailstone sequence from 27:
has length 112
starts with 27, 82, 41, 124
ends with 8, 4, 2, 1
The hailstone sequence from 77031 has length 351.


=={{header|FALSE}}==
[$1&$[%3*1+0~]?~[2/]?]n:
[[$." "$1>][n;!]#%]s:
[1\[$1>][\1+\n;!]#%]c:
27s;! 27c;!."
"
0m:0f:
1[$100000\>][$c;!$m;>[m:$f:0]?%1+]#%
f;." has hailstone sequence length "m;.


=={{header|Forth}}==
: hail-next ( n -- n )
dup 1 and if 3 * 1+ else 2/ then ;
: .hail ( n -- )
begin dup . dup 1 > while hail-next repeat drop ;
: hail-len ( n -- n )
1 begin over 1 > while swap hail-next swap 1+ repeat nip ;

27 hail-len . cr
27 .hail cr

: longest-hail ( max -- )
0 0 rot 1+ 1 do ( n length )
i hail-len 2dup < if
nip nip i swap
else drop then
loop
swap . ." has hailstone sequence length " . ;

100000 longest-hail


=={{header|Fortran}}==
{{works with|Fortran|95 and later}}
program Hailstone
implicit none

integer :: i, maxn
integer :: maxseqlen = 0, seqlen
integer, allocatable :: seq(:)

call hs(27, seqlen)
allocate(seq(seqlen))
call hs(27, seqlen, seq)
write(*,"(a,i0,a)") "Hailstone sequence for 27 has ", seqlen, " elements"
write(*,"(a,4(i0,a),3(i0,a),i0)") "Sequence = ", seq(1), ", ", seq(2), ", ", seq(3), ", ", seq(4), " ...., ", &
seq(seqlen-3), ", ", seq(seqlen-2), ", ", seq(seqlen-1), ", ", seq(seqlen)

do i = 1, 99999
call hs(i, seqlen)
if (seqlen > maxseqlen) then
maxseqlen = seqlen
maxn = i
end if
end do
write(*,*)
write(*,"(a,i0,a,i0,a)") "Longest sequence under 100000 is for ", maxn, " with ", maxseqlen, " elements"

deallocate(seq)

contains

subroutine hs(number, length, seqArray)
integer, intent(in) :: number
integer, intent(out) :: length
integer, optional, intent(inout) :: seqArray(:)
integer :: n

n = number
length = 1
if(present(seqArray)) seqArray(1) = n
do while(n /= 1)
if(mod(n,2) == 0) then
n = n / 2
else
n = n * 3 + 1
end if
length = length + 1
if(present(seqArray)) seqArray(length) = n
end do
end subroutine

end program

Output:

Hailstone sequence for 27 has 112 elements
Sequence = 27, 82, 41, 124, ...., 8, 4, 2, 1

Longest sequence under 100000 is for 77031 with 351 elements


=={{header|Frege}}==

{{trans|Haskell}}
{{Works with|Frege|3.20.113}}

module Hailstone where

import Data.List (maximumBy)

hailstone :: Int -> [Int]
hailstone 1 = [1]
hailstone n | even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (n * 3 + 1)

withResult :: (t -> t1) -> t -> (t1, t)
withResult f x = (f x, x)

main _ = do
let h27 = hailstone 27
printStrLn $ show $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
printStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
printStrLn $ show $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) (1..100000)


{{out}}


112
hailstone 27: [27, 82, 41, 124] ... [8, 4, 2, 1]
(351, 77031)
runtime 4.374 wallclock seconds.


=={{header|F_Sharp|F#}}==
let rec hailstone n = seq {
match n with
| 1 -> yield 1
| n when n % 2 = 0 -> yield n; yield! hailstone (n / 2)
| n -> yield n; yield! hailstone (n * 3 + 1)
}

let hailstone27 = hailstone 27 |> Array.ofSeq
assert (Array.length hailstone27 = 112)
assert (hailstone27.[..3] = [|27;82;41;124|])
assert (hailstone27.[108..] = [|8;4;2;1|])

let maxLen, maxI = Seq.max <| seq { for i in 1..99999 -> Seq.length (hailstone i), i}
printfn "Maximum length %d was found for hailstone(%d)" maxLen maxI

Output:
Maximum length 351 was found for hailstone(77031)


=={{header|GAP}}==
CollatzSequence := function(n)
local v;
v := [ n ];
while n > 1 do
if IsEvenInt(n) then
n := QuoInt(n, 2);
else
n := 3*n + 1;
fi;
Add(v, n);
od;
return v;
end;

CollatzLength := function(n)
local m;
m := 1;
while n > 1 do
if IsEvenInt(n) then
n := QuoInt(n, 2);
else
n := 3*n + 1;
fi;
m := m + 1;
od;
return m;
end;

CollatzMax := function(a, b)
local n, len, nmax, lmax;
lmax := 0;
for n in [a .. b] do
len := CollatzLength(n);
if len > lmax then
nmax := n;
lmax := len;
fi;
od;
return [ nmax, lmax ];
end;

CollatzSequence(27);
# [ 27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206,
# 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502,
# 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429,
# 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300,
# 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1 ]
CollatzLength(27);
# 112

CollatzMax(1, 100);
# [ 97, 119 ]
CollatzMax(1, 1000);
# [ 871, 179 ]
CollatzMax(1, 10000);
# [ 6171, 262 ]
CollatzMax(1, 100000);
# [ 77031, 351 ]
CollatzMax(1, 1000000);
# [ 837799, 525 ]


=={{header|Go}}==
package main

import "fmt"

// 1st arg is the number to generate the sequence for.
// 2nd arg is a slice to recycle, to reduce garbage.
func hs(n int, recycle []int) []int {
s := append(recycle[:0], n)
for n > 1 {
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
s = append(s, n)
}
return s
}

func main() {
seq := hs(27, nil)
fmt.Printf("hs(27): %d elements: [%d %d %d %d ... %d %d %d %d]\n",
len(seq), seq[0], seq[1], seq[2], seq[3],
seq[len(seq)-4], seq[len(seq)-3], seq[len(seq)-2], seq[len(seq)-1])

var maxN, maxLen int
for n := 1; n < 100000; n++ {
seq = hs(n, seq)
if len(seq) > maxLen {
maxN = n
maxLen = len(seq)
}
}
fmt.Printf("hs(%d): %d elements\n", maxN, maxLen)
}

Output:

hs(27): 112 elements: [27 82 41 124 ... 8 4 2 1]
hs(77031): 351 elements

Alternate solution (inspired both by recent news of a new proof submitted for publication and by recent chat on #rosettacode about generators.)

This solution interprets the wording of the task differently, and takes the word "generate" to mean use a [[generator]]. This has the advantage of not storing the whole sequence in memory at once. Elements are generated one at a time, counted and discarded. A time optimization added for task 3 is to store the sequence lengths computed so far.

Output is the same as version above.
package main

import "fmt"

// Task 1 implemented with a generator. Calling newHg will "create
// a routine to generate the hailstone sequence for a number."
func newHg(n int) func() int {
return func() (n0 int) {
n0 = n
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
return
}
}

func main() {
// make generator for sequence starting at 27
hg := newHg(27)
// save first four elements for printing later
s1, s2, s3, s4 := hg(), hg(), hg(), hg()
// load next four elements in variables to use as shift register.
e4, e3, e2, e1 := hg(), hg(), hg(), hg()
// 4+4= 8 that we've generated so far
ec := 8
// until we get to 1, generate another value, shift, and increment.
// note that intermediate elements--those shifted off--are not saved.
for e1 > 1 {
e4, e3, e2, e1 = e3, e2, e1, hg()
ec++
}
// Complete task 2:
fmt.Printf("hs(27): %d elements: [%d %d %d %d ... %d %d %d %d]\n",
ec, s1, s2, s3, s4, e4, e3, e2, e1)

// Task 3: strategy is to not store sequences, but just the length
// of each sequence. as soon as the sequence we're currently working on
// dips into the range that we've already computed, we short-circuit
// to the end by adding the that known length to whatever length
// we've accumulated so far.

var nMaxLen int // variable holds n with max length encounted so far
// slice holds sequence length for each n as it is computed
var computedLen [1e5]int
computedLen[1] = 1
for n := 2; n < 1e5; n++ {
var ele, lSum int
for hg := newHg(n); ; lSum++ {
ele = hg()
// as soon as we get an element in the range we have already
// computed, we're done...
if ele < n {
break
}
}
// just add the sequence length already computed from this point.
lSum += computedLen[ele]
// save the sequence length for this n
computedLen[n] = lSum
// and note if it's the maximum so far
if lSum > computedLen[nMaxLen] {
nMaxLen = n
}
}
fmt.Printf("hs(%d): %d elements\n", nMaxLen, computedLen[nMaxLen])
}


=={{header|Groovy}}==
def hailstone = { long start ->
def sequence = []
while (start != 1) {
sequence << start
start = (start % 2l == 0l) ? start / 2l : 3l * start + 1l
}
sequence << start
}

Test Code
def sequence = hailstone(27)
assert sequence.size() == 112
assert sequence[0..3] == [27, 82, 41, 124]
assert sequence[-4..-1] == [8, 4, 2, 1]

def results = (1..100000).collect { [n:it, size:hailstone(it).size()] }.max { it.size }
println results

Output:
[n:77031, size:351]


=={{header|Haskell}}==
import Data.List (maximumBy)
import Data.Ord (comparing)

hailstone :: Int -> [Int]
hailstone 1 = [1]
hailstone n | even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (n * 3 + 1)

withResult :: (t -> t1) -> t -> (t1, t)
withResult f x = (f x, x)

main :: IO ()
main = do
let h27 = hailstone 27
print $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
putStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
print $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) [1..100000]

Output:
112
hailstone 27: [27,82,41,124] ... [8,4,2,1]
(351,77031)


=={{header|HicEst}}==
DIMENSION stones(1000)

H27 = hailstone(27)
ALIAS(stones,1, first4,4)
ALIAS(stones,H27-3, last4,4)
WRITE(ClipBoard, Name) H27, first4, "...", last4

longest_sequence = 0
DO try = 1, 1E5
elements = hailstone(try)
IF(elements >= longest_sequence) THEN
number = try
longest_sequence = elements
WRITE(StatusBar, Name) number, longest_sequence
ENDIF
ENDDO
WRITE(ClipBoard, Name) number, longest_sequence
END

FUNCTION hailstone( n )
USE : stones

stones(1) = n
DO i = 1, LEN(stones)
IF(stones(i) == 1) THEN
hailstone = i
RETURN
ELSEIF( MOD(stones(i),2) ) THEN
stones(i+1) = 3*stones(i) + 1
ELSE
stones(i+1) = stones(i) / 2
ENDIF
ENDDO
END

H27=112; first4(1)=27; first4(2)=82; first4(3)=41; first4(4)=124; ...; last4(1)=8; last4(2)=4; last4(3)=2; last4(4)=1;

number=77031; longest_sequence=351;

=={{header|Icon}} and {{header|Unicon}}==
A simple solution that generates (in the Icon sense) the sequence is:
procedure hailstone(n)
while n > 1 do {
suspend n
n := if n%2 = 0 then n/2 else 3*n+1
}
suspend 1
end

and a test program for this solution is:
procedure main(args)
n := integer(!args) | 27
every writes(" ",hailstone(n))
end

but this solution is computationally expensive when run repeatedly (task 3).

The following solution uses caching to improve performance on task 3 at the expense of space.
procedure hailstone(n)
static cache
initial {
cache := table()
cache[1] := [1]
}
/cache[n] := [n] ||| hailstone(if n%2 = 0 then n/2 else 3*n+1)
return cache[n]
end


A test program is:
procedure main(args)
n := integer(!args) | 27
task2(n)
write()
task3()
end

procedure task2(n)
count := 0
every writes(" ",right(!(sequence := hailstone(n)),5)) do
if (count +:= 1) % 15 = 0 then write()
write()
write(*sequence," value",(*sequence=1,"")|"s"," in the sequence.")
end

procedure task3()
maxHS := 0
every n := 1 to 100000 do {
count := *hailstone(n)
if maxHS <:= count then maxN := n
}
write(maxN," has a sequence of ",maxHS," values")
end

A sample run is:

->hs
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484
242 121 364 182 91 274 137 412 206 103 310 155 466 233 700
350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167
502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051
6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488
244 122 61 184 92 46 23 70 35 106 53 160 80 40 20
10 5 16 8 4 2 1
112 values in the sequence.

77031 has a sequence of 351 values
->


=={{header|Io}}==
Here is a simple, brute-force approach:

makeItHail := method(n,
stones := list(n)
while (n != 1,
if(n isEven,
n = n / 2,
n = 3 * n + 1
)
stones append(n)
)
)

out := makeItHail(27)
writeln("For the sequence beginning at 27, the number of elements generated is ", out size, ".")
write("The first four elements generated are ")
for(i, 0, 3,
write(out at(i), " ")
)
writeln(".")

write("The last four elements generated are ")
for(i, out size - 4, out size - 1,
write(out at(i), " ")
)
writeln(".")

numOfElems := 0
nn := 3
for(x, 3, 100000,
out = makeItHail(x)
if(out size > numOfElems,
numOfElems = out size
nn = x
)
)

writeln("For numbers less than or equal to 100,000, ", nn,
" has the longest sequence of ", numOfElems, " elements.")


Output:

For the sequence beginning at 27, the number of elements generated is 112.
The first four elements generated are 27 82 41 124 .
The last four elements generated are 8 4 2 1 .
For numbers less than or equal to 100,000, 77031 has the longest sequence of 351 elements.


=={{header|Ioke}}==
{{needs-review|Ioke|Calculates the Hailstone sequence but might not complete everything from task description.}}
collatz = method(n,
n println
unless(n <= 1,
if(n even?, collatz(n / 2), collatz(n * 3 + 1)))
)


=={{header|Inform 7}}==
This solution uses a cache to speed up the length calculation for larger numbers.
{{works with|Glulx virtual machine}}
Home is a room.

To decide which list of numbers is the hailstone sequence for (N - number):
let result be a list of numbers;
add N to result;
while N is not 1:
if N is even, let N be N / 2;
otherwise let N be (3 * N) + 1;
add N to result;
decide on result.

Hailstone length cache relates various numbers to one number.

To decide which number is the hailstone sequence length for (N - number):
let ON be N;
let length so far be 0;
while N is not 1:
if N relates to a number by the hailstone length cache relation:
let result be length so far plus the number to which N relates by the hailstone length cache relation;
now the hailstone length cache relation relates ON to result;
decide on result;
if N is even, let N be N / 2;
otherwise let N be (3 * N) + 1;
increment length so far;
let result be length so far plus 1;
now the hailstone length cache relation relates ON to result;
decide on result.

To say first and last (N - number) entry/entries in (L - list of values of kind K):
let length be the number of entries in L;
if length <= N * 2:
say L;
else:
repeat with M running from 1 to N:
if M > 1, say ", ";
say entry M in L;
say " ... ";
repeat with M running from length - N + 1 to length:
say entry M in L;
if M < length, say ", ".

When play begins:
let H27 be the hailstone sequence for 27;
say "Hailstone sequence for 27 has [number of entries in H27] element[s]: [first and last 4 entries in H27].";
let best length be 0;
let best number be 0;
repeat with N running from 1 to 99999:
let L be the hailstone sequence length for N;
if L > best length:
let best length be L;
let best number be N;
say "The number under 100,000 with the longest hailstone sequence is [best number] with [best length] element[s].";
end the story.


Output:
Hailstone sequence for 27 has 112 elements: 27, 82, 41, 124 ... 8, 4, 2, 1.
The number under 100,000 with the longest hailstone sequence is 77031 with 351 elements.


=={{header|J}}==
'''Solution:'''
hailseq=: -:`(1 3&p.)@.(2&|) ^:(1 ~: ]) ^:a:"0
'''Usage:'''
# hailseq 27 NB. sequence length
112
4 _4 {."0 1 hailseq 27 NB. first & last 4 numbers in sequence
27 82 41 124
8 4 2 1
(>:@(i. >./) , >./) #@hailseq }.i. 1e5 NB. number < 100000 with max seq length & its seq length
77031 351

See also the [[j:Essays/Collatz Conjecture|Collatz Conjecture essay on the J wiki]].

=={{header|Java}}==
{{works with|Java|1.5+}}
import java.util.ArrayList;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

class Hailstone {

public static List getHailstoneSequence(long n) {
if (n <= 0)
throw new IllegalArgumentException("Invalid starting sequence number");
List list = new ArrayList();
list.add(Long.valueOf(n));
while (n != 1) {
if ((n & 1) == 0)
n = n / 2;
else
n = 3 * n + 1;
list.add(Long.valueOf(n));
}
return list;
}

public static void main(String[] args) {
List sequence27 = getHailstoneSequence(27);
System.out.println("Sequence for 27 has " + sequence27.size() + " elements: " + sequence27);

long MAX = 100000;
// Simple way
{
long highestNumber = 1;
int highestCount = 1;
for (long i = 2; i < MAX; i++) {
int count = getHailstoneSequence(i).size();
if (count > highestCount) {
highestCount = count;
highestNumber = i;
}
}
System.out.println("Method 1, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}

// More memory efficient way
{
long highestNumber = 1;
int highestCount = 1;
for (long i = 2; i < MAX; i++) {
int count = 1;
long n = i;
while (n != 1) {
if ((n & 1) == 0)
n = n / 2;
else
n = 3 * n + 1;
count++;
}
if (count > highestCount) {
highestCount = count;
highestNumber = i;
}
}
System.out.println("Method 2, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}

// Efficient for analyzing all sequences
{
long highestNumber = 1;
long highestCount = 1;
Map sequenceMap = new HashMap();
sequenceMap.put(Long.valueOf(1), Integer.valueOf(1));

List currentList = new ArrayList();
for (long i = 2; i < MAX; i++) {
currentList.clear();
Long n = Long.valueOf(i);
Integer count = null;
while ((count = sequenceMap.get(n)) == null) {
currentList.add(n);
long nValue = n.longValue();
if ((nValue & 1) == 0)
n = Long.valueOf(nValue / 2);
else
n = Long.valueOf(3 * nValue + 1);
}
int curCount = count.intValue();
for (int j = currentList.size() - 1; j >= 0; j--)
sequenceMap.put(currentList.get(j), Integer.valueOf(++curCount));
if (curCount > highestCount) {
highestCount = curCount;
highestNumber = i;
}
}
System.out.println("Method 3, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}
return;
}
}

Output:
Sequence for 27 has 112 elements: [27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1]
Method 1, number 77031 has the longest sequence, with a length of 351
Method 2, number 77031 has the longest sequence, with a length of 351
Method 3, number 77031 has the longest sequence, with a length of 351


=={{header|JavaScript}}==
function hailstone (n) {
var seq = [n];
while (n > 1) {
n = n % 2 ? 3 * n + 1 : n / 2;
seq.push(n);
}
return seq;
}

// task 2: verify the sequence for n = 27
var h = hailstone(27), hLen = h.length;
print("sequence 27 is (" + h.slice(0, 4).join(", ") + " ... "
+ h.slice(hLen - 4, hLen).join(", ") + "). length: " + hLen);

// task 3: find the longest sequence for n < 100000
for (var n, max = 0, i = 100000; --i;) {
var seq = hailstone(i), sLen = seq.length;
if (sLen > max) {
n = i;
max = sLen;
}
}
print("longest sequence: " + max + " numbers for starting point " + n);

outputs
sequence 27 is (27, 82, 41, 124 ... 8, 4, 2, 1). length: 112
longest sequence: 351 numbers for starting point 77031


=={{header|Julia}}==
function hailstone(n)
seq = [n]
while n>1
n = n % 2 == 0 ? n >> 1 : 3n + 1
push!(seq,n)
end
return seq
end

julia> h = hailstone(27);

julia> @assert length(h) == 112

julia> @assert h[1:4] == [27,82,41,124]

julia> @assert h[end-3:end] == [8,4,2,1]

julia> maximum([(length(hailstone(i)),i) for i in 1:100000])
(351,77031)


=={{header|K}}==
hail: (1<){:[x!2;1+3*x;_ x%2]}\
seqn: hail 27

#seqn
112
4#seqn
27 82 41 124
-4#seqn
8 4 2 1

{m,x@s?m:|/s:{#hail x}'x}{x@&x!2}!:1e5
351 77031


=={{header|Limbo}}==

implement Hailstone;

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

Hailstone: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;

seq := hailstone(big 27);
l := len seq;

sys->print("hailstone(27): ");
for(i := 0; i < 4; i++) {
sys->print("%bd, ", hd seq);
seq = tl seq;
}
sys->print("⋯");

while(len seq > 4)
seq = tl seq;

while(seq != nil) {
sys->print(", %bd", hd seq);
seq = tl seq;
}
sys->print(" (length %d)\n", l);

max := 1;
maxn := big 1;
for(n := big 2; n < big 100000; n++) {
cur := len hailstone(n);
if(cur > max) {
max = cur;
maxn = n;
}
}
sys->print("hailstone(%bd) has length %d\n", maxn, max);
}

hailstone(i: big): list of big
{
if(i == big 1)
return big 1 :: nil;
if(i % big 2 == big 0)
return i :: hailstone(i / big 2);
return i :: hailstone((big 3 * i) + big 1);
}


{{out}}
hailstone(27):  27, 82, 41, 124, ⋯, 8, 4, 2, 1 (length 112)
hailstone(77031) has length 351


=={{header|Lasso}}==
[
define_tag("hailstone", -required="n", -type="integer", -copy);
local("sequence") = array(#n);
while(#n != 1);
((#n % 2) == 0) ? #n = (#n / 2) | #n = (#n * 3 + 1);
#sequence->insert(#n);
/while;
return(#sequence);
/define_tag;

local("result");
#result = hailstone(27);
while(#result->size > 8);
#result->remove(5);
/while;
#result->insert("...",5);

"Hailstone sequence for n = 27 -> { " + #result->join(", ") + " }";

local("longest_sequence") = 0;
local("longest_index") = 0;
loop(-from=1, -to=100000);
local("length") = hailstone(loop_count)->size;
if(#length > #longest_sequence);
#longest_index = loop_count;
#longest_sequence = #length;
/if;
/loop;

"
";
"Number with the longest sequence under 100,000: " #longest_index + ", with " + #longest_sequence + " elements.";
]


=={{header|Logo}}==
to hail.next :n
output ifelse equal? 0 modulo :n 2 [:n/2] [3*:n + 1]
end

to hail.seq :n
if :n = 1 [output [1]]
output fput :n hail.seq hail.next :n
end

show hail.seq 27
show count hail.seq 27

to max.hail :n
localmake "max.n 0
localmake "max.length 0
repeat :n [if greater? count hail.seq repcount :max.length [
make "max.n repcount
make "max.length count hail.seq repcount
] ]
(print :max.n [has hailstone sequence length] :max.length)
end

max.hail 100000


=={{header|Logtalk}}==
:- object(hailstone).

:- public(generate_sequence/2).
:- mode(generate_sequence(+natural, -list(natural)), zero_or_one).
:- info(generate_sequence/2, [
comment is 'Generates the Hailstone sequence that starts with its first argument. Fails if the argument is not a natural number.',
argnames is ['Start', 'Sequence']
]).

:- public(write_sequence/1).
:- mode(write_sequence(+natural), zero_or_one).
:- info(write_sequence/1, [
comment is 'Writes to the standard output the Hailstone sequence that starts with its argument. Fails if the argument is not a natural number.',
argnames is ['Start']
]).

:- public(sequence_length/2).
:- mode(sequence_length(+natural, -natural), zero_or_one).
:- info(sequence_length/2, [
comment is 'Calculates the length of the Hailstone sequence that starts with its first argument. Fails if the argument is not a natural number.',
argnames is ['Start', 'Length']
]).

:- public(longest_sequence/4).
:- mode(longest_sequence(+natural, +natural, -natural, -natural), zero_or_one).
:- info(longest_sequence/4, [
comment is 'Calculates the longest Hailstone sequence in the interval [Start, End]. Fails if the interval is not valid.',
argnames is ['Start', 'End', 'N', 'Length']
]).

generate_sequence(Start, Sequence) :-
integer(Start),
Start >= 1,
sequence(Start, Sequence).

sequence(1, [1]) :-
!.
sequence(N, [N| Sequence]) :-
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence(M, Sequence).

write_sequence(Start) :-
integer(Start),
Start >= 1,
sequence(Start).

sequence(1) :-
!,
write(1), nl.
sequence(N) :-
write(N), write(' '),
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence(M).

sequence_length(Start, Length) :-
integer(Start),
Start >= 1,
sequence_length(Start, 1, Length).

sequence_length(1, Length, Length) :-
!.
sequence_length(N, Length0, Length) :-
Length1 is Length0 + 1,
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence_length(M, Length1, Length).

longest_sequence(Start, End, N, Length) :-
integer(Start),
integer(End),
Start >= 1,
Start =< End,
longest_sequence(Start, End, 1, N, 1, Length).

longest_sequence(Current, End, N, N, Length, Length) :-
Current > End,
!.
longest_sequence(Current, End, N0, N, Length0, Length) :-
sequence_length(Current, 1, CurrentLength),
Next is Current + 1,
( CurrentLength > Length0 ->
longest_sequence(Next, End, Current, N, CurrentLength, Length)
; longest_sequence(Next, End, N0, N, Length0, Length)
).

:- end_object.

Testing:
| ?- hailstone::write_sequence(27).
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
true

| ?- hailstone::sequence_length(27, Length).
Length = 112
true

| ?- hailstone::longest_sequence(1, 100000, N, Length).
N = 77031, Length = 351
true


=={{header|LOLCODE}}==
There is presently no way to query a BUKKIT for the existence of a given key, thus making memoization infeasible. This solution takes advantage of prior knowledge to run in reasonable time.
HAI 1.3

HOW IZ I hailin YR stone
I HAS A sequence ITZ A BUKKIT
sequence HAS A length ITZ 1
sequence HAS A SRS 0 ITZ stone

IM IN YR stoner
BOTH SAEM stone AN 1, O RLY?
YA RLY, FOUND YR sequence
OIC

MOD OF stone AN 2, O RLY?
YA RLY, stone R SUM OF PRODUKT OF stone AN 3 AN 1
NO WAI, stone R QUOSHUNT OF stone AN 2
OIC

sequence HAS A SRS sequence'Z length ITZ stone
sequence'Z length R SUM OF sequence'Z length AN 1
IM OUTTA YR stoner
IF U SAY SO

I HAS A hail27 ITZ I IZ hailin YR 27 MKAY
VISIBLE "hail(27) = "!

IM IN YR first4 UPPIN YR i TIL BOTH SAEM i AN 4
VISIBLE hail27'Z SRS i " "!
IM OUTTA YR first4
VISIBLE "..."!

IM IN YR last4 UPPIN YR i TIL BOTH SAEM i AN 4
VISIBLE " " hail27'Z SRS SUM OF 108 AN i!
IM OUTTA YR last4
VISIBLE ", length = " hail27'Z length

I HAS A max, I HAS A len ITZ 0

BTW, DIS IZ RLY NOT FAST SO WE ONLY CHEK N IN [75000, 80000)
IM IN YR maxer UPPIN YR n TIL BOTH SAEM n AN 5000
I HAS A n ITZ SUM OF n AN 75000
I HAS A seq ITZ I IZ hailin YR n MKAY
BOTH SAEM len AN SMALLR OF len AN seq'Z length, O RLY?
YA RLY, max R n, len R seq'Z length
OIC
IM OUTTA YR maxer

VISIBLE "len(hail(" max ")) = " len

KTHXBYE

{{out}}
hail(27) = 27 82 41 124 ... 8 4 2 1, length = 112
len(hail(77031)) = 351


=={{header|Lua}}==
function hailstone( n, print_numbers )
local n_iter = 1

while n ~= 1 do
if print_numbers then print( n ) end
if n % 2 == 0 then
n = n / 2
else
n = 3 * n + 1
end

n_iter = n_iter + 1
end
if print_numbers then print( n ) end

return n_iter;
end

hailstone( 27, true )

max_i, max_iter = 0, 0
for i = 1, 100000 do
num = hailstone( i, false )
if num >= max_iter then
max_i = i
max_iter = num
end
end

print( string.format( "Needed %d iterations for the number %d.\n", max_iter, max_i ) )


=={{header|Maple}}==
Define the procedure:

hailstone := proc( N )
local n := N, HS := Array([n]);
while n > 1 do
if type(n,even) then
n := n/2;
else
n := 3*n+1;
end if;
HS(numelems(HS)+1) := n;
end do;
HS;
end proc;

Run the command and show the appropriate portion of the result;

> r := hailstone(27):
[ 1..112 1-D Array ]
r := [ Data Type: anything ]
[ Storage: rectangular ]
[ Order: Fortran_order ]
> r(1..4) ... r(-4..);
[27, 82, 41, 124] .. [8, 4, 2, 1]

Compute the first 100000 sequences:

longest := 0; n := 0;
for i from 1 to 100000 do
len := numelems(hailstone(i));
if len > longest then
longest := len;
n := i;
end if;
od:
printf("The longest Hailstone sequence in the first 100k is n=%d, with %d terms\n",n,longest);

Output:

The longest Hailstone sequence in the first 100k is n=77031, with 351 terms


=={{header|Mathematica}}==
Here are three ways to generate the sequence.
=== Fixed-Point formulation ===
HailstoneFP[n_] := Drop[FixedPointList[If[# != 1, Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ], 1] &, n], -1]
=== Recursive formulation using piece-wise function definitions ===
HailstoneR[1] := {1}
HailstoneR[n_Integer] := Prepend[HailstoneR[3 n + 1], n] /; OddQ[n] && n > 0
HailstoneR[n_Integer] := Prepend[HailstoneR[n/2], n] /; EvenQ[n] && n > 0

=== Nested function-call formulation ===
I use this version to do the validation:
Hailstone[n_] :=
NestWhileList[Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ] &, n, # != 1 &];
c27 = Hailstone@27;
Print["Hailstone sequence for n = 27: [", c27[[;; 4]], "...", c27[[-4 ;;]], "]"]
Print["Length Hailstone[27] = ", Length@c27]

longest = -1; comp = 0;
Do[temp = Length@Hailstone@i;
If[comp < temp, comp = temp; longest = i],
{i, 100000}
]
Print["Longest Hailstone sequence at n = ", longest, "\nwith length = ", comp];

Output:

Hailstone sequence for n = 27: [{27,82,41,124}...{8,4,2,1}]
Length Hailstone[27] = 112
Longest Hailstone sequence at n = 77031
with length = 351

I think the fixed-point and the recursive piece-wise function formulations are more idiomatic for Mathematica

=={{header|MATLAB}} / {{header|Octave}}==
function x = hailstone(n)
% iterative definition
global VERBOSE;
x = 1;
while (1)
if VERBOSE,
printf('%i ',n); % print element
end;

if n==1,
return;
elseif mod(n,2),
n = 3*n+1;
else
n = n/2;
end;
x = x + 1;
end;
end;

Show sequence of hailstone(27) and number of elements
global VERBOSE;
VERBOSE = 1; % display of sequence elements turned on
N = hailstone(27); %display sequence
printf('\n\n%i\n',N); %

Output:

>> global VERBOSE; VERBOSE=1; hailstone(27)
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1

112


global VERBOSE;
VERBOSE = 0; % display of sequence elements turned off
N = 100000;
M = zeros(N,1);
for k=1:N,
M(k) = hailstone(k); %display sequence
end;
[maxLength, n] = max(M)

Output:

maxLength = 351
n = 77031


=={{header|Maxima}}==
collatz(n) := block([L], L: [n], while n > 1 do
(n: if evenp(n) then n/2 else 3*n + 1, L: endcons(n, L)), L)$

collatz_length(n) := block([m], m: 1, while n > 1 do
(n: if evenp(n) then n/2 else 3*n + 1, m: m + 1), m)$

collatz_max(n) := block([j, m, p], m: 0,
for i from 1 thru n do
(p: collatz_length(i), if p > m then (m: p, j: i)),
[j, m])$

collatz(27); /* [27, 82, 41, ..., 4, 2, 1] */
length(%); /* 112 */
collatz_length(27); /* 112 */
collatz_max(100000); /* [77031, 351] */


=={{header|Modula-2}}==
MODULE hailst;

IMPORT InOut;

CONST maxCard = MAX (CARDINAL) DIV 3;
TYPE action = (List, Count, Max);
VAR a : CARDINAL;

PROCEDURE HailStone (start : CARDINAL; type : action) : CARDINAL;

VAR n, max, count : CARDINAL;

BEGIN
count := 1;
n := start;
max := n;
LOOP
IF type = List THEN
InOut.WriteCard (n, 12);
IF count MOD 6 = 0 THEN InOut.WriteLn END
END;
IF n = 1 THEN EXIT END;
IF ODD (n) THEN
IF n < maxCard THEN
n := 3 * n + 1;
IF n > max THEN max := n END
ELSE
InOut.WriteString ("Exceeding max value for type CARDINAL at count = ");
InOut.WriteCard (count, 10);
InOut.WriteString (" for intermediate value ");
InOut.WriteCard (n, 10);
InOut.WriteString (". Aborting.");
HALT
END
ELSE
n := n DIV 2
END;
INC (count)
END;
IF type = Max THEN RETURN max ELSE RETURN count END
END HailStone;

PROCEDURE FindMax (num : CARDINAL);

VAR val, maxCount, maxVal, cnt : CARDINAL;

BEGIN
maxCount := 0;
maxVal := 0;
FOR val := 2 TO num DO
cnt := HailStone (val, Count);
IF cnt > maxCount THEN
maxVal := val;
maxCount := cnt
END
END;
InOut.WriteString ("Longest sequence below "); InOut.WriteCard (num, 1);
InOut.WriteString (" is "); InOut.WriteCard (HailStone (maxVal, Count), 1);
InOut.WriteString (" for n = "); InOut.WriteCard (maxVal, 1);
InOut.WriteString (" with an intermediate maximum of ");
InOut.WriteCard (HailStone (maxVal, Max), 1);
InOut.WriteLn
END FindMax;

BEGIN
a := HailStone (27, List);
InOut.WriteLn;
InOut.WriteString ("Iterations total = "); InOut.WriteCard (HailStone (27, Count), 12);
InOut.WriteString (" max value = "); InOut.WriteCard (HailStone (27, Max) , 12);
InOut.WriteLn;
FindMax (100000);
InOut.WriteString ("Done."); InOut.WriteLn
END hailst.

Producing:
jan@Beryllium:~/modula/rosetta$ hailst
27 82 41 124 62 31
94 47 142 71 214 107
322 161 484 242 121 364
182 91 274 137 412 206
103 310 155 466 233 700
350 175 526 263 790 395
1186 593 1780 890 445 1336
668 334 167 502 251 754
377 1132 566 283 850 425
1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858
2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232
4616 2308 1154 577 1732 866
433 1300 650 325 976 488
244 122 61 184 92 46
23 70 35 106 53 160
80 40 20 10 5 16
8 4 2 1
Iterations total = 112 max value = 9232
Longest sequence below 100000 is 351 for n = 77031 with an intermediate maximum of 21933016
Done.
When trying the same for all values below 1 million:

Exceeding max value for type CARDINAL at n = 159487 , count = 60 and intermediate value 1699000271. Aborting.


=={{header|MUMPS}}==
hailstone(n) ;
If n=1 Quit n
If n#2 Quit n_" "_$$hailstone(3*n+1)
Quit n_" "_$$hailstone(n\2)
Set x=$$hailstone(27) Write !,$Length(x," ")," terms in ",x,!
112 terms in 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1


=={{header|NetRexx}}==
/* NetRexx */

options replace format comments java crossref savelog symbols binary

do
start = 27
hs = hailstone(start)
hsCount = hs.words
say 'The number' start 'has a hailstone sequence comprising' hsCount 'elements'
say ' its first four elements are:' hs.subword(1, 4)
say ' and last four elements are:' hs.subword(hsCount - 3)

hsMax = 0
hsCountMax = 0
llimit = 100000
loop x_ = 1 to llimit - 1
hs = hailstone(x_)
hsCount = hs.words
if hsCount > hsCountMax then do
hsMax = x_
hsCountMax = hsCount
end
end x_

say 'The number' hsMax 'has the longest hailstone sequence in the range 1 to' llimit - 1 'with a sequence length of' hsCountMax
catch ex = Exception
ex.printStackTrace
end

return

method hailstone(hn = long) public static returns Rexx signals IllegalArgumentException

hs = Rexx('')
if hn <= 0 then signal IllegalArgumentException('Invalid start point. Must be a positive integer greater than 0')

loop label n_ while hn > 1
hs = hs' 'hn
if hn // 2 \= 0 then hn = hn * 3 + 1
else hn = hn % 2
end n_
hs = hs' 'hn

return hs.strip

;Output

The number 27 has a hailstone sequence comprising 112 elements
its first four elements are: 27 82 41 124
and last four elements are: 8 4 2 1
The number 77031 has the longest hailstone sequence in the range 1 to 99999 with a sequence length of 351


=={{header|Oberon-2}}==
MODULE hailst;

IMPORT Out;

CONST maxCard = MAX (INTEGER) DIV 3;
List = 1;
Count = 2;
Max = 3;

VAR a : INTEGER;

PROCEDURE HailStone (start, type : INTEGER) : INTEGER;

VAR n, max, count : INTEGER;

BEGIN
count := 1;
n := start;
max := n;
LOOP
IF type = List THEN
Out.Int (n, 12);
IF count MOD 6 = 0 THEN Out.Ln END
END;
IF n = 1 THEN EXIT END;
IF ODD (n) THEN
IF n < maxCard THEN
n := 3 * n + 1;
IF n > max THEN max := n END
ELSE
Out.String ("Exceeding max value for type INTEGER at: ");
Out.String (" n = "); Out.Int (start, 12);
Out.String (" , count = "); Out.Int (count, 12);
Out.String (" and intermediate value ");
Out.Int (n, 1);
Out.String (". Aborting.");
Out.Ln;
HALT (2)
END
ELSE
n := n DIV 2
END;
INC (count)
END;
IF type = Max THEN RETURN max ELSE RETURN count END
END HailStone;


PROCEDURE FindMax (num : INTEGER);

VAR val, maxCount, maxVal, cnt : INTEGER;

BEGIN
maxCount := 0;
maxVal := 0;
FOR val := 2 TO num DO
cnt := HailStone (val, Count);
IF cnt > maxCount THEN
maxVal := val;
maxCount := cnt
END
END;
Out.String ("Longest sequence below "); Out.Int (num, 1);
Out.String (" is "); Out.Int (HailStone (maxVal, Count), 1);
Out.String (" for n = "); Out.Int (maxVal, 1);
Out.String (" with an intermediate maximum of ");
Out.Int (HailStone (maxVal, Max), 1);
Out.Ln
END FindMax;

BEGIN
a := HailStone (27, List);
Out.Ln;
Out.String ("Iterations total = "); Out.Int (HailStone (27, Count), 12);
Out.String (" max value = "); Out.Int (HailStone (27, Max) , 12);
Out.Ln;
FindMax (1000000);
Out.String ("Done.");
Out.Ln
END hailst.

Producing

27 82 41 124 62 31
94 47 142 71 214 107
322 161 484 242 121 364
182 91 274 137 412 206
103 310 155 466 233 700
350 175 526 263 790 395
1186 593 1780 890 445 1336
668 334 167 502 251 754
377 1132 566 283 850 425
1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858
2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232
4616 2308 1154 577 1732 866
433 1300 650 325 976 488
244 122 61 184 92 46
23 70 35 106 53 160
80 40 20 10 5 16
8 4 2 1

Iterations total = 112 max value = 9232

Exceeding max value for type INTEGER at: n = 113383 , count = 120 and intermediate value 827370449. Aborting.


=={{header|OCaml}}==
#load "nums.cma";;
open Num;;

(* generate Hailstone sequence *)
let hailstone n =
let one = Int 1
and two = Int 2
and three = Int 3 in
let rec g s x =
if x =/ one
then x::s
else g (x::s) (if mod_num x two =/ one
then three */ x +/ one
else x // two)
in
g [] (Int n)
;;

(* compute only sequence length *)
let haillen n =
let one = Int 1
and two = Int 2
and three = Int 3 in
let rec g s x =
if x =/ one
then s+1
else g (s+1) (if mod_num x two =/ one
then three */ x +/ one
else x // two)
in
g 0 (Int n)
;;

(* max length for starting values in 1..n *)
let hailmax =
let rec g idx len = function
| 0 -> (idx, len)
| i ->
let a = haillen i in
if a > len
then g i a (i-1)
else g idx len (i-1)
in
g 0 0
;;

hailmax 100000 ;;
(* - : int * int = (77031, 351) *)

List.rev_map string_of_num (hailstone 27) ;;

(* - : string list =
["27"; "82"; "41"; "124"; "62"; "31"; "94"; "47"; "142"; "71"; "214"; "107";
"322"; "161"; "484"; "242"; "121"; "364"; "182"; "91"; "274"; "137"; "412";
"206"; "103"; "310"; "155"; "466"; "233"; "700"; "350"; "175"; "526"; "263";
"790"; "395"; "1186"; "593"; "1780"; "890"; "445"; "1336"; "668"; "334";
"167"; "502"; "251"; "754"; "377"; "1132"; "566"; "283"; "850"; "425";
"1276"; "638"; "319"; "958"; "479"; "1438"; "719"; "2158"; "1079"; "3238";
"1619"; "4858"; "2429"; "7288"; "3644"; "1822"; "911"; "2734"; "1367";
"4102"; "2051"; "6154"; "3077"; "9232"; "4616"; "2308"; "1154"; "577";
"1732"; "866"; "433"; "1300"; "650"; "325"; "976"; "488"; "244"; "122";
"61"; "184"; "92"; "46"; "23"; "70"; "35"; "106"; "53"; "160"; "80"; "40";
"20"; "10"; "5"; "16"; "8"; "4"; "2"; "1"] *)


=={{header|ooRexx}}==

sequence = hailstone(27)
say "Hailstone sequence for 27 has" sequence~items "elements and is ["sequence~toString('l', ", ")"]"

highestNumber = 1
highestCount = 1

loop i = 2 to 100000
sequence = hailstone(i)
count = sequence~items
if count > highestCount then do
highestNumber = i
highestCount = count
end
end
say "Number" highestNumber "has the longest sequence with" highestCount "elements"

-- short routine to generate a hailstone sequence
::routine hailstone
use arg n

sequence = .array~of(n)
loop while n \= 1
if n // 2 == 0 then n = n / 2
else n = 3 * n + 1
sequence~append(n)
end
return sequence

Output:

Hailstone sequence for 27 has 112 elements and is [27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 77, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 102, 051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 0, 40, 20, 10, 5, 16, 8, 4, 2, 1]
Number 77031 has the longest sequence with 351 elements


=={{header|Order}}==
To display the length, and first and last elements, of the hailstone sequence for 27, we could do this:
#include

#define ORDER_PP_DEF_8hailstone ORDER_PP_FN( \
8fn(8N, \
8cond((8equal(8N, 1), 8seq(1)) \
(8is_0(8remainder(8N, 2)), \
8seq_push_front(8N, 8hailstone(8quotient(8N, 2)))) \
(8else, \
8seq_push_front(8N, 8hailstone(8inc(8times(8N, 3))))))) )

ORDER_PP(
8lets((8H, 8seq_map(8to_lit, 8hailstone(27)))
(8S, 8seq_size(8H)),
8print(8(h(27) - length:) 8to_lit(8S) 8comma 8space
8(starts with:) 8seq_take(4, 8H) 8comma 8space
8(ends with:) 8seq_drop(8minus(8S, 4), 8H))
) )

{{out}}
h(27) - length:112, starts with:(27)(82)(41)(124), ends with:(8)(4)(2)(1)

Unfortunately, the C preprocessor not really being designed with large amounts of garbage collection in mind, trying to compute the hailstone sequences up to 100000 is almost guaranteed to run out of memory (and take a very, very long time). If we wanted to try, we could add this to the program, which in most languages would use relatively little memory:
#define ORDER_PP_DEF_8h_longest ORDER_PP_FN( \
8fn(8M, 8P, \
8if(8is_0(8M), \
8P, \
8let((8L, 8seq_size(8hailstone(8M))), \
8h_longest(8dec(8M), \
8if(8greater(8L, 8tuple_at_1(8P)), \
8pair(8M, 8L), 8P))))) )

ORDER_PP(
8let((8P, 8h_longest(8nat(1,0,0,0,0,0), 8pair(0, 0))),
8pair(8to_lit(8tuple_at_0(8P)), 8to_lit(8tuple_at_1(8P))))
)


...or even this "more elegant" version, which will run out of memory very quickly indeed (but in practice seems to work better for smaller ranges):
ORDER_PP(
8let((8P,
8seq_head(
8seq_sort(8fn(8P, 8Q, 8greater(8tuple_at_1(8P),
8tuple_at_1(8Q))),
8seq_map(8fn(8N,
8pair(8N, 8seq_size(8hailstone(8N)))),
8seq_iota(1, 8nat(1,0,0,0,0,0)))))),
8pair(8to_lit(8tuple_at_0(8P)), 8to_lit(8tuple_at_1(8P)))) )


Notice that large numbers (>100) must be entered as digit sequences with 8nat. 8to_lit converts a digit sequence back to a readable number.

=={{header|Oz}}==
declare
fun {HailstoneSeq N}
N > 0 = true %% assert
if N == 1 then [1]
elseif {IsEven N} then N|{HailstoneSeq N div 2}
else N|{HailstoneSeq 3*N+1}
end
end

HSeq27 = {HailstoneSeq 27}
{Length HSeq27} = 112
{List.take HSeq27 4} = [27 82 41 124]
{List.drop HSeq27 108} = [8 4 2 1]

fun {MaxBy2nd A=A1#A2 B=B1#B2}
if B2 > A2 then B else A end
end

Pairs = {Map {List.number 1 99999 1}
fun {$ I} I#{Length {HailstoneSeq I}} end}

MaxI#MaxLen = {List.foldL Pairs MaxBy2nd 0#0}
{System.showInfo
"Maximum length "#MaxLen#" was found for hailstone("#MaxI#")"}

Output:

Maximum length 351 was found for hailstone(77031)


=={{header|PARI/GP}}==
show(n)={
my(t=1);
while(n>1,
print1(n",");
n=if(n%2,
3*n+1
,
n/2
);
t++
);
print(1);
t
};

len(n)={
my(t=1);
while(n>1,
if(n%2,
t+=2;
n+=(n>>1)+1
,
t++;
n>>=1
)
);
t
};

show(27)
r=0;for(n=1,1e5,t=len(n);if(t>r,r=t;ra=n));print(ra"\t"r)

Output:
27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,91,274,137,4
12,206,103,310,155,466,233,700,350,175,526,263,790,395,1186,593,1780,890,445,133
6,668,334,167,502,251,754,377,1132,566,283,850,425,1276,638,319,958,479,1438,719
,2158,1079,3238,1619,4858,2429,7288,3644,1822,911,2734,1367,4102,2051,6154,3077,
9232,4616,2308,1154,577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,2
3,70,35,106,53,160,80,40,20,10,5,16,8,4,2,1

and
77031   351


=={{header|Pascal}}==
See [[Hailstone_sequence#Delphi | Delphi]]

=={{header|Perl}}==
=== Straightforward ===
#!/usr/bin/perl

use warnings;
use strict;

my @h = hailstone(27);
print "Length of hailstone(27) = " . scalar @h . "\n";
print "[" . join(", ", @h[0 .. 3], "...", @h[-4 .. -1]) . "]\n";

my ($max, $n) = (0, 0);
for my $x (1 .. 99_999) {
@h = hailstone($x);
if (scalar @h > $max) {
($max, $n) = (scalar @h, $x);
}
}

print "Max length $max was found for hailstone($n) for numbers < 100_000\n";


sub hailstone {
my ($n) = @_;

my @sequence = ($n);

while ($n > 1) {
if ($n % 2 == 0) {
$n = int($n / 2);
} else {
$n = $n * 3 + 1;
}

push @sequence, $n;
}

return @sequence;
}


Output:

Length of hailstone(27) = 112
[27, 82, 41, 124, ..., 8, 4, 2, 1]
Max length 351 was found for hailstone(77031) for numbers < 100_000


=== Compact ===
A more compact version:
#!/usr/bin/perl
use strict;

sub hailstone {
@_ = local $_ = shift;
push @_, $_ = $_ % 2 ? 3 * $_ + 1 : $_ / 2 while $_ > 1;
@_;
}

my @h = hailstone($_ = 27);
print "$_: @h[0 .. 3] ... @h[-4 .. -1] (".@h.")\n";

@h = ();
for (1 .. 99_999) { @h = ($_, $h[2]) if ($h[2] = hailstone($_)) > $h[1] }
printf "%d: (%d)\n", @h;


The same approach as in the compact version above, obfuscated:
sub _{my$_=$_[''];push@_,$_&1?$_+=$_++<<1:($_>>=1)while$_^1;@_}
@_=_($_=031^2);print "$_: @_[0..3] ... @_[-4..-1] (".@_.")\n";
$_[1]<($_[2]=_($_))and@_=($_,$_[2])for 1..1e5-1;printf "%d: (%d)\n", @_;


Output in either case:

27: 27 82 41 124 ... 8 4 2 1 (112)
77031: (351)


=={{header|Perl 6}}==
sub hailstone($n) { $n, { $_ %% 2 ?? $_ div 2 !! $_ * 3 + 1 } ... 1 }

my @h = hailstone(27);
say "Length of hailstone(27) = {+@h}";
say ~@h;

my $m max= +hailstone($_) => $_ for 1..99_999;
say "Max length $m.key() was found for hailstone($m.value()) for numbers < 100_000";


=={{header|PHP}}==
function hailstone($n,$seq=array()){
$sequence = $seq;
$sequence[] = $n;
if($n == 1){
return $sequence;
}else{
$n = ($n%2==0) ? $n/2 : (3*$n)+1;
return hailstone($n, $sequence);
}
}

$result = hailstone(27);
echo count($result) . ' Elements.
';
echo 'Starting with : ' . implode(",",array_slice($result,0,4)) .' and ending with : ' . implode(",",array_slice($result,count($result)-4)) . '
';

$maxResult = array(0);

for($i=1;$i<=100000;$i++){
$result = count(hailstone($i));
if($result > max($maxResult)){
$maxResult = array($i=>$result);
}
}
foreach($maxResult as $key => $val){
echo 'Number < 100000 with longest Hailstone seq.: ' . $key . ' with length of ' . $val;
}


112 Elements.
Starting with : 27,82,41,124 and ending with : 8,4,2,1
Number < 100000 with longest Hailstone seq.: 77031 with length of 351


=={{header|PicoLisp}}==
(de hailstone (N)
(make
(until (= 1 (link N))
(setq N
(if (bit? 1 N)
(inc (* N 3))
(/ N 2) ) ) ) ) )

(let L (hailstone 27)
(println 27 (length L) (head 4 L) '- (tail 4 L)) )

(let N (maxi '((N) (length (hailstone N))) (range 1 100000))
(println N (length (hailstone N))) )

Output:
27 112 (27 82 41 124) - (8 4 2 1)
77031 351


=={{header|Pike}}==
#!/usr/bin/env pike

int next(int n)
{
if (n==1)
return 0;
if (n%2)
return 3*n+1;
else
return n/2;
}

array(int) hailstone(int n)
{
array seq = ({ n });
while (n=next(n))
seq += ({ n });
return seq;
}

void main()
{
array(int) two = hailstone(27);
if (equal(two[0..3], ({ 27, 82, 41, 124 })) && equal(two[<3..], ({ 8,4,2,1 })))
write("sizeof(({ %{%d, %}, ... %{%d, %} }) == %d\n", two[0..3], two[<3..], sizeof(two));

mapping longest = ([ "length":0, "start":0 ]);

foreach(allocate(100000); int start; )
{
int length = sizeof(hailstone(start));
if (length > longest->length)
{
longest->length = length;
longest->start = start;
}
}
write("longest sequence starting at %d has %d elements\n", longest->start, longest->length);
}


Output:
sizeof(({ 27, 82, 41, 124, , ... 8, 4, 2, 1, }) == 112
longest sequence starting at 77031 has 351 elements

=={{header|PL/I}}==
test: proc options (main);
declare (longest, n) fixed (15);
declare flag bit (1);
declare (i, value) fixed (15);

/* Task 1: */
flag = '1'b;
put skip list ('The sequence for 27 is');
i = hailstones(27);

/* Task 2: */
flag = '0'b;
longest = 0;
do i = 1 to 99999;
if longest < hailstones(i) then
do; longest = hailstones(i); value = i; end;
end;
put skip edit (value, ' has the longest sequence of ', longest) (a);

hailstones: procedure (n) returns ( fixed (15));
declare n fixed (15) nonassignable;
declare (m, p) fixed (15);

m = n;
p = 1;
if flag then put skip list (m);
do p = 1 by 1 while (m > 1);
if iand(m, 1) = 0 then
m = m/2;
else
m = 3*m + 1;
if flag then put skip list (m);
end;
if flag then put skip list ('The hailstone sequence has length' || p);
return (p);
end hailstones;

end test;

Output:

The sequence for 27 is
27
82
41
124
62
31
94
47
142
71
214
107
322
161
484
242
121
364
182
91
274
137
412
206
103
310
155
466
233
700
350
175
526
263
790
395
1186
593
1780
890
445
1336
668
334
167
502
251
754
377
1132
566
283
850
425
1276
638
319
958
479
1438
719
2158
1079
3238
1619
4858
2429
7288
3644
1822
911
2734
1367
4102
2051
6154
3077
9232
4616
2308
1154
577
1732
866
433
1300
650
325
976
488
244
122
61
184
92
46
23
70
35
106
53
160
80
40
20
10
5
16
8
4
2
1
The hailstone sequence has length 112
77031 has the longest sequence of 351


=={{header|Powershell}}==
{{output?|Powershell}}
{{works with|Powershell|3.0}}

function Get-HailStone ($n)
{
switch($n)
{
1 {$n;return}
{$n % 2 -eq 0}{$n; return Get-Hailstone ($n = $n / 2)}
{$n % 2 -ne 0}{$n; return Get-Hailstone ($n = ($n * 3) +1)}

}
}

function Get-HailStoneBelowLimit($UpperLimit)
{
begin {$Counts = @()}

process
{
for ($i = 1; $i -lt $UpperLimit; $i++)
{
$Object =
[pscustomobject]@{
'Number' = $i
'Count' = (Get-HailStone $i).count
}

$Counts += $Object
}
}

end {$Counts}
}
Get-HailStoneBelowLimit 100000 |
Sort-Object count -descending |
Select-Object number -first 1


=={{header|Prolog}}==
1. Create a routine to generate the hailstone sequence for a number.
hailstone(1,[1]) :- !.
hailstone(N,[N|S]) :- 0 is N mod 2, N1 is N / 2, hailstone(N1,S).
hailstone(N,[N|S]) :- 1 is N mod 2, N1 is (3 * N) + 1, hailstone(N1, S).


2. Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1.

The following query performs the test.
hailstone(27,X),
length(X,112),
append([27, 82, 41, 124], _, X),
append(_, [8, 4, 2, 1], X).


3. Show the number less than 100,000 which has the longest hailstone sequence together with that sequences length.
longestHailstoneSequence(M, Seq, Len) :- longesthailstone(M, 1, 1, Seq, Len).
longesthailstone(1, Cn, Cl, Mn, Ml):- Mn = Cn,
Ml = Cl.
longesthailstone(N, _, Cl, Mn, Ml) :- hailstone(N, X),
length(X, L),
Cl < L,
N1 is N-1,
longesthailstone(N1, N, L, Mn, Ml).
longesthailstone(N, Cn, Cl, Mn, Ml) :- N1 is N-1,
longesthailstone(N1, Cn, Cl, Mn, Ml).

run this query.
longestHailstoneSequence(100000, Seq, Len).
to get the following result

Seq = 77031,
Len = 351


===Constraint Handling Rules===
CHR is a programming language created by '''Professor Thom Frühwirth'''.

Works with SWI-Prolog and module '''chr''' written by '''Tom Schrijvers''' and '''Jan Wielemaker'''


:- use_module(library(chr)).
:- chr_option(debug, off).
:- chr_option(optimize, full).

:- chr_constraint collatz/2, hailstone/1, clean/0.

% to remove all constraints hailstone/1 after computation
clean @ clean \ hailstone(_) <=> true.
clean @ clean <=> true.

% compute Collatz number
init @ collatz(1,X) <=> X = 1 | true.
collatz @ collatz(N, C) <=> (N mod 2 =:= 0 -> C is N / 2; C is 3 * N + 1).

% Hailstone loop
hailstone(1) ==> true.
hailstone(N) ==> N \= 1 | collatz(N, H), hailstone(H).


Code for task one :
task1 :-
hailstone(27),
findall(X, find_chr_constraint(hailstone(X)), L),
clean,
% check the requirements
( (length(L, 112), append([27, 82, 41, 124 | _], [8,4,2,1], L)) -> writeln(ok); writeln(ko)).

Output :
 ?- task1.
ok
true.

Code for task two :
longest_sequence :-
seq(2, 100000, 1-[1], Len-V),
format('For ~w sequence has ~w len ! ~n', [V, Len]).


% walk through 2 to 100000 and compute the length of the sequences
% memorize the longest
seq(N, Max, Len-V, Len-V) :- N is Max + 1, !.
seq(N, Max, CLen - CV, FLen - FV) :-
len_seq(N, Len - N),
( Len > CLen -> Len1 = Len, V1 = [N]
; Len = CLen -> Len1 = Len, V1 = [N | CV]
; Len1 = CLen, V1 = CV),
N1 is N+1,
seq(N1, Max, Len1 - V1, FLen - FV).

% compute the len of the Hailstone sequence for a number
len_seq(N, Len - N) :-
hailstone(N),
findall(hailstone(X), find_chr_constraint(hailstone(X)), L),
length(L, Len),
clean.

Output :
 ?- longest_sequence.
For [77031] sequence has 351 len !
true.


=={{header|Pure}}==
// 1. Create a routine to generate the hailstone sequence for a number.
type odd x::int = x mod 2;
type even x::int = ~odd x;
odd x = typep odd x;
even x = typep even x;

hailstone 1 = [1];
hailstone n::even = n:hailstone (n div 2);
hailstone n::odd = n:hailstone (3*n + 1);

// 2. Use the routine to show that the hailstone sequence for the number 27
// has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
n = 27;
hs = hailstone n;
l = # hs;
using system;

printf
("the hailstone sequence for the number %d has %d elements " +
"starting with %s and ending with %s\n")
(n, l, __str__ (hs!!(0..3)), __str__ ( hs!!((l-4)..l)));

// 3. Show the number less than 100,000 which has the longest hailstone
// sequence together with that sequences length.
printf ("the number under 100,000 with the longest sequence is %d " +
"with a sequence length of %d\n")
(foldr (\ (a,b) (c,d) -> if (b > d) then (a,b) else (c,d))
(0,0)
(map (\ x -> (x, # hailstone x)) (1..100000)));

Output:

the hailstone sequence for the number 27 has 112 elements starting with [27,82,41,124] and ending with [8,4,2,1]
the number under 100,000 with the longest sequence is 77031 with a sequence length of 351


=={{header|Python}}==
def hailstone(n):
seq = [n]
while n>1:
n = 3*n + 1 if n & 1 else n//2
seq.append(n)
return seq

if __name__ == '__main__':
h = hailstone(27)
assert len(h)==112 and h[:4]==[27, 82, 41, 124] and h[-4:]==[8, 4, 2, 1]
print("Maximum length %i was found for hailstone(%i) for numbers <100,000" %
max((len(hailstone(i)), i) for i in range(1,100000)))


'''Sample Output'''
Maximum length 351 was found for hailstone(77031) for numbers <100,000


=={{header|R}}==
### PART 1:
makeHailstone <- function(n){
hseq <- n
while (hseq[length(hseq)] > 1){
current.value <- hseq[length(hseq)]
if (current.value %% 2 == 0){
next.value <- current.value / 2
} else {
next.value <- (3 * current.value) + 1
}
hseq <- append(hseq, next.value)
}
return(list(hseq=hseq, seq.length=length(hseq)))
}

### PART 2:
twenty.seven <- makeHailstone(27)
twenty.seven$hseq
twenty.seven$seq.length

### PART 3:
max.length <- 0; lower.bound <- 1; upper.bound <- 100000

for (index in lower.bound:upper.bound){
current.hseq <- makeHailstone(index)
if (current.hseq$seq.length > max.length){
max.length <- current.hseq$seq.length
max.index <- index
}
}

cat("Between ", lower.bound, " and ", upper.bound, ", the input of ",
max.index, " gives the longest hailstone sequence, which has length ",
max.length, ". \n", sep="")


Output: > twenty.seven$hseq
[1] 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484
[16] 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700
[31] 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167
[46] 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438
[61] 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051
[76] 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488
[91] 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20
[106] 10 5 16 8 4 2 1

> twenty.seven$seq.length
[1] 112

Between 1 and 1e+05, the input of 77031 gives the longest hailstone sequence,
which has length 351.


=={{header|Racket}}==

#lang racket

(define hailstone
(let ([t (make-hasheq)])
(hash-set! t 1 '(1))
(λ(n) (hash-ref! t n
(λ() (cons n (hailstone (if (even? n) (/ n 2) (+ (* 3 n) 1)))))))))

(define h27 (hailstone 27))
(printf "h(27) = ~s, ~s items\n"
`(,@(take h27 4) ... ,@(take-right h27 4))
(length h27))

(define N 100000)
(define longest
(for/fold ([m #f]) ([i (in-range 1 (add1 N))])
(define h (hailstone i))
(if (and m (> (cdr m) (length h))) m (cons i (length h)))))
(printf "for x<=~s, ~s has the longest sequence with ~s items\n"
N (car longest) (cdr longest))


Output:

h(27) = (27 82 41 124 ... 8 4 2 1), 112 items
for x<=100000, 77031 has the longest sequence with 351 items


=={{header|REXX}}==
===non-optimized===
/*REXX pgm tests a number and a range for hailstone (Collatz) sequences.*/
parse arg x y . /*get optional arguments from CL.*/
if x=='' | x==',' then x=27 /*Any 1st argument? Use default.*/
if y=='' | y==',' then y=100000-1 /*Any 2nd argument? Use default.*/
numeric digits 20; @.=0 /*handle big #s; initialize array*/
$=hailstone(x) /*═══════════════════task 1═════════════════════════*/
say x ' has a hailstone sequence of ' words($)
say ' and starts with: ' subword($, 1, 4) " ∙∙∙"
say ' and ends with: ∙∙∙' subword($, max(1, words($)-3))
say
if y==0 then exit /*═══════════════════task 2═════════════════════════*/
w=0; do j=1 for y /*traipse through the numbers. */
call hailstone j /*compute the hailstone sequence.*/
if #hs<=w then iterate /*Not big 'nuff? Then keep going.*/
bigJ=j; w=#hs /*remember what # has biggest HS.*/
end /*j*/
say '(between 1──►'y") " bigJ ' has the longest hailstone sequence:' w
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────HAILSTONE subroutine────────────────*/
hailstone: procedure expose #hs; parse arg n 1 s /*N & S set to 1st arg*/

do #hs=1 while n\==1 /*loop while N isn't unity. */
if n//2 then n=n*3+1 /*if N is odd, calc: 3*n +1 */
else n=n%2 /* " " " even, perform fast ÷ */
s=s n /*build a sequence list (append).*/
end /*#hs*/
return s

'''output'''

27 has a hailstone sequence of 112
and starts with: 27 82 41 124 ∙∙∙
and ends with: ∙∙∙ 8 4 2 1

(between 1──►99999) 77031 has the longest hailstone sequence: 351


===optimized===
This optimized version is about seven times faster than the unoptimized version.
/*REXX pgm tests a number and a range for hailstone (Collatz) sequences.*/
parse arg x y . /*get optional arguments from CL.*/
if x=='' | x==',' then x=27 /*Any 1st argument? Use default.*/
if y=='' | y==',' then y=99999 /*Any 2nd argument? Use default.*/
numeric digits 20; @.=0 /*handle big #s; initialize array*/
$=hailstone(x) /*═══════════════════task 1═════════════════════════*/
say x ' has a hailstone sequence of ' words($)
say ' and starts with: ' subword($, 1, 4) " ∙∙∙"
say ' and ends with: ∙∙∙' subword($, max(1, words($)-3))
say
if y==0 then exit /*═══════════════════task 2═════════════════════════*/
w=0; do j=1 for y /*loop through all numbers <100k.*/
$=hailstone(j) /*compute the hailstone sequence.*/
#hs=words($) /*find the length of the sequence*/
if #hs<=w then iterate /*Not big 'nuff? Then keep going.*/
bigJ=j; w=#hs /*remember what # has biggest HS.*/
end /*j*/
say '(between 1──►'y") " bigJ ' has the longest hailstone sequence:' w
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────HAILSTONE subroutine────────────────*/
hailstone: procedure expose @.; parse arg n 1 s 1 o /*N,S,O = 1st arg.*/
@.1= /*special case for unity. */
do forever /*loop while N isn't unity. */
if @.n\==0 then do; s=s @.n; leave; end /*been here before?*/
if n//2 then n=n*3+1 /*if N is odd, calc: 3*n +1 */
else n=n%2 /* " " " even, perform fast ÷ */
s=s n /*build a sequence list (append).*/
end /*forever*/
@.o=subword(s,2) /*memoization for this hailstone.*/
return s

'''output''' is the same as the non-optimized version.




=={{header|Ruby}}==
This program uses new methods (Integer#even? and Enumerable#max_by) from Ruby 1.8.7.
{{works with|Ruby|1.8.7}}
def hailstone n
seq = [n]
until n == 1
n = (n.even?) ? (n / 2) : (3 * n + 1)
seq << n
end
seq
end

# for n = 27, show sequence length and first and last 4 elements
hs27 = hailstone 27
p [hs27.length, hs27[0..3], hs27[-4..-1]]

# find the longest sequence among n less than 100,000
n, len = (1 ... 100_000) .collect {|n|
[n, hailstone(n).length]} .max_by {|n, len| len}
puts "#{n} has a hailstone sequence length of #{len}"
puts "the largest number in that sequence is #{hailstone(n).max}"

Output:
[112, [27, 82, 41, 124], [8, 4, 2, 1]]
77031 has a hailstone sequence length of 351
the largest number in that sequence is 21933016


=== With shared structure ===
This version builds some linked lists with shared structure. ''Hailstone::ListNode'' is an adaptation of ListNode from [[Singly-linked list/Element definition#Ruby]]. When two sequences contain the same value, those two lists share a tail. This avoids recomputing the end of the sequence.
{{works with|Ruby|1.8.7}}
module Hailstone
class ListNode
include Enumerable
attr_reader :value, :size, :succ

def initialize(value, size, succ=nil)
@value, @size, @succ = value, size, succ
end

def each
node = self
while node
yield node.value
node = node.succ
end
end
end

@@sequence = {1 => ListNode.new(1, 1)}

module_function

def sequence(n)
unless @@sequence[n]
ary = []
m = n
until succ = @@sequence[m]
ary << m
m = (m.even?) ? (m / 2) : (3 * m + 1)
end
ary.reverse_each do |m|
@@sequence[m] = succ = ListNode.new(m, succ.size + 1, succ)
end
end
@@sequence[n]
end
end

# for n = 27, show sequence length and first and last 4 elements
hs27 = Hailstone.sequence(27).to_a
p [hs27.length, hs27[0..3], hs27[-4..-1]]

# find the longest sequence among n less than 100,000
hs_big = (1 ... 100_000) .collect {|n|
Hailstone.sequence n}.max_by {|hs| hs.size}
puts "#{hs_big.first} has a hailstone sequence length of #{hs_big.size}"
puts "the largest number in that sequence is #{hs_big.max}"


=={{header|Scala}}==
[[Category:Scala Implementations]]
{{libheader|Scala}}
{{works with|Scala|2.10.2}}
object HailstoneSequence extends App {
def hailstone(n: Int): Stream[Int] =
n #:: (if (n == 1) Stream.empty else hailstone(if (n % 2 == 0) n / 2 else n * 3 + 1))

val nr = args.headOption.map(_.toInt).getOrElse(27)
val collatz = hailstone(nr)
println(s"Use the routine to show that the hailstone sequence for the number: $nr.")
println(collatz.toList)
println(s"It has ${collatz.length} elements.")
println
println(
"Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.")
val (n, len) = (1 until 100000).map(n => (n, hailstone(n).length)).maxBy(_._2)
println(s"Longest hailstone sequence length= $len occurring with number $n.")
}

{{Out}}
Use the routine to show that the hailstone sequence for the number: 27.
List(27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1)
It has 112 elements.

Compute the number < 100,000, which has the longest hailstone sequence with that sequence's length.
Longest hailstone sequence length= 351 occurring with number 77031.


=={{header|Scheme}}==
(define (collatz n)
(if (= n 1) '(1)
(cons n (collatz (if (even? n) (/ n 2) (+ 1 (* 3 n)))))))

(define (collatz-length n)
(let aux ((n n) (r 1)) (if (= n 1) r
(aux (if (even? n) (/ n 2) (+ 1 (* 3 n))) (+ r 1)))))

(define (collatz-max a b)
(let aux ((i a) (j 0) (k 0))
(if (> i b) (list j k)
(let ((h (collatz-length i)))
(if (> h k) (aux (+ i 1) i h) (aux (+ i 1) j k))))))

(collatz 27)
; (27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182
; 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395
; 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283
; 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429
; 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154
; 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35
; 106 53 160 80 40 20 10 5 16 8 4 2 1)

(collatz-length 27)
; 112

(collatz-max 1 100000)
; (77031 351)


=={{header|Seed7}}==
$ include "seed7_05.s7i";

const func array integer: hailstone (in var integer: n) is func
result
var array integer: hSequence is 0 times 0;
begin
while n <> 1 do
hSequence &:= n;
if odd(n) then
n := 3 * n + 1;
else
n := n div 2;
end if;
end while;
hSequence &:= n;
end func;

const func integer: hailstoneSequenceLength (in var integer: n) is func
result
var integer: sequenceLength is 1;
begin
while n <> 1 do
incr(sequenceLength);
if odd(n) then
n := 3 * n + 1;
else
n := n div 2;
end if;
end while;
end func;

const proc: main is func
local
var integer: number is 0;
var integer: length is 0;
var integer: maxLength is 0;
var integer: numberOfMaxLength is 0;
var array integer: h27 is 0 times 0;
begin
for number range 1 to 99999 do
length := hailstoneSequenceLength(number);
if length > maxLength then
maxLength := length;
numberOfMaxLength := number;
end if;
end for;
h27 := hailstone(27);
writeln("hailstone(27):");
for number range 1 to 4 do
write(h27[number] <& ", ");
end for;
write("....");
for number range length(h27) -3 to length(h27) do
write(", " <& h27[number]);
end for;
writeln(" length=" <& length(h27));
writeln("Maximum length " <& maxLength <& " at number=" <& numberOfMaxLength);
end func;

Output:

hailstone(27):
27, 82, 41, 124, ...., 8, 4, 2, 1 length=112
Maximum length 351 at number=77031


=={{header|Smalltalk}}==
{{works with|GNU Smalltalk}}
Object subclass: Sequences [
Sequences class >> hailstone: n [
|seq|
seq := OrderedCollection new.
seq add: n.
(n = 1) ifTrue: [ ^seq ].
(n even) ifTrue: [ seq addAll: (Sequences hailstone: (n / 2)) ]
ifFalse: [ seq addAll: (Sequences hailstone: ( (3*n) + 1 ) ) ].
^seq.
]

Sequences class >> hailstoneCount: n [
^ (Sequences hailstoneCount: n num: 1)
]

"this 'version' avoids storing the sequence, it just counts
its length - no memoization anyway"
Sequences class >> hailstoneCount: n num: m [
(n = 1) ifTrue: [ ^m ].
(n even) ifTrue: [ ^ Sequences hailstoneCount: (n / 2) num: (m + 1) ]
ifFalse: [ ^ Sequences hailstoneCount: ( (3*n) + 1) num: (m + 1) ].
]
].


|r|
r := Sequences hailstone: 27. "hailstone 'from' 27"
(r size) displayNl. "its length"

"test 'head' ..."
( (r first: 4) = #( 27 82 41 124 ) asOrderedCollection ) displayNl.

"... and 'tail'"
( ( (r last: 4 ) ) = #( 8 4 2 1 ) asOrderedCollection) displayNl.

|longest|
longest := OrderedCollection from: #( 1 1 ).
2 to: 100000 do: [ :c |
|l|
l := Sequences hailstoneCount: c.
(l > (longest at: 2) ) ifTrue: [ longest replaceFrom: 1 to: 2 with: { c . l } ].
].

('Sequence generator %1, sequence length %2' % { (longest at: 1) . (longest at: 2) })
displayNl.


=={{header|SNUSP}}==

/@+@@@+++# 27
| halve odd /===count<<\ /recurse\ #/?\ zero
$>@/===!/===-?\==>?!/-<+++\ \!/=!\@\>?!\@/<@\.!\-/
/+<-\!>\?-<+>/++++<\?>+++/*6+4 | | \=/ \=itoa=@@@+@+++++#
\=>?/<=!=\ | | ! /+ !/+ !/+ !/+ \ mod10
|//!==/========\ | /<+> -\!?-\!?-\!?-\!?-\!
/=>?\<=/\<+>!\->+>+<>=print@/\ln \?!\-?!\-?!\-?!\-?!\-?/\ div10
\+<-/!< ----------.++++++++++/ # +/! +/! +/! +/! +/


=={{header|Tcl}}==
The core looping structure is an example of an [[Loops/N plus one half|n-plus-one-half loop]], except the loop is officially infinite here.
proc hailstone n {
while 1 {
lappend seq $n
if {$n == 1} {return $seq}
set n [expr {$n & 1 ? $n*3+1 : $n/2}]
}
}

set h27 [hailstone 27]
puts "h27 len=[llength $h27]"
puts "head4 = [lrange $h27 0 3]"
puts "tail4 = [lrange $h27 end-3 end]"

set maxlen [set max 0]
for {set i 1} {$i<100000} {incr i} {
set l [llength [hailstone $i]]
if {$l>$maxlen} {set maxlen $l;set max $i}
}
puts "max is $max, with length $maxlen"

Output:

h27 len=112
head4 = 27 82 41 124
tail4 = 8 4 2 1
max is 77031, with length 351


=={{header|TXR}}==
@(do (defun hailstone (n)
(cons n
(gen (not (eq n 1))
(set n (if (evenp n)
(trunc n 2)
(+ (* 3 n) 1)))))))
@(next :list @(mapcar* (fun tostring) (hailstone 27)))
27
82
41
124
@(skip)
8
4
2
1
@(eof)
@(do (let ((max 0) maxi)
(each* ((i (range 1 99999))
(h (mapcar* (fun hailstone) i))
(len (mapcar* (fun length) h)))
(if (> len max)
(progn
(set max len)
(set maxi i))))
(format t "longest sequence is ~a for n = ~a\n" max maxi)))


$ txr -l hailstone.txr
longest sequence is 351 for n = 77031


=={{header|UNIX Shell}}==
The best way is to use a shell with built-in arrays and arithmetic, such as Bash.
{{works with|Bash}}
#!/bin/bash
# seq is the array genereated by hailstone
# index is used for seq
declare -a seq
declare -i index

# Create a routine to generate the hailstone sequence for a number
hailstone () {
unset seq index
seq[$((index++))]=$((n=$1))
while [ $n -ne 1 ]; do
[ $((n % 2)) -eq 1 ] && ((n=n*3+1)) || ((n=n/2))
seq[$((index++))]=$n
done
}

# Use the routine to show that the hailstone sequence for the number 27
# has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
i=27
hailstone $i
echo "$i: ${#seq[@]}"
echo "${seq[@]:0:4} ... ${seq[@]:(-4):4}"

# Show the number less than 100,000 which has the longest hailstone
# sequence together with that sequences length.
# (But don't show the actual sequence)!
max=0
maxlen=0
for ((i=1;i<100000;i++)); do
hailstone $i
if [ $((len=${#seq[@]})) -gt $maxlen ]; then
max=$i
maxlen=$len
fi
done

echo "${max} has a hailstone sequence length of ${maxlen}"


output
27: 112
27 82 41 124 ... 8 4 2 1
77031 has a hailstone sequence of 351


===Bourne Shell===
This script follows tradition for the Bourne Shell; its hailstone() function writes the sequence to standard output, so the shell can capture or pipe this output. This script is '''very slow''' because it forks many processes. Each `command substitution` forks a subshell, and each expr(1) command forks a process.

* Therefore, this script only examines sequences '''from 1 to 1000''', not 100000. A fast computer might run this script in 45 to 120 seconds, using most time to run system calls in kernel mode. If the script went to 100000, it would need several hours.

{{works with|Bourne Shell}}
# Outputs a hailstone sequence from $1, with one element per line.
# Clobbers $n.
hailstone() {
n=`expr "$1" + 0`
eval "test $? -lt 2 || return $?" # $n must be integer.

echo $n
while test $n -ne 1; do
if expr $n % 2 >/dev/null; then
n=`expr 3 \* $n + 1`
else
n=`expr $n / 2`
fi
echo $n
done
}

set -- `hailstone 27`
echo "Hailstone sequence from 27 has $# elements:"
first="$1, $2, $3, $4"
shift `expr $# - 4`
echo " $first, ..., $1, $2, $3, $4"

i=1 max=0 maxlen=0
while test $i -lt 1000; do
len=`hailstone $i | wc -l | tr -d ' '`
test $len -gt $maxlen && max=$i maxlen=$len
i=`expr $i + 1`
done
echo "Hailstone sequence from $max has $maxlen elements."


==={{header|C Shell}}===
This script is several times faster than the previous Bourne Shell script, because it uses C Shell expressions, not the expr(1) command. This script is '''slow''', but it can reach 100000, and a fast computer might run it in less than 15 minutes.

# Outputs a hailstone sequence from !:1, with one element per line.
# Clobbers $n.
alias hailstone eval \''@ n = \!:1:q \\
echo $n \\
while ( $n != 1 ) \\
if ( $n % 2 ) then \\
@ n = 3 * $n + 1 \\
else \\
@ n /= 2 \\
endif \\
echo $n \\
end \\
'\'

set sequence=(`hailstone 27`)
echo "Hailstone sequence from 27 has $#sequence elements:"
@ i = $#sequence - 3
echo " $sequence[1-4] ... $sequence[$i-]"

# hailstone-length $i
# acts like
# @ len = `hailstone $i | wc -l | tr -d ' '`
# but without forking any subshells.
alias hailstone-length eval \''@ n = \!:1:q \\
@ len = 1 \\
while ( $n != 1 ) \\
if ( $n % 2 ) then \\
@ n = 3 * $n + 1 \\
else \\
@ n /= 2 \\
endif \\
@ len += 1 \\
end \\
'\'

@ i = 1
@ max = 0
@ maxlen = 0
while ($i < 100000)
# XXX - I must run hailstone-length in a subshell, because my
# C Shell has a bug when it runs hailstone-length inside this
# while ($i < 1000) loop: it forgets about this loop, and
# reports an error <>
@ len = `hailstone-length $i; echo $len`
if ($len > $maxlen) then
@ max = $i
@ maxlen = $len
endif
@ i += 1
end
echo "Hailstone sequence from $max has $maxlen elements."


$ csh -f hailstone.csh
Hailstone sequence from 27 has 112 elements:
27 82 41 124 ... 8 4 2 1
Hailstone sequence from 77031 has 351 elements.


=={{header|Ursala}}==
#import std
#import nat

hail = @iNC ~&h~=1->x ^C\~& @h ~&h?\~&t successor+ sum@iNiCX

#show+

main =

<
^T(@ixX take/$4; %nLP~~lrxPX; ^|TL/~& :/'...',' has length '--@h+ %nP+ length) hail 27,
^|TL(~&,:/' has sequence length ') %nP~~ nleq$^&r ^(~&,length+ hail)* nrange/1 100000>

The hail function computes the sequence as follows.
* Given a number as an argument, @iNC makes a list containing only that number before passing it to the rest of the function. The i in the expression stands for the identity function, N for the constant null function, and C for the cons operator.
* The iteration combinator (->) is used with a predicate of ~&h~=l which tests the condition that the head (~&h) of its argument is not equal (~=) to 1. Iteration of the rest of the function continues while this predicate holds.
* The x suffix says to return the reversal of the list after the iteration finishes.
* The function being iterated builds a list using the cons operator (^C) with the identity function (~&) of the argument for the tail, and the result of the rest of the line for the head.
* The @h operator says that the function following will be applied to the head of the list.
* The conditional operator (?) has the head function (~&h) as its predicate, which tests whether the head of its argument is non-null.
* In this case, the argument is a natural number, but naturals are represented as lists of booleans, so taking the head of a number is the same as testing the least significant bit.
* If the condition is not met, the number has a 0 least significant bit, and therefore is even. In this case, the conditional predicate calls for taking its tail (~&t), effectively dividing it by 2 using a bit shift.
* If the condition is met, the number is odd, so the rest of the function computes the successor of the number multiplied by three.
* Rather than multiplying the hard way, the function sum@iNiCX computes the sum of the pair (X) of numbers given by the identity function (i) of the argument, and the doubling of the argument (NiC), also obtained by a bit shift, with a zero bit (N) consed (C) with the identity (i).
Most of the main expression pertains to less interesting printing and formatting, but the part that searches for the longest sequence in the range is nleq$^&r ^(~&,length+ hail)* nrange/1 100000.
* The expression nrange/1 100000 evaluates to the list of the first 100000 positive integers.
* The map operator (*) causes a list to be made of the results of its operand applied to each number.
* The operand to the map operator, applied to an individual number in the list, constructs a pair (^) with the identity function (~&) of the number on the left, and the length of the hail sequence on the right.
* The maximizing operator ($^) with respect to the natural less or equal relation (nleq) applied to the right sides (&r) of its pair of arguments extracts the number with the maximum length sequence.

output:
<27,82,41,124>...<8,4,2,1> has length 112
77031 has sequence length 351


=={{header|XPL0}}==
include c:\cxpl\codes; \intrinsic 'code' declarations
int Seq(1000); \more than enough for longest sequence

func Hailstone(N); \Return length of Hailstone sequence starting at N
int N; \ also fills Seq array with sequence
int I;
[I:= 0;
loop [Seq(I):= N; I:= I+1;
if N=1 then return I;
N:= if N&1 then N*3+1 else N/2;
];
];

int N, SN, Len, MaxLen;
[Len:= Hailstone(27);
Text(0, "27's Hailstone length = "); IntOut(0, Len); CrLf(0);

Text(0, "Sequence = ");
for N:= 0 to 3 do [IntOut(0, Seq(N)); ChOut(0, ^ )];
Text(0, "... ");
for N:= Len-4 to Len-1 do [IntOut(0, Seq(N)); ChOut(0, ^ )];
CrLf(0);

MaxLen:= 0;
for N:= 1 to 100_000-1 do
[Len:= Hailstone(N);
if Len > MaxLen then [MaxLen:= Len; SN:= N]; \save N with max length
];
IntOut(0, SN); Text(0, "'s Hailstone length = "); IntOut(0, MaxLen);
]


Output:

27's Hailstone length = 112
Sequence = 27 82 41 124 ... 8 4 2 1
77031's Hailstone length = 351

Hailstone sequence

Pete: This time, I screwed up alphabetization.


{{task}}
The Hailstone sequence of numbers can be generated from a starting positive integer, n by:
* If n is 1 then the sequence ends.
* If n is even then the next n of the sequence = n/2
* If n is odd then the next n of the sequence = (3 * n) + 1

The (unproven), [[wp:Collatz conjecture|Collatz conjecture]] is that the hailstone sequence for any starting number always terminates.

'''Task Description:'''
# Create a routine to generate the hailstone sequence for a number.
# Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1
# Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.
(But don't show the actual sequence!)

'''See Also:'''

* [http://xkcd.com/710 xkcd] (humourous).

=={{header|ACL2}}==
(defun hailstone (len)
(loop for x = len
then (if (evenp x)
(/ x 2)
(+ 1 (* 3 x)))
collect x until (= x 1)))

;; Must be tail recursive
(defun max-hailstone-start (limit mx curr)
(declare (xargs :mode :program))
(if (zp limit)
(mv mx curr)
(let ((new-mx (len (hailstone limit))))
(if (> new-mx mx)
(max-hailstone-start (1- limit) new-mx limit)
(max-hailstone-start (1- limit) mx curr)))))


Output:
> (take 4 (hailstone 27))
(27 82 41 124)
> (nthcdr 108 (hailstone 27))
(8 4 2 1)
> (len (hailstone 27))
112
> (max-hailstone-start 100000 0 0)
(351 77031)


=={{header|Ada}}==
Similar to [[#C|C method]]:
with Ada.Text_IO; use Ada.Text_IO;
procedure hailstone is
type int_arr is array(Positive range <>) of Integer;
type int_arr_pt is access all int_arr;

function hailstones(num:Integer; pt:int_arr_pt) return Integer is
stones : Integer := 1;
n : Integer := num;
begin
if pt /= null then pt(1) := num; end if;
while (n/=1) loop
stones := stones + 1;
if n mod 2 = 0 then n := n/2;
else n := (3*n)+1;
end if;
if pt /= null then pt(stones) := n; end if;
end loop;
return stones;
end hailstones;

nmax,stonemax,stones : Integer := 0;
list : int_arr_pt;
begin
stones := hailstones(27,null);
list := new int_arr(1..stones);
stones := hailstones(27,list);
put(" 27: "&Integer'Image(stones)); new_line;
for n in 1..4 loop put(Integer'Image(list(n))); end loop;
put(" .... ");
for n in stones-3..stones loop put(Integer'Image(list(n))); end loop;
new_line;
for n in 1..100000 loop
stones := hailstones(n,null);
if stones>stonemax then
nmax := n; stonemax := stones;
end if;
end loop;
put_line(Integer'Image(nmax)&" max @ n= "&Integer'Image(stonemax));
end hailstone;

Output:

27: 112
27 82 41 124 .... 8 4 2 1
77031 max @ n= 351


===Alternative method===
A method without pointers or dynamic memory allocation, but slower for simply counting. This is also used for the "executable library" task [[Executable library#Ada]].

hailstones.ads:
package Hailstones is
type Integer_Sequence is array(Positive range <>) of Integer;
function Create_Sequence (N : Positive) return Integer_Sequence;
end Hailstones;

hailstones.adb:
package body Hailstones is
function Create_Sequence (N : Positive) return Integer_Sequence is
begin
if N = 1 then
-- terminate
return (1 => N);
elsif N mod 2 = 0 then
-- even
return (1 => N) & Create_Sequence (N / 2);
else
-- odd
return (1 => N) & Create_Sequence (3 * N + 1);
end if;
end Create_Sequence;
end Hailstones;

example main.adb:
with Ada.Text_IO;
with Hailstones;

procedure Main is
package Integer_IO is new Ada.Text_IO.Integer_IO (Integer);

procedure Print_Sequence (X : Hailstones.Integer_Sequence) is
begin
for I in X'Range loop
Integer_IO.Put (Item => X (I), Width => 0);
if I < X'Last then
Ada.Text_IO.Put (", ");
end if;
end loop;
Ada.Text_IO.New_Line;
end Print_Sequence;

Hailstone_27 : constant Hailstones.Integer_Sequence :=
Hailstones.Create_Sequence (N => 27);

begin
Ada.Text_IO.Put_Line ("Length of 27:" & Integer'Image (Hailstone_27'Length));
Ada.Text_IO.Put ("First four: ");
Print_Sequence (Hailstone_27 (Hailstone_27'First .. Hailstone_27'First + 3));
Ada.Text_IO.Put ("Last four: ");
Print_Sequence (Hailstone_27 (Hailstone_27'Last - 3 .. Hailstone_27'Last));

declare
Longest_Length : Natural := 0;
Longest_N : Positive;
Length : Natural;
begin
for I in 1 .. 99_999 loop
Length := Hailstones.Create_Sequence (N => I)'Length;
if Length > Longest_Length then
Longest_Length := Length;
Longest_N := I;
end if;
end loop;
Ada.Text_IO.Put_Line ("Longest length is" & Integer'Image (Longest_Length));
Ada.Text_IO.Put_Line ("with N =" & Integer'Image (Longest_N));
end;
end Main;

output:
Length of 27: 112
First four: 27, 82, 41, 124
Last four: 8, 4, 2, 1
Longest length is 351
with N = 77031


=={{header|ALGOL 68}}==
{{trans|C}} - note: This specimen retains the original C coding style.
{{works with|ALGOL 68|Standard - no extensions to language used}}
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny]}}
{{works with|ELLA ALGOL 68|Any (with appropriate job cards) - using the ''print'' routine rather than ''printf''}}
MODE LINT = # LONG ... # INT;

PROC hailstone = (INT in n, REF[]LINT array)INT:
(
INT hs := 1;
INT index := 0;
LINT n := in n;

WHILE n /= 1 DO
hs +:= 1;
IF array ISNT REF[]LINT(NIL) THEN array[index +:= 1] := n FI;
n := IF ODD n THEN 3*n+1 ELSE n OVER 2 FI
OD;
IF array ISNT REF[]LINT(NIL) THEN array[index +:= 1] := n FI;
hs
);

main:
(
INT j, hmax := 0;
INT jatmax, n;
INT border = 4;

FOR j TO 100000-1 DO
n := hailstone(j, NIL);
IF hmax < n THEN
hmax := n;
jatmax := j
FI
OD;

[2]INT test := (27, jatmax);
FOR key TO UPB test DO
INT val = test[key];
n := hailstone(val, NIL);
[n]LINT array;
n := hailstone(val, array);

printf(($"[ "n(border)(g(0)", ")" ..."n(border)(", "g(0))"] len="g(0)l$,
array[:border], array[n-border+1:], n))
#;free(array) #
OD;
printf(($"Max "g(0)" at j="g(0)l$, hmax, jatmax))
# ELLA Algol68RS:
print(("Max",hmax," at j=",jatmax, new line))
#
)

Output:

[ 27, 82, 41, 124, ..., 8, 4, 2, 1] len=112
[ 77031, 231094, 115547, 346642, ..., 8, 4, 2, 1] len=351
Max 351 at j=77031


=={{header|APL}}==
{{works with|Dyalog APL}}
seq←hailstone n;next
⍝ Returns the hailstone sequence for a given number

seq←n ⍝ Init the sequence
:While n≠1
next←(n÷2) (1+3×n) ⍝ Compute both possibilities
n←next[1+2|n] ⍝ Pick the appropriate next step
seq,←n ⍝ Append that to the sequence
:EndWhile

Output:
5↑hailstone 27
27 82 41 124 62
¯5↑hailstone 27
16 8 4 2 1
⍴hailstone 27
112
1↑{⍵[⍒↑(⍴∘hailstone)¨⍵]}⍳100000
77031


=={{header|AutoHotkey}}==
; Submitted by MasterFocus --- http://tiny.cc/iTunis

; [1] Generate the Hailstone Seq. for a number

List := varNum := 7 ; starting number is 7, not counting elements
While ( varNum > 1 )
List .= ", " ( varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 ) )
MsgBox % List

; [2] Seq. for starting number 27 has 112 elements

Count := 1, List := varNum := 27 ; starting number is 27, counting elements
While ( varNum > 1 )
Count++ , List .= ", " ( varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 ) )
MsgBox % "Sequence:`n" List "`n`nCount: " Count

; [3] Find number<100000 with longest seq. and show both values

MaxNum := Max := 0 ; reset the Maximum variables
TimesToLoop := 100000 ; limit number here is 100000
Offset := 70000 ; offset - use 0 to process from 0 to 100000
Loop, %TimesToLoop%
{
If ( TimesToLoop < ( varNum := Index := A_Index+Offset ) )
Break
text := "Processing...`n-------------------`n"
text .= "Current starting number: " Index "`n"
text .= "Current sequence count: " Count
text .= "`n-------------------`n"
text .= "Maximum starting number: " MaxNum "`n"
text .= "Maximum sequence count: " Max " <<" ; text split to avoid long code lines
ToolTip, %text%
Count := 1 ; going to count the elements, but no "List" required
While ( varNum > 1 )
Count++ , varNum := ( Mod(varNum,2) ? (varNum*3)+1 : varNum//2 )
If ( Count > Max )
Max := Count , MaxNum := Index ; set the new maximum values, if necessary
}
ToolTip
MsgBox % "Number: " MaxNum "`nCount: " Max

=={{header|AutoIt}}==



$Hail = Hailstone(27)
ConsoleWrite("Sequence-Lenght: "&$Hail&@CRLF)
$Big = -1
$Sequenzlenght = -1
For $I = 1 To 100000
$Hail = Hailstone($i, False)
If Number($Hail) > $Sequenzlenght Then
$Sequenzlenght = Number($Hail)
$Big = $i
EndIf
Next
ConsoleWrite("Longest Sequence : "&$Sequenzlenght&" from number "&$Big&@CRLF)
Func Hailstone($int, $sequence = True)
$Counter = 0
While True
$Counter += 1
If $sequence = True Then ConsoleWrite($int & ",")
If $int = 1 Then ExitLoop
If Not Mod($int, 2) Then
$int = $int / 2
Else
$int = 3 * $int + 1
EndIf
If Not Mod($Counter, 25) AND $sequence = True Then ConsoleWrite(@CRLF)
WEnd
If $sequence = True Then ConsoleWrite(@CRLF)
Return $Counter
EndFunc ;==>Hailstone

Output:
27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,91,274,137,412,206,103,
310,155,466,233,700,350,175,526,263,790,395,1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132,
566,283,850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,7288,3644,1822,911,2734,1367,4102,2051,
6154,3077,9232,4616,2308,1154,577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,106,
53,160,80,40,20,10,5,16,8,4,2,1,
Sequence-Lenght: 112
Longest Sequence : 351 from number 77031


=={{header|AWK}}==

#!/usr/bin/awk -f
function hailstone(v, verbose) {
n = 1;
u = v;
while (1) {
if (verbose) printf " "u;
if (u==1) return(n);
n++;
if (u%2 > 0 )
u = 3*u+1;
else
u = u/2;
}
}

BEGIN {
i = 27;
printf("hailstone(%i) has %i elements\n",i,hailstone(i,1));
ix=0;
m=0;
for (i=1; i<100000; i++) {
n = hailstone(i,0);
if (m m=n;
ix=i;
}
}
printf("longest hailstone sequence is %i and has %i elements\n",ix,m);
}

Output:

27 82 41 124 ....... 8 4 2 1
hailstone(27) has 112 elements
longest hailstone sequence is 77031 and has 351 elements


=={{header|BASIC}}==
==={{header|Applesoft BASIC}}===
10 HOME

100 N = 27
110 GOSUB 400"HAILSTONE
120 DEF FN L(I) = E(I + 4 * (I < 0))
130IFL=112AND(S(0)=27ANDS(1)=82ANDS(2)=41ANDS(3)=124)AND(FNL(M-3)=8ANDFNL(M-2)=4ANDFNL(M-1)=2ANDFNL(M)=1)THENPRINT"THE HAILSTONE SEQUENCE FOR THE NUMBER 27 HAS 112 ELEMENTS STARTING WITH 27, 82, 41, 124 AND ENDING WITH 8, 4, 2, 1"
140 PRINT
150 V = PEEK(37) + 1

200 N = 1
210 GOSUB 400"HAILSTONE
220 MN = 1
230 ML = L
240 FOR I = 2 TO 99999
250 N = I
260 GOSUB 400"HAILSTONE
270 IFL>MLTHENMN=I:ML=L:VTABV:HTAB1:PRINT "THE NUMBER " MN " HAS A HAILSTONE SEQUENCE LENGTH OF "L" WHICH IS THE LONGEST HAILSTONE SEQUENCE OF NUMBERS LESS THAN ";:Y=PEEK(37)+1:X=PEEK(36)+1
280 IF Y THEN VTAB Y : HTAB X : PRINTI+1;
290 NEXT I

300 END

400 M = 0
410 FOR L = 1 TO 1E38
420 IF L < 5 THEN S(L-1) = N
430 M = (M + 1) * (M < 3)
440 E(M) = N
450 IF N = 1 THEN RETURN
460 EVEN = INT(N/2)=N/2
470 IF EVEN THEN N=N/2
480 IF NOT EVEN THEN N = (3 * N) + 1
490 NEXT L : STOP


==={{header|BBC BASIC}}===
seqlen% = FNhailstone(27, TRUE)
PRINT '"Sequence length = "; seqlen%
maxlen% = 0
FOR number% = 2 TO 100000
seqlen% = FNhailstone(number%, FALSE)
IF seqlen% > maxlen% THEN
maxlen% = seqlen%
maxnum% = number%
ENDIF
NEXT
PRINT "The number with the longest hailstone sequence is " ; maxnum%
PRINT "Its sequence length is " ; maxlen%
END

DEF FNhailstone(N%, S%)
LOCAL L%
IF S% THEN PRINT N%;
WHILE N% <> 1
IF N% AND 1 THEN N% = 3 * N% + 1 ELSE N% DIV= 2
IF S% THEN PRINT N%;
L% += 1
ENDWHILE
= L% + 1

'''Output:'''

27 82 41 124 62 31 94 47
142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206
103 310 155 466 233 700 350 175
526 263 790 395 1186 593 1780 890
445 1336 668 334 167 502 251 754
377 1132 566 283 850 425 1276 638
319 958 479 1438 719 2158 1079 3238
1619 4858 2429 7288 3644 1822 911 2734
1367 4102 2051 6154 3077 9232 4616 2308
1154 577 1732 866 433 1300 650 325
976 488 244 122 61 184 92 46
23 70 35 106 53 160 80 40
20 10 5 16 8 4 2 1

Sequence length = 112
The number with the longest hailstone sequence is 77031
Its sequence length is 351


==={{header|Liberty BASIC}}===
print "Part 1: Create a routine to generate the hailstone sequence for a number."
print ""
while hailstone < 1 or hailstone <> int(hailstone)
input "Please enter a positive integer: "; hailstone
wend
print ""
print "The following is the 'Hailstone Sequence' for your number..."
print ""
print hailstone
while hailstone <> 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
print hailstone
wend
print ""
input "Hit 'Enter' to continue to part 2...";dummy$
cls
print "Part 2: Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1."
print ""
print "No. in Seq.","Hailstone Sequence Number for 27"
print ""
c = 1: hailstone = 27
print c, hailstone
while hailstone <> 1
c = c + 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
print c, hailstone
wend
print ""
input "Hit 'Enter' to continue to part 3...";dummy$
cls
print "Part 3: Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.(But don't show the actual sequence)!"
print ""
print "Calculating result... Please wait... This could take a little while..."
print ""
print "Percent Done", "Start Number", "Seq. Length", "Maximum Sequence So Far"
print ""
for cc = 1 to 99999
hailstone = cc: c = 1
while hailstone <> 1
c = c + 1
if hailstone / 2 = int(hailstone / 2) then hailstone = hailstone / 2 else hailstone = (3 * hailstone) + 1
wend
if c > max then max = c: largesthailstone = cc
locate 1, 7
print " "
locate 1, 7
print using("###.###", cc / 99999 * 100);"%", cc, c, max
scan
next cc
print ""
print "The number less than 100,000 with the longest 'Hailstone Sequence' is "; largesthailstone;". It's sequence length is "; max;"."
end


==={{header|OxygenBasic}}===


function Hailstone(sys *n)
'=========================
if n and 1
n=n*3+1
else
n=n>>1
end if
end function

function HailstoneSequence(sys n) as sys
'=======================================
count=1
do
Hailstone n
Count++
if n=1 then exit do
end do
return count
end function

'MAIN
'====

maxc=0
maxn=0
e=100000
for n=1 to e
c=HailstoneSequence n
if c>maxc
maxc=c
maxn=n
end if
next

print e ", " maxn ", " maxc

'result 100000, 77031, 351


==={{header|PureBasic}}===
NewList Hailstones.i() ; Make a linked list to use as we do not know the numbers of elements needed for an Array

Procedure.i FillHailstones(n) ; Fills the list & returns the amount of elements in the list
Shared Hailstones() ; Get access to the Hailstones-List
ClearList(Hailstones()) ; Remove old data
Repeat
AddElement(Hailstones()) ; Add an element to the list
Hailstones()=n ; Fill current value in the new list element
If n=1
ProcedureReturn ListSize(Hailstones())
ElseIf n%2=0
n/2
Else
n=(3*n)+1
EndIf
ForEver
EndProcedure

If OpenConsole()
Define i, l, maxl, maxi
l=FillHailstones(27)
Print("#27 has "+Str(l)+" elements and the sequence is: "+#CRLF$)
ForEach Hailstones()
If i=6
Print(#CRLF$)
i=0
EndIf
i+1
Print(RSet(Str(Hailstones()),5))
If Hailstones()<>1
Print(", ")
EndIf
Next

i=1
Repeat
l=FillHailstones(i)
If l>maxl
maxl=l
maxi=i
EndIf
i+1
Until i>=100000
Print(#CRLF$+#CRLF$+"The longest sequence below 100000 is #"+Str(maxi)+", and it has "+Str(maxl)+" elements.")

Print(#CRLF$+#CRLF$+"Press ENTER to exit."): Input()
CloseConsole()
EndIf


'''Output'''
#27 has 112 elements and the sequence is:
27, 82, 41, 124, 62, 31,
94, 47, 142, 71, 214, 107,
322, 161, 484, 242, 121, 364,
182, 91, 274, 137, 412, 206,
103, 310, 155, 466, 233, 700,
350, 175, 526, 263, 790, 395,
1186, 593, 1780, 890, 445, 1336,
668, 334, 167, 502, 251, 754,
377, 1132, 566, 283, 850, 425,
1276, 638, 319, 958, 479, 1438,
719, 2158, 1079, 3238, 1619, 4858,
2429, 7288, 3644, 1822, 911, 2734,
1367, 4102, 2051, 6154, 3077, 9232,
4616, 2308, 1154, 577, 1732, 866,
433, 1300, 650, 325, 976, 488,
244, 122, 61, 184, 92, 46,
23, 70, 35, 106, 53, 160,
80, 40, 20, 10, 5, 16,
8, 4, 2, 1

The longest sequence found up to 100000 is #77031 which has 351 elements.

Press ENTER to exit.

==={{header|Run BASIC}}===
print "Part 1: Create a routine to generate the hailstone sequence for a number."
print ""

while hailstone < 1 or hailstone <> int(hailstone)
input "Please enter a positive integer: "; hailstone
wend
count = doHailstone(hailstone,"Y")

print: print "Part 2: Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1."
count = doHailstone(27,"Y")

print: print "Part 3: Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.(But don't show the actual sequence)!"
print "Calculating result... Please wait... This could take a little while..."
print "Stone Percent Count"
for i = 1 to 99999
count = doHailstone(i,"N")
if count > maxCount then
theBigStone = i
maxCount = count
print using("#####",i);" ";using("###.#", i / 99999 * 100);"% ";using("####",count)
end if
next i
end

'---------------------------------------------
' pass number and print (Y/N)
FUNCTION doHailstone(hailstone,prnt$)
if prnt$ = "Y" then
print
print "The following is the 'Hailstone Sequence' for number:";hailstone
end if
while hailstone <> 1
if (hailstone and 1) then hailstone = (hailstone * 3) + 1 else hailstone = hailstone / 2
doHailstone = doHailstone + 1
if prnt$ = "Y" then
print hailstone;chr$(9);
if (doHailstone mod 10) = 0 then print
end if
wend
END FUNCTION


==={{header|Visual Basic .NET}}===
{{works with|Visual Basic .NET|2005+}}
Module HailstoneSequence
Sub Main()
' Checking sequence of 27.

Dim l As List(Of Long) = HailstoneSequence(27)
Console.WriteLine("27 has {0} elements in sequence:", l.Count())

For i As Integer = 0 To 3 : Console.Write("{0}, ", l(i)) : Next
Console.Write("... ")
For i As Integer = l.Count - 4 To l.Count - 1 : Console.Write(", {0}", l(i)) : Next

Console.WriteLine()

' Finding longest sequence for numbers below 100000.

Dim max As Integer = 0
Dim maxCount As Integer = 0

For i = 1 To 99999
l = HailstoneSequence(i)
If l.Count > maxCount Then
max = i
maxCount = l.Count
End If
Next
Console.WriteLine("Max elements in sequence for number below 100k: {0} with {1} elements.", max, maxCount)
Console.ReadLine()
End Sub

Private Function HailstoneSequence(ByVal n As Long) As List(Of Long)
Dim valList As New List(Of Long)()
valList.Add(n)

Do Until n = 1
n = IIf(n Mod 2 = 0, n / 2, (3 * n) + 1)
valList.Add(n)
Loop

Return valList
End Function

End Module


Output:
27 has 112 elements in sequence:
27, 82, 41, 124, ... , 8, 4, 2, 1
Max elements in sequence for number below 100k: 77031 with 351 elements.


=={{header|Batch File}}==
''1. Create a routine to generate the hailstone sequence for a number. ''
@echo off
setlocal enabledelayedexpansion
if "%1" equ "" goto :eof
call :hailstone %1 seq cnt
echo %seq%
goto :eof

:hailstone
set num=%1
set %2=%1

:loop
if %num% equ 1 goto :eof
call :iseven %num% res
if %res% equ T goto divideby2
set /a num = (3 * num) + 1
set %2=!%2! %num%
goto loop
:divideby2
set /a num = num / 2
set %2=!%2! %num%
goto loop

:iseven
set /a tmp = %1 %% 2
if %tmp% equ 1 (
set %2=F
) else (
set %2=T
)
goto :eof

''Demonstration''
>hailstone.cmd 20
20 10 5 16 8 4 2 1


=={{header|Befunge}}==
{{needs-review|Befunge|Calculates the Hailstone sequence but might not complete everything from task description.}}
&>:.:1-|
>3*^ @
|%2: <
v>2/>+


=={{header|Bracmat}}==
(
( hailstone
= L len
. !arg:?L
& whl
' ( !arg:~1
& (!arg*1/2:~/|3*!arg+1):?arg
& !arg !L:?L
)
& (!L:? [?len&!len.!L)
)
& ( reverse
= L e
. :?L
& whl'(!arg:%?e ?arg&!e !L:?L)
& !L
)
& hailstone$27:(?len.?list)
& reverse$!list:?first4 [4 ? [-5 ?last4
& put$"Hailstone sequence starting with "
& put$!first4
& put$(str$(" has " !len " elements and ends with "))
& put$(!last4 \n)
& 1:?N
& 0:?max:?Nmax
& whl
' ( !N+1:<100000:?N
& hailstone$!N
: ( >!max:?max&!N:?Nmax
| ?
. ?
)
)
& out
$ ( str
$ ( "The number <100000 with the longest hailstone sequence is "
!Nmax
" with "
!max
" elements."
)
)
);


=={{header|Brainf***}}==
{{incomplete}}
Prints the number of terms required to map the input to 1. Does not count the first term of the sequence.
>,[
[
----------[
>>>[>>>>]+[[-]+<[->>>>++>>>>+[>>>>]++[->+<<<<<]]<<<]
++++++[>------<-]>--[>>[->>>>]+>+[<<<<]>-],<
]>
]>>>++>+>>[
<<[>>>>[-]+++++++++<[>-<-]+++++++++>[-[<->-]+[<<<<]]<[>+<-]>]
>[>[>>>>]+[[-]<[+[->>>>]>+<]>[<+>[<<<<]]+<<<<]>>>[->>>>]+>+[<<<<]]
>[[>+>>[<<<<+>>>>-]>]<<<<[-]>[-<<<<]]>>>>>>>
]>>+[[-]++++++>>>>]<<<<[[<++++++++>-]<.[-]<[-]<[-]<]<,
]

27
111


=={{header|Brat}}==
hailstone = { num |
sequence = [num]
while { num != 1 }
{ true? num % 2 == 0
{ num = num / 2 }
{ num = num * 3 + 1 }
sequence << num
}

sequence
}

#Check sequence for 27
seq = hailstone 27
true? (seq[0,3] == [27 82 41 124] && seq[-1, -4] == [8 4 2 1])
{ p "Sequence for 27 is correct" }
{ p "Sequence for 27 is not correct!" }

#Find longest sequence for numbers < 100,000
longest = [number: 0 length: 0]

1.to 99999 { index |
seq = hailstone index
true? seq.length > longest[:length]
{ longest[:length] = seq.length
longest[:number] = index
p "Longest so far: #{index} @ #{longest[:length]} elements"
}

index = index + 1
}

p "Longest was starting from #{longest[:number]} and was of length #{longest[:length]}"

Output:
Sequence for 27 is correct
Longest so far: 1 @ 1 elements
Longest so far: 2 @ 2 elements
Longest so far: 3 @ 8 elements
...
Longest so far: 52527 @ 340 elements
Longest so far: 77031 @ 351 elements
Longest was starting from 77031 and was of length 351


=={{header|Burlesque}}==


blsq ) 27{^^^^2.%{3.*1.+}\/{2./}\/ie}{1!=}w!bx{\/+]}{\/isn!}w!L[
112


=={{header|C}}==
#include
#include

int hailstone(int n, int *arry)
{
int hs = 1;

while (n!=1) {
hs++;
if (arry) *arry++ = n;
n = (n&1) ? (3*n+1) : (n/2);
}
if (arry) *arry++ = n;
return hs;
}

int main()
{
int j, hmax = 0;
int jatmax, n;
int *arry;

for (j=1; j<100000; j++) {
n = hailstone(j, NULL);
if (hmax < n) {
hmax = n;
jatmax = j;
}
}
n = hailstone(27, NULL);
arry = malloc(n*sizeof(int));
n = hailstone(27, arry);

printf("[ %d, %d, %d, %d, ...., %d, %d, %d, %d] len=%d\n",
arry[0],arry[1],arry[2],arry[3],
arry[n-4], arry[n-3], arry[n-2], arry[n-1], n);
printf("Max %d at j= %d\n", hmax, jatmax);
free(arry);

return 0;
}

Output
[ 27, 82, 41, 124, ...., 8, 4, 2, 1] len= 112
Max 351 at j= 77031


===With caching===
Much faster if you want to go over a million or so.
#include

#define N 10000000
#define CS N /* cache size */

typedef unsigned long ulong;
ulong cache[CS] = {0};

ulong hailstone(ulong n)
{
int x;
if (n == 1) return 1;
if (n < CS && cache[n]) return cache[n];

x = 1 + hailstone((n & 1) ? 3 * n + 1 : n / 2);
if (n < CS) cache[n] = x;
return x;
}

int main()
{
int i, l, max = 0, mi;
for (i = 1; i < N; i++) {
if ((l = hailstone(i)) > max) {
max = l;
mi = i;
}
}
printf("max below %d: %d, length %d\n", N, mi, max);
return 0;
}


=={{header|C sharp|C#}}==
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;

namespace Hailstone
{
class Program
{
public static List hs(int n,List seq)
{
List sequence = seq;
sequence.Add(n);
if (n == 1)
{
return sequence;
}else{
int newn = (n % 2 == 0) ? n / 2 : (3 * n) + 1;
return hs(newn, sequence);
}
}

static void Main(string[] args)
{
int n = 27;
List sequence = hs(n,new List());
Console.WriteLine(sequence.Count + " Elements");
List start = sequence.GetRange(0, 4);
List end = sequence.GetRange(sequence.Count - 4, 4);
Console.WriteLine("Starting with : " + string.Join(",", start) + " and ending with : " + string.Join(",", end));
int number = 0, longest = 0;
for (int i = 1; i < 100000; i++)
{
int count = (hs(i, new List())).Count;
if (count > longest)
{
longest = count;
number = i;
}
}
Console.WriteLine("Number < 100000 with longest Hailstone seq.: " + number + " with length of " + longest);
}
}
}


112 Elements
Starting with : 27,82,41,124 and ending with : 8,4,2,1
Number < 100000 with longest Hailstone seq.: 77031 with length of 351


===With caching===
As with the [[#C|C example]], much faster if you want to go over a million or so.
using System;
using System.Collections.Generic;

namespace ConsoleApplication1
{
class Program
{
public static void Main()
{
int longestChain = 0, longestNumber = 0;

var recursiveLengths = new Dictionary();

const int maxNumber = 100000;

for (var i = 1; i <= maxNumber; i++)
{
var chainLength = Hailstone(i, recursiveLengths);
if (longestChain >= chainLength)
continue;

longestChain = chainLength;
longestNumber = i;
}
Console.WriteLine("max below {0}: {1} ({2} steps)", maxNumber, longestNumber, longestChain);
}

private static int Hailstone(int num, Dictionary lengths)
{
if (num == 1)
return 1;

while (true)
{
if (lengths.ContainsKey(num))
return lengths[num];

lengths[num] = 1 + ((num%2 == 0) ? Hailstone(num/2, lengths) : Hailstone((3*num) + 1, lengths));
}
}
}
}


max below 100000: 77031 (351 steps)


=={{header|C++}}==
#include
#include
#include

std::vector hailstone(int i)
{
std::vector v;
while(true){
v.push_back(i);
if (1 == i) break;
i = (i % 2) ? (3 * i + 1) : (i / 2);
}
return v;
}

std::pair find_longest_hailstone_seq(int n)
{
std::pair maxseq(0, 0);
int l;
for(int i = 1; i < n; ++i){
l = hailstone(i).size();
if (l > maxseq.second) maxseq = std::make_pair(i, l);
}
return maxseq;
}

int main () {

// Use the routine to show that the hailstone sequence for the number 27
std::vector h27;
h27 = hailstone(27);
// has 112 elements
int l = h27.size();
std::cout << "length of hailstone(27) is " << l;
// starting with 27, 82, 41, 124 and
std::cout << " first four elements of hailstone(27) are ";
std::cout << h27[0] << " " << h27[1] << " "
<< h27[2] << " " << h27[3] << std::endl;
// ending with 8, 4, 2, 1
std::cout << " last four elements of hailstone(27) are "
<< h27[l-4] << " " << h27[l-3] << " "
<< h27[l-2] << " " << h27[l-1] << std::endl;

std::pair m = find_longest_hailstone_seq(100000);

std::cout << "the longest hailstone sequence under 100,000 is " << m.first
<< " with " << m.second << " elements." <
return 0;
}


output:

length of hailstone(27) is 112 first four elements of hailstone(27) are 27 82 41 124
last four elements of hailstone(27) are 8 4 2 1
the longest hailstone sequence under 100,000 is 77031 with 351 elements.

=={{header|CLIPS}}==
(deftemplate longest
(slot bound) ; upper bound for the range of values to check
(slot next (default 2)) ; next value that needs to be checked
(slot start (default 1)) ; starting value of longest sequence
(slot len (default 1)) ; length of longest sequence
)

(deffacts startup
(query 27)
(longest (bound 100000))
)

(deffunction hailstone-next
(?n)
(if (evenp ?n)
then (div ?n 2)
else (+ (* 3 ?n) 1)
)
)

(defrule extend-sequence
?hail <- (hailstone $?sequence ?tail&:(> ?tail 1))
=>
(retract ?hail)
(assert (hailstone ?sequence ?tail (hailstone-next ?tail)))
)

(defrule start-query
(query ?num)
=>
(assert (hailstone ?num))
)

(defrule result-query
(query ?num)
(hailstone ?num $?sequence 1)
=>
(bind ?sequence (create$ ?num ?sequence 1))
(printout t "Hailstone sequence starting with " ?num ":" crlf)
(bind ?len (length ?sequence))
(printout t " Length: " ?len crlf)
(printout t " First four: " (implode$ (subseq$ ?sequence 1 4)) crlf)
(printout t " Last four: " (implode$ (subseq$ ?sequence (- ?len 3) ?len)) crlf)
(printout t crlf)
)

(defrule longest-create-next-hailstone
(longest (bound ?bound) (next ?next))
(test (<= ?next ?bound))
(not (hailstone ?next $?))
=>
(assert (hailstone ?next))
)

(defrule longest-check-next-hailstone
?longest <- (longest (bound ?bound) (next ?next) (start ?start) (len ?len))
(test (<= ?next ?bound))
?hailstone <- (hailstone ?next $?sequence 1)
=>
(retract ?hailstone)
(bind ?thislen (+ 2 (length ?sequence)))
(if (> ?thislen ?len) then
(modify ?longest (start ?next) (len ?thislen) (next (+ ?next 1)))
else
(modify ?longest (next (+ ?next 1)))
)
)

(defrule longest-finished
(longest (bound ?bound) (next ?next) (start ?start) (len ?len))
(test (> ?next ?bound))
=>
(printout t "The number less than " ?bound " that has the largest hailstone" crlf)
(printout t "sequence is " ?start " with a length of " ?len "." crlf)
(printout t crlf)
)


Output:
The number less than 100000 that has the largest hailstone
sequence is 77031 with a length of 351.

Hailstone sequence starting with 27:
Length: 112
First four: 27 82 41 124
Last four: 8 4 2 1


=={{header|Clojure}}==
(defn hailstone-seq [n]
(:pre [(pos? n)])
(lazy-seq
(cond (= n 1) '(1)
(even? n) (cons n (hailstone-seq (/ n 2)))
:else (cons n (hailstone-seq (+ (* n 3) 1))))))

(def hseq27 (hailstone-seq 27))
(assert (= (count hseq27) 112))
(assert (= (take 4 hseq27) [27 82 41 124]))
(assert (= (drop 108 hseq27) [8 4 2 1]))

(let [{max-i :num, max-len :len}
(reduce #(max-key :len %1 %2)
(for [i (range 1 100000)]
{:num i, :len (count (hailstone-seq i))}))]
(println "Maximum length" max-len "was found for hailstone(" max-i ")."))


=={{header|CoffeeScript}}==
Recursive version:
hailstone = (n) ->
if n is 1
[n]

else if n % 2 is 0
[n].concat hailstone n/2

else
[n].concat hailstone (3*n) + 1

h27 = hailstone 27
console.log "hailstone(27) = #{h27[0..3]} ... #{h27[-4..]} (length: #{h27.length})"

maxlength = 0
maxnums = []

for i in [1..100000]
seq = hailstone i

if seq.length is maxlength
maxnums.push i
else if seq.length > maxlength
maxlength = seq.length
maxnums = [i]

console.log "Max length: #{maxlength}; numbers generating sequences of this length: #{maxnums}"

hailstone(27) = 27,82,41,124 ... 8,4,2,1 (length: 112)
Max length: 351; numbers generating sequences of this length: 77031


=={{header|Common Lisp}}==
(defun hailstone (n)
(cond ((= n 1) '(1))
((evenp n) (cons n (hailstone (/ n 2))))
(t (cons n (hailstone (+ (* 3 n) 1))))))

(defun longest (n)
(let ((k 0) (l 0))
(loop for i from 1 below n do
(let ((len (length (hailstone i))))
(when (> len l) (setq l len k i)))
finally (format t "Longest hailstone sequence under ~A for ~A, having length ~A." n k l))))

Sample session:
ROSETTA> (length (hailstone 27))
112
ROSETTA> (subseq (hailstone 27) 0 4)
(27 82 41 124)
ROSETTA> (last (hailstone 27) 4)
(8 4 2 1)
ROSETTA> (longest-hailstone 100000)
Longest hailstone sequence under 100000 for 77031, having length 351.
NIL


=={{header|D}}==
===Basic Version===
import std.stdio, std.algorithm, std.range, std.typecons;

auto hailstone(uint n) pure nothrow {
auto result = [n];
while (n != 1) {
n = n & 1 ? n*3 + 1 : n/2;
result ~= n;
}
return result;
}

void main() {
enum M = 27;
immutable h = M.hailstone;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);

enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.hailstone.length, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

{{out}}
hailstone(27)= [27, 82, 41, 124] ... [8, 4, 2, 1]
Length hailstone(27)= 112
Longest sequence in [1,100000]= 77031 with len 351

===Faster Lazy Version===
Same output.
import std.stdio, std.algorithm, std.range, std.typecons;

struct Hailstone {
uint n;
bool empty() const pure nothrow { return n == 0; }
uint front() const pure nothrow { return n; }
void popFront() pure nothrow {
n = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
}
}

void main() {
enum M = 27;
immutable h = M.Hailstone.array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);

enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.Hailstone.walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}


===Lazy Version With Caching===
Faster, same output.
import std.stdio, std.algorithm, std.range, std.typecons;

struct Hailstone(size_t cacheSize = 500_000) {
size_t n;
__gshared static size_t[cacheSize] cache;

bool empty() const pure nothrow { return n == 0; }
size_t front() const pure nothrow { return n; }

void popFront() nothrow {
if (n >= cacheSize) {
n = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
} else if (cache[n]) {
n = cache[n];
} else {
immutable n2 = n == 1 ? 0 : (n & 1 ? n*3 + 1 : n/2);
n = cache[n] = n2;
}
}
}

void main() {
enum M = 27;
const h = M.Hailstone!().array;
writeln("hailstone(", M, ")= ", h[0 .. 4], " ... " , h[$ - 4 .. $]);
writeln("Length hailstone(", M, ")= ", h.length);

enum N = 100_000;
immutable p = iota(1, N)
.map!(i => tuple(i.Hailstone!().walkLength, i))
.reduce!max;
writeln("Longest sequence in [1,", N, "]= ",p[1]," with len ",p[0]);
}

=={{header|Déjà Vu}}==
local hailstone:
swap [ over ]
while < 1 dup:
if % over 2:
#odd
++ * 3
else:
#even
/ swap 2
swap push-through rot dup
drop

if = (name) :(main):
local :h27 hailstone 27
!. = 112 len h27
!. = 27 h27! 0
!. = 82 h27! 1
!. = 41 h27! 2
!. = 124 h27! 3
!. = 8 h27! 108
!. = 4 h27! 109
!. = 2 h27! 110
!. = 1 h27! 111

local :max 0
local :maxlen 0
for i range 1 99999:
dup len hailstone i
if < maxlen:
set :maxlen
set :max i
else:
drop
!print( "number: " to-str max ", length: " to-str maxlen )
else:
@hailstone

{{out}}
true
true
true
true
true
true
true
true
true
number: 77031, length: 351


=={{header|Dart}}==
List hailstone(int n) {
if(n<=0) {
throw new IllegalArgumentException("start value must be >=1)");
}
Queue seq=new Queue();
seq.add(n);
while(n!=1) {
n=n%2==0?(n/2).toInt():3*n+1;
seq.add(n);
}
return new List.from(seq);
}

// apparently List is missing toString()
String iterableToString(Iterable seq) {
String str="[";
Iterator i=seq.iterator();
while(i.hasNext()) {
str+=i.next();
if(i.hasNext()) {
str+=",";
}
}
return str+"]";
}

main() {
for(int i=1;i<=10;i++) {
print("h($i)="+iterableToString(hailstone(i)));
}
List h27=hailstone(27);
List first4=h27.getRange(0,4);
print("first 4 elements of h(27): "+iterableToString(first4));
Expect.listEquals([27,82,41,124],first4);

List last4=h27.getRange(h27.length-4,4);
print("last 4 elements of h(27): "+iterableToString(last4));
Expect.listEquals([8,4,2,1],last4);

print("length of sequence h(27): "+h27.length);
Expect.equals(112,h27.length);

int seq,max=0;
for(int i=1;i<=100000;i++) {
List h=hailstone(i);
if(h.length>max) {
max=h.length;
seq=i;
}
}
print("up to 100000 the sequence h($seq) has the largest length ($max)");
}

Output
h(1)=[1]
h(2)=[2,1]
h(3)=[3,10,5,16,8,4,2,1]
h(4)=[4,2,1]
h(5)=[5,16,8,4,2,1]
h(6)=[6,3,10,5,16,8,4,2,1]
h(7)=[7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
h(8)=[8,4,2,1]
h(9)=[9,28,14,7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
h(10)=[10,5,16,8,4,2,1]
first 4 elements of h(27): [27,82,41,124]
last 4 elements of h(27): [8,4,2,1]
length of sequence h(27): 112
up to 100000 the sequence h(77031) has the largest length (351)


=={{header|Dc}}==
Firstly, this code takes the value from the stack, computes and prints the corresponding Hailstone sequence, and the length of the sequence.
The q procedure is for counting the length of the sequence.
The e and o procedure is for even and odd number respectively.
The x procedure is for overall control.
27
[[--: ]nzpq]sq
[d 2/ p]se
[d 3*1+ p]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx

Output

82
41
124
62
(omitted)
8
4
2
1
--: 112


Then we could wrap the procedure x with a new procedure s, and call it with l which is loops the value of t from 1 to 100000, and cleaning up the stack after each time we finish up with a number.
Register L for the length of the longest sequence and T for the corresponding number.
Also, procedure q is slightly modified for storing L and T if needed, and all printouts in procedure e and o are muted.
0dsLsT1st
[dsLltsT]sM
[[zdlL [d 2/]se
[d 3*1+ ]so
[d2% 0=e d1=q d2% 1=o d1=q lxx]dsxx]ss
[lt1+dstlsxc lt100000>l]dslx
lTn[:]nlLp

Output (Takes quite some time on a decent machine)
77031:351


=={{header|Delphi}}==
program ShowHailstoneSequence;

{$APPTYPE CONSOLE}

uses SysUtils, Generics.Collections;

procedure GetHailstoneSequence(aStartingNumber: Integer; aHailstoneList: TList);
var
n: Integer;
begin
aHailstoneList.Clear;
aHailstoneList.Add(aStartingNumber);
n := aStartingNumber;

while n <> 1 do
begin
if Odd(n) then
n := (3 * n) + 1
else
n := n div 2;
aHailstoneList.Add(n);
end;
end;

var
i: Integer;
lList: TList;
lMaxSequence: Integer;
lMaxLength: Integer;
begin
lList := TList.Create;
try
GetHailstoneSequence(27, lList);
Writeln(Format('27: %d elements', [lList.Count]));
Writeln(Format('[%d,%d,%d,%d ... %d,%d,%d,%d]',
[lList[0], lList[1], lList[2], lList[3],
lList[lList.Count - 4], lList[lList.Count - 3], lList[lList.Count - 2], lList[lList.Count - 1]]));
Writeln;

lMaxSequence := 0;
lMaxLength := 0;
for i := 1 to 100000 do
begin
GetHailstoneSequence(i, lList);
if lList.Count > lMaxLength then
begin
lMaxSequence := i;
lMaxLength := lList.Count;
end;
end;
Writeln(Format('Longest sequence under 100,000: %d with %d elements', [lMaxSequence, lMaxLength]));
finally
lList.Free;
end;

Readln;
end.

Output:
27: 112 elements
[27 82 41 124 ... 8 4 2 1]

Longest sequence under 100,000: 77031 with 351 elements


=={{header|Elixir}}==
defmodule Hailstone do
def step(1), do: 0
def step(n) when Integer.even?(n), do: div(n,2)
def step(n) when Integer.odd?(n), do: n*3 + 1
def sequence(n) do
Enum.to_list(Stream.take_while(Stream.iterate(n, &step/1), &(&1 > 0)))
end

def run do
seq27 = Hailstone.sequence(27)
len27 = length(seq27)
repr = String.replace(inspect(seq27, limit: 4), "]",
String.replace(inspect(Enum.drop(seq27,len27-4)), "[", ", "))
IO.puts("Hailstone(27) has #{len27} elements: #{repr}")

{start, len} = Enum.max_by( Enum.map(1..100_000, fn(n) -> {n, length(Hailstone.sequence(n))} end),
fn({_,len}) -> len end )
IO.puts("Longest sequence starting under 100000 begins with #{start} and has #{len} elements.")
end
end

Hailstone.run


{{out}}
Hailstone(27) has 112 elements: [27, 82, 41, 124, ..., 8, 4, 2, 1]
Longest sequence starting under 100000 begins with 77031 and has 351 elements.


=={{header|Erlang}}==
-module(hailstone).
-import(io).
-export([main/0]).

hailstone(1) -> [1];
hailstone(N) when N band 1 == 1 -> [N|hailstone(N * 3 + 1)];
hailstone(N) when N band 1 == 0 -> [N|hailstone(N div 2)].

max_length(Start, Stop) ->
F = fun (N) -> {length(hailstone(N)), N} end,
Lengths = lists:map(F, lists:seq(Start, Stop)),
lists:max(Lengths).

main() ->
io:format("hailstone(4): ~w~n", [hailstone(4)]),
Seq27 = hailstone(27),
io:format("hailstone(27) length: ~B~n", [length(Seq27)]),
io:format("hailstone(27) first 4: ~w~n",
[lists:sublist(Seq27, 4)]),
io:format("hailstone(27) last 4: ~w~n",
[lists:nthtail(length(Seq27) - 4, Seq27)]),
io:format("finding maximum hailstone(N) length for 1 <= N <= 100000..."),
{Length, N} = max_length(1, 100000),
io:format(" done.~nhailstone(~B) length: ~B~n", [N, Length]).

Output:
Eshell V5.8.4  (abort with ^G)
1> c(hailstone).
{ok,hailstone}
2> hailstone:main().
hailstone(4): [4,2,1]
hailstone(27) length: 112
hailstone(27) first 4: [27,82,41,124]
hailstone(27) last 4: [8,4,2,1]
finding maximum hailstone(N) length for 1 <= N <= 100000... done.
hailstone(77031) length: 351
ok


=={{header|Euler Math Toolbox}}==


>function hailstone (n) ...
$ v=[n];
$ repeat
$ if mod(n,2) then n=3*n+1;
$ else n=n/2;
$ endif;
$ v=v|n;
$ until n==1;
$ end;
$ return v;
$ endfunction
>hailstone(27), length(%)
[ 27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242
121 364 182 91 274 137 412 206 103 310 155 466 233 700
350 175 526 263 790 395 1186 593 1780 890 445 1336 668
334 167 502 251 754 377 1132 566 283 850 425 1276 638 319
958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644
1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154
577 1732 866 433 1300 650 325 976 488 244 122 61 184 92
46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1 ]
112
>function hailstonelength (n) ...
$ v=zeros(1,n);
$ v[1]=4; v[2]=2;
$ loop 3 to n;
$ count=1;
$ n=#;
$ repeat
$ if mod(n,2) then n=3*n+1;
$ else n=n/2;
$ endif;
$ if n<=cols(v) and v[n] then
$ v[#]=v[n]+count;
$ break;
$ endif;
$ count=count+1;
$ end;
$ end;
$ return v;
$ endfunction
>h=hailstonelength(100000);
>ex=extrema(h); ex[3], ex[4]
351
77031


=={{header|Euphoria}}==
function hailstone(atom n)
sequence s
s = {n}
while n != 1 do
if remainder(n,2)=0 then
n /= 2
else
n = 3*n + 1
end if
s &= n
end while
return s
end function

function hailstone_count(atom n)
integer count
count = 1
while n != 1 do
if remainder(n,2)=0 then
n /= 2
else
n = 3*n + 1
end if
count += 1
end while
return count
end function

sequence s
s = hailstone(27)
puts(1,"hailstone(27) =\n")
? s
printf(1,"len = %d\n\n",length(s))

integer max,imax,count
max = 0
for i = 2 to 1e5-1 do
count = hailstone_count(i)
if count > max then
max = count
imax = i
end if
end for

printf(1,"The longest hailstone sequence under 100,000 is %d with %d elements.\n",
{imax,max})

Output:
hailstone(27) =
{27,82,41,124,62,31,94,47,142,71,214,107,322,161,484,242,121,364,182,
91,274,137,412,206,103,310,155,466,233,700,350,175,526,263,790,395,
1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132,566,283,
850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,
7288,3644,1822,911,2734,1367,4102,2051,6154,3077,9232,4616,2308,1154,
577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,
106,53,160,80,40,20,10,5,16,8,4,2,1}
len = 112

The longest hailstone sequence under 100,000 is 77031 with 351 elements.


=={{header|Excel}}==
{{needs-review|Excel|Calculates the Hailstone sequence but might not complete everything from task description.}}

In cell '''A1''', place the starting number.
In cell '''A2''' enter this formula '''=IF(MOD(A1,2)=0,A1/2,A1*3+1)'''
Drag and copy the formula down until 4, 2, 1
=={{header|Ezhil}}==
Ezhil is a Tamil programming language, see [http://en.wikipedia.org/wiki/Ezhil_%28programming_language%29 | Wikipedia] entry.


நிரல்பாகம் hailstone ( எண் )
பதிப்பி "=> ",எண் #hailstone seq
@( எண் == 1 ) ஆனால்
பின்கொடு எண்
முடி

@( (எண்%2) == 1 ) ஆனால்
hailstone( 3*எண் + 1)
இல்லை
hailstone( எண்/2 )
முடி
முடி


எண்கள் = [5,17,19,23,37]
@(எண்கள் இல் இவ்வெண்) ஒவ்வொன்றாக
பதிப்பி "****** calculating hailstone seq for ",இவ்வெண்," *********"
hailstone( இவ்வெண் )
பதிப்பி "**********************************************"
முடி


=={{header|Factor}}==
! rosetta/hailstone/hailstone.factor
USING: arrays io kernel math math.ranges prettyprint sequences vectors ;
IN: rosetta.hailstone

: hailstone ( n -- seq )
[ 1vector ] keep
[ dup 1 number= ]
[
dup even? [ 2 / ] [ 3 * 1 + ] if
2dup swap push
] until
drop ;

: main ( -- )
27 hailstone dup dup
"The hailstone sequence from 27:" print
" has length " write length .
" starts with " write 4 head [ unparse ] map ", " join print
" ends with " write 4 tail* [ unparse ] map ", " join print

! Maps n => { length n }, and reduces to longest Hailstone sequence.
1 100000 [a,b)
[ [ hailstone length ] keep 2array ]
[ [ [ first ] bi@ > ] most ] map-reduce
first2
"The hailstone sequence from " write pprint
" has length " write pprint "." print ;
PRIVATE>

MAIN: main

Output:
$ ./factor -run=rosetta.hailstone
Loading resource:work/rosetta/hailstone/hailstone.factor
The hailstone sequence from 27:
has length 112
starts with 27, 82, 41, 124
ends with 8, 4, 2, 1
The hailstone sequence from 77031 has length 351.


=={{header|FALSE}}==
[$1&$[%3*1+0~]?~[2/]?]n:
[[$." "$1>][n;!]#%]s:
[1\[$1>][\1+\n;!]#%]c:
27s;! 27c;!."
"
0m:0f:
1[$100000\>][$c;!$m;>[m:$f:0]?%1+]#%
f;." has hailstone sequence length "m;.


=={{header|Forth}}==
: hail-next ( n -- n )
dup 1 and if 3 * 1+ else 2/ then ;
: .hail ( n -- )
begin dup . dup 1 > while hail-next repeat drop ;
: hail-len ( n -- n )
1 begin over 1 > while swap hail-next swap 1+ repeat nip ;

27 hail-len . cr
27 .hail cr

: longest-hail ( max -- )
0 0 rot 1+ 1 do ( n length )
i hail-len 2dup < if
nip nip i swap
else drop then
loop
swap . ." has hailstone sequence length " . ;

100000 longest-hail


=={{header|Fortran}}==
{{works with|Fortran|95 and later}}
program Hailstone
implicit none

integer :: i, maxn
integer :: maxseqlen = 0, seqlen
integer, allocatable :: seq(:)

call hs(27, seqlen)
allocate(seq(seqlen))
call hs(27, seqlen, seq)
write(*,"(a,i0,a)") "Hailstone sequence for 27 has ", seqlen, " elements"
write(*,"(a,4(i0,a),3(i0,a),i0)") "Sequence = ", seq(1), ", ", seq(2), ", ", seq(3), ", ", seq(4), " ...., ", &
seq(seqlen-3), ", ", seq(seqlen-2), ", ", seq(seqlen-1), ", ", seq(seqlen)

do i = 1, 99999
call hs(i, seqlen)
if (seqlen > maxseqlen) then
maxseqlen = seqlen
maxn = i
end if
end do
write(*,*)
write(*,"(a,i0,a,i0,a)") "Longest sequence under 100000 is for ", maxn, " with ", maxseqlen, " elements"

deallocate(seq)

contains

subroutine hs(number, length, seqArray)
integer, intent(in) :: number
integer, intent(out) :: length
integer, optional, intent(inout) :: seqArray(:)
integer :: n

n = number
length = 1
if(present(seqArray)) seqArray(1) = n
do while(n /= 1)
if(mod(n,2) == 0) then
n = n / 2
else
n = n * 3 + 1
end if
length = length + 1
if(present(seqArray)) seqArray(length) = n
end do
end subroutine

end program

Output:

Hailstone sequence for 27 has 112 elements
Sequence = 27, 82, 41, 124, ...., 8, 4, 2, 1

Longest sequence under 100000 is for 77031 with 351 elements


=={{header|Frege}}==

{{trans|Haskell}}
{{Works with|Frege|3.20.113}}

module Hailstone where

import Data.List (maximumBy)

hailstone :: Int -> [Int]
hailstone 1 = [1]
hailstone n | even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (n * 3 + 1)

withResult :: (t -> t1) -> t -> (t1, t)
withResult f x = (f x, x)

main _ = do
let h27 = hailstone 27
printStrLn $ show $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
printStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
printStrLn $ show $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) (1..100000)


{{out}}


112
hailstone 27: [27, 82, 41, 124] ... [8, 4, 2, 1]
(351, 77031)
runtime 4.374 wallclock seconds.


=={{header|F_Sharp|F#}}==
let rec hailstone n = seq {
match n with
| 1 -> yield 1
| n when n % 2 = 0 -> yield n; yield! hailstone (n / 2)
| n -> yield n; yield! hailstone (n * 3 + 1)
}

let hailstone27 = hailstone 27 |> Array.ofSeq
assert (Array.length hailstone27 = 112)
assert (hailstone27.[..3] = [|27;82;41;124|])
assert (hailstone27.[108..] = [|8;4;2;1|])

let maxLen, maxI = Seq.max <| seq { for i in 1..99999 -> Seq.length (hailstone i), i}
printfn "Maximum length %d was found for hailstone(%d)" maxLen maxI

Output:
Maximum length 351 was found for hailstone(77031)


=={{header|GAP}}==
CollatzSequence := function(n)
local v;
v := [ n ];
while n > 1 do
if IsEvenInt(n) then
n := QuoInt(n, 2);
else
n := 3*n + 1;
fi;
Add(v, n);
od;
return v;
end;

CollatzLength := function(n)
local m;
m := 1;
while n > 1 do
if IsEvenInt(n) then
n := QuoInt(n, 2);
else
n := 3*n + 1;
fi;
m := m + 1;
od;
return m;
end;

CollatzMax := function(a, b)
local n, len, nmax, lmax;
lmax := 0;
for n in [a .. b] do
len := CollatzLength(n);
if len > lmax then
nmax := n;
lmax := len;
fi;
od;
return [ nmax, lmax ];
end;

CollatzSequence(27);
# [ 27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206,
# 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502,
# 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429,
# 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300,
# 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1 ]
CollatzLength(27);
# 112

CollatzMax(1, 100);
# [ 97, 119 ]
CollatzMax(1, 1000);
# [ 871, 179 ]
CollatzMax(1, 10000);
# [ 6171, 262 ]
CollatzMax(1, 100000);
# [ 77031, 351 ]
CollatzMax(1, 1000000);
# [ 837799, 525 ]


=={{header|Go}}==
package main

import "fmt"

// 1st arg is the number to generate the sequence for.
// 2nd arg is a slice to recycle, to reduce garbage.
func hs(n int, recycle []int) []int {
s := append(recycle[:0], n)
for n > 1 {
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
s = append(s, n)
}
return s
}

func main() {
seq := hs(27, nil)
fmt.Printf("hs(27): %d elements: [%d %d %d %d ... %d %d %d %d]\n",
len(seq), seq[0], seq[1], seq[2], seq[3],
seq[len(seq)-4], seq[len(seq)-3], seq[len(seq)-2], seq[len(seq)-1])

var maxN, maxLen int
for n := 1; n < 100000; n++ {
seq = hs(n, seq)
if len(seq) > maxLen {
maxN = n
maxLen = len(seq)
}
}
fmt.Printf("hs(%d): %d elements\n", maxN, maxLen)
}

Output:

hs(27): 112 elements: [27 82 41 124 ... 8 4 2 1]
hs(77031): 351 elements

Alternate solution (inspired both by recent news of a new proof submitted for publication and by recent chat on #rosettacode about generators.)

This solution interprets the wording of the task differently, and takes the word "generate" to mean use a [[generator]]. This has the advantage of not storing the whole sequence in memory at once. Elements are generated one at a time, counted and discarded. A time optimization added for task 3 is to store the sequence lengths computed so far.

Output is the same as version above.
package main

import "fmt"

// Task 1 implemented with a generator. Calling newHg will "create
// a routine to generate the hailstone sequence for a number."
func newHg(n int) func() int {
return func() (n0 int) {
n0 = n
if n&1 == 0 {
n = n / 2
} else {
n = 3*n + 1
}
return
}
}

func main() {
// make generator for sequence starting at 27
hg := newHg(27)
// save first four elements for printing later
s1, s2, s3, s4 := hg(), hg(), hg(), hg()
// load next four elements in variables to use as shift register.
e4, e3, e2, e1 := hg(), hg(), hg(), hg()
// 4+4= 8 that we've generated so far
ec := 8
// until we get to 1, generate another value, shift, and increment.
// note that intermediate elements--those shifted off--are not saved.
for e1 > 1 {
e4, e3, e2, e1 = e3, e2, e1, hg()
ec++
}
// Complete task 2:
fmt.Printf("hs(27): %d elements: [%d %d %d %d ... %d %d %d %d]\n",
ec, s1, s2, s3, s4, e4, e3, e2, e1)

// Task 3: strategy is to not store sequences, but just the length
// of each sequence. as soon as the sequence we're currently working on
// dips into the range that we've already computed, we short-circuit
// to the end by adding the that known length to whatever length
// we've accumulated so far.

var nMaxLen int // variable holds n with max length encounted so far
// slice holds sequence length for each n as it is computed
var computedLen [1e5]int
computedLen[1] = 1
for n := 2; n < 1e5; n++ {
var ele, lSum int
for hg := newHg(n); ; lSum++ {
ele = hg()
// as soon as we get an element in the range we have already
// computed, we're done...
if ele < n {
break
}
}
// just add the sequence length already computed from this point.
lSum += computedLen[ele]
// save the sequence length for this n
computedLen[n] = lSum
// and note if it's the maximum so far
if lSum > computedLen[nMaxLen] {
nMaxLen = n
}
}
fmt.Printf("hs(%d): %d elements\n", nMaxLen, computedLen[nMaxLen])
}


=={{header|Groovy}}==
def hailstone = { long start ->
def sequence = []
while (start != 1) {
sequence << start
start = (start % 2l == 0l) ? start / 2l : 3l * start + 1l
}
sequence << start
}

Test Code
def sequence = hailstone(27)
assert sequence.size() == 112
assert sequence[0..3] == [27, 82, 41, 124]
assert sequence[-4..-1] == [8, 4, 2, 1]

def results = (1..100000).collect { [n:it, size:hailstone(it).size()] }.max { it.size }
println results

Output:
[n:77031, size:351]


=={{header|Haskell}}==
import Data.List (maximumBy)
import Data.Ord (comparing)

hailstone :: Int -> [Int]
hailstone 1 = [1]
hailstone n | even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (n * 3 + 1)

withResult :: (t -> t1) -> t -> (t1, t)
withResult f x = (f x, x)

main :: IO ()
main = do
let h27 = hailstone 27
print $ length h27
let h4 = show $ take 4 h27
let t4 = show $ drop (length h27 - 4) h27
putStrLn ("hailstone 27: " ++ h4 ++ " ... " ++ t4)
print $ maximumBy (comparing fst) $ map (withResult (length . hailstone)) [1..100000]

Output:
112
hailstone 27: [27,82,41,124] ... [8,4,2,1]
(351,77031)


=={{header|HicEst}}==
DIMENSION stones(1000)

H27 = hailstone(27)
ALIAS(stones,1, first4,4)
ALIAS(stones,H27-3, last4,4)
WRITE(ClipBoard, Name) H27, first4, "...", last4

longest_sequence = 0
DO try = 1, 1E5
elements = hailstone(try)
IF(elements >= longest_sequence) THEN
number = try
longest_sequence = elements
WRITE(StatusBar, Name) number, longest_sequence
ENDIF
ENDDO
WRITE(ClipBoard, Name) number, longest_sequence
END

FUNCTION hailstone( n )
USE : stones

stones(1) = n
DO i = 1, LEN(stones)
IF(stones(i) == 1) THEN
hailstone = i
RETURN
ELSEIF( MOD(stones(i),2) ) THEN
stones(i+1) = 3*stones(i) + 1
ELSE
stones(i+1) = stones(i) / 2
ENDIF
ENDDO
END

H27=112; first4(1)=27; first4(2)=82; first4(3)=41; first4(4)=124; ...; last4(1)=8; last4(2)=4; last4(3)=2; last4(4)=1;

number=77031; longest_sequence=351;

=={{header|Icon}} and {{header|Unicon}}==
A simple solution that generates (in the Icon sense) the sequence is:
procedure hailstone(n)
while n > 1 do {
suspend n
n := if n%2 = 0 then n/2 else 3*n+1
}
suspend 1
end

and a test program for this solution is:
procedure main(args)
n := integer(!args) | 27
every writes(" ",hailstone(n))
end

but this solution is computationally expensive when run repeatedly (task 3).

The following solution uses caching to improve performance on task 3 at the expense of space.
procedure hailstone(n)
static cache
initial {
cache := table()
cache[1] := [1]
}
/cache[n] := [n] ||| hailstone(if n%2 = 0 then n/2 else 3*n+1)
return cache[n]
end


A test program is:
procedure main(args)
n := integer(!args) | 27
task2(n)
write()
task3()
end

procedure task2(n)
count := 0
every writes(" ",right(!(sequence := hailstone(n)),5)) do
if (count +:= 1) % 15 = 0 then write()
write()
write(*sequence," value",(*sequence=1,"")|"s"," in the sequence.")
end

procedure task3()
maxHS := 0
every n := 1 to 100000 do {
count := *hailstone(n)
if maxHS <:= count then maxN := n
}
write(maxN," has a sequence of ",maxHS," values")
end

A sample run is:

->hs
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484
242 121 364 182 91 274 137 412 206 103 310 155 466 233 700
350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167
502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438
719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051
6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488
244 122 61 184 92 46 23 70 35 106 53 160 80 40 20
10 5 16 8 4 2 1
112 values in the sequence.

77031 has a sequence of 351 values
->


=={{header|Io}}==
Here is a simple, brute-force approach:

makeItHail := method(n,
stones := list(n)
while (n != 1,
if(n isEven,
n = n / 2,
n = 3 * n + 1
)
stones append(n)
)
)

out := makeItHail(27)
writeln("For the sequence beginning at 27, the number of elements generated is ", out size, ".")
write("The first four elements generated are ")
for(i, 0, 3,
write(out at(i), " ")
)
writeln(".")

write("The last four elements generated are ")
for(i, out size - 4, out size - 1,
write(out at(i), " ")
)
writeln(".")

numOfElems := 0
nn := 3
for(x, 3, 100000,
out = makeItHail(x)
if(out size > numOfElems,
numOfElems = out size
nn = x
)
)

writeln("For numbers less than or equal to 100,000, ", nn,
" has the longest sequence of ", numOfElems, " elements.")


Output:

For the sequence beginning at 27, the number of elements generated is 112.
The first four elements generated are 27 82 41 124 .
The last four elements generated are 8 4 2 1 .
For numbers less than or equal to 100,000, 77031 has the longest sequence of 351 elements.


=={{header|Ioke}}==
{{needs-review|Ioke|Calculates the Hailstone sequence but might not complete everything from task description.}}
collatz = method(n,
n println
unless(n <= 1,
if(n even?, collatz(n / 2), collatz(n * 3 + 1)))
)


=={{header|Inform 7}}==
This solution uses a cache to speed up the length calculation for larger numbers.
{{works with|Glulx virtual machine}}
Home is a room.

To decide which list of numbers is the hailstone sequence for (N - number):
let result be a list of numbers;
add N to result;
while N is not 1:
if N is even, let N be N / 2;
otherwise let N be (3 * N) + 1;
add N to result;
decide on result.

Hailstone length cache relates various numbers to one number.

To decide which number is the hailstone sequence length for (N - number):
let ON be N;
let length so far be 0;
while N is not 1:
if N relates to a number by the hailstone length cache relation:
let result be length so far plus the number to which N relates by the hailstone length cache relation;
now the hailstone length cache relation relates ON to result;
decide on result;
if N is even, let N be N / 2;
otherwise let N be (3 * N) + 1;
increment length so far;
let result be length so far plus 1;
now the hailstone length cache relation relates ON to result;
decide on result.

To say first and last (N - number) entry/entries in (L - list of values of kind K):
let length be the number of entries in L;
if length <= N * 2:
say L;
else:
repeat with M running from 1 to N:
if M > 1, say ", ";
say entry M in L;
say " ... ";
repeat with M running from length - N + 1 to length:
say entry M in L;
if M < length, say ", ".

When play begins:
let H27 be the hailstone sequence for 27;
say "Hailstone sequence for 27 has [number of entries in H27] element[s]: [first and last 4 entries in H27].";
let best length be 0;
let best number be 0;
repeat with N running from 1 to 99999:
let L be the hailstone sequence length for N;
if L > best length:
let best length be L;
let best number be N;
say "The number under 100,000 with the longest hailstone sequence is [best number] with [best length] element[s].";
end the story.


Output:
Hailstone sequence for 27 has 112 elements: 27, 82, 41, 124 ... 8, 4, 2, 1.
The number under 100,000 with the longest hailstone sequence is 77031 with 351 elements.


=={{header|J}}==
'''Solution:'''
hailseq=: -:`(1 3&p.)@.(2&|) ^:(1 ~: ]) ^:a:"0
'''Usage:'''
# hailseq 27 NB. sequence length
112
4 _4 {."0 1 hailseq 27 NB. first & last 4 numbers in sequence
27 82 41 124
8 4 2 1
(>:@(i. >./) , >./) #@hailseq }.i. 1e5 NB. number < 100000 with max seq length & its seq length
77031 351

See also the [[j:Essays/Collatz Conjecture|Collatz Conjecture essay on the J wiki]].

=={{header|Java}}==
{{works with|Java|1.5+}}
import java.util.ArrayList;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

class Hailstone {

public static List getHailstoneSequence(long n) {
if (n <= 0)
throw new IllegalArgumentException("Invalid starting sequence number");
List list = new ArrayList();
list.add(Long.valueOf(n));
while (n != 1) {
if ((n & 1) == 0)
n = n / 2;
else
n = 3 * n + 1;
list.add(Long.valueOf(n));
}
return list;
}

public static void main(String[] args) {
List sequence27 = getHailstoneSequence(27);
System.out.println("Sequence for 27 has " + sequence27.size() + " elements: " + sequence27);

long MAX = 100000;
// Simple way
{
long highestNumber = 1;
int highestCount = 1;
for (long i = 2; i < MAX; i++) {
int count = getHailstoneSequence(i).size();
if (count > highestCount) {
highestCount = count;
highestNumber = i;
}
}
System.out.println("Method 1, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}

// More memory efficient way
{
long highestNumber = 1;
int highestCount = 1;
for (long i = 2; i < MAX; i++) {
int count = 1;
long n = i;
while (n != 1) {
if ((n & 1) == 0)
n = n / 2;
else
n = 3 * n + 1;
count++;
}
if (count > highestCount) {
highestCount = count;
highestNumber = i;
}
}
System.out.println("Method 2, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}

// Efficient for analyzing all sequences
{
long highestNumber = 1;
long highestCount = 1;
Map sequenceMap = new HashMap();
sequenceMap.put(Long.valueOf(1), Integer.valueOf(1));

List currentList = new ArrayList();
for (long i = 2; i < MAX; i++) {
currentList.clear();
Long n = Long.valueOf(i);
Integer count = null;
while ((count = sequenceMap.get(n)) == null) {
currentList.add(n);
long nValue = n.longValue();
if ((nValue & 1) == 0)
n = Long.valueOf(nValue / 2);
else
n = Long.valueOf(3 * nValue + 1);
}
int curCount = count.intValue();
for (int j = currentList.size() - 1; j >= 0; j--)
sequenceMap.put(currentList.get(j), Integer.valueOf(++curCount));
if (curCount > highestCount) {
highestCount = curCount;
highestNumber = i;
}
}
System.out.println("Method 3, number " + highestNumber + " has the longest sequence, with a length of " + highestCount);
}
return;
}
}

Output:
Sequence for 27 has 112 elements: [27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1]
Method 1, number 77031 has the longest sequence, with a length of 351
Method 2, number 77031 has the longest sequence, with a length of 351
Method 3, number 77031 has the longest sequence, with a length of 351


=={{header|JavaScript}}==
function hailstone (n) {
var seq = [n];
while (n > 1) {
n = n % 2 ? 3 * n + 1 : n / 2;
seq.push(n);
}
return seq;
}

// task 2: verify the sequence for n = 27
var h = hailstone(27), hLen = h.length;
print("sequence 27 is (" + h.slice(0, 4).join(", ") + " ... "
+ h.slice(hLen - 4, hLen).join(", ") + "). length: " + hLen);

// task 3: find the longest sequence for n < 100000
for (var n, max = 0, i = 100000; --i;) {
var seq = hailstone(i), sLen = seq.length;
if (sLen > max) {
n = i;
max = sLen;
}
}
print("longest sequence: " + max + " numbers for starting point " + n);

outputs
sequence 27 is (27, 82, 41, 124 ... 8, 4, 2, 1). length: 112
longest sequence: 351 numbers for starting point 77031


=={{header|Julia}}==
function hailstone(n)
seq = [n]
while n>1
n = n % 2 == 0 ? n >> 1 : 3n + 1
push!(seq,n)
end
return seq
end

julia> h = hailstone(27);

julia> @assert length(h) == 112

julia> @assert h[1:4] == [27,82,41,124]

julia> @assert h[end-3:end] == [8,4,2,1]

julia> maximum([(length(hailstone(i)),i) for i in 1:100000])
(351,77031)


=={{header|K}}==
hail: (1<){:[x!2;1+3*x;_ x%2]}\
seqn: hail 27

#seqn
112
4#seqn
27 82 41 124
-4#seqn
8 4 2 1

{m,x@s?m:|/s:{#hail x}'x}{x@&x!2}!:1e5
351 77031


=={{header|Lasso}}==
[
define_tag("hailstone", -required="n", -type="integer", -copy);
local("sequence") = array(#n);
while(#n != 1);
((#n % 2) == 0) ? #n = (#n / 2) | #n = (#n * 3 + 1);
#sequence->insert(#n);
/while;
return(#sequence);
/define_tag;

local("result");
#result = hailstone(27);
while(#result->size > 8);
#result->remove(5);
/while;
#result->insert("...",5);

"Hailstone sequence for n = 27 -> { " + #result->join(", ") + " }";

local("longest_sequence") = 0;
local("longest_index") = 0;
loop(-from=1, -to=100000);
local("length") = hailstone(loop_count)->size;
if(#length > #longest_sequence);
#longest_index = loop_count;
#longest_sequence = #length;
/if;
/loop;

"
";
"Number with the longest sequence under 100,000: " #longest_index + ", with " + #longest_sequence + " elements.";
]


=={{header|Logo}}==
to hail.next :n
output ifelse equal? 0 modulo :n 2 [:n/2] [3*:n + 1]
end

to hail.seq :n
if :n = 1 [output [1]]
output fput :n hail.seq hail.next :n
end

show hail.seq 27
show count hail.seq 27

to max.hail :n
localmake "max.n 0
localmake "max.length 0
repeat :n [if greater? count hail.seq repcount :max.length [
make "max.n repcount
make "max.length count hail.seq repcount
] ]
(print :max.n [has hailstone sequence length] :max.length)
end

max.hail 100000


=={{header|Limbo}}==

implement Hailstone;

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

Hailstone: module {
init: fn(ctxt: ref Draw->Context, args: list of string);
};

init(nil: ref Draw->Context, nil: list of string)
{
sys = load Sys Sys->PATH;

seq := hailstone(big 27);
l := len seq;

sys->print("hailstone(27): ");
for(i := 0; i < 4; i++) {
sys->print("%bd, ", hd seq);
seq = tl seq;
}
sys->print("⋯");

while(len seq > 4)
seq = tl seq;

while(seq != nil) {
sys->print(", %bd", hd seq);
seq = tl seq;
}
sys->print(" (length %d)\n", l);

max := 1;
maxn := big 1;
for(n := big 2; n < big 100000; n++) {
cur := len hailstone(n);
if(cur > max) {
max = cur;
maxn = n;
}
}
sys->print("hailstone(%bd) has length %d\n", maxn, max);
}

hailstone(i: big): list of big
{
if(i == big 1)
return big 1 :: nil;
if(i % big 2 == big 0)
return i :: hailstone(i / big 2);
return i :: hailstone((big 3 * i) + big 1);
}


{{out}}
hailstone(27):  27, 82, 41, 124, ⋯, 8, 4, 2, 1 (length 112)
hailstone(77031) has length 351

=={{header|Logtalk}}==
:- object(hailstone).

:- public(generate_sequence/2).
:- mode(generate_sequence(+natural, -list(natural)), zero_or_one).
:- info(generate_sequence/2, [
comment is 'Generates the Hailstone sequence that starts with its first argument. Fails if the argument is not a natural number.',
argnames is ['Start', 'Sequence']
]).

:- public(write_sequence/1).
:- mode(write_sequence(+natural), zero_or_one).
:- info(write_sequence/1, [
comment is 'Writes to the standard output the Hailstone sequence that starts with its argument. Fails if the argument is not a natural number.',
argnames is ['Start']
]).

:- public(sequence_length/2).
:- mode(sequence_length(+natural, -natural), zero_or_one).
:- info(sequence_length/2, [
comment is 'Calculates the length of the Hailstone sequence that starts with its first argument. Fails if the argument is not a natural number.',
argnames is ['Start', 'Length']
]).

:- public(longest_sequence/4).
:- mode(longest_sequence(+natural, +natural, -natural, -natural), zero_or_one).
:- info(longest_sequence/4, [
comment is 'Calculates the longest Hailstone sequence in the interval [Start, End]. Fails if the interval is not valid.',
argnames is ['Start', 'End', 'N', 'Length']
]).

generate_sequence(Start, Sequence) :-
integer(Start),
Start >= 1,
sequence(Start, Sequence).

sequence(1, [1]) :-
!.
sequence(N, [N| Sequence]) :-
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence(M, Sequence).

write_sequence(Start) :-
integer(Start),
Start >= 1,
sequence(Start).

sequence(1) :-
!,
write(1), nl.
sequence(N) :-
write(N), write(' '),
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence(M).

sequence_length(Start, Length) :-
integer(Start),
Start >= 1,
sequence_length(Start, 1, Length).

sequence_length(1, Length, Length) :-
!.
sequence_length(N, Length0, Length) :-
Length1 is Length0 + 1,
( N mod 2 =:= 0 ->
M is N // 2
; M is (3 * N) + 1
),
sequence_length(M, Length1, Length).

longest_sequence(Start, End, N, Length) :-
integer(Start),
integer(End),
Start >= 1,
Start =< End,
longest_sequence(Start, End, 1, N, 1, Length).

longest_sequence(Current, End, N, N, Length, Length) :-
Current > End,
!.
longest_sequence(Current, End, N0, N, Length0, Length) :-
sequence_length(Current, 1, CurrentLength),
Next is Current + 1,
( CurrentLength > Length0 ->
longest_sequence(Next, End, Current, N, CurrentLength, Length)
; longest_sequence(Next, End, N0, N, Length0, Length)
).

:- end_object.

Testing:
| ?- hailstone::write_sequence(27).
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1
true

| ?- hailstone::sequence_length(27, Length).
Length = 112
true

| ?- hailstone::longest_sequence(1, 100000, N, Length).
N = 77031, Length = 351
true


=={{header|LOLCODE}}==
There is presently no way to query a BUKKIT for the existence of a given key, thus making memoization infeasible. This solution takes advantage of prior knowledge to run in reasonable time.
HAI 1.3

HOW IZ I hailin YR stone
I HAS A sequence ITZ A BUKKIT
sequence HAS A length ITZ 1
sequence HAS A SRS 0 ITZ stone

IM IN YR stoner
BOTH SAEM stone AN 1, O RLY?
YA RLY, FOUND YR sequence
OIC

MOD OF stone AN 2, O RLY?
YA RLY, stone R SUM OF PRODUKT OF stone AN 3 AN 1
NO WAI, stone R QUOSHUNT OF stone AN 2
OIC

sequence HAS A SRS sequence'Z length ITZ stone
sequence'Z length R SUM OF sequence'Z length AN 1
IM OUTTA YR stoner
IF U SAY SO

I HAS A hail27 ITZ I IZ hailin YR 27 MKAY
VISIBLE "hail(27) = "!

IM IN YR first4 UPPIN YR i TIL BOTH SAEM i AN 4
VISIBLE hail27'Z SRS i " "!
IM OUTTA YR first4
VISIBLE "..."!

IM IN YR last4 UPPIN YR i TIL BOTH SAEM i AN 4
VISIBLE " " hail27'Z SRS SUM OF 108 AN i!
IM OUTTA YR last4
VISIBLE ", length = " hail27'Z length

I HAS A max, I HAS A len ITZ 0

BTW, DIS IZ RLY NOT FAST SO WE ONLY CHEK N IN [75000, 80000)
IM IN YR maxer UPPIN YR n TIL BOTH SAEM n AN 5000
I HAS A n ITZ SUM OF n AN 75000
I HAS A seq ITZ I IZ hailin YR n MKAY
BOTH SAEM len AN SMALLR OF len AN seq'Z length, O RLY?
YA RLY, max R n, len R seq'Z length
OIC
IM OUTTA YR maxer

VISIBLE "len(hail(" max ")) = " len

KTHXBYE

{{out}}
hail(27) = 27 82 41 124 ... 8 4 2 1, length = 112
len(hail(77031)) = 351


=={{header|Lua}}==
function hailstone( n, print_numbers )
local n_iter = 1

while n ~= 1 do
if print_numbers then print( n ) end
if n % 2 == 0 then
n = n / 2
else
n = 3 * n + 1
end

n_iter = n_iter + 1
end
if print_numbers then print( n ) end

return n_iter;
end

hailstone( 27, true )

max_i, max_iter = 0, 0
for i = 1, 100000 do
num = hailstone( i, false )
if num >= max_iter then
max_i = i
max_iter = num
end
end

print( string.format( "Needed %d iterations for the number %d.\n", max_iter, max_i ) )


=={{header|Maple}}==
Define the procedure:

hailstone := proc( N )
local n := N, HS := Array([n]);
while n > 1 do
if type(n,even) then
n := n/2;
else
n := 3*n+1;
end if;
HS(numelems(HS)+1) := n;
end do;
HS;
end proc;

Run the command and show the appropriate portion of the result;

> r := hailstone(27):
[ 1..112 1-D Array ]
r := [ Data Type: anything ]
[ Storage: rectangular ]
[ Order: Fortran_order ]
> r(1..4) ... r(-4..);
[27, 82, 41, 124] .. [8, 4, 2, 1]

Compute the first 100000 sequences:

longest := 0; n := 0;
for i from 1 to 100000 do
len := numelems(hailstone(i));
if len > longest then
longest := len;
n := i;
end if;
od:
printf("The longest Hailstone sequence in the first 100k is n=%d, with %d terms\n",n,longest);

Output:

The longest Hailstone sequence in the first 100k is n=77031, with 351 terms


=={{header|Mathematica}}==
Here are three ways to generate the sequence.
=== Fixed-Point formulation ===
HailstoneFP[n_] := Drop[FixedPointList[If[# != 1, Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ], 1] &, n], -1]
=== Recursive formulation using piece-wise function definitions ===
HailstoneR[1] := {1}
HailstoneR[n_Integer] := Prepend[HailstoneR[3 n + 1], n] /; OddQ[n] && n > 0
HailstoneR[n_Integer] := Prepend[HailstoneR[n/2], n] /; EvenQ[n] && n > 0

=== Nested function-call formulation ===
I use this version to do the validation:
Hailstone[n_] :=
NestWhileList[Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ] &, n, # != 1 &];
c27 = Hailstone@27;
Print["Hailstone sequence for n = 27: [", c27[[;; 4]], "...", c27[[-4 ;;]], "]"]
Print["Length Hailstone[27] = ", Length@c27]

longest = -1; comp = 0;
Do[temp = Length@Hailstone@i;
If[comp < temp, comp = temp; longest = i],
{i, 100000}
]
Print["Longest Hailstone sequence at n = ", longest, "\nwith length = ", comp];

Output:

Hailstone sequence for n = 27: [{27,82,41,124}...{8,4,2,1}]
Length Hailstone[27] = 112
Longest Hailstone sequence at n = 77031
with length = 351

I think the fixed-point and the recursive piece-wise function formulations are more idiomatic for Mathematica

=={{header|MATLAB}} / {{header|Octave}}==
function x = hailstone(n)
% iterative definition
global VERBOSE;
x = 1;
while (1)
if VERBOSE,
printf('%i ',n); % print element
end;

if n==1,
return;
elseif mod(n,2),
n = 3*n+1;
else
n = n/2;
end;
x = x + 1;
end;
end;

Show sequence of hailstone(27) and number of elements
global VERBOSE;
VERBOSE = 1; % display of sequence elements turned on
N = hailstone(27); %display sequence
printf('\n\n%i\n',N); %

Output:

>> global VERBOSE; VERBOSE=1; hailstone(27)
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1

112


global VERBOSE;
VERBOSE = 0; % display of sequence elements turned off
N = 100000;
M = zeros(N,1);
for k=1:N,
M(k) = hailstone(k); %display sequence
end;
[maxLength, n] = max(M)

Output:

maxLength = 351
n = 77031


=={{header|Maxima}}==
collatz(n) := block([L], L: [n], while n > 1 do
(n: if evenp(n) then n/2 else 3*n + 1, L: endcons(n, L)), L)$

collatz_length(n) := block([m], m: 1, while n > 1 do
(n: if evenp(n) then n/2 else 3*n + 1, m: m + 1), m)$

collatz_max(n) := block([j, m, p], m: 0,
for i from 1 thru n do
(p: collatz_length(i), if p > m then (m: p, j: i)),
[j, m])$

collatz(27); /* [27, 82, 41, ..., 4, 2, 1] */
length(%); /* 112 */
collatz_length(27); /* 112 */
collatz_max(100000); /* [77031, 351] */


=={{header|Modula-2}}==
MODULE hailst;

IMPORT InOut;

CONST maxCard = MAX (CARDINAL) DIV 3;
TYPE action = (List, Count, Max);
VAR a : CARDINAL;

PROCEDURE HailStone (start : CARDINAL; type : action) : CARDINAL;

VAR n, max, count : CARDINAL;

BEGIN
count := 1;
n := start;
max := n;
LOOP
IF type = List THEN
InOut.WriteCard (n, 12);
IF count MOD 6 = 0 THEN InOut.WriteLn END
END;
IF n = 1 THEN EXIT END;
IF ODD (n) THEN
IF n < maxCard THEN
n := 3 * n + 1;
IF n > max THEN max := n END
ELSE
InOut.WriteString ("Exceeding max value for type CARDINAL at count = ");
InOut.WriteCard (count, 10);
InOut.WriteString (" for intermediate value ");
InOut.WriteCard (n, 10);
InOut.WriteString (". Aborting.");
HALT
END
ELSE
n := n DIV 2
END;
INC (count)
END;
IF type = Max THEN RETURN max ELSE RETURN count END
END HailStone;

PROCEDURE FindMax (num : CARDINAL);

VAR val, maxCount, maxVal, cnt : CARDINAL;

BEGIN
maxCount := 0;
maxVal := 0;
FOR val := 2 TO num DO
cnt := HailStone (val, Count);
IF cnt > maxCount THEN
maxVal := val;
maxCount := cnt
END
END;
InOut.WriteString ("Longest sequence below "); InOut.WriteCard (num, 1);
InOut.WriteString (" is "); InOut.WriteCard (HailStone (maxVal, Count), 1);
InOut.WriteString (" for n = "); InOut.WriteCard (maxVal, 1);
InOut.WriteString (" with an intermediate maximum of ");
InOut.WriteCard (HailStone (maxVal, Max), 1);
InOut.WriteLn
END FindMax;

BEGIN
a := HailStone (27, List);
InOut.WriteLn;
InOut.WriteString ("Iterations total = "); InOut.WriteCard (HailStone (27, Count), 12);
InOut.WriteString (" max value = "); InOut.WriteCard (HailStone (27, Max) , 12);
InOut.WriteLn;
FindMax (100000);
InOut.WriteString ("Done."); InOut.WriteLn
END hailst.

Producing:
jan@Beryllium:~/modula/rosetta$ hailst
27 82 41 124 62 31
94 47 142 71 214 107
322 161 484 242 121 364
182 91 274 137 412 206