$ 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;


func hailstone (n) {
    var sequence = [n]
    while (n > 1) {
        sequence << (
            n.is_even ? n.div!(2)
                      : n.mul!(3).add!(1)
        )
    }
    return(sequence)
}

# The hailstone sequence for the number 27
var arr = hailstone(var nr = 27)
say "#{nr}: #{arr.first(4)} ... #{arr.last(4)} (#{arr.len})"

# The longest hailstone sequence for a number less than 100,000
var h = [0, 0]
for i (1 .. 99_999) {
    (var l = hailstone(i).len) > h[1] && (
        h = [i, l]
    )
}

printf("%d: (%d)\n", h...)


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) ].
  ]
].


func hailstone(var n:Int) -> [Int] {

    var arr = [n]

    while n != 1 {

        if n % 2 == 0 {
            n /= 2
        } else {
            n = (3 * n) + 1
        }

        arr.append(n)
    }

    return arr
}

let n = hailstone(27)

println("hailstone(27): \(n[0...3]) ... \(n[n.count-4...n.count-1]) for a count of \(n.count).")

var longest = (n: 1, len: 1)

for i in 1...100_000 {

    let new = hailstone(i)

    if new.count > longest.len {
        longest = (i, new.count)
    }
}

println("Longest sequence for numbers under 100,000 is with \(longest.n). Which has \(longest.len) items.")


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"


prompt N
N→M: 0→X: 1→L
While L=1
X+1→X
Disp M
If M=1
Then: 0→L
Else
If remainder(M,2)=1
Then: 3*M+1→M
Else: M/2→M
End
End
End
{N,X}


#lang transd

MainModule: {
    hailstone: (λ n Int()
        (with seq Vector<Int>([n])
            (while (> n 1)
                (= n (if (mod n 2) (+ (* 3 n) 1)
                      else (/ n 2)))
                (append seq n)
            )
            (ret seq)
        )
    ),

    _start: (λ
        (with h (hailstone 27) l 0 n 0 t 0
            (lout "Length of (27): " (size h))
            (lout "First 4 of (27): " Range(in: h 0 4))
            (lout "Last 4 of (27): " Range(in: h -4 -0))
        (for i in Range(100000) do
            (= t (size (hailstone (to-Int i)))) (if (> t l) (= l t) (= n i))
        )
        (lout "For n < 100.000 the max. sequence length is " l " for " n)
        )
    )
}


@(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)))


' ------=< MAIN >=------

m = 0
Proc _hailstone_print(27)
Print

For x = 1 To 10000
    n = Func(_hailstone(x))
    If n > m Then
        t = x
        m = n
    EndIf
Next

Print  "The longest sequence is for "; t; ", it has a sequence length of "; m

End

_hailstone_print Param (1)
    ' print the number and sequence

    Local (1)
    [email protected] = 1

    Print "sequence for number "; [email protected]
    Print Using "________"; [email protected];   'starting number

    Do While [email protected] # 1
        If ([email protected] % 2 ) = 1 Then
            [email protected] = [email protected] * 3 + 1   ' n * 3 + 1
        Else
            [email protected] = [email protected] / 2       ' n / 2
        EndIf

        [email protected] = [email protected] + 1
        Print Using "________"; [email protected];

        If ([email protected] % 10) = 0 Then Print
    Loop

    Print : Print
    Print "sequence length = "; [email protected]
    Print

    For [email protected] = 0 To 79
      Print "-";
    Next

    Print
Return

_hailstone Param (1)
    ' normal version
    ' only counts the sequence

    Local (1)
    [email protected] = 1

    Do While [email protected] # 1
        If ([email protected] % 2) = 1 Then
            [email protected] = [email protected] * 3 + 1  ' n * 3 + 1
        Else
            [email protected] = [email protected] / 2      ' divide number by 2
        EndIf

        [email protected] = [email protected] + 1
    Loop

Return ([email protected])


#!/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}"


import "math"

def hailstone (int n)
	decl int<> seq
	while (> n 1)
		append n seq
		if (= (mod n 2) 0)
			set n (floor (/ n 2))
		else
			set n (int (+ (* 3 n) 1))
		end if
	end while
	append n seq
	return seq
end hailstone


#import std
#import nat

hail = @iNC ~&h~=1->x ^C\~& @h ~&h?\~&t successor+ [email protected]

#show+

main =

<
   ^T(@ixX take/$4; %nLP~~lrxPX; ^|TL/~& :/'...',' has length '[email protected]+ %nP+ length) hail 27,
   ^|TL(~&,:/' has sequence length ') %nP~~ nleq$^&r ^(~&,length+ hail)* nrange/1 100000>


Private Function hailstone(ByVal n As Long) As Collection
    Dim s As New Collection
    s.Add CStr(n), CStr(n)
    i = 0
    Do While n <> 1
        If n Mod 2 = 0 Then
            n = n / 2
        Else
            n = 3 * n + 1
        End If
        s.Add CStr(n), CStr(n)
    Loop
    Set hailstone = s
End Function

Private Function hailstone_count(ByVal n As Long)
    Dim count As Long: count = 1
    Do While n <> 1
        If n Mod 2 = 0 Then
            n = n / 2
        Else
            n = 3 * n + 1
        End If
        count = count + 1
    Loop
    hailstone_count = count
End Function

Public Sub rosetta()
    Dim s As Collection, i As Long
    Set s = hailstone(27)
    Dim ls As Integer: ls = s.count
    Debug.Print "hailstone(27) = ";
    For i = 1 To 4
        Debug.Print s(i); ", ";
    Next i
    Debug.Print "... ";
    For i = s.count - 4 To s.count - 1
        Debug.Print s(i); ", ";
    Next i
    Debug.Print s(s.count)
    Debug.Print "length ="; ls
    Dim hmax As Long: hmax = 1
    Dim imax As Long: imax = 1
    Dim count As Integer
    For i = 2 To 100000# - 1
        count = hailstone_count(i)
        If count > hmax Then
            hmax = count
            imax = i
        End If
    Next i
    Debug.Print "The longest hailstone sequence under 100,000 is"; imax; "with"; hmax; "elements."
End Sub


'function arguments: "num" is the number to sequence and "return" is the value to return - "s" for the sequence or
'"e" for the number elements.
Function hailstone_sequence(num,return)
    n = num
	sequence = num
	elements = 1
	Do Until n = 1
		If n Mod 2 = 0 Then
			n = n / 2
		Else
			n = (3 * n) + 1
		End If
		sequence = sequence & " " & n
		elements = elements + 1
	Loop
	Select Case return
		Case "s"
			hailstone_sequence = sequence
		Case "e"
			hailstone_sequence = elements
	End Select
End Function

'test driving.
'show sequence for 27
WScript.StdOut.WriteLine "Sequence for 27: " & hailstone_sequence(27,"s")
WScript.StdOut.WriteLine "Number of Elements: " & hailstone_sequence(27,"e")
WScript.StdOut.WriteBlankLines(1)
'show the number less than 100k with the longest sequence
count = 1
n_elements = 0
n_longest = ""
Do While count < 100000
	current_n_elements = hailstone_sequence(count,"e")
	If current_n_elements > n_elements Then
		n_elements = current_n_elements
		n_longest = "Number: " & count & " Length: " & n_elements
	End If
	count = count + 1
Loop
WScript.StdOut.WriteLine "Number less than 100k with the longest sequence: "
WScript.StdOut.WriteLine n_longest


Option Explicit
Dim flag As Boolean ' true to print values
Sub main()
    Dim longest As Long, n As Long
    Dim i As Long, value As Long
    ' Task 1:
    flag = True
    i = 27
    Debug.Print "The hailstone sequence has length of "; i; " is "; hailstones(i)
    ' Task 2:
    flag = False
    longest = 0
    For i = 1 To 99999
        If longest < hailstones(i) Then
            longest = hailstones(i)
            value = i
        End If
    Next i
    Debug.Print value; " has the longest sequence of "; longest
End Sub 'main
Function hailstones(n As Long) As Long
    Dim m As Long, p As Long
    Dim m1 As Long, m2 As Long, m3 As Long, m4 As Long
    If flag Then Debug.Print "The sequence for"; n; "is: ";
    p = 1
    m = n
    If flag Then Debug.Print m;
    While m > 1
        p = p + 1
        If (m Mod 2) = 0 Then
            m = m / 2
        Else
            m = 3 * m + 1
        End If
        If p <= 4 Then If flag Then Debug.Print m;
        m4 = m3
        m3 = m2
        m2 = m1
        m1 = m
    Wend
    If flag Then
        If p <= 4 Then
            Debug.Print
        ElseIf p = 5 Then
            Debug.Print m1
        ElseIf p = 6 Then
            Debug.Print m2; m1
        ElseIf p = 7 Then
            Debug.Print m3; m2; m1
        ElseIf p = 8 Then
            Debug.Print m4; m3; m2; m1
        Else
            Debug.Print "..."; m4; m3; m2; m1
        End If
    End If
    hailstones = p
End Function 'hailstones


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


// 1st arg is the number to generate the sequence for.
// 2nd arg is a slice to recycle, to reduce garbage.
fn hs(nn int, recycle []int) []int {
    mut n := nn
    mut s := recycle[..0]
    s << n
    for n > 1 {
        if n&1 == 0 {
            n /= 2
        } else {
            n = 3*n + 1
        }
        s << n
    }
    return s
}

fn main() {
    mut seq := hs(27, [])
    println("hs(27): $seq.len elements: [${seq[0]} ${seq[1]} ${seq[2]} ${seq[3]} ... ${seq[seq.len-4]} ${seq[seq.len-3]} ${seq[seq.len-2]} ${seq[seq.len-1]}]")

    mut max_n, mut max_len := 0,0
    for n in 1..100000 {
        seq = hs(n, seq)
        if seq.len > max_len {
            max_n = n
            max_len = seq.len
        }
    }
    println("hs($max_n): $max_len elements")
}


var hailstone = Fn.new { |n|
    if (n < 1) Fiber.abort("Parameter must be a positive integer.")
    var h = [n]
    while (n != 1) {
        n = (n%2 == 0) ? (n/2).floor : 3*n + 1
        h.add(n)
    }
    return h
}

var h = hailstone.call(27)
System.print("For the Hailstone sequence starting with n = 27:")
System.print("   Number of elements  = %(h.count)")
System.print("   First four elements = %(h[0..3])")
System.print("   Final four elements = %(h[-4..-1])")

System.print("\nThe Hailstone sequence for n < 100,000 with the longest length is:")
var longest = 0
var longlen = 0
for (n in 1..99999) {
    var h = hailstone.call(n)
    var c = h.count
    if (c > longlen) {
        longest = n
        longlen = c
    }
}
System.print("   Longest = %(longest)")
System.print("   Length  = %(longlen)")


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);
]


;;;;;;;;;;;;;;;;;;; HEADER   ;;;;;;;;;;;;;;;;;;;
read "\SrcCPC\winape_macros.asm"
read "\SrcCPC\MemoryMap.asm"
read "\SrcALL\winapeBuildCompat.asm"
;;;;;;;;;;;;;;;;;;; PROGRAM  ;;;;;;;;;;;;;;;;;;;

org &8000
ld de,27
call doHailstone
;returns length of sequence, and writes each entry in the sequence
;	to RAM

;print the sequence length (in hex)
ld a,h
call ShowHex
ld a,l
ld (memdump_smc),a
;just to prove I didn't need to know the sequence length at
;	compile time, I'll store the calculated length as the operand
;	of "doMemDump" which normally takes a constant embedded after
;	it as the number of bytes to display.

;      If that doesn't make sense, don't worry.
;      This has nothing to do with calculating the hailstone sequence, just showing the results.
call ShowHex

call NewLine		;prints CRLF
call NewLine

call doMemDump
memdump_smc:
byte 0			;operand of "doMemDump" (gets overwritten with the sequence length)
word HailstoneBuffer	;operand of "doMemDump"

ret

;;;;;;;;;;;;;;;;;;; LIBRARY  ;;;;;;;;;;;;;;;;;;;
read "\SrcCPC\winape_stringop.asm"
read "\SrcCPC\winape_showhex.asm"

doHailstone:
;you need the proper input for the function "hailstone"
;returns addr. of last element in IX.
call hailstone
ld de,HailstoneBuffer
or a	;clear carry
push ix
pop hl		;returns element count in HL.
sbc hl,de	;subtract the two to get the length of the array.

SRL H
RR L		;divide array size by 2, since each entry is 2 bytes.
INC L
ret nz		;if no carry, don't increment H.
INC H
ret

hailstone:
;input - de = n
ld ix,HailstoneBuffer
ld a,d
or e
ret z	;zero is not allowed.
loop_hailstone:
ld (IX+0),e
ld (IX+1),d
ld a,e
cp 1
jr nz,continue_hailstone
ld a,d
or a
ret z	;if de = 1, stop.
continue_hailstone:
bit 0,e
jr z,DE_IS_EVEN
;de is odd
push de
pop hl		;ld hl,de

SLA E
RL D
add hl,de	;hl = de*3

ld de,1
add hl,de

push hl
pop de		;ld de,hl

inc ix
inc ix
jr loop_hailstone

DE_IS_EVEN:
SRL D		;A/2
RR E
inc ix
inc ix
jr loop_hailstone

doMemDump:
;show the hailstone sequence to the screen. This is just needed to display the data, if you don't care about that
;you can stop reading here.
pop hl		;get PC
ld b,(hl)	;get byte count
inc hl
ld e,(hl)	;get low byte of start addr.
inc hl
ld d,(hl)	;get high byte of start addr.
inc hl
push hl		;now when we return we'll skip the data block.
ex de,hl

call NewLine

;we'll dump 8 words per line.

ld c,8
loop_doMemDump:
inc hl
ld a,(hl)
call ShowHex
dec hl
ld a,(hl)
call ShowHex
ld a,' '
call PrintChar
inc hl
inc hl
dec c
ld a,c
and %00001111
jr nz,continueMemdump
ld c,8
continueMemdump:
djnz loop_doMemDump
ret

HailstoneBuffer:
ds 512,0


fcn collatz(n,z=L()){ z.append(n); if(n==1) return(z);
   if(n.isEven) return(self.fcn(n/2,z)); return(self.fcn(n*3+1,z)) }


10 LET n=27: LET s=1
20 GO SUB 1000
30 PRINT '"Sequence length = ";seqlen
40 LET maxlen=0: LET s=0
50 FOR m=2 TO 100000
60 LET n=m
70 GO SUB 1000
80 IF seqlen>maxlen THEN LET maxlen=seqlen: LET maxnum=m
90 NEXT m
100 PRINT "The number with the longest hailstone sequence is ";maxnum
110 PRINT "Its sequence length is ";maxlen
120 STOP
1000 REM Hailstone
1010 LET l=0
1020 IF s THEN PRINT n;"  ";
1030 IF n=1 THEN LET seqlen=l+1: RETURN
1040 IF FN m(n,2)=0 THEN LET n=INT (n/2): GO TO 1060
1050 LET n=3*n+1
1060 LET l=l+1
1070 GO TO 1020
2000 DEF FN m(a,b)=a-INT (a/b)*b


*        Hamming numbers           12/03/2017
HAM      CSECT
         USING  HAM,R13            base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1               ii=1
       DO WHILE=(C,R6,LE,=F'20')   do ii=1 to 20
         BAL    R14,PRTHAM           call prtham
         LA     R6,1(R6)             ii++
       ENDDO    ,                  enddo ii
         LA     R6,1691            ii=1691
         BAL    R14,PRTHAM         call prtham
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
PRTHAM   EQU    *             ---- prtham
         ST     R14,R14PRT         save return addr
         LR     R1,R6              ii
         XDECO  R1,XDEC            edit
         MVC    PG+2(4),XDEC+8     output ii
         LR     R1,R6              ii
         BAL    R14,HAMMING        call hamming(ii)
         XDECO  R0,XDEC            edit
         MVC    PG+8(10),XDEC+2    output hamming(ii)
         XPRNT  PG,L'PG            print buffer
         L      R14,R14PRT         restore return addr
         BR     R14           ---- return
HAMMING  EQU    *             ---- hamming(ll)
         ST     R14,R14HAM         save return addr
         ST     R1,LL              ll
         MVC    HH,=F'1'           h(1)=1
         SR     R0,R0              0
         ST     R0,I               i=0
         ST     R0,J               j=0
         ST     R0,K               k=0
         MVC    X2,=F'2'           x2=2
         MVC    X3,=F'3'           x3=3
         MVC    X5,=F'5'           x5=5
         LA     R7,1               n=1
         L      R2,LL              ll
         BCTR   R2,0               -1
         ST     R2,LLM1            ll-1
       DO WHILE=(C,R7,LE,LLM1)     do n=1 to ll-1
         L      R4,X2                m=x2
       IF C,R4,GT,X3 THEN            if m>x3 then
         L      R4,X3                  m=x3
       ENDIF    ,                    endif
       IF C,R4,GT,X5 THEN            if m>x5 then
         L      R4,X5                  m=x5
       ENDIF    ,                    endif
         LR     R1,R7                n
         SLA    R1,2                 *4
         ST     R4,HH(R1)            h(n+1)=m
       IF C,R4,EQ,X2 THEN            if m=x2 then
         L      R1,I                   i
         LA     R1,1(R1)               i+1
         ST     R1,I                   i=i+1
         SLA    R1,2                   *4
         L      R2,HH(R1)              h(i+1)
         MH     R2,=H'2'               *2
         ST     R2,X2                  x2=2*h(i+1)
       ENDIF    ,                    endif
       IF C,R4,EQ,X3 THEN            if m=x3 then
         L      R1,J                   j
         LA     R1,1(R1)               j+1
         ST     R1,J                   j=j+1
         SLA    R1,2                   *4
         L      R2,HH(R1)              h(j+1)
         MH     R2,=H'3'               *3
         ST     R2,X3                  x3=3*h(j+1)
       ENDIF    ,                    endif
       IF C,R4,EQ,X5 THEN            if m=x5 then
         L      R1,K                   k
         LA     R1,1(R1)               k+1
         ST     R1,K                   k=k+1
         SLA    R1,2                   *4
         L      R2,HH(R1)              h(k+1)
         MH     R2,=H'5'               *5
         ST     R2,X5                  x5=5*h(k+1)
       ENDIF    ,                    endif
         LA     R7,1(R7)             n++
       ENDDO    ,                  enddo n
         L      R1,LL              ll
         SLA    R1,2               *4
         L      R0,HH-4(R1)        return h(ll)
         L      R14,R14HAM         restore return addr
         BR     R14           ---- return
R14HAM   DS     A                  return addr of hamming
R14PRT   DS     A                  return addr of print
LL       DS     F                  ll
LLM1     DS     F                  ll-1
I        DS     F                  i
J        DS     F                  j
K        DS     F                  k
X2       DS     F                  x2
X3       DS     F                  x3
X5       DS     F                  x5
PG       DC     CL80'H(xxxx)=xxxxxxxxxx'
XDEC     DS     CL12               temp
         LTORG                     positioning literal pool
HH       DS     1691F              array h(1691)
         YREGS
         END    HAM


with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO; use Ada.Text_IO;
with GNATCOLL.GMP.Integers;
with GNATCOLL.GMP.Lib;

procedure Hamming is

   type Log_Type is new Long_Long_Float;
   package Funcs is new Ada.Numerics.Generic_Elementary_Functions (Log_Type);

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

   generic
      Factors : Factors_Array := (2, 3, 5);
      --  The factors for smooth numbers. Hamming numbers are 5-smooth.
   package Smooth_Numbers is
      type Number is private;
      function Compute (Nth : Positive) return Number;
      function Image (N : Number) return String;

   private
      type Exponent_Type is new Natural;
      type Exponents_Array is array (Factors'Range) of Exponent_Type;
      --  Numbers are stored as the exponents of the prime factors.

      type Number is record
         Exponents : Exponents_Array;
         Log       : Log_Type;
         --  The log of the value, used to ease sorting.
      end record;

      function "=" (N1, N2 : Number) return Boolean
        is (for all F in Factors'Range => N1.Exponents (F) = N2.Exponents (F));
   end Smooth_Numbers;

   package body Smooth_Numbers is
      One : constant Number := (Exponents => (others => 0), Log => 0.0);
      Factors_Log : array (Factors'Range) of Log_Type;

      function Image (N : Number) return String is
         use GNATCOLL.GMP.Integers, GNATCOLL.GMP.Lib;
         R, Tmp : Big_Integer;
      begin
         Set (R, "1");
         for F in Factors'Range loop
            Set (Tmp, Factors (F)'Image);
            Raise_To_N (Tmp, GNATCOLL.GMP.Unsigned_Long (N.Exponents (F)));
            Multiply (R, Tmp);
         end loop;
         return Image (R);
      end Image;

      function Compute (Nth : Positive) return Number is
         Candidates : array (Factors'Range) of Number;

         Values     : array (1 .. Nth) of Number;
         --  Will result in Storage_Error for very large values of Nth

         Indices    : array (Factors'Range) of Natural :=
            (others => Values'First);
         Current    : Number;
         Tmp        : Number;
      begin
         for F in Factors'Range loop
            Factors_Log (F) := Funcs.Log (Log_Type (Factors (F)));
            Candidates (F) := One;
            Candidates (F).Exponents (F) := 1;
            Candidates (F).Log := Factors_Log (F);
         end loop;

         Values (1) := One;

         for Count in 2 .. Nth loop
            --  Find next value (the lowest of the candidates)
            Current := Candidates (Factors'First);
            for F in Factors'First + 1 .. Factors'Last loop
               if Candidates (F).Log < Current.Log then
                  Current := Candidates (F);
               end if;
            end loop;

            Values (Count) := Current;

            --  Update the candidates. There might be several candidates with
            --  the same value
            for F in Factors'Range loop
               if Candidates (F) = Current then
                  Indices (F) := Indices (F) + 1;

                  Tmp := Values (Indices (F));
                  Tmp.Exponents (F) := Tmp.Exponents (F) + 1;
                  Tmp.Log := Tmp.Log + Factors_Log (F);

                  Candidates (F) := Tmp;
               end if;
            end loop;
         end loop;

         return Values (Nth);
      end Compute;
   end Smooth_Numbers;

   package Hamming is new Smooth_Numbers ((2, 3, 5));

begin
   for N in 1 .. 20 loop
      Put (" " & Hamming.Image (Hamming.Compute (N)));
   end loop;
   New_Line;

   Put_Line (Hamming.Image (Hamming.Compute (1691)));
   Put_Line (Hamming.Image (Hamming.Compute (1_000_000)));
end Hamming;


PR precision=100 PR

MODE SERIES = FLEX [1 : 0] UNT, # Initially, no elements #
     UNT = LONG LONG INT; # A 100-digit unsigned integer #

PROC hamming number = (INT n) UNT: # The n-th Hamming number #
     CASE n
     IN 1, 2, 3, 4, 5, 6, 8, 9, 10, 12 # First 10 in a table #
     OUT # Additional operators #
         OP MIN = (INT i, j) INT: (i < j | i | j), MIN = (UNT i, j) UNT: (i < j | i | j);
         PRIO MIN = 9;
         OP LAST = (SERIES h) UNT: h[UPB h]; # Last element of a series #
         OP +:= = (REF SERIES s, UNT elem) VOID:
            # Extend a series by one element, only keep the elements you need #
            (INT lwb = (i MIN j) MIN k, upb = UPB s;
             REF SERIES new s = HEAP FLEX [lwb : upb + 1] UNT;
             (new s[lwb : upb] := s[lwb : upb], new s[upb + 1] := elem);
             s := new s
            );
         # Determine the n-th hamming number iteratively #
         SERIES h := 1, # Series, initially one element #
         UNT m2 := 2, m3 := 3, m5 := 5, # Multipliers #
         INT i := 1, j := 1, k := 1; # Counters #
         TO n - 1
         DO h +:= (m2 MIN m3) MIN m5;
            (LAST h = m2 | m2 := 2 * h[i +:= 1]);
            (LAST h = m3 | m3 := 3 * h[j +:= 1]);
            (LAST h = m5 | m5 := 5 * h[k +:= 1])
         OD;
         LAST h
     ESAC;

FOR k TO 20
DO print ((whole (hamming number (k), 0), blank))
OD;
print ((newline, whole (hamming number (1 691), 0)));
print ((newline, whole (hamming number (1 000 000), 0)))


begin
    % returns the minimum of a and b                    %
    integer procedure min ( integer value a, b ) ; if a < b then a else b;
    % find and print Hamming Numbers                        %
    % Algol W only supports 32-bit integers so we just find %
    % the 1691 32-bit Hamming Numbers                       %
    integer MAX_HAMMING;
    MAX_HAMMING := 1691;
    begin
        integer array H( 1 :: MAX_HAMMING );
        integer p2, p3, p5, last2, last3, last5;
        H( 1 ) := 1;
        last2  := last3 := last5 := 1;
        p2     := 2;
        p3     := 3;
        p5     := 5;
        for hPos := 2 until MAX_HAMMING do begin
            integer m;
            % the next Hamming number is the lowest of the next multiple of 2, 3, and 5 %
            m := min( min( p2, p3 ), p5 );
            H( hPos ) := m;
            if m = p2 then begin
                last2 := last2 + 1;
                p2    := 2 * H( last2 )
            end if_used_power_of_2 ;
            if m = p3 then begin
                last3 := last3 + 1;
                p3    := 3 * H( last3 )
            end if_used_power_of_3 ;
            if m = p5 then begin
                last5 := last5 + 1;
                p5    := 5 * H( last5 )
            end if_used_power_of_5 ;
        end for_hPos ;
        i_w := 1;
        s_w := 1;
        write( H( 1 ) );
        for i := 2 until 20 do writeon( H( i ) );
        write( H( MAX_HAMMING ) )
    end
end.


hamming: function [limit][
    if limit=1 -> return 1
    h: map 0..limit-1 'z -> 1
    x2: 2, x3: 3, x5: 5
    i: 0, j: 0, k: 0

    loop 1..limit-1 'n [
        set h n min @[x2 x3 x5]
        if x2 = h\[n] [
            i: i + 1
            x2: 2 * h\[i]
        ]
        if x3 = h\[n] [
            j: j + 1
            x3: 3 * h\[j]
        ]
        if x5 = h\[n] [
            k: k + 1
            x5: 5 * h\[k]
        ]
    ]
    last h
]
print map 1..20 => hamming
print hamming 1691
print hamming 1000000


//
// How to compile:
// patscc -DATS_MEMALLOC_LIBC -o hamming hamming.dats
//
#include
"share/atspre_staload.hats"

fun
min3
(
  A: arrayref(int, 3)
) : natLt(3) = i where
{
  var x: int = A[0]
  var i: natLt(3) = 0
  val () = if A[1] < x then (x := A[1]; i := 1)
  val () = if A[2] < x then (x := A[2]; i := 2)
} (* end of [min3] *)

fun
hamming
{n:pos}
(
  n: int(n)
) : int = let
//
var A = @[int](2, 3, 5)
val A = $UNSAFE.cast{arrayref(int, 3)}([email protected])
var I = @[int](1, 1, 1)
val I = $UNSAFE.cast{arrayref(int, 3)}([email protected])
val H = arrayref_make_elt<int> (i2sz(succ(n)), 0)
val () = H[0] := 1
//
fun
loop{k:pos}
  (k: int(k)) : void =
(
//
if
k < n
then let
  val i = min3(A)
  val k =
  (
    if A[i] > H[k-1] then (H[k] := A[i]; k+1) else k
  ) : intBtwe(k, k+1)
  val ii = I[i]
  val () = I[i] := ii+1
  val ii = $UNSAFE.cast{natLte(n)}(ii)
  val () = if i = 0 then A[i] := 2*H[ii]
  val () = if i = 1 then A[i] := 3*H[ii]
  val () = if i = 2 then A[i] := 5*H[ii]
in
  loop(k)
end // end of [then]
else () // end of [else]
//
) (* end of [loop] *)
//
in
  loop (1); H[n-1]
end (* end of [hamming] *)

implement
main0 () =
{
val () =
loop(1) where
{
fun
loop
{n:pos}
(
  n: int(n)
) : void =
if
n <= 20
then let
  val () =
  println! ("hamming(",n,") = ", hamming(n))
in
  loop(n+1)
end // end of [then]
// end of [if]
} (* end of [val] *)
val n = 1691
val () = println! ("hamming(",n,") = ", hamming(n))
//
} (* end of [main0] *)


SetBatchLines, -1
Msgbox % hamming(1,20)
Msgbox % hamming(1690)
return

hamming(first,last=0)
{
	if (first < 1)
		ans=ERROR

	if (last = 0)
		last := first

	i:=0, j:=0, k:=0

	num1 := ceil((last * 20)**(1/3))
	num2 := ceil(num1 * ln(2)/ln(3))
	num3 := ceil(num1 * ln(2)/ln(5))

	loop
	{
		H := (2**i) * (3**j) * (5**k)
		if (H > 0)
			ans = %H%`n%ans%
		i++
		if (i > num1)
		{
			i=0
			j++
			if (j > num2)
			{
				j=0
				k++
			}
		}
		if (k > num3)
			break
	}
	Sort ans, N

	Loop, parse, ans, `n, `r
	{
		if (A_index > last)
			break
		if (A_index < first)
			continue
		Output = %Output%`n%A_LoopField%
	}

	return Output
}


# syntax: gawk -M -f hamming_numbers.awk
BEGIN {
    for (i=1; i<=20; i++) {
      printf("%d ",hamming(i))
    }
    printf("\n1691: %d\n",hamming(1691))
    printf("\n1000000: %d\n",hamming(1000000))
    exit(0)
}
function hamming(limit,  h,i,j,k,n,x2,x3,x5) {
    h[0] = 1
    x2 = 2
    x3 = 3
    x5 = 5
    for (n=1; n<=limit; n++) {
      h[n] = min(x2,min(x3,x5))
      if (h[n] == x2) { x2 = 2 * h[++i] }
      if (h[n] == x3) { x3 = 3 * h[++j] }
      if (h[n] == x5) { x5 = 5 * h[++k] }
    }
    return(h[limit-1])
}
function min(x,y) {
    return((x < y) ? x : y)
}


print "The first 20 Hamming numbers are :"
for i = 1 to 20
    print Hamming(i);" ";
next i

print
print "H( 1691) = "; Hamming(1691)
end

function min(a, b)
    if a < b then return a else return b
end function

function Hamming(limit)
    dim h(1000000)

    h[0] = 1
    x2 = 2 : x3 = 3 : x5 = 5
    i  = 0 : j  = 0 : k  = 0
    for n = 1 to limit
        h[n]  = min(x2, min(x3, x5))
        if x2 = h[n] then i += 1: x2 = 2 *h[i]
        if x3 = h[n] then j += 1: x3 = 3 *h[j]
        if x5 = h[n] then k += 1: x5 = 5 *h[k]
    next n
    return h[limit -1]
end function


cat hamming_numbers.bc
define min(x,y) {
 if (x < y) {
	return x
 } else {
	return y
 }
}
define hamming(limit) {
 i = 0
 j = 0
 k = 0
 h[0] = 1
 x2 = 2
 x3 = 3
 x5 = 5
 for (n=1; n<=limit; n++) {
  h[n] = min(x2,min(x3,x5))
  if (h[n] == x2) { x2 = 2 * h[++i] }
  if (h[n] == x3) { x3 = 3 * h[++j] }
  if (h[n] == x5) { x5 = 5 * h[++k] }
 }
 return (h[limit-1])
}
for (lab=1; lab<=20; lab++) {
 hamming(lab)
}
hamming(1691)
hamming(1000000)
quit


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

typedef unsigned long long ham;

size_t alloc = 0, n = 1;
ham *q = 0;

void qpush(ham h)
{
	int i, j;
	if (alloc <= n) {
		alloc = alloc ? alloc * 2 : 16;
		q = realloc(q, sizeof(ham) * alloc);
	}

	for (i = n++; (j = i/2) && q[j] > h; q[i] = q[j], i = j);
	q[i] = h;
}

ham qpop()
{
	int i, j;
	ham r, t;
	/* outer loop for skipping duplicates */
	for (r = q[1]; n > 1 && r == q[1]; q[i] = t) {
		/* inner loop is the normal down heap routine */
		for (i = 1, t = q[--n]; (j = i * 2) < n;) {
			if (j + 1 < n && q[j] > q[j+1]) j++;
			if (t <= q[j]) break;
			q[i] = q[j], i = j;
		}
	}

	return r;
}

int main()
{
	int i;
	ham h;

	for (qpush(i = 1); i <= 1691; i++) {
		/* takes smallest value, and queue its multiples */
		h = qpop();
		qpush(h * 2);
		qpush(h * 3);
		qpush(h * 5);

		if (i <= 20 || i == 1691)
			printf("%6d: %llu\n", i, h);
	}

	/* free(q); */
	return 0;
}


using System;
using System.Numerics;
using System.Linq;

namespace Hamming {

    class MainClass {

        public static BigInteger Hamming(int n) {
            BigInteger two = 2, three = 3, five = 5;
            var h = new BigInteger[n];
            h[0] = 1;
            BigInteger x2 = 2, x3 = 3, x5 = 5;
            int i = 0, j = 0, k = 0;

            for (int index = 1; index < n; index++) {
                h[index] = BigInteger.Min(x2, BigInteger.Min(x3, x5));
                if (h[index] == x2) x2 = two * h[++i];
                if (h[index] == x3) x3 = three * h[++j];
                if (h[index] == x5) x5 = five * h[++k];
            }
            return h[n - 1];
        }

        public static void Main(string[] args) {
            Console.WriteLine(string.Join(" ", Enumerable.Range(1, 20).ToList().Select(x => Hamming(x))));
            Console.WriteLine(Hamming(1691));
            Console.WriteLine(Hamming(1000000));
        }
    }
}


#include <iostream>
#include <vector>
// Hamming like sequences Generator
//
// Nigel Galloway. August 13th., 2012
//
class Ham {
private:
	std::vector<unsigned int> _H, _hp, _hv, _x;
public:
	bool operator!=(const Ham& other) const {return true;}
	Ham begin() const {return *this;}
        Ham end() const {return *this;}
	unsigned int operator*() const {return _x.back();}
	Ham(const std::vector<unsigned int> &pfs):_H(pfs),_hp(pfs.size(),0),_hv({pfs}),_x({1}){}
	const Ham& operator++() {
	  for (int i=0; i<_H.size(); i++) for (;_hv[i]<=_x.back();_hv[i]=_x[++_hp[i]]*_H[i]);
	  _x.push_back(_hv[0]);
	  for (int i=1; i<_H.size(); i++) if (_hv[i]<_x.back()) _x.back()=_hv[i];
	  return *this;
	}
};


use BigInteger; use Time;

// Chapel doesn't have closure functions that can capture variables from
// outside scope, so we use a class to emulate them for this special case;
// the member fields mult, mrglst, and mltlst, emulate "captured" variables
// that would normally be captured by the `next` continuation closure...
class HammingsList {
    const head: bigint;
    const mult: uint(8);
    var mrglst: shared HammingsList?;
    var mltlst: shared HammingsList?;
    var tail: shared HammingsList? = nil;
    proc init(hd: bigint, mlt: uint(8), mrgl: shared HammingsList?,
                                        mltl: shared HammingsList?) {
        head = hd; mult = mlt; mrglst = mrgl; mltlst = mltl; }
    proc next(): shared HammingsList {
        if tail != nil then return tail: shared HammingsList;
        const nhd: bigint = mltlst!.head * mult;
        if mrglst == nil then {
            tail = new shared HammingsList(nhd, mult,
                                           nil: shared HammingsList?,
                                           nil: shared HammingsList?);
            mltlst = mltlst!.next();
            tail!.mltlst <=> mltlst;
        }
        else {
            if mrglst!.head < nhd then {
                tail = new shared HammingsList(mrglst!.head, mult,
                                               nil: shared HammingsList?,
                                               nil: shared HammingsList?);
                mrglst = mrglst!.next(); mrglst <=> tail!.mrglst;
                mltlst <=> tail!.mltlst;
            }
            else {
                tail = new shared HammingsList(nhd, mult,
                                               nil: shared HammingsList?,
                                               nil: shared HammingsList?);
                mltlst = mltlst!.next(); mltlst <=> tail!.mltlst;
                mrglst <=> tail!.mrglst;
            }
        }
        return tail: shared HammingsList;
    }
}

proc u(n: uint(8), s: shared HammingsList?): shared HammingsList {
    var r = new shared HammingsList(1: bigint, n, s,
                                    nil: shared HammingsList?);
    r.mltlst = r; // lazy recursion!
    return r.next();
}

iter hammings(): bigint {
    var nxt: shared HammingsList? = nil: shared HammingsList?;
    const mlts: [ 0 .. 2 ] int = [ 5, 3, 2 ];
    for m in mlts do nxt = u(m: uint(8), nxt);
    yield 1 : bigint;
    while true { yield nxt!.head; nxt = nxt!.next(); }
}

write("The first 20 Hamming numbers are: ");
var cnt: int = 0;
for h in hammings() { write(" ", h); cnt += 1; if cnt >= 20 then break; }
write(".\nThe 1691st Hamming number is ");
cnt = 0;
for h in hammings() { cnt += 1; if cnt < 1691 then continue; write(h); break; }
writeln(".\nThe millionth Hamming number is ");
var timer: Timer; timer.start(); cnt = 0;
for h in hammings() { cnt += 1; if cnt < 1000000 then continue; write(h); break; }
timer.stop(); writeln(".\nThis last took ",
                      timer.elapsed(TimeUnits.milliseconds), " milliseconds.");


(defn smerge [xs ys]
  (lazy-seq
    (let [x (first xs),
          y (first ys),
          [z xs* ys*]
          (cond
            (< x y) [x (rest xs) ys]
            (> x y) [y xs (rest ys)]
            :else   [x (rest xs) (rest ys)])]
      (cons z (smerge xs* ys*)))))

(def hamming
  (lazy-seq
    (->> (map #(*' 5 %) hamming)
         (smerge (map #(*' 3 %) hamming))
         (smerge (map #(*' 2 %) hamming))
         (cons 1))))


# Generate hamming numbers in order.  Hamming numbers have the
# property that they don't evenly divide any prime numbers outside
# a given set, such as [2, 3, 5].

generate_hamming_sequence = (primes, max_n) ->
  # We use a lazy algorithm, only ever keeping N candidates
  # in play, one for each of our seed primes.  Let's say
  # primes is [2,3,5].  Our virtual streams are these:
  #
  # hammings:    1,2,3,4,5,6,8,10,12,15,16,18,20,...
  # hammings*2:  2,4,6,9.10,12,16,20,24,30,32,36,40...
  # hammings*3:  3,6,9,12,15,18,24,30,36,45,...
  # hammings*5:  5,10,15,20,25,30,40,50,...
  #
  # After encountering 40 for the last time, our candidates
  # will be
  #   50 = 2 * 25
  #   45 = 3 * 15
  #   50 = 5 * 10
  # Then, after 45
  #   50 = 2 * 25
  #   48 = 3 * 16 <= new
  #   50 = 5 * 10
  hamming_numbers = [1]
  candidates = ([p, p, 1] for p in primes)
  last_number = 1
  while hamming_numbers.length < max_n
    # Get the next candidate Hamming Number tuple.
    i = min_idx(candidates)
    candidate = candidates[i]
    [n, p, seq_idx] = candidate

    # Add to sequence unless it's a duplicate.
    if n > last_number
      hamming_numbers.push n
      last_number = n

    # Replace the candidate with its successor (based on
    # p = 2, 3, or 5).
    #
    # This is the heart of the algorithm.  Let's say, over the
    # primes [2,3,5], we encounter the hamming number 32 based on it being
    # 2 * 16, where 16 is the 12th number in the sequence.
    # We'll be passed in [32, 2, 12] as candidate, and
    # hamming_numbers will be [1,2,3,4,5,6,8,9,10,12,16,18,...]
    # by now.  The next candidate we need to enqueue is
    # [36, 2, 13], where the numbers mean this:
    #
    #    36 - next multiple of 2 of a Hamming number
    #     2 - prime number
    #    13 - 1-based index of 18 in the sequence
    #
    # When we encounter [36, 2, 13], we will then enqueue
    # [40, 2, 14], based on 20 being the 14th hamming number.
    q = hamming_numbers[seq_idx]
    candidates[i] = [p*q, p, seq_idx+1]

  hamming_numbers

min_idx = (arr) ->
  # Don't waste your time reading this--it just returns
  # the index of the smallest tuple in an array, respecting that
  # the tuples may contain integers. (CS compiles to JS, which is
  # kind of stupid about sorting.  There are libraries to work around
  # the limitation, but I wanted this code to be standalone.)
  less_than = (tup1, tup2) ->
    i = 0
    while i < tup2.length
      return true if tup1[i] <= tup2[i]
      return false if tup1[i] > tup2[i]
      i += 1

  min_i = 0
  for i in [1...arr.length]
    if less_than arr[i], arr[min_i]
      min_i = i
  return min_i

primes = [2, 3, 5]
numbers = generate_hamming_sequence(primes, 10000)
console.log numbers[1690]
console.log numbers[9999]


(defun next-hamm (factors seqs)
  (let ((x (apply #'min (map 'list #'first seqs))))
    (loop for s in seqs
	  for f in factors
	  for i from 0
	  with add = t do
	  (if (= x (first s)) (pop s))
	  ;; prevent a value from being added to multiple lists
	  (when add
	    (setf (elt seqs i) (nconc s (list (* x f))))
	    (if (zerop (mod x f)) (setf add nil)))
    finally (return x))))

(loop with factors = '(2 3 5)
      with seqs    = (loop for i in factors collect '(1))
      for n from 1 to 1000001 do
      (let ((x (next-hamm factors seqs)))
	(if (or (< n 21)
		(= n 1691)
		(= n 1000000)) (format t "~d: ~d~%" n x))))


require "big"

def hamming(limit)
  h = Array.new(limit, 1.to_big_i)     # h = Array.new(limit+1, 1.to_big_i)
  x2, x3, x5 = 2.to_big_i, 3.to_big_i, 5.to_big_i
  i, j, k = 0, 0, 0
  (1...limit).each do |n|              # (1..limit).each do |n|
    h[n] = Math.min(x2, Math.min(x3, x5))
    x2 = 2 * h[i += 1] if x2 == h[n]
    x3 = 3 * h[j += 1] if x3 == h[n]
    x5 = 5 * h[k += 1] if x5 == h[n]
  end
  h[limit - 1]
end

start = Time.monotonic
print "Hamming Number (1..20): "; (1..20).each { |i| print "#{hamming(i)} " }
puts
puts "Hamming Number 1691: #{hamming 1691}"
puts "Hamming Number 1,000,000: #{hamming 1_000_000}"
puts "Elasped Time: #{(Time.monotonic - start).total_seconds} secs"


import std.stdio, std.bigint, std.algorithm, std.range, core.memory;

auto hamming(in uint n) pure nothrow /*@safe*/ {
    immutable BigInt two = 2, three = 3, five = 5;
    auto h = new BigInt[n];
    h[0] = 1;
    BigInt x2 = 2, x3 = 3, x5 = 5;
    size_t i, j, k;

    foreach (ref el; h.dropOne) {
        el = min(x2, x3, x5);
        if (el == x2) x2 = two   * h[++i];
        if (el == x3) x3 = three * h[++j];
        if (el == x5) x5 = five  * h[++k];
    }
    return h.back;
}

void main() {
    GC.disable;
    iota(1, 21).map!hamming.writeln;
    1_691.hamming.writeln;
    1_000_000.hamming.writeln;
}


import 'dart:math';

final lb2of2 = 1.0;
final lb2of3 = log(3.0) / log(2.0);
final lb2of5 = log(5.0) / log(2.0);

class Trival {
  final double log2;
  final int twos;
  final int threes;
  final int fives;
  Trival mul2() {
    return Trival(this.log2 + lb2of2, this.twos + 1, this.threes, this.fives);
  }
  Trival mul3() {
    return Trival(this.log2 + lb2of3, this.twos, this.threes + 1, this.fives);
  }
  Trival mul5() {
    return Trival(this.log2 + lb2of5, this.twos, this.threes, this.fives + 1);
  }
  @override String toString() {
    return this.log2.toString() + " "
      + this.twos.toString() + " "
      + this.threes.toString() + " "
      + this.fives.toString();
  }
  const Trival(this.log2, this.twos, this.threes, this.fives);
}

Iterable<Trival> makeHammings() sync* {
  var one = Trival(0.0, 0, 0, 0);
  yield(one);
  var s532 = one.mul2();
  var mrg = one.mul3();
  var s53 = one.mul3().mul3(); // equivalent to 9 for advance step
  var s5 = one.mul5();
  var i = -1; var j = -1;
  List<Trival> h = [];
  List<Trival> m = [];
  Trival rslt;
  while (true) {
    if (s532.log2 < mrg.log2) {
      rslt = s532; h.add(s532); ++i; s532 = h[i].mul2();
    } else {
      rslt = mrg; h.add(mrg);
      if (s53.log2 < s5.log2) {
        mrg = s53; m.add(s53); ++j; s53 = m[j].mul3();
      } else {
        mrg = s5; m.add(s5); s5 = s5.mul5();
      }
      if (j > (m.length >> 1)) {m.removeRange(0, j); j = 0; }
    }
    if (i > (h.length >> 1)) {h.removeRange(0, i); i = 0; }
    yield(rslt);
  }
}

BigInt trival2Int(Trival tv) {
  return BigInt.from(2).pow(tv.twos)
           * BigInt.from(3).pow(tv.threes)
           * BigInt.from(5).pow(tv.fives);
}

void main() {
  final numhams = 1000000000000;
  var hamseqstr = "The first 20 Hamming numbers are:  ( ";
  makeHammings().take(20)
      .forEach((h) => hamseqstr += trival2BigInt(h).toString() + " ");
  print(hamseqstr + ")");
  var nthhamseqstr = "The first 20 Hamming numbers are:  ( ";
  for (var i = 1; i <= 20; ++i) {
    nthhamseqstr += trival2BigInt(nthHamming(i)).toString() + " ";
  }
  print(nthhamseqstr + ")");
  final strt = DateTime.now().millisecondsSinceEpoch;
  final answr = makeHammings().skip(999999).first;
  final elpsd = DateTime.now().millisecondsSinceEpoch - strt;
  print("The ${numhams}th Hamming number is:  $answr");
  print("in full as:  ${trival2BigInt(answr)}");
  print("This test took $elpsd milliseconds.");
}


$ limit = p1
$
$ n = 0
$ h_'n = 1
$ x2 = 2
$ x3 = 3
$ x5 = 5
$ i = 0
$ j = 0
$ k = 0
$
$ n = 1
$ loop:
$  x = x2
$  if x3 .lt. x then $ x = x3
$  if x5 .lt. x then $ x = x5
$  h_'n = x
$  if x2 .eq. h_'n
$  then
$   i = i + 1
$   x2 = 2 * h_'i
$  endif
$  if x3 .eq. h_'n
$  then
$   j = j + 1
$   x3 = 3 * h_'j
$  endif
$  if x5 .eq. h_'n
$  then
$   k = k + 1
$   x5 = 5 * h_'k
$  endif
$  n = n + 1
$  if n .le. limit then $ goto loop
$
$ i = 0
$ loop2:
$  write sys$output h_'i
$  i = i + 1
$  if i .lt. 20 then $ goto loop2
$
$ n = limit - 1
$ write sys$output h_'n


note
	description    : "Initial part, in order, of the sequence of Hamming numbers"
	math           : "[
			   Hamming numbers, also known as regular numbers and 5-smooth numbers, are natural integers
			   that have 2, 3 and 5 as their only prime factors.
		         ]"
	computer_arithmetic :
	                 "[
			   This version avoids integer overflow and stops at the last representable number in the sequence.
		         ]"
	output         : "[
    			   Per requirements of the RosettaCode example, execution will produce items of indexes 1 to 20 and 1691.
    			   The algorithm (procedure `hamming') is more general and will produce the first `n' Hamming numbers
    			   for any `n'.
    			  ]"
	source         : "This problem was posed in Edsger W. Dijkstra, A Discipline of Programming, Prentice Hall, 1978"
	date           : "8 August 2012"
	authors        : "Bertrand Meyer", "Emmanuel Stapf"
	revision       : "1.0"
	libraries      : "Relies on SORTED_TWO_WAY_LIST from EiffelBase"
	implementation : "[
			   Using SORTED_TWO_WAY_LIST provides an elegant illustration of how to implement
			   a lazy scheme in Eiffel through the use of object-oriented data structures.
			 ]"
	warning        : "[
			   The formatting (<lang>) specifications for Eiffel in RosettaCode are slightly obsolete:
			   `note' and other newer keywords not supported, red color for manifest strings.
			   This should be fixed soon.
		         ]"

class
	APPLICATION

create
	make

feature {NONE} -- Initialization

	make
			-- Print first 20 Hamming numbers, in order, and the 1691-st one.
		local
			Hammings: like hamming
				-- List of Hamming numbers, up to 1691-st one.
		do
			Hammings := hamming (1691)
			across 1 |..| 20 as i loop
				io.put_natural (Hammings.i_th (i.item)); io.put_string (" ")
			end
			io.put_new_line; io.put_natural (Hammings.i_th (1691)); io.put_new_line
		end

feature -- Basic operations

	hamming (n: INTEGER): ARRAYED_LIST [NATURAL]
			-- First `n' elements (in order) of the Hamming sequence,
			-- or as many of them as will not produce overflow.
		local
			sl: SORTED_TWO_WAY_LIST [NATURAL]
			overflow: BOOLEAN
			first, next: NATURAL
		do
			create Result.make (n); create sl.make
			sl.extend (1); sl.start
			across 1 |..| n as i invariant
				-- "The numbers output so far are the first `i' - 1 Hamming numbers, in order".
				-- "Result.first is the `i'-th Hamming number."
			until sl.is_empty loop
				first := sl.first; sl.start
				Result.extend (first); sl.remove
				across << 2, 3, 5 >> as multiplier loop
					next := multiplier.item * first
					overflow := overflow or next <= first
					if not overflow and then not sl.has (next) then sl.extend (next) end
				end
			end
		end
end


defmodule Hamming do
  def generater do
    queues = [{2, queue}, {3, queue}, {5, queue}]
    Stream.unfold({1, queues}, fn {n, q} -> next(n, q) end)
  end

  defp next(n, queues) do
    queues = Enum.map(queues, fn {m, queue} -> {m, push(queue, m*n)} end)
    min    = Enum.map(queues, fn {_, queue} -> top(queue) end) |> Enum.min
    queues = Enum.map(queues, fn {m, queue} ->
               {m, (if min==top(queue), do: erase_top(queue), else: queue)}
             end)
    {n, {min, queues}}
  end

  defp queue, do: {[], []}

  defp push({input, output}, term), do: {[term | input], output}

  defp top({input, []}), do: List.last(input)
  defp top({_, [h|_]}), do: h

  defp erase_top({input, []}), do: erase_top({[], Enum.reverse(input)})
  defp erase_top({input, [_|t]}), do: {input, t}
end

IO.puts "first twenty Hamming numbers:"
IO.inspect Hamming.generater |> Enum.take(20)
IO.puts "1691st Hamming number:"
IO.puts Hamming.generater |> Enum.take(1691) |> List.last
IO.puts "one millionth Hamming number:"
IO.puts Hamming.generater |> Enum.take(1_000_000) |> List.last


module Main exposing ( main )

import Bitwise exposing (..)
import BigInt
import Task exposing ( Task, succeed, perform, andThen )
import Html exposing (Html, div, text)
import Browser exposing ( element )
import Time exposing ( now, posixToMillis )

cLIMIT : Int
cLIMIT = 1000000

-- an infinite non-empty non-memoizing Co-Inductive Stream (CIS)...
type CIS a = CIS a (() -> CIS a)

takeCIS2List : Int -> CIS a -> List a
takeCIS2List n cis =
  let loop i (CIS hd tl) lst =
        if i < 1 then List.reverse lst
        else loop (i - 1) (tl()) (hd :: lst)
  in loop n cis []

nthCIS : Int -> CIS a -> a
nthCIS n (CIS hd tl) =
  if n <= 1 then hd else nthCIS (n - 1) (tl())

type PriorityQ comparable v =
  Mt
  | Br comparable v (PriorityQ comparable v)
                    (PriorityQ comparable v)

emptyPQ : PriorityQ comparable v
emptyPQ = Mt

peekMinPQ : PriorityQ comparable v -> Maybe (comparable, v)
peekMinPQ  pq = case pq of
                  (Br k v _ _) -> Just (k, v)
                  Mt -> Nothing

pushPQ : comparable -> v -> PriorityQ comparable v
           -> PriorityQ comparable v
pushPQ wk wv pq =
  case pq of
    Mt -> Br wk wv Mt Mt
    (Br vk vv pl pr) ->
      if wk <= vk then Br wk wv (pushPQ vk vv pr) pl
      else Br vk vv (pushPQ wk wv pr) pl

siftdown : comparable -> v -> PriorityQ comparable v
             -> PriorityQ comparable v -> PriorityQ comparable v
siftdown wk wv pql pqr =
  case pql of
    Mt -> Br wk wv Mt Mt
    (Br vkl vvl pll prl) ->
      case pqr of
        Mt -> if wk <= vkl then Br wk wv pql Mt
              else Br vkl vvl (Br wk wv Mt Mt) Mt
        (Br vkr vvr plr prr) ->
          if wk <= vkl && wk <= vkr then Br wk wv pql pqr
          else if vkl <= vkr then Br vkl vvl (siftdown wk wv pll prl) pqr
               else Br vkr vvr pql (siftdown wk wv plr prr)

replaceMinPQ : comparable -> v -> PriorityQ comparable v
                 -> PriorityQ comparable v
replaceMinPQ wk wv pq = case pq of
                          Mt -> Mt
                          (Br _ _ pl pr) -> siftdown wk wv pl pr

type alias Trival = (Int, Int, Int)
showTrival : Trival -> String
showTrival tv =
  let (x2, x3, x5) = tv
      xpnd x m r =
        if x <= 0 then r
        else xpnd (shiftRightBy 1 x) (BigInt.mul m m)
                  (if (and 1 x) /= 0 then BigInt.mul m r else r)
  in BigInt.fromInt 1 |> xpnd x2 (BigInt.fromInt 2)
       |> xpnd x3 (BigInt.fromInt 3) |> xpnd x5 (BigInt.fromInt 5)
       |> BigInt.toString

type alias LogRep = { lr: Float, trv: Trival }
ltLogRep : LogRep -> LogRep -> Bool
ltLogRep lra lrb = lra.lr < lrb.lr
oneLogRep : LogRep
oneLogRep = { lr = 0.0, trv = (0, 0, 0) }
lg2_2 : Float
lg2_2 = 1.0 -- log base two of two
lg2_3 : Float
lg2_3 = logBase 2.0 3.0
lg2_5 : Float
lg2_5 = logBase 2.0 5.0
multLR2 : LogRep -> LogRep
multLR2 lr = let (x2, x3, x5) = lr.trv
             in LogRep (lr.lr + lg2_2) (x2 + 1, x3, x5)
multLR3 : LogRep -> LogRep
multLR3 lr = let (x2, x3, x5) = lr.trv
             in LogRep (lr.lr + lg2_3) (x2, x3 + 1, x5)
multLR5 : LogRep -> LogRep
multLR5 lr = let (x2, x3, x5) = lr.trv
             in LogRep (lr.lr + lg2_5) (x2, x3, x5 + 1)

hammingsLog : () -> CIS Trival
hammingsLog() =
  let im235 = multLR2 oneLogRep
      im35 = multLR3 oneLogRep
      imrg = im35
      im5 = multLR5 oneLogRep
      next bpq mpq m235 mrg m35 m5 =
        if ltLogRep m235 mrg then
          let omin = case peekMinPQ bpq of
                       Just (lr, trv) -> LogRep lr trv
                       otherwise -> m235 -- at the beginning!
              nm235 = multLR2 omin
              nbpq = replaceMinPQ m235.lr m235.trv bpq
          in CIS m235.trv <| \ () ->
               next nbpq mpq nm235 mrg m35 m5
        else
          if ltLogRep mrg m5 then
            let omin = case peekMinPQ mpq of
                         Just (lr, trv) -> LogRep lr trv
                         otherwise -> mrg -- at the beginning!
                nm35 = multLR3 omin
                nmrg = if ltLogRep nm35 m5 then nm35 else m5
                nmpq = replaceMinPQ mrg.lr mrg.trv mpq
                nbpq = pushPQ mrg.lr mrg.trv bpq
            in CIS mrg.trv <| \ () ->
                 next nbpq nmpq m235 nmrg nm35 m5
          else
            let nm5 = multLR5 m5
                nmrg = if ltLogRep m35 nm5 then m35 else nm5
                nmpq = pushPQ m5.lr m5.trv mpq
                nbpq = pushPQ m5.lr m5.trv bpq
            in CIS m5.trv <| \ () ->
                 next nbpq nmpq m235 nmrg m35 nm5
  in CIS (0, 0, 0) <| \ () ->
       next emptyPQ emptyPQ im235 imrg im35 im5

-- following code has to do with outputting to a web page using MUV/TEA...

type alias Model = { time: Int
                   , str1: String, str2: String, str3: String }

type Msg = Start Int | Done ( Int, Trival )

timemillis : () -> Task Never Int -- a side effect function
timemillis() = now |> andThen (\ t -> succeed (posixToMillis t))

test : Int -> Cmd Msg -- side effect function chain (includes "perform")...
test lmt =
  timemillis()
    |> andThen (\ t -> succeed ( t, nthCIS lmt (hammingsLog()) ))
    |> perform Done

myupdate : Msg -> Model -> (Model, Cmd Msg)
myupdate msg mdl =
  case msg of
    Start tm -> ( Model tm mdl.str1 mdl.str2 "Running...", test cLIMIT )
    Done (stptm, answr) ->
      ( ( Model stptm mdl.str1 mdl.str2
                  <| "The " ++ String.fromInt cLIMIT ++
                        "th Hamming number is " ++
                        showTrival answr ++ " in " ++
                        String.fromInt (stptm - mdl.time) ++
                        " milliseconds." )
      , Cmd.none ) -- terminates computation; allows UI update...

myview : Model -> Html msg
myview mdl =
  div [] [ div [] [text mdl.str1]
         , div [] [text mdl.str2]
         , div [] [text mdl.str3] ]

main : Program () Model Msg
main =
  element { init = \ _ -> ( Model 0
                              ("The first 20 Hamming numbers are:  " ++
                                (hammingsLog() |> takeCIS2List 20
                                  |> List.map showTrival
                                  |> String.join ", ") ++ ".")
                              ("The 1691st Hamming number is " ++
                                 (hammingsLog() |> nthCIS 1691
                                                |> showTrival) ++ ".")
                              "", perform Start (timemillis()) )
          , update = myupdate
          , subscriptions = \ _ -> Sub.none
          , view = myview }


PROGRAM HAMMING

!$DOUBLE

DIM H[2000]

PROCEDURE HAMMING(L%->RES)
      LOCAL I%,J%,K%,N%,M,X2,X3,X5
      H[0]=1
      X2=2  X3=3  X5=5
      FOR N%=1 TO L%-1 DO
        M=X2
        IF M>X3 THEN M=X3 END IF
        IF M>X5 THEN M=X5 END IF
        H[N%]=M
        IF M=X2 THEN I%+=1  X2=2*H[I%]  END IF
        IF M=X3 THEN J%+=1  X3=3*H[J%]  END IF
        IF M=X5 THEN K%+=1  X5=5*H[K%]  END IF
      END FOR
      RES=H[L%-1]
END PROCEDURE

BEGIN
      FOR H%=1 TO 20 DO
        HAMMING(H%->RES)
        PRINT("H(";H%;")=";RES)
      END FOR
      HAMMING(1691->RES)
      PRINT("H(1691)=";RES)
END PROGRAM


type LazyList<'a> = Cons of 'a * Lazy<LazyList<'a>> // ': fix colouring

let rec hammings() =
  let rec (-|-) (Cons(x, nxf) as xs) (Cons(y, nyf) as ys) =
    if x < y then Cons(x, lazy(nxf.Value -|- ys))
    elif x > y then Cons(y, lazy(xs -|- nyf.Value))
    else Cons(x, lazy(nxf.Value -|- nyf.Value))
  let rec inf_map f (Cons(x, nxf)) =
    Cons(f x, lazy(inf_map f nxf.Value))
  Cons(1I, lazy(let x = inf_map ((*) 2I) hamming
                let y = inf_map ((*) 3I) hamming
                let z = inf_map ((*) 5I) hamming
                x -|- y -|- z))

// testing...
[<EntryPoint>]
let main args =
  let rec iterLazyListFor f n (Cons(v, rf)) =
    if n > 0 then f v; iterLazyListFor f (n - 1) rf.Value
  let rec nthLazyList n ((Cons(v, rf)) as ll) =
    if n <= 1 then v else nthLazyList (n - 1) rf.Value
  printf "( "; iterLazyListFor (printf "%A ") 20 (hammings()); printfn ")"
  printfn "%A" (hammings() |> nthLazyList 1691)
  printfn "%A" (hammings() |> nthLazyList 1000000)
  0


USING: accessors deques dlists fry kernel make math math.order
;
IN: rosetta.hamming

TUPLE: hamming-iterator 2s 3s 5s ;

: <hamming-iterator> ( -- hamming-iterator )
    hamming-iterator new
        1 1dlist >>2s
        1 1dlist >>3s
        1 1dlist >>5s ;

: enqueue ( n hamming-iterator -- )
    [ [ 2 * ] [ 2s>> ] bi* push-back ]
    [ [ 3 * ] [ 3s>> ] bi* push-back ]
    [ [ 5 * ] [ 5s>> ] bi* push-back ] 2tri ;

: next ( hamming-iterator -- n )
    dup [ 2s>> ] [ 3s>> ] [ 5s>> ] tri
    3dup [ peek-front ] [email protected] min min
    [
        '[
            dup peek-front _ =
            [ pop-front* ] [ drop ] if
        ] [email protected]
    ] [ swap enqueue ] [ ] tri ;

: next-n ( hamming-iterator n -- seq )
    swap '[ _ [ _ next , ] times ] { } make ;

: nth-from-now ( hamming-iterator n -- m )
    1 - over '[ _ next drop ] times next ;


\ manipulating and computing with Hamming numbers:

: extract2 ( h -- l )
    40 rshift ;

: extract3 ( h -- m )
    20 rshift $fffff and ;

: extract5 ( h -- n )
    $fffff and ;

' + alias h* ( h1 h2 -- h )

: h. { h -- }
    ." 2^"  h extract2 0 .r
    ." *3^" h extract3 0 .r
    ." *5^" h extract5 . ;

\ the following numbers have been produced with bc -l as follows
1 62 lshift constant ldscale2
 7309349404307464679 constant ldscale3 \ 2^62*l(3)/l(2) (rounded up)
10708003330985790206 constant ldscale5 \ 2^62*l(5)/l(2) (rounded down)

: hld { h -- ud }
    \ ud is a scaled fixed-point representation of the logarithm dualis of h
    h extract2 ldscale2 um*
    h extract3 ldscale3 um* d+
    h extract5 ldscale5 um* d+ ;

: h<= ( h1 h2 -- f )
    2dup = if
        2drop true exit
    then
    hld rot hld assert( 2over 2over d<> )
    du>= ;

: hmin ( h1 h2 -- h )
    2dup h<= if
        drop
    else
        nip
    then ;

\ actual algorithm

0 value seq
variable seqlast 0 seqlast !

: lastseq ( -- u )
    \ last stored number in the sequence
    seq seqlast @ th @ ;

: genseq ( h1 "name" -- )
    \ h1 is the factor for the sequence
    create , 0 , \ factor and index of element used for last return
  does> ( -- u2 )
    \ u2 is the next number resulting from multiplying h1 with numbers
    \ in the sequence that is larger than the last number in the
    \ sequence
    dup @ lastseq { h1 l } cell+ dup @ begin ( index-addr index )
        seq over th @ h1 h* dup l h<= while
            drop 1+ repeat
    >r swap ! r> ;

$10000000000 genseq s2
$00000100000 genseq s3
$00000000001 genseq s5

: nextseq ( -- )
    s2 s3 hmin s5 hmin , 1 seqlast +! ;

: nthseq ( u1 -- h )
    \ the u1 th element in the sequence
    dup seqlast @ u+do
        nextseq
    loop
    1- 0 max cells seq + @ ;

: .nseq ( u1 -- )
    dup seqlast @ u+do
        nextseq
    loop
    0 u+do
        seq i th @ h.
    loop ;

here to seq
0 , \ that's 1

20 .nseq
cr    1691 nthseq h.
cr 1000000 nthseq h.


program Hamming_Test
  use big_integer_module
  implicit none

  call Hamming(1,20)
  write(*,*)
  call Hamming(1691)
  write(*,*)
  call Hamming(1000000)

contains

subroutine Hamming(first, last)

  integer, intent(in) :: first
  integer, intent(in), optional :: last
  integer :: i, n, i2, i3, i5, lim
  type(big_integer), allocatable :: hnums(:)

  if(present(last)) then
    lim = last
  else
    lim = first
  end if

  if(first < 1 .or. lim > 2500000 ) then
    write(*,*) "Invalid input"
    return
  end if

  allocate(hnums(lim))

  i2 = 1 ;  i3 = 1 ; i5 = 1
  hnums(1) = 1
  n = 1
  do while(n < lim)
    n = n + 1
    hnums(n) = mini(2*hnums(i2), 3*hnums(i3), 5*hnums(i5))
    if(2*hnums(i2) == hnums(n)) i2 = i2 + 1
    if(3*hnums(i3) == hnums(n)) i3 = i3 + 1
    if(5*hnums(i5) == hnums(n)) i5 = i5 + 1
  end do

  if(present(last)) then
    do i = first, last
      call print_big(hnums(i))
      write(*, "(a)", advance="no") " "
    end do
  else
    call print_big(hnums(first))
  end if

  deallocate(hnums)
end subroutine

function mini(a, b, c)
  type(big_integer) :: mini
  type(big_integer), intent(in) :: a, b, c

  if(a < b ) then
    if(a < c) then
      mini = a
    else
      mini = c
    end if
  else if(b < c) then
    mini = b
  else
    mini = c
  end if
end function mini
end program


' FB 1.05.0 Win64

' The biggest integer which FB supports natively is 8 bytes so unable
' to calculate 1 millionth Hamming number without using an external
' "bigint" library such as GMP

Function min(x As Integer, y As Integer) As Integer
  Return IIf(x < y, x, y)
End Function

Function hamming(n As Integer) As Integer
  Dim h(1 To n) As Integer
  h(1) = 1
  Dim As Integer i = 1, j = 1, k = 1
  Dim As Integer x2 = 2, x3 = 3, x5 = 5

  For m As Integer = 2 To n
    h(m) = min(x2, min(x3, x5))
    If h(m) = x2 Then
      i += 1
      x2 = 2 * h(i)
    End If
    If h(m) = x3 Then
      j += 1
      x3 = 3 * h(j)
    End if
    If h(m) = x5 Then
      k += 1
      x5 = 5 * h(k)
    End If
  Next

  Return h(n)
End Function

Print "The first 20 Hamming numbers are :"
For i As Integer = 1 To 20
  Print hamming(i); " ";
Next
Print : Print
Print "The 1691st hamming number is :"
Print hamming(1691)
Print
Print "Press any key to quit"
Sleep


native scala.collection.mutable.Queue

val hamming =
  q2 = Queue()
  q3 = Queue()
  q5 = Queue()

  def enqueue( n ) =
    q2.enqueue( n*2 )
    q3.enqueue( n*3 )
    q5.enqueue( n*5 )

  def stream =
    val n = min( min(q2.head(), q3.head()), q5.head() )

    if q2.head() == n then q2.dequeue()
    if q3.head() == n then q3.dequeue()
    if q5.head() == n then q5.dequeue()

    enqueue( n )
    n # stream()

  for q <- [q2, q3, q5] do q.enqueue( 1 )

  stream()


package main

import (
    "fmt"
    "math/big"
)

func min(a, b *big.Int) *big.Int {
    if a.Cmp(b) < 0 {
        return a
    }
    return b
}

func hamming(n int) []*big.Int {
    h := make([]*big.Int, n)
    h[0] = big.NewInt(1)
    two, three, five    := big.NewInt(2), big.NewInt(3), big.NewInt(5)
    next2, next3, next5 := big.NewInt(2), big.NewInt(3), big.NewInt(5)
    i, j, k := 0, 0, 0
    for m := 1; m < len(h); m++ {
        h[m] = new(big.Int).Set(min(next2, min(next3, next5)))
        if h[m].Cmp(next2) == 0 { i++; next2.Mul(  two, h[i]) }
        if h[m].Cmp(next3) == 0 { j++; next3.Mul(three, h[j]) }
        if h[m].Cmp(next5) == 0 { k++; next5.Mul( five, h[k]) }
    }
    return h
}

func main() {
    h := hamming(1e6)
    fmt.Println(h[:20])
    fmt.Println(h[1691-1])
    fmt.Println(h[len(h)-1])
}


class Hamming {

    static final ONE = BigInteger.ONE
    static final THREE = BigInteger.valueOf(3)
    static final FIVE = BigInteger.valueOf(5)

    static void main(args) {
        print 'Hamming(1 .. 20) ='
        (1..20).each {
            print " ${hamming it}"
        }
        println "\nHamming(1691) = ${hamming 1691}"
        println "Hamming(1000000) = ${hamming 1000000}"
    }

    static hamming(n) {
        def priorityQueue = new PriorityQueue<BigInteger>()
        priorityQueue.add ONE

        def lowest

        n.times {
            lowest = priorityQueue.poll()
            while (priorityQueue.peek() == lowest) {
                priorityQueue.poll()
            }
            updateQueue(priorityQueue, lowest)
        }

        lowest
    }

    static updateQueue(priorityQueue, lowest) {
        priorityQueue.add(lowest.shiftLeft 1)
        priorityQueue.add(lowest.multiply THREE)
        priorityQueue.add(lowest.multiply FIVE)
    }
}


# Lazily generate the three Hamming numbers that can be derived directly
#   from a known Hamming number h
class Triplet : Class (cv, ce)

    method nextVal()
        suspend cv := @ce
    end

    initially (baseNum)
        cv := 2*baseNum
        ce := create (3|5)*baseNum
end

# Generate Hamming numbers, in order.  Default is first 30
#  But an optional argument can be used to generate more (or less)
#   e.g. hamming 5000 generates the first 5000.
procedure main(args)
    limit := integer(args[1]) | 30
    every write("\t", generateHamming() \ limit)
end

# Do the work.   Start with known Hamming number 1 and maintain
#   a set of triplet Hamming numbers as they get derived from that
#   one.  Most of the code here is to figure out which Hamming
#   number is next in sequence (while removing duplicates)
procedure generateHamming()
    triplers := set()
    insert(triplers, Triplet(1))

    suspend 1
    repeat {
        # Pick a Hamming triplet that *may* have the next smallest number
        t1 := !triplers         # any will do to start

        every t1 ~=== (t2 := !triplers) do {
            if t1.cv > t2.cv then {
               # oops we were wrong, switch assumption
               t1 := t2
               }
            else if t1.cv = t2.cv then {
               # t2's value is a duplicate, so
               # advance triplet t2, if none left in t2, remove it
               t2.nextVal() | delete(triplers, t2)
               }
           }

        # Ok, t1 has the next Hamming number, grab it
        suspend t1.cv
        insert(triplers, Triplet(t1.cv))
        # Advance triplet t1, if none left in t1, remove it
        t1.nextVal() | delete(triplers, t1)
        }
end


hamming=: {. (/:[email protected][email protected]] , 2 3 5 * {)/@(1x ,~ [email protected])


import java.math.BigInteger;
import java.util.PriorityQueue;

final class Hamming {
    private static BigInteger THREE = BigInteger.valueOf(3);
    private static BigInteger FIVE = BigInteger.valueOf(5);

    private static void updateFrontier(BigInteger x,
                                       PriorityQueue<BigInteger> pq) {
        pq.offer(x.shiftLeft(1));
        pq.offer(x.multiply(THREE));
        pq.offer(x.multiply(FIVE));
    }

    public static BigInteger hamming(int n) {
        if (n <= 0)
            throw new IllegalArgumentException("Invalid parameter");
        PriorityQueue<BigInteger> frontier = new PriorityQueue<BigInteger>();
        updateFrontier(BigInteger.ONE, frontier);
        BigInteger lowest = BigInteger.ONE;
        for (int i = 1; i < n; i++) {
            lowest = frontier.poll();
            while (frontier.peek().equals(lowest))
                frontier.poll();
            updateFrontier(lowest, frontier);
        }
        return lowest;
    }

    public static void main(String[] args) {
        System.out.print("Hamming(1 .. 20) =");
        for (int i = 1; i < 21; i++)
             System.out.print(" " + hamming(i));
        System.out.println("\nHamming(1691) = " + hamming(1691));
        System.out.println("Hamming(1000000) = " + hamming(1000000));
    }
}


function hamming() {
    var queues = {2: [], 3: [], 5: []};
    var base;
    var next_ham = 1;
    while (true) {
        yield next_ham;

        for (base in queues) {queues[base].push(next_ham * base)}

        next_ham = [ queue[0] for each (queue in queues) ].reduce(function(min, val) {
            return Math.min(min,val)
        });

        for (base in queues) {if (queues[base][0] == next_ham) queues[base].shift()}
    }
}

var ham = hamming();
var first20=[], i=1;

for (; i <= 20; i++)
    first20.push(ham.next());
print(first20.join(', '));
print('...');
for (; i <= 1690; i++)
    ham.next();
print(i + " => " + ham.next());


# Return the index in the input array of the min_by(f) value
def index_min_by(f):
  . as $in
  | if length == 0 then null
    else .[0] as $first
    | reduce range(0; length) as $i
        ([0, $first, ($first|f)];   # state: [ix; min; f|min]
         ($in[$i]|f) as $v
         | if $v < .[2] then [ $i, $in[$i], $v ] else . end)
    | .[0]
    end;

# Emit n Hamming numbers if n>0; the nth if n<0
def hamming(n):

  # input: [twos, threes, fives] of which at least one is assumed to be non-empty
  # output: the index of the array holding the min of the firsts
  def next: map( .[0] ) | index_min_by(.);

  # input: [value, [twos, threes, fives] ....]
  # ix is the index in [twos, threes, fives] of the array to be popped
  # output: [popped, updated_arrays ...]
  def pop(ix):
    .[1] as $triple
    | setpath([0];    $triple[ix][0])
    | setpath([1,ix]; $triple[ix][1:]);

  # input: [x, [twos, threes, fives], count]
  # push value*2 to twos, value*3 to threes, value*5 to fives and increment count
  def push(v):
    [.[0], [.[1][0] + [2*v], .[1][1] + [3*v], .[1][2] + [5*v]], .[2] + 1];

  # _hamming is the workhorse
  # input: [previous, [twos, threes, fives], count]
  def _hamming:
    .[0] as $previous
    | if (n > 0 and .[2] == n) or (n<0 and .[2] == -n) then $previous
      else (.[1]|next) as $ix     # $ix cannot be null
      | pop($ix)
      | .[0] as $next
      | (if $next == $previous then empty elif n>=0 then $previous else empty end),
        (if $next == $previous then . else push($next) end | _hamming)
      end;
  [1, [[2],[3],[5]], 1] | _hamming;

. as $n | hamming($n)


function hammingsequence(N)
    if N < 1
        throw("Hamming sequence exponent must be a positive integer")
    end
    ham = N > 4000 ? Vector{BigInt}([1]) : Vector{Int}([1])
    base2, base3, base5 = (1, 1, 1)
    for i in 1:N-1
        x = min(2ham[base2], 3ham[base3], 5ham[base5])
        push!(ham, x)
        if 2ham[base2] <= x
            base2 += 1
        end
        if 3ham[base3] <= x
            base3 += 1
        end
        if 5ham[base5] <= x
            base5 += 1
        end
    end
    ham
end

println(hammingsequence(20))
println(hammingsequence(1691)[end])
println(hammingsequence(1000000)[end])


import java.math.BigInteger
import java.util.*

val Three = BigInteger.valueOf(3)!!
val Five = BigInteger.valueOf(5)!!

fun updateFrontier(x : BigInteger, pq : PriorityQueue<BigInteger>) {
    pq.add(x.shiftLeft(1))
    pq.add(x.multiply(Three))
    pq.add(x.multiply(Five))
}

fun hamming(n : Int) : BigInteger {
    val frontier = PriorityQueue<BigInteger>()
    updateFrontier(BigInteger.ONE, frontier)
    var lowest = BigInteger.ONE
    for (i in 1 .. n-1) {
        lowest = frontier.poll() ?: lowest
        while (frontier.peek() == lowest)
            frontier.poll()
        updateFrontier(lowest, frontier)
    }
    return lowest
}

fun main(args : Array<String>) {
    System.out.print("Hamming(1 .. 20) =")
    for (i in 1 .. 20)
        System.out.print(" ${hamming(i)}")
    System.out.println("\nHamming(1691) = ${hamming(1691)}")
    System.out.println("Hamming(1000000) = ${hamming(1000000)}")
}


dim h( 1000000)

for i =1 to 20
    print hamming( i); " ";
next i

print
print "H( 1691)", hamming( 1691)
print "H( 1000000)", hamming( 1000000)

end

function hamming( limit)
    h( 0) =1
    x2 =2: x3 =3: x5 =5
    i  =0: j  =0: k  =0
    for n =1 to limit
        h( n) = min( x2, min( x3, x5))
        if x2 = h( n) then i = i +1: x2 =2 *h( i)
        if x3 = h( n) then j = j +1: x3 =3 *h( j)
        if x5 = h( n) then k = k +1: x5 =5 *h( k)
    next n
    hamming =h( limit -1)
end function


to init.ham
  ; queues
  make "twos   [1]
  make "threes [1]
  make "fives  [1]
end
to next.ham
                          localmake "ham first :twos
  if less? first :threes :ham [make "ham first :threes]
  if less? first :fives  :ham [make "ham first :fives]

  if equal? :ham first :twos   [ignore dequeue "twos]
  if equal? :ham first :threes [ignore dequeue "threes]
  if equal? :ham first :fives  [ignore dequeue "fives]

  queue "twos   :ham * 2
  queue "threes :ham * 3
  queue "fives  :ham * 5

  output :ham
end

init.ham
repeat      20 [print  next.ham]
repeat 1690-20 [ignore next.ham]
print next.ham


function hiter()
  hammings = {1}
  prev, vals = {1, 1, 1}
  index = 1
  local function nextv()
    local n, v = 1, hammings[prev[1]]*2
	if hammings[prev[2]]*3 < v then n, v = 2, hammings[prev[2]]*3 end
	if hammings[prev[3]]*5 < v then n, v = 3, hammings[prev[3]]*5 end
	prev[n] = prev[n] + 1
	if hammings[index] == v then return nextv() end
	index = index + 1
	hammings[index] = v
	return v
  end
  return nextv
end

j = hiter()
for i = 1, 20 do
  print(j())
end
n, l = 0, 0
while n < 2^31 do n, l = j(), n end
print(l)


Module hamming_long {
	function hamming(l as long, &h(),&last()) {
		l=if(l<1->1&, l)
		long oldlen=len(h())
		if oldlen<l then dim h(l) else =h(l-1): exit
		def long  i, j, k, n, m, x2, x3, x5, ll
		stock last(0) out x2,x3,x5,i,j,k
		n=oldlen : ll=l-1
		{	m=x2
			if m>x3 then m=x3
			if m>x5 then m=x5
			h(n)=m
			if n>=1690 then =h(n):break
			if m=x2 then i++:x2=2&*h(i)
			if m=x3 then j++:x3=3&*h(j)
			if m=x5 then k++:x5=5&*h(k)
			if n<ll then n++: loop
		}
		stock last(0) in x2,x3,x5,i,j,k
		=h(ll)
	}
	dim h(1)=1&, last()
	def long i
	const nl$={
	}
	document doc$
	last()=(2&,3&,5&,0&,0&,0&)
	for i=1 to 20
		Doc$=format$("{0::-10} {1::-10}", i, hamming(i,&h(), &last()))+nl$
	next i
	i=1691
	Doc$=format$("{0::-10} {1::-10}", i, hamming(i,&h(), &last()))+nl$
	print #-2,Doc$
	clipboard Doc$
}
 hamming_long


n = 40;

powers_2 = 2.^[0:n-1];
powers_3 = 3.^[0:n-1];
powers_5 = 5.^[0:n-1];

matrix = powers_2' * powers_3;
powers_23 = sort(reshape(matrix,n*n,1));

matrix = powers_23 * powers_5;
powers_235 = sort(reshape(matrix,n*n*n,1));

%
% Remove the integer overflow values.
%
powers_235 = powers_235(powers_235 > 0);

disp(powers_235(1:20))
disp(powers_235(1691))


Hamming(n)	New count,ok,next,number,which
	For which=2,3,5 Set number=1
	For count=1:1:n Do
	. Set ok=0 Set:count<21 ok=1 Set:count=1691 ok=1 Set:count=n ok=1
	. Write:ok !,$Justify(count,5),": ",number
	. For which=2,3,5 Set next(number*which)=which
	. Set number=$Order(next(""))
	. Kill next(number)
	. Quit
	Quit
Do Hamming(2000)

    1: 1
    2: 2
    3: 3
    4: 4
    5: 5
    6: 6
    7: 8
    8: 9
    9: 10
   10: 12
   11: 15
   12: 16
   13: 18
   14: 20
   15: 24
   16: 25
   17: 27
   18: 30
   19: 32
   20: 36
 1691: 2125764000
 2000: 8062156800


import bigints

proc min(a: varargs[BigInt]): BigInt =
  result = a[0]
  for i in 1..a.high:
    if a[i] < result: result = a[i]

proc hamming(limit: int): BigInt =
  var
    h = newSeq[BigInt](limit)
    x2 = initBigInt(2)
    x3 = initBigInt(3)
    x5 = initBigInt(5)
    i, j, k = 0
  for i in 0..h.high: h[i] = initBigInt(1)

  for n in 1 ..< limit:
    h[n] = min(x2, x3, x5)
    if x2 == h[n]:
      inc i
      x2 = h[i] * 2
    if x3 == h[n]:
      inc j
      x3 = h[j] * 3
    if x5 == h[n]:
      inc k
      x5 = h[k] * 5

  result = h[h.high]

for i in 1 .. 20:
  stdout.write hamming(i), " "
echo ""
echo hamming(1691)
echo hamming(1_000_000)


module ISet = Set.Make(struct type t = int let compare=compare end)

let pq = ref (ISet.singleton 1)

let next () =
  let m = ISet.min_elt !pq in
  pq := ISet.(remove m !pq  |> add (2*m) |> add (3*m) |> add (5*m));
  m

let () =

  print_string "The first 20 are: ";

  for i = 1 to 20
  do
    Printf.printf "%d " (next ())
  done;

  for i = 21 to 1690
  do
    ignore (next ())
  done;

  Printf.printf "\nThe 1691st is %d\n" (next ());


declare
  fun lazy {HammingFun}
     1|{FoldL1 [{MultHamming 2} {MultHamming 3} {MultHamming 5}] LMerge}
  end

  Hamming = {HammingFun}

  fun {MultHamming N}
     {LMap Hamming fun {$ X} N*X end}
  end

  fun lazy {LMap Xs F}
     case Xs
     of nil  then nil
     [] X|Xr then {F X}|{LMap Xr F}
     end
  end

  fun lazy {LMerge Xs=X|Xr Ys=Y|Yr}
     if     X < Y then X|{LMerge Xr Ys}
     elseif X > Y then Y|{LMerge Xs Yr}
     else              X|{LMerge Xr Yr}
     end
  end

  fun {FoldL1 X|Xr F}
     {FoldL Xr F X}
  end
in
  {ForAll {List.take Hamming 20} System.showInfo}
  {System.showInfo {Nth Hamming 1690}}
  {System.showInfo {Nth Hamming 1000000}}


program HammNumb;
{$IFDEF FPC}
  {$MODE DELPHI}
  {$OPTIMIZATION ON}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
{
type
  NativeUInt = longWord;
}
var
  pot   : array[0..2] of NativeUInt;

function NextHammNumb(n:NativeUInt):NativeUInt;
var
  q,p,nr : NativeUInt;
begin
  repeat
    nr := n+1;
    n := nr;

    p := 0;
    while NOT(ODD(nr)) do
    begin
      inc(p);
      nr := nr div 2;
    end;
    Pot[0]:= p;

    p := 0;
    q := nr div 3;
    while q*3=nr do
    Begin
      inc(P);
      nr := q;
      q := nr div 3;
    end;
    Pot[1] := p;

    p := 0;
    q := nr div 5;
    while q*5=nr do
    Begin
      inc(P);
      nr := q;
      q := nr div 5;
    end;
    Pot[2] := p;

  until nr = 1;
  result:= n;
end;

procedure Check;
var
  i,n: NativeUint;
begin
  n := 1;
  for i := 1 to 20 do
  begin
    n := NextHammNumb(n);
    write(n,' ');
  end;
  writeln;
  writeln;
  n := 1;
  for i := 1 to 1690 do
    n := NextHammNumb(n);
  writeln('No ',i:4,' | ',n,' = 2^',Pot[0],' 3^',Pot[1],' 5^',Pot[2]);
end;

Begin
  Check;
End.


use strict;
use warnings;
use List::Util 'min';

# If you want the large output, uncomment either the one line
# marked (1) or the two lines marked (2)
#use Math::GMP qw/:constant/;        # (1) uncomment this to use Math::GMP
#use Math::GMPz;                     # (2) uncomment this plus later line for Math::GMPz

sub ham_gen {
    my @s = ([1], [1], [1]);
    my @m = (2, 3, 5);
    #@m = map { Math::GMPz->new($_) } @m;     # (2) uncomment for Math::GMPz

    return sub {
	my $n = min($s[0][0], $s[1][0], $s[2][0]);
	for (0 .. 2) {
	     shift @{$s[$_]} if $s[$_][0] == $n;
	     push @{$s[$_]}, $n * $m[$_]
	}
	return $n
    }
}

my $h = ham_gen;
my $i = 0;
++$i, print $h->(), " " until $i > 20;
print "...\n";

++$i, $h->() until $i == 1690;
print ++$i, "-th: ", $h->(), "\n";

# You will need to pick one of the bigint choices
#++$i, $h->() until $i == 999999;
#print ++$i, "-th: ", $h->(), "\n";


with javascript_semantics
function hamming(integer N)
sequence h = repeat(1,N)
atom x2 = 2, x3 = 3, x5 = 5, hn
integer i = 1, j = 1, k = 1
    for n=2 to N do
        hn = min(x2,min(x3,x5))
        h[n] = hn
        if hn==x2 then i += 1 x2 = 2*h[i] end if
        if hn==x3 then j += 1 x3 = 3*h[j] end if
        if hn==x5 then k += 1 x5 = 5*h[k] end if
    end for
    return h[N]
end function

include builtins\mpfr.e

function mpz_hamming(integer N)
sequence h = mpz_inits(N,1)
mpz x2 = mpz_init(2),
    x3 = mpz_init(3),
    x5 = mpz_init(5),
    hn = mpz_init()
integer i = 1, j = 1, k = 1
    for n=2 to N do
        mpz_set(hn,mpz_min({x2,x3,x5}))
        mpz_set(h[n],hn)
        if mpz_cmp(hn,x2)=0 then i += 1 mpz_mul_si(x2,h[i],2) end if
        if mpz_cmp(hn,x3)=0 then j += 1 mpz_mul_si(x3,h[j],3) end if
        if mpz_cmp(hn,x5)=0 then k += 1 mpz_mul_si(x5,h[k],5) end if
    end for
    return h[N]
end function

sequence s = {}
for i=1 to 20 do
    s = append(s,hamming(i))
end for
?s
printf(1,"%d\n",hamming(1691))
printf(1,"%d (wrong!)\n",hamming(1000000)) --(the hn==x2 etc fail, so multiplies are all wrong)

printf(1,"%s\n",{mpz_get_str(mpz_hamming(1691))})
printf(1,"%s\n",{mpz_get_str(mpz_hamming(1000000))})


go =>
   println([hamming(I) : I in 1..20]),
   time(println(hamming_1691=hamming(1691))),
   time(println(hamming_1000000=hamming(1000000))),
   nl.

hamming(1) = 1.
hamming(2) = 2.
hamming(3) = 3.
hamming(N) = Hamming =>
   A = new_array(N),
   [Next2, Next3, Next5] = [2,3,5],
   A[1] := Next2, A[2] := Next3, A[3] := Next5,
   I = 0, J = 0, K = 0, M = 1,
   while (M < N)
      A[M] := min([Next2,Next3,Next5]),
      if A[M] == Next2 then I := I+1, Next2 := 2*A[I] end,
      if A[M] == Next3 then J := J+1, Next3 := 3*A[J] end,
      if A[M] == Next5 then K := K+1, Next5 := 5*A[K] end,
      M := M + 1
   end,
   Hamming = A[N-1].


(de hamming (N)
   (let (L (1)  H)
      (do N
         (for (X L X (cadr X))      # Find smallest result
            (setq H (car X)) )
         (idx 'L H NIL)             # Remove it
         (for I (2 3 5)             # Generate next results
            (idx 'L (* I H) T) ) )
      H ) )

(println (make (for N 20 (link (hamming N)))))
(println (hamming 1691))   # very fast
(println (hamming 1000000))   # runtime about 13 minutes on i5-3570S


(subscriptrange):
Hamming: procedure options (main); /* 14 November 2013 with fixes 2021 */
   declare (H(2000), p2, p3, p5, twoTo31, Hm, tenP(11)) decimal(12)fixed;
   declare (i, j, k, m, d, w) fixed binary;

   /* Quicksorts in-place the array of integers H, from lb to ub */
   quicksortH: procedure( lb, ub ) recursive;
      declare ( lb,   ub    )binary(15)fixed;
      declare ( left, right )binary(15)fixed;
      declare ( pivot, swap )decimal(12)fixed;
      declare sorting        bit(1);
      if ub > lb then do
         /* more than one element, so must sort */
         left    = lb;
         right   = ub;
         /* choosing the middle element of the array as the pivot */
         pivot   = H( left + ( ( right + 1 ) - left ) / 2 );
         sorting = '1'b;
         do while( sorting );
            do while( left  <= ub & H( left  ) < pivot ); left  = left  + 1; end;
            do while( right >= lb & H( right ) > pivot ); right = right - 1; end;
            sorting = ( left <= right );
            if sorting then do;
               swap       = H( left  );
               H( left  ) = H( right );
               H( right ) = swap;
               left       = left  + 1;
               right      = right - 1;
            end;
         end;
         call quicksortH( lb,   right );
         call quicksortH( left, ub    );
      end;
   end quicksortH ;

   /* find 2^31 - the limit for Hamming numbers we need to find */
   twoTo31 = 2;
   do i = 2 to 31;
      twoTo31 = twoTo31 * 2;
   end;
   /* calculate powers of 10 so we can check the number of digits */
   /* the numbers will have */
   tenP( 1 ) = 10;
   do i = 2 to 11;
      tenP( i ) = 10 * tenP( i - 1 );
   end;

   /* find the numbers */
   m = 0;
   p5 = 1;
   do k = 0 to 13;
      p3 = 1;
      do j = 0 to 19;
         Hm = 0;
         p2 = 1;
         do i = 0 to 31 while( Hm < twoTo31 );
            /* count the number of digits p2 * p3 * p5 will have */
            d = 0;
            do w = 1 to 11 while( tenP(w) < p2 ); d = d + 1; end;
            do w = 1 to 11 while( tenP(w) < p3 ); d = d + 1; end;
            do w = 1 to 11 while( tenP(w) < p5 ); d = d + 1; end;
            if d < 11 then do;
               /* the product will be small enough */
               Hm = p2 * p3 * p5;
               if Hm < twoTo31 then do;
                  m = m + 1;
                  H(m) = Hm;
               end;
            end;
            p2 = p2 * 2;
         end;
         p3 = p3 * 3;
      end;
      p5 = p5 * 5;
   end;

   /* sort the numbers */
   call quicksortH( 1, m );

   put skip list( 'The first 20 Hamming numbers:' );
   do i = 1 to 20;
      put skip list (H(i));
   end;
   put skip list( 'Hamming number 1691:' );
   put skip list (H(1691));

end Hamming;


%% collect N elements produced by a generator in a row

take( 0, Next, Z-Z, Next).
take( N, Next, [A|B]-Z, NZ):- N>0, !, next(Next,A,Next1),
  N1 is N-1,
  take(N1,Next1,B-Z,NZ).

%% a generator provides specific {next} implementation

next( hamm( A2,B,C3,D,E5,F,[H|G] ), H, hamm(X,U,Y,V,Z,W,G) ):-
  H is min(A2, min(C3,E5)),
  (   A2 =:= H -> B=[N2|U],X is N2*2 ; (X,U)=(A2,B) ),
  (   C3 =:= H -> D=[N3|V],Y is N3*3 ; (Y,V)=(C3,D) ),
  (   E5 =:= H -> F=[N5|W],Z is N5*5 ; (Z,W)=(E5,F) ).

mkHamm( hamm(1,X,1,X,1,X,X) ).       % Hamming numbers generator init state

main(N) :-
    mkHamm(G),take(20,G,A-[],_),           write(A), nl,
    take(1691-1,G,_,G2),take(2,G2,B-[],_),     write(B), nl,
    take(  N  -1,G,_,G3),take(2,G3,[C1|_]-_,_),   write(C1), nl.


#X2 = 2
#X3 = 3
#X5 = 5

Macro Ham(w)
  PrintN("H("+Str(w)+") = "+Str(Hamming(w)))
EndMacro

Procedure.i Hamming(l.i)
  Define.i i,j,k,n,m,x=#X2,y=#X3,z=#X5
  Dim h.i(l) : h(0)=1
  For n=1 To l-1
    m=x
    If m>y : m=y : EndIf
    If m>z : m=z : EndIf
    h(n)=m
    If m=x : i+1 : x=#X2*h(i) : EndIf
    If m=y : j+1 : y=#X3*h(j) : EndIf
    If m=z : k+1 : z=#X5*h(k) : EndIf
  Next
  ProcedureReturn h(l-1)
EndProcedure

OpenConsole("Hamming numbers")
For h.i=1 To 20
  Ham(h)
Next
Ham(1691)
Input()


F maxsumseq(sequence)
   V (start, end, sum_start) = (-1, -1, -1)
   V (maxsum_, sum_) = (0, 0)
   L(x) sequence
      sum_ += x
      I maxsum_ < sum_
         maxsum_ = sum_
         (start, end) = (sum_start, L.index)
      E I sum_ < 0
         sum_ = 0
         sum_start = L.index
   assert(maxsum_ == sum(sequence[start + 1 .. end]))
   R sequence[start + 1 .. end]

print(maxsumseq([-1, 2, -1]))
print(maxsumseq([-1, 2, -1, 3, -1]))
print(maxsumseq([-1, 1, 2, -5, -6]))
print(maxsumseq([-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1]))


from itertools import islice

def hamming2():
    '''\
    This version is based on a snippet from:
        https://web.archive.org/web/20081219014725/http://dobbscodetalk.com:80
                         /index.php?option=com_content&task=view&id=913&Itemid=85
        http://www.drdobbs.com/architecture-and-design/hamming-problem/228700538
        Hamming problem
        Written by Will Ness
        December 07, 2008

        When expressed in some imaginary pseudo-C with automatic
        unlimited storage allocation and BIGNUM arithmetics, it can be
        expressed as:
            hamming = h where
              array h;
              n=0; h[0]=1; i=0; j=0; k=0;
              x2=2*h[ i ]; x3=3*h[j]; x5=5*h[k];
              repeat:
                h[++n] = min(x2,x3,x5);
                if (x2==h[n]) { x2=2*h[++i]; }
                if (x3==h[n]) { x3=3*h[++j]; }
                if (x5==h[n]) { x5=5*h[++k]; }
    '''
    h = 1
    _h=[h]    # memoized
    multipliers  = (2, 3, 5)
    multindeces  = [0 for i in multipliers] # index into _h for multipliers
    multvalues   = [x * _h[i] for x,i in zip(multipliers, multindeces)]
    yield h
    while True:
        h = min(multvalues)
        _h.append(h)
        for (n,(v,x,i)) in enumerate(zip(multvalues, multipliers, multindeces)):
            if v == h:
                i += 1
                multindeces[n] = i
                multvalues[n]  = x * _h[i]
        # cap the memoization
        mini = min(multindeces)
        if mini >= 1000:
            del _h[:mini]
            multindeces = [i - mini for i in multindeces]
        #
        yield h


PROC PrintArray(INT ARRAY a INT first,last)
  INT i

  Put('[)
  FOR i=first TO last
  DO
    IF i>first THEN Put(' ) FI
    PrintI(a(i))
  OD
  Put(']) PutE()
RETURN

PROC Process(INT ARRAY a INT size)
  INT i,j,beg,end
  INT sum,best

  beg=0 end=-1 best=0
  FOR i=0 TO size-1
  DO
    sum=0
    FOR j=i TO size-1
    DO
      sum==+a(j)
      IF sum>best THEN
        best=sum
        beg=i
        end=j
      FI
    OD
  OD

  Print("Seq=") PrintArray(a,0,size-1)
  PrintF("Max sum=%i %ESubseq=",best)
  PrintArray(a,beg,end) PutE()
RETURN

PROC Main()
  INT ARRAY
    a(11)=[1 2 3 4 5 65528 65527 65516 40 25 65531],
    b(11)=[65535 65534 3 5 6 65534 65535 4 65532 2 65535],
    c(5)=[65535 65534 65533 65532 65531],
    d(0)=[]

  Process(a,11)
  Process(b,11)
  Process(c,5)
  Process(d,0)
RETURN


with Ada.Text_Io; use Ada.Text_Io;

procedure Max_Subarray is
   type Int_Array is array (Positive range <>) of Integer;
   Empty_Error : Exception;
   function Max(Item : Int_Array) return Int_Array is
      Start : Positive;
      Finis : Positive;
      Max_Sum : Integer := Integer'First;
      Sum : Integer;
   begin
      if Item'Length = 0 then
         raise Empty_Error;
      end if;

      for I in Item'range loop
         Sum := 0;
         for J in I..Item'Last loop
            Sum := Sum + Item(J);
            if Sum > Max_Sum then
               Max_Sum := Sum;
               Start := I;
               Finis := J;
            end if;
         end loop;
      end loop;
      return Item(Start..Finis);
   end Max;
   A : Int_Array := (-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1);
   B : Int_Array := Max(A);
begin
   for I in B'range loop
      Put_Line(Integer'Image(B(I)));
   end loop;
exception
   when Empty_Error =>
      Put_Line("Array being analyzed has no elements.");
end Max_Subarray;


FUNCTION min (a, b)
    IF a < b THEN min = a ELSE min = b
END FUNCTION

FUNCTION Hamming (limit)
    DIM h(limit)

    h(0) = 1
    x2 = 2
    x3 = 3
    x5 = 5
    i = 0
    j = 0
    k = 0
    FOR n = 1 TO limit
        h(n) = min(x2, min(x3, x5))
        IF x2 = h(n) THEN
            i = i + 1
            x2 = 2 * h(i)
        END IF
        IF x3 = h(n) THEN
            j = j + 1
            x3 = 3 * h(j)
        END IF
        IF x5 = h(n) THEN
            k = k + 1
            x5 = 5 * h(k)
        END IF
    NEXT n
    Hamming = h(limit - 1)
END FUNCTION

PRINT "The first 20 Hamming numbers are :"
FOR i = 1 TO 20
    PRINT Hamming(i); " ";
NEXT i

PRINT
PRINT "H( 1691) = "; Hamming(1691)


gsss(list l, integer &start, &end, &maxsum)
{
    integer e, f, i, sum;

    end = f = maxsum = start = sum = 0;
    for (i, e in l) {
        sum += e;
        if (sum < 0) {
            sum = 0;
            f = i + 1;
        } elif (maxsum < sum) {
            maxsum = sum;
            end = i + 1;
            start = f;
        }
    }
}

main(void)
{
    integer start, end, sum;
    list l;

    l = list(-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1);
    gsss(l, start, end, sum);
    o_("Max sum ", sum, "\n");
    if (start < end) {
        l.ocall(o_, 1, start, end - 1, " ");
        o_newline();
    }

    0;
}


main:
(
        []INT a = (-1 , -2 , 3 , 5 , 6 , -2 , -1 , 4 , -4 , 2 , -1);

        INT begin max, end max, max sum, sum;

        sum := 0;
        begin max := 0;
        end max := -1;
        max sum := 0;

        FOR begin FROM LWB a TO UPB a DO
                sum := 0;
                FOR end FROM begin TO UPB a DO
                        sum +:= a[end];
                        IF sum > max sum THEN
                                max sum := sum;
                                begin max := begin;
                                end max := end
                        FI
                OD
        OD;

        FOR i FROM begin max TO end max DO
                print(a[i])
        OD

)


(define smerge
  [X|Xs] [Y|Ys] -> [X | (freeze (smerge (thaw Xs) [Y|Ys]))] where (< X Y)
  [X|Xs] [Y|Ys] -> [Y | (freeze (smerge [X|Xs] (thaw Ys)))] where (> X Y)
  [X|Xs] [_|Ys] -> [X | (freeze (smerge (thaw Xs) (thaw Ys)))])

(define smerge3
  Xs Ys Zs -> (smerge Xs (smerge Ys Zs)))

(define smap
  F [S|Ss] -> [(F S)|(freeze (smap F (thaw Ss)))])

(set hamming [1 | (freeze (smerge3 (smap (* 2) (value hamming))
                                   (smap (* 3) (value hamming))
                                   (smap (* 5) (value hamming))))])

(define stake
  _      0 -> []
  [S|Ss] N -> [S|(stake (thaw Ss) (1- N))])

(stake (value hamming) 20)


-- maxSubseq :: [Int] -> [Int] -> (Int, [Int])
on maxSubseq(xs)
    script go
        on |λ|(ab, x)
            set a to fst(ab)
            set {m1, m2} to {fst(a), snd(a)}
            set high to max(Tuple(0, {}), Tuple(m1 + x, m2 & {x}))
            Tuple(high, max(snd(ab), high))
        end |λ|
    end script

    snd(foldl(go, Tuple(Tuple(0, {}), Tuple(0, {})), xs))
end maxSubseq

-- TEST ---------------------------------------------------
on run
    set mx to maxSubseq({-1, -2, 3, 5, 6, -2, -1, 4, -4, 2, -1})
    {fst(mx), snd(mx)}
end run

-- GENERIC ABSTRACTIONS -----------------------------------

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

-- gt :: Ord a => a -> a -> Bool
on gt(x, y)
    set c to class of x
    if record is c or list is c then
        fst(x) > fst(y)
    else
        x > y
    end if
end gt

-- fst :: (a, b) -> a
on fst(tpl)
    if class of tpl is record then
        |1| of tpl
    else
        item 1 of tpl
    end if
end fst

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

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

-- snd :: (a, b) -> b
on snd(tpl)
    if class of tpl is record then
        |2| of tpl
    else
        item 2 of tpl
    end if
end snd

-- Tuple (,) :: a -> b -> (a, b)
on Tuple(a, b)
    {type:"Tuple", |1|:a, |2|:b, length:2}
end Tuple


  ' [ 2 3 5 ] smoothwith [ size 1000000 = ]
  dup 20 split drop echo cr
  dup 1690 peek echo cr
  -1 peek echo


subarraySum: function [arr][
    curr: 0
    mx: 0
    fst: size arr
    lst: 0
    currFst: 0

    loop.with: 'i arr [e][
        curr: curr + e
        if e > curr [
            curr: e
            currFst: i
        ]
        if curr > mx [
            mx: curr
            fst: currFst
            lst: i
        ]
    ]
    if? lst > fst -> return @[mx, slice arr fst lst]
    else -> return [0, []]
]

sequences: @[
    @[1, 2, 3, 4, 5, neg 8, neg 9, neg 20, 40, 25, neg 5]
    @[neg 1, neg 2, 3, 5, 6, neg 2, neg 1, 4, neg 4, 2, neg 1]
    @[neg 1, neg 2, neg 3, neg 4, neg 5]
    @[]
]

loop sequences 'seq [
    print [pad "sequence:" 15 seq]
    processed: subarraySum seq
    print [pad "max sum:" 15 first processed]
    print [pad "subsequence:" 15 last processed "\n"]
]


(*
** This one is
** translated into ATS from the Ocaml entry
*)

(* ****** ****** *)
//
// How to compile:
// patscc -DATS_MEMALLOC_LIBC -o maxsubseq maxsubseq.dats
//
(* ****** ****** *)
//
#include
"share/atspre_staload.hats"
//
(* ****** ****** *)

typedef ints = List0(int)

(* ****** ****** *)

fun
maxsubseq
  (xs: ints): (int, ints) = let
//
fun
loop
(
  sum: int, seq: ints
, maxsum: int, maxseq: ints, xs: ints
) : (int, ints) =
(
case+ xs of
| nil () =>
  (
    maxsum
  , list_vt2t(list_reverse(maxseq))
  ) (* end of [nil] *)
| cons (x, xs) => let
    val sum = sum + x
    and seq = cons (x, seq)
  in
    if sum < 0
      then loop (0, nil, maxsum, maxseq, xs)
      else (
        if sum > maxsum
          then loop (sum, seq, sum, seq, xs)
          else loop (sum, seq, maxsum, maxseq, xs)
      ) (* end of [else] *)
  end // end of [cons]
)
//
in
  loop (0, nil, 0, nil, xs)
end // end of [maxsubseq]

implement
main0 () = () where
{
val
(maxsum
,maxseq) =
maxsubseq
(
  $list{int}(~1,~2,3,5,6,~2,~1,4,~4,2,~1)
)
//
val () = println! ("maxsum = ", maxsum)
val () = println! ("maxseq = ", maxseq)
//
} (* end of [main0] *)