require('Tk')

class Honeycombs(
    Number size   = 36,
    Array letters = @('A' .. 'Z').shuffle.first(20),
) {

    define tk   = %S<Tk>
    has changed = Hash()

    func altitude(n) {
        sqrt(3/4) * n
    }

    method polygon_coordinates(x, y, size) {
        var alt = altitude(size)
        return (x - size,       y,
                x - size/2, y - alt,
                x + size/2, y - alt,
                x + size,       y,
                x + size/2, y + alt,
                x - size/2, y + alt,
               );
    }

    method change(canvas, id, letter_id) {
        return {
            canvas.itemconfigure(id,        '-fill' => 'magenta')
            canvas.itemconfigure(letter_id, '-fill' => 'black')
            changed{id} = true

            if (20 == changed.len) {
                say "All letters pressed."
                canvas.MainWindow.after(10, { tk.exit })
            }
        }
    }

    method comb(canvas, fromx, fromy, size, count) {
        for x,y in (
            RangeNum(fromx, 3*count*size - 1,          3*size) ~X
            RangeNum(fromy,     7.5*size - 1, 2*altitude(size))
        ) {
            var id = canvas.createPolygon(
                                  self.polygon_coordinates(x, y, size),
                                  '-outline' => 'black',
                                  '-fill'    => 'yellow',
                                  '-width'   => 2,
                                )
            var letter = letters.shift
            var letter_id = canvas.createText(x, y,
                                     '-fill' => 'red',
                                     '-text' => letter,
                                     '-font' => "{sans} #{size * 0.9}",
                                )
            canvas.MainWindow.bind('all', letter.lc,
                                      self.change(canvas, id, letter_id))
            [id, letter_id].each { |b|
                canvas.bind(b, '<Button-1>',
                                      self.change(canvas, id, letter_id))
            }
        }
    }

    method display(title) {
        {
            var mw     = %s'MainWindow'.new('-title' => title)
            var canvas = mw.Canvas('-width'  => 8*size,
                                   '-height' => 8*size).pack

            self.comb(canvas, size,       size,                  size, 3)
            self.comb(canvas, size * 2.5, size + altitude(size), size, 2)

            var btn = mw.Button('-text'      => 'Quit',
                                '-underline' => 0,
                                '-command'   => { tk.exit },
                               ).pack
            mw.bind('<Alt-q>', { btn.invoke })
            tk.MainLoop()
        }.fork
    }
}

Honeycombs().display(title: 'Honeycombs')


package require Tcl 8.5
package require Tk

# How to make a honeycomb
proc honeycomb {w letterpattern} {
    canvas $w -width 500 -height 470
    set basey 10
    foreach row $letterpattern {
	set basex 10
	set majoroffsety 0
	foreach letter $row {
	    set x [expr {$basex + 60}]
	    set y [expr {$basey + 50 + $majoroffsety}]
	    drawhex $w $x $y $letter 30 50
	    set majoroffsety [expr {50 - $majoroffsety}]
	    incr basex 90
	}
	incr basey 100
    }
    return $w
}

namespace import tcl::mathop::?   ;# For convenience
# How to draw a single hexagon, centered at a particular point.
proc drawhex {w x y ch dx dy} {
    if {$ch eq ""} return          ;# Allow elision of cells (not used here)
    $w create polygon \
	[- $x $dx] [- $y $dy] [+ $x $dx] [- $y $dy] [+ $x $dx $dx] $y \
	[+ $x $dx] [+ $y $dy] [- $x $dx] [+ $y $dy] [- $x $dx $dx] $y \
	-fill yellow -outline black -tags [list hex$ch hull$ch] -width 3
    $w create text $x $y -text $ch -fill red -tags [list hex$ch txt$ch] \
	-font {Arial 72 bold}
    # Install bindings on items
    $w bind hex$ch <Enter> [list enterhex $w $ch]
    $w bind hex$ch <Leave> [list leavehex $w $ch]
    $w bind hex$ch <Button-1> [list dohex $w $ch]
    # Handle keyboard activity through canvas-level bindings
    bind $w [string toupper $ch] [list dokey $w $ch]
    bind $w [string tolower $ch] [list dokey $w $ch]
}

# Callbacks for various bindings
proc enterhex {w ch} {
    global chosen
    if {$ch ni $chosen} {
	$w itemconfigure hull$ch -fill magenta
	$w itemconfigure txt$ch -fill black
    }
}
proc leavehex {w ch} {
    global chosen
    if {$ch ni $chosen} {
	$w itemconfigure hull$ch -fill yellow
	$w itemconfigure txt$ch -fill red
    }
}
proc dohex {w ch} {
    global chosen
    if {$ch ni $chosen} {
	lappend chosen $ch
	puts "chosen $ch"
    }
    if {[llength $chosen] >= 5} {
	destroy $w
    }
}
proc dokey {w ch} {
    enterhex $w $ch
    dohex $w $ch
}

# Initial declarations of state variables
set chosen {}
set letterpattern {
    {L A R N D}
    {G U I Y T}
    {P C F E B}
    {V S O M K}
}

# Build the GUI
pack [honeycomb .c $letterpattern]
focus .c
# Usually don't use this, but it's ideal for this interaction pattern
tkwait window .c
puts "overall list of characters: $chosen"
exit


import "graphics" for Canvas, Color
import "dome" for Window, Process
import "math" for Math
import "font" for Font
import "input" for Mouse, Keyboard
import "random" for Random
import "./polygon" for Polygon

var Rand = Random.new()

class Hexagon is Polygon {
    static baseColor { Color.yellow }
    static selectedColor { Color.pink }

    construct new(x, y, halfWidth, letter) {
        _x = x
        _y = y
        _letter = letter
        var vertices = List.filled(6, null)
        for (i in 0..5) {
            var vx = x + halfWidth * Math.cos(i * Num.pi / 3)
            var vy = y + halfWidth * Math.sin(i * Num.pi / 3)
            vertices[i] = [vx, vy]
        }
        super(vertices, "")
        _selected = false
    }

    letter { _letter }
    selected { _selected }
    selected=(v) { _selected = v }

    draw() {
        var col = selected ? Hexagon.selectedColor : Hexagon.baseColor
        drawfill(col)
        super.draw(Color.black)
        col = selected ? Color.black : Color.red
        Canvas.print(_letter, _x - 8, _y - 8, col)
    }
}

class Honeycombs {
    construct new(width, height) {
        Window.title = "Honeycombs"
        Window.resize(width, height)
        Canvas.resize(width, height)
        var letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".toList
        Rand.shuffle(letters)
        _letters = letters[0..19]
        _x1 = 150
        _y1 = 100
        _x2 = 225
        _y2 = 143
        _w  = 150
        _h  = 87
        _hs = null
        _comb = List.filled(20, null)
        Font.load("memory", "memory.ttf", 48)
        Font["memory"].antialias = true
        Canvas.font = "memory"
    }

    drawHexagons() {
         for (i in 0..._comb.count) {
            var x
            var y
            if (i < 12) {
                x = _x1 + (i % 3) * _w
                y = _y1 + (i / 3).floor * _h
            } else {
                x = _x2 + (i % 2) * _w
                y = _y2 + ((i - 12) / 2).floor * _h
            }
            _comb[i] = Hexagon.new(x, y, (_w / 3).floor, _letters[i])
            _comb[i].draw()
        }
    }

    allSelected() { _comb.all { |h| h.selected } }

    init() {
        drawHexagons()
    }

    update() {
        _hs = null
        if (Mouse.isButtonPressed("left")) {
            for (h in _comb) {
                if (h.contains(Mouse.position.x, Mouse.position.y)) {
                    _hs = h
                    break
                }
            }
        } else if (Keyboard.allPressed.count > 0) {
            for (h in _comb) {
                if (Keyboard.isKeyDown(h.letter)) {
                    _hs = h
                    break
                }
            }
        }
    }

    draw(alpha) {
        if (_hs) {
            _hs.selected = true
            _hs.draw()
            if (allSelected()) Process.exit(0)
        }
    }
}

var Game = Honeycombs.new(600, 500)


include c:\cxpl\stdlib;                 \(color definitions, etc.)

proc DrawHexagon(X0, Y0, Side, Color);  \Draw a filled hexagon centered at X0,Y0
int  X0, Y0, Side, Color;
int  X, Y;
for Y:= -Side*19/22 to +Side*19/22 do           \19/22 aprox = sqrt(3.0)/2.0
    for X:= -Side to +Side do
        if abs(X) + abs(Y)*23/38 <= Side then   \23/38 aprox = 1.0/sqrt(3.0)
            Point(X+X0, Y+Y0, Color);

def Cols=5, Rows=4, X0=23, Y0=20;               \matrix shape, offset on screen
int C, R, X, Y, Letter, Counter, SaveX(26), SaveY(26);
[SetVid($101);                                  \set video to 640x480x8 graphics
for Letter:= 0 to 26-1 do SaveX(Letter):= 0;
Attrib(LMagenta<<8);                            \light magenta letter background
for R:= 0 to Rows-1 do
    for C:= 0 to Cols-1 do
        [X:= C*35 + X0;  Y:= R*40 + (C&1)*20 + Y0;
        DrawHexagon(X, Y, 22, LMagenta);
        repeat Letter:= Ran(26) until SaveX(Letter) = 0;
        Move(X-4, Y-7);  ChOut(6, Letter+^A);
        SaveX(Letter):= X;  SaveY(Letter):= Y;  \save coordinates for letter
        ];
Counter:= 0;
repeat  Letter:= ChIn(1);                       \get letter from keyboard
        if Letter>=^a & Letter<=^z then Letter:= Letter-$20;    \make uppercase
        if Letter>=^A & Letter<=^Z then
           if SaveX(Letter-^A) # 0 then         \letter is available
                [X:= SaveX(Letter-^A);  Y:= SaveY(Letter-^A);
                DrawHexagon(X, Y, 22, Yellow);  \change color
                Move(X-4, Y-7);
                Attrib(Yellow<<8);  ChOut(6, Letter);
                Move(Counter*8+8, Rows*40+30);  \show record of chosen letters
                Attrib(Yellow);  ChOut(6, Letter);
                Counter:= Counter+1;
                SaveX(Letter-^A):= 0;           \letter is no longer available
                ]
           else ChOut(0, Bel)                   \letter is not available
        else ChOut(0, Bel);                     \not a letter (A..Z)
until   Counter >= Cols*Rows;
SetVid($03);                                    \restore normal text display
]


V last = 1 << 20
V a_list = [0] * (last+1)
a_list[0] = -50'000
a_list[1] = 1
a_list[2] = 1

V v = a_list[2]
V k1 = 2
V lg2 = 1
V amax = 0.0

L(n) 3..last
   v = a_list[v] + a_list[n - v]
   a_list[n] = v
   amax = max(amax, Float(v) / n)
   I (k1 [&] n) == 0
      print(‘Maximum between 2^#. and 2^#. was #.6’.format(lg2, lg2 + 1, amax))
      amax = 0
      lg2++
   k1 = n


*        Hofstadter-Conway $10,000 sequence    07/05/2016
HOFSTADT START
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save registers
         ST     R13,4(R15)         link backward SA
         ST     R15,8(R13)         link forward SA
         LR     R13,R15            establish addressability
         USING  HOFSTADT,R13       set base register
         LA     R4,2               pow2=2
         LA     R8,4               p2=2**pow2
         MVC    A+0,=F'1'          a(1)=1
         MVC    A+4,=F'1'          a(2)=1
         LA     R6,3               n=3
LOOPN    C      R6,UPRDIM          do n=3 to uprdim
         BH     ELOOPN
         LR     R1,R6              n
         SLA    R1,2
         L      R5,A-8(R1)         a(n-1)
         LR     R1,R5
         SLA    R1,2
         L      R2,A-4(R1)         a(a(n-1))
         LR     R1,R6              n
         SR     R1,R5              n-a(n-1)
         SLA    R1,2
         L      R3,A-4(R1)         a(n-a(n-1)
         AR     R2,R3              a(a(n-1))+a(n-a(n-1))
         LR     R1,R6              n
         SLA    R1,2
         ST     R2,A-4(R1)         a(n)=a(a(n-1))+a(n-a(n-1))
         LR     R1,R6              n
         SLA    R1,2
         L      R2,A-4(R1)         a(n)
         MH     R2,=H'10000'       fixed point 4dec
         SRDA   R2,32
         DR     R2,R6              /n
         LR     R7,R3              r=a(n)/n
         C      R7,=F'5500'        if r>=0.55
         BL     EIF1
         LR     R9,R6              mallows=n
EIF1     C      R7,PEAK            if r>peak
         BNH    EIF2
         ST     R7,PEAK            peak=r
         ST     R6,PEAKPOS         peakpos=n
EIF2     CR     R6,R8              if n=p2
         BNE    EIF3
         LR     R1,R4              pow2
         BCTR   R1,0               pow2-1
         XDECO  R1,XDEC            edit pow2-1
         MVC    PG1+18(2),XDEC+10
         XDECO  R4,XDEC            edit pow2
         MVC    PG1+27(2),XDEC+10
         L      R1,PEAK            peak
         XDECO  R1,XDEC            edit peak
         MVC    PG1+35(4),XDEC+8
         L      R1,PEAKPOS         peakpos
         XDECO  R1,XDEC            edit peakpos
         MVC    PG1+45(5),XDEC+7
         XPRNT  PG1,80             print buffer
         LA     R4,1(R4)           pow2=pow2+1
         SLA    R8,1               p2=2**pow2
         MVC    PEAK,=F'5000'      peak=0.5
EIF3     LA     R6,1(R6)           n=n+1
         B      LOOPN
ELOOPN   L      R1,L               l
         XDECO  R1,XDEC            edit l
         MVC    PG2+6(2),XDEC+10
         XDECO  R9,XDEC            edit mallows
         MVC    PG2+29(5),XDEC+7
         XPRNT  PG2,80             print buffer
RETURN   L      R13,4(0,R13)       restore savearea pointer
         LM     R14,R12,12(R13)    restore registers
         XR     R15,R15            return code = 0
         BR     R14                return to caller
         LTORG
L        DC     F'12'
UPRDIM   DC     F'4096'            2^L
PEAK     DC     F'5000'            0.5 fixed point 4dec
PEAKPOS  DC     F'0'
XDEC     DS     CL12
PG1      DC CL80'maximum between 2^xx and 2^xx is 0.xxxx at n=xxxxx'
PG2      DC CL80'for l=xx : mallows number is xxxxx'
A        DS     4096F              array a(uprdim)
         REGEQU
         END    HOFSTADT


-- Ada95 version
-- Allocation of arrays on the heap

with Ada.Text_IO; use Ada.Text_IO;
with Unchecked_Deallocation;

procedure Conway is

   package Real_io is new Float_IO (Float);

   Maxrange : constant := 2 ** 20;

   type Sequence is array (Positive range 1 .. Maxrange) of Positive;
   type Sequence_Ptr is access all Sequence;
   procedure Free is new Unchecked_Deallocation (Sequence, Sequence_Ptr);

   S : Sequence_Ptr := new Sequence;

   type Ratio_Array is array (Positive range 1 .. Maxrange) of Float;
   type Ratio_Ptr is access all Ratio_Array;
   procedure Free is new Unchecked_Deallocation (Ratio_Array, Ratio_Ptr);

   Ratio : Ratio_Ptr := new Ratio_Array;

   Mallows : Positive;
   M       : Natural := 0;
begin
   S (1) := 1;
   S (2) := 1;
   for K in 3 .. Maxrange loop
      S (K) := S (S (K - 1)) + S (K - S (K - 1));
   end loop;

   for k in 1 .. Maxrange loop
      Ratio (k) := Float (S (k)) / Float (k);
   end loop;

   for N in 1 .. 19 loop
      declare
         Max   : Float := 0.0;
         Where : Positive;
      begin
         for K in 2 ** N .. 2 ** (N + 1) loop
            if Max < Ratio (K) then
               Max   := Ratio (K);
               Where := K;
            end if;
         end loop;
         if (M = 0 and Max < 0.55) then
            M := N - 1;
         end if;
         Put
           ("Maximun of a(n)/n between 2^" &
            Integer'Image (N) &
            " and 2^" &
            Integer'Image (N + 1) &
            " was ");
         Real_io.Put (Max, Fore => 1, Aft => 8, Exp => 0);
         Put_Line (" at" & Integer'Image (Where));
      end;
   end loop;
   --  Calculate Mallows number
   for I in reverse 2 ** M .. 2 ** (M + 1) loop
      if (Ratio (I) > 0.55) then
         Mallows := I;
         exit;
      end if;
   end loop;
   Put_Line ("Mallows number" & Integer'Image (Mallows));
   Free (S);
   Free (Ratio);
end Conway;


PROC do sqnc = (INT max)INT:
BEGIN
    [max]INT a list;
    INT k1 := 2,
        lg2 := 1,
        v := a list[1] := a list[2] := 1; # Concurrent declaration and assignment in declarations are allowed #

    INT nmax;
    LONG REAL amax := 0.0;

    INT mallows number;

    FOR n FROM 3 TO max DO
      v := a list[n] := a list[v] + a list[n-v];

      ( amax < v/n | amax := v/n; nmax := n );  # When given a Boolean as the 1st expression, ( | ) is the short form of IF...THEN...FI #

      IF v/n >= 0.55 THEN                       # This is the equivalent full form of the above construct #
          mallows number := n
      FI;

      IF ABS(BIN k1 AND BIN n) = 0 THEN
      # 'BIN' converts an INT type to a BITS type; In this context, 'ABS' reverses that operation #
        printf(($"Maximum between 2^"g(0)" and 2^"g(0)" is about "g(-10,8)" at "g(0)l$, lg2,lg2+1, amax, nmax));
        amax := 0;
        lg2 PLUSAB 1   # 'PLUSAB' (plus-and-becomes) has the short form +:= #
      FI;
      k1 := n
    OD;
    mallows number   # the result of the last expression evaluated is returned as the result of the PROC #
END;

INT mallows number = do sqnc(2**20); # This definition of 'mallows number' does not clash with the variable
                                       of the same name inside PROC do sqnc - they are in different scopes#

printf(($"You too might have won $1000 with an answer of n = "g(0)$, mallows number))


on HC10000(ceiling)
    script o
        property lst : {1, 1}
        property maxima : {}
    end script

    set p to missing value
    set max to 0
    set maxPos to 0
    set power to 0
    set x to end of o's lst
    repeat with n from 3 to ceiling
        set x to (item x of o's lst) + (item -x of o's lst)
        set end of o's lst to x
        set ann to x / n
        if (ann is not less than 0.55) then set p to n
        if (ann > max) then
            set max to ann
            set maxPos to n
        end if
        if (ann is 0.5) then
            set power to power + 1
            set end of o's maxima to {|<-powers->|:{power, power + 1}, n:maxPos, max:max}
            set max to 0
        end if
    end repeat

    return {p:p, maxima:o's maxima}
end HC10000

HC10000(2 ^ 20)


#!/usr/bin/awk -f
BEGIN {
  NN = 20;
  iterativeHCsequence(2^NN+1,Q);
  for (K=1; K<NN; K++) {
    m = 0;
    for (n=2^K+1; n<=2^(K+1); n++) {
        v = Q[n]/n;
	if (m < v) {nn=n; m = v};
    }
    printf "Maximum a(n)/n between 2^%i and 2^%i is %f at n=%i\n",K,K+1,m,nn;
  }
  print "number of Q(n)<Q(n+1) for n<=100000 : " NN;
}

function iterativeHCsequence(N,Q) {
  Q[1] = 1;
  Q[2] = 1;
  for (n=3; n<=N; n++) {
    Q[n] = Q[Q[n-1]]+Q[n-Q[n-1]];
  }
}


arraybase 1
pow2 = 2
p2 = 2 ^ pow2
peak = .5
dim a(2 ^ 20)
a[1] = 1
a[2] = 1

for n = 3 to 2 ^ 20
    a[n] = a[a[n-1]] + a[n-a[n-1]]
    r = a[n] / n
    if r >= .55 then mallows = n
    if r > peak then peak = r : peakpos = n
    if n = p2 then
        print "Maximum between 2 ^ "; rjust((pow2 - 1),2); " and 2 ^ "; rjust(pow2,2); " is "; ljust(peak,13,"0"); " at n = "; peakpos
        pow2 += 1
        p2 = 2 ^ pow2
        peak = .5
    end if
next n

print
print "Mallows number is "; mallows


( ( a
  =
    .   !arg:(1|2)&1
      | (as..find)$!arg:(?.?arg)&!arg
      |     (as..insert)
          $ ( !arg
            . a$(a$(!arg+-1))+a$(!arg+-1*a$(!arg+-1)):?arg
            )
        & !arg
  )
& new$hash:?as
& 0:?n:?maxan/n
& 1:?pow
&   whl
  ' ( 1+!n:?n
    & !pow:~>20
    & ( 2^!pow:~!n
      |     out
          $ ( str
            $ ( "Between 2^"
                !pow+-1
                " and 2^"
                !pow
                " the maximum value of a(n)/n is reached for n = "
                !maxn
                " with the value "
                !maxan/n
              )
            )
        & 0:?maxan/n
        & 1+!pow:?pow
      )
    & a$!n*!n^-1:?an/n
    & (   !an/n:>!maxan/n:?maxan/n
        & !n:?maxn
      |
      )
    & ( !an/n:~<11/20:?Man/n&!n:?Mallows
      |
      )
    )
&   out
  $ ( str
    $ ( "Mallows number is "
        !Mallows
        ", where a("
        !Mallows
        ")/"
        !Mallows
        " == "
        !Man/n
        ", which is greater than 0.55 by "
        !Man/n+-11/20
      )
    )
)


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

int a_list[1<<20 + 1];

int doSqnc( int m)
{
    int max_df = 0;
    int p2_max = 2;
    int v, n;
    int k1 = 2;
    int lg2 = 1;
    double amax = 0;
    a_list[0] = -50000;
    a_list[1] = a_list[2] = 1;
    v = a_list[2];

    for (n=3; n <= m;  n++) {
        v = a_list[n] = a_list[v] + a_list[n-v];
        if ( amax < v*1.0/n) amax = v*1.0/n;
        if ( 0 == (k1&n)) {
            printf("Maximum between 2^%d and 2^%d was %f\n", lg2,lg2+1, amax);
            amax = 0;
            lg2++;
        }
        k1 = n;
    }
    return 1;
}


using System;
using System.Linq;

namespace HofstadterConway
{
    class Program
    {
        static int[] GenHofstadterConway(int max)
        {
            int[] result = new int[max];
            result[0]=result[1]=1;
            for (int ix = 2; ix < max; ix++)
                result[ix] = result[result[ix - 1] - 1] + result[ix - result[ix - 1]];
            return result;
        }

        static void Main(string[] args)
        {
            double[] adiv = new double[1 << 20];
            {
                int[] a = GenHofstadterConway(1 << 20);
                for (int i = 0; i < 1 << 20; i++)
                    adiv[i] = a[i] / (double)(i + 1);
            }
            for (int p = 2; p <= 20; p++)
            {
                var max = Enumerable.Range(
                     (1 << (p - 1)) - 1,
                     (1 << p) - (1 << (p - 1))
                     )
                     .Select(ix => new { I = ix + 1, A = adiv[ix] })
                     .OrderByDescending(x => x.A)
                     .First();
                Console.WriteLine("Maximum from 2^{0} to 2^{1} is {2} at {3}",
                    p - 1, p, max.A, max.I);
            }
            Console.WriteLine("The winning number is {0}.",
                Enumerable.Range(0, 1 << 20)
                    .Last(i => (adiv[i] > 0.55)) + 1
                );
        }
    }
}


#include <deque>
#include <iostream>

int hcseq(int n)
{
  static std::deque<int> seq(2, 1);
  while (seq.size() < n)
  {
    int x = seq.back();
    seq.push_back(seq[x-1] + seq[seq.size()-x]);
  }
  return seq[n-1];
}

int main()
{
  int pow2 = 1;
  for (int i = 0; i < 20; ++i)
  {
    int pow2next = 2*pow2;
    double max = 0;
    for (int n = pow2; n < pow2next; ++n)
    {
      double anon = hcseq(n)/double(n);
      if (anon > max)
        max = anon;
    }
    std::cout << "maximum of a(n)/n between 2^" << i
              << " (" << pow2 << ") and 2^" << i+1
              << " (" << pow2next << ") is " << max << "\n";
    pow2 = pow2next;
  }
}


(ns rosettacode.hofstader-conway
  (:use [clojure.math.numeric-tower :only [expt]]))

;; A literal transcription of the definition, with memoize doing the heavy lifting
(def conway
  (memoize
    (fn [x]
      (if (< x 3)
        1
        (+  (-> x dec conway conway)
           (->> x dec conway (- x) conway))))))

(let [N      (drop 1 (range))
      pow2   (map #(expt 2 %) N)
      ; Split the natural numbers into groups at each power of two
      groups (partition-by (fn [x] (filter #(> % x) pow2)) N)
      maxima (->> (map #(map conway %) groups)
                  (map #(map / %2 %1) groups)  ; Each conway number divided by its index
                  (map #(apply max %)))
      m20    (take 20 maxima)]
  (println
    (take 4 maxima) "\n"
    (apply >= m20)  "\n"
    (map double m20)))   ; output the decimal forms


(defparameter *hof-con*
  (make-array '(2) :initial-contents '(1 1) :adjustable t
	      :element-type 'integer :fill-pointer 2))

(defparameter *hof-con-ratios*
  (make-array '(2) :initial-contents '(1.0 0.5) :adjustable t
	      :element-type 'single-float :fill-pointer 2))

(defun hof-con (n)
  (let ((l (length *hof-con*)))
    (if (<= n l) (aref *hof-con* (1- n))
	(extend-hof-con-sequence l n))))

(defun extend-hof-con-sequence (l n)
  (loop for i from l below n do
       (let* ((x (aref *hof-con* (1- i)))
	      (hc (+ (aref *hof-con* (1- x))
		     (aref *hof-con* (- i x)))))
	 (vector-push-extend hc *hof-con*)
	 (vector-push-extend (/ hc (+ i 1.0)) *hof-con-ratios*)))
  (aref *hof-con* (1- n)))

(defun max-in-array-range (arr id1 id2)
  (let ((m 0) (id 0))
    (loop for i from (1- id1) to (1- id2) do
	 (let ((n (aref arr i)))
	   (if (> n m) (setq m n id i))))
    (values m (1+ id))))

(defun maxima (po2)
  (hof-con (expt 2 po2))
  (loop for i from 1 below po2 do
       (let ((id1 (expt 2 i)) (id2 (expt 2 (1+ i))))
	 (multiple-value-bind (m id)
	     (max-in-array-range *hof-con-ratios* id1 id2)
	   (format t "Local maximum in [~A .. ~A]: ~A at n = ~A~%" id1 id2 m id)))))

(defun mallows (po2)
  (let ((n (expt 2 po2)))
    (hof-con n)
    (do ((i (1- n) (1- i)))
	((> (aref *hof-con-ratios* i) 0.55) (+ i 1)))))


import std.stdio, std.algorithm;

void hofstadterConwaySequence(in int m) {
    auto alist = new int[m + 1];
    alist[0 .. 2] = 1;
    auto v = alist[2];
    int k1 = 2, lg2 = 1;
    double amax = 0.0;

    foreach (n; 2 .. m + 1) {
        v = alist[n] = alist[v] + alist[n - v];
        amax = max(amax, v * 1.0 / n);
        if ((k1 & n) == 0) {
            writefln("Max in [2^%d, 2^%d]: %f", lg2, lg2 + 1, amax);
            amax = 0;
            lg2++;
        }
        k1 = n;
    }
}

void main() {
    hofstadterConwaySequence(2 ^^ 20);
}


(decimals 4)
(cache-size 2000000)

(define (a n)
	(+ (a (a (1- n))) (a (- n (a (1- n))))))

(remember 'a #(0 1 1)) ;; memoize

;; prints max a(n)/n in [2**i 2**i+1] intervals
;; return Mallows number checked up to 2**20
(define (task  (maxv) (start 1) (end 2) (v) (mrange 0))
	(for ((i  (in-range 1 21)))
	(set! maxv 0)

	(for ((n  (in-range start end)))
	(set! v (// (a n) n))
	#:when (> v maxv)
		(set! maxv v))
	    (when (and (zero? mrange) (< maxv 0.55)) (set! mrange end))

	(printf "[%d .. %d]  →  max a(n)/n:  %d " start end maxv)
	(set! start end)
	(set! end (* start 2)))

;; mallows
	(for ((n (in-range mrange 2 -1)))
		#:break (> (// (a n) n) 0.55) => n )
	)


class
	APPLICATION

create
	make

feature

	make
			--Tests the feature sequence.
		local
			j, n, exp: INTEGER
			max: REAL_64
		do
			exp := 15
			n := (2 ^ exp).floor
			sequence (n)
			across
				1 |..| (exp - 1) as c
			loop
				max := 0
				from
					j := (2 ^ c.item).floor
				until
					j > 2 ^ (c.item + 1)
				loop
					if members [j] / j > max then
						max := members [j] / j
					end
					j := j + 1
				end
				io.put_string ("Between 2^" + c.item.out + "and 2^" + (c.item + 1).out + " the max is: " + max.out)
				io.new_line
			end
		end

feature {NONE}

	members: LINKED_LIST [INTEGER]
			-- Members of the Hofstadter Conway $10000 sequence.

	sequence (n: INTEGER)
			-- Hofstadter Conway $10000 sequence up to 'n' in 'members'.
		require
			n_positive: n > 0
		local
			last: INTEGER
		do
			create members.make
			members.extend (1)
			members.extend (1)
			across
				3 |..| n as c
			loop
				last := members.last
				members.extend (members [last] + members [c.item - last])
			end
		end

end


-module( hofstadter_conway ).

-export( [sequence/1, sequence_div_n/1, task/0] ).

-record( power_of_2, {div_n=0, max=4, min=2, n=0} ).

sequence( 1 ) -> [1];
sequence( 2 ) -> [1, 1];
sequence( Up_to ) when Up_to >= 3 ->
        From_3 = lists:seq( 3, Up_to ),
        Dict = lists:foldl( fun sequence_dict/2, dict:from_list([{1, 1}, {2, 1}]), From_3 ),
	[1, 1 | [dict:fetch(X, Dict) || X <- From_3]].

sequence_div_n( N ) ->
        Sequence = sequence( N ),
	[{X, Y / X} || {X, Y} <- lists:zip(lists:seq(1, N), Sequence)].

task() ->
       [_First | Rest] = sequence_div_n( erlang:round(math:pow(2, 20)) ),
       {_Power, Powers} = lists:foldl( fun max_between_power_of_2/2, {#power_of_2{}, []}, Rest ),
       [io:fwrite( "Maximum between ~p and ~p is ~p for n=~p~n", [X#power_of_2.min, X#power_of_2.max, X#power_of_2.div_n, X#power_of_2.n]) || X <- Powers].

max_between_power_of_2( {N, _Div_n}, {#power_of_2{max=N}=P, Acc} ) ->
        {#power_of_2{max=N * 2, min=N}, [P | Acc]};
max_between_power_of_2( {N, Larger_div_n}, {#power_of_2{div_n=Div_n}=P, Acc} ) when Larger_div_n > Div_n ->
        {P#power_of_2{n=N, div_n=Larger_div_n}, Acc};
max_between_power_of_2( _, Both ) -> Both.

sequence_dict( Key, Dict ) ->
        Last_number = dict:fetch( Key - 1, Dict ),
        At_begining = dict:fetch( Last_number, Dict ),
        At_end = dict:fetch( Key - Last_number, Dict ),
        dict:store( Key, At_begining + At_end, Dict ).


let a = ResizeArray[0; 1; 1]
while a.Count <= (1 <<< 20) do
  a.[a.[a.Count - 1]] + a.[a.Count - a.[a.Count - 1]] |> a.Add
for p = 1 to 19 do
  Seq.max [|for i in 1 <<< p .. 1 <<< p+1 -> float a.[i] / float i|]
  |> printf "Maximum in %6d..%7d is %g\n" (1 <<< p) (1 <<< p+1)
let mallows, _ = a
                 |> List.ofSeq
                 |> List.mapi (fun i n -> i, n)
                 |> List.rev
                 |> List.find (fun (i, n)  -> float(n) / float(i) > 0.55)
printfn "Mallows number is %d" mallows


USING: combinators formatting io kernel locals math math.ranges
prettyprint sequences splitting ;

MEMO:: a ( n -- a(n) )  ! memoize the recurrence relation
    n {
        { 1 [ 1 ] }
        { 2 [ 1 ] }
        [ 1 - a a n n 1 - a - a + ]
    } case ;

20 2^ [1,b] [ [ a ] [ 1 + / ] bi* ] map-index
[
    { 1/2 } split harvest rest-slice
    [ supremum ] map 1 19 [a,b]
    [ dup 1 + [ 2^ ] [email protected] "%f max in (%d, %d)\n" printf ]
    2each
]
[ "Mallow's number: " write [ 0.55 >= ] find-last drop 1 + . ]
bi


program conway
  implicit none
  integer :: a(2**20)  ! The sequence a(n)
  real    :: b(2**20)  ! The sequence a(n)/n
  real    :: v         ! Max value in the range [2*i, 2**(i+1)]
  integer :: nl(1)     ! The location of v in the array b(n)
  integer :: i, N, first, second, last, m

  ! Populate a(n) and b(n)
  a(1:2) = [1, 1]
  b(1:2) = [1.0e0, 0.5e0]
  N = 2
  do i=1,2**20
     last = a(N)
     first = a(last)
     second = a(N-last+1)
     N = N+1
     a(N:N) = first + second
     b(N:N) = a(N:N)/real(N)
  end do

  ! Calculate the max values in the logarithmic ranges
  m = 0
  do i=1,19
     v = maxval(b(2**i:2**(i+1)))
     nl = maxloc(b(2**i:2**(i+1)))
     write(*,'(2(a,i0),a,f8.6,a,i0)') &
          'Max. between 2**', i,      &
          ' and 2**', (i+1),          &
          ' is ', v,                  &
          ' at n = ', 2**i+nl(1)-1
     if (m == 0 .and. v < 0.55e0) then
        m = i-1
     end if
  end do

  ! Calculate Mallows number
  do i=2**(m+1), 2**m,-1
     if (b(i) > 0.55e0) then
        exit
     end if
  end do
  write(*,'(a,i0)') 'Mallows number = ',i

end program conway


window 1

// Set width of tab
def tab 9

dim as long Mallows, n, pow2, p2, pPos, uprLim
dim as double p
print

// Adjust array elements depending on size of sequence
_maxArrayElements = 1200000

input "Enter upper limit between 1 and 20 (Enter 20 gives 2^20): "; uprLim

dim as double r
dim as long a( _maxArrayElements )

if uprLim < 1 or uprLim > 20 then uprLim = 20

a(1) = 1
a(2) = 1
pow2 = 2
p2 = 2 ^ pow2
p = 0.5
pPos = 0

print

for n = 3 to 2 ^ uprLim
   a(n) = a( a( n-1 ) ) + a( n-a( n-1 ) )
   r = a(n) / n
      if r >= 0.55 then Mallows = n
      if r > p
         p = r
         pPos = n
      end if

      if n == p2
         print "Maximum of a(n)/n between", " 2^"; pow2-1; " and 2^"; pow2," is "; p;, " at n = "; pPos
         pow2 = pow2 + 1
         p2   = 2 ^ pow2
         p    = 0.5
      end if
next
print
print "Dr. Mallow's winning number is:"; Mallows

HandleEvents


package main

import (
    "fmt"
)

func main() {
    a := []int{0, 1, 1} // ignore 0 element. work 1 based.
    x := 1  // last number in list
    n := 2  // index of last number in list = len(a)-1
    mallow := 0
    for p := 1; p < 20; p++ {
        max := 0.
        for nextPot := n*2; n < nextPot; {
            n = len(a) // advance n
            x = a[x]+a[n-x]
            a = append(a, x)
            f := float64(x)/float64(n)
            if f > max {
                max = f
            }
            if f >= .55 {
                mallow = n
            }
        }
        fmt.Printf("max between 2^%d and 2^%d was %f\n", p, p+1, max)
    }
    fmt.Println("winning number", mallow)
}


import Data.List
import Data.Ord
import Data.Array
import Text.Printf

hc :: Int -> Array Int Int
hc n = arr
  where arr = listArray (1, n) $ 1 : 1 : map (f (arr!)) [3 .. n]
        f a i = a (a $ i - 1) + a (i - a (i - 1))

printMaxima :: (Int, (Int, Double)) -> IO ()
printMaxima (n, (pos, m)) =
    printf "Max between 2^%-2d and 2^%-2d is %1.5f at n = %6d\n"
                             n    (n + 1)        m        pos

main = do
    mapM_ printMaxima maxima
    printf "Mallows's number is %d\n" mallows
  where
    hca = hc $ 2^20
    hc' n  = fromIntegral (hca!n) / fromIntegral n
    maxima = zip [0..] $ map max powers
    max seq = maximumBy (comparing snd) $ zip seq (map hc' seq)
    powers = map (\n -> [2^n .. 2^(n + 1) - 1]) [0 .. 19]
    mallows = last.takeWhile ((< 0.55) . hc') $ [2^20, 2^20 - 1 .. 1]


procedure main(args)
    m       := integer(!args) | 20
    nextNum := create put(A := [], 1 | 1 | |A[A[*A]]+A[-A[*A]])[*A]
    p2      := 2 ^ (p := 1)
    maxv    := 0
    every n := 1 to (2^m) do {
        if maxv <:= (x := @nextNum / real(n)) then maxm := n
        if x >= 0.55 then mallows := n   # Want *this* n, not next one!
        if n = p2 then {
            write("Max between 2^",p-1," and 2^",p," is ",maxv," at n = ",maxm)
            p2 := 2 ^ (p +:= 1)
            maxv := 0
            }
        }
    write("Mallows's number is ",\mallows | "NOT found!")
end


   hc10k =:  , ] +/@:{~ (,&<: -.)@{:    NB.  Actual sequence a(n)
   AnN   =:  % 1[email protected]:#                  NB.  a(n)/n
   MxAnN =:  >./;.1~ 2 (=<.)@:^. 1[email protected]# NB.  Maxima of a(n)/n between successive powers of 2


//  Title:  Hofstadter-Conway $10,000 sequence

public class HofstadterConwaySequence {

    private static int MAX = (int) Math.pow(2, 20) + 1;
    private static int[] HCS = new int[MAX];
    static {
        HCS[1] = 1;
        HCS[2] = 1;
        for ( int n = 3 ; n < MAX ; n++ ) {
            int nm1 = HCS[n - 1];
            HCS[n] = HCS[nm1] + HCS[n - nm1];
        }
    }

    public static void main(String[] args) {
        int mNum = 0;
        for ( int m = 1 ; m < 20 ; m++ ) {
            int min = (int) Math.pow(2, m);
            int max = min * 2;
            double maxRatio = 0.0;
            int nVal = 0;
            for ( int n = min ; n <= max ; n ++ ) {
                double ratio = (double) HCS[n] / n;
                if ( ratio > maxRatio ) {
                    maxRatio = Math.max(ratio,  maxRatio);
                    nVal = n;
                }
                if ( ratio >= 0.55 ) {
                    mNum = n;
                }
            }
            System.out.printf("Max ratio between 2^%d and 2^%d is %f at n = %,d%n", m, m+1, maxRatio, nVal);
        }
        System.out.printf("Mallow's number is %d.%n", mNum);
    }

}


var hofst_10k = function(n) {
	var memo = [1, 1];

	var a = function(n) {
		var result = memo[n-1];
		if (typeof result !== 'number') {
			result = a(a(n-1))+a(n-a(n-1));
			memo[n-1] = result;
		}
		return result;
	}
	return a;
}();

var maxima_between_twos = function(exp) {
	var current_max = 0;
	for(var i = Math.pow(2,exp)+1; i < Math.pow(2,exp+1); i += 1) {
		current_max = Math.max(current_max, hofst_10k(i)/i);
	}
	return current_max;
}

for(var i = 1; i <= 20; i += 1) {
	console.log("Maxima between 2^"+i+"-2^"+(i+1)+" is: "+maxima_between_twos(i)+"\n");
}


def hcSequence($limit):
  reduce range(3; $limit) as $n ([0,1,1];
    .[$n-1] as $p
    | .[$n] = .[$p] + .[$n-$p]);

def task($limit):
  hcSequence($limit) as $a
  | "     Range          Maximum",
    "----------------   --------",
    (foreach range(2; $limit) as $n ( {max: $a[1], pow2: 1, p:1 };
       ($a[$n] / $n) as $r
       | .emit = null
       | if $r > .max then .max=$r else . end
       | if ($n == .pow2 * 2)
         then .emit = "2 ^ \(.p-1) to 2 ^ \(.p)   \(.max)"
         | .pow2 *= 2
         | .p +=  1
         | .max = $r
	 else . end;
	 select(.emit).emit)),

     ( (first( range( $limit-1; 0; -1) as $n
          | if ($a[$n]/$n >= 0.55) then $n else empty end) ) // 0
          | "\nMallows' number = \(.)") ;

task( pow(2;20) + 1 )


# v0.6

# Task 1
function hofstadterconway(n::Integer)::Vector{Int}
    rst = fill(1, n)
    for i in 3:n
        rst[i] = rst[rst[i - 1]] + rst[i - rst[i - 1]]
    end
    return rst
end

function hcfraction(n::Integer)::Vector{Float64}
    rst = Array{Float64}(n)
    for (i, a) in enumerate(hofstadterconway(n))
        rst[i] = abs(a) / i
    end
    return rst
end

# Task 2
seq = hcfraction(2 ^ 20)
for i in 1:20
    a, b = 2 ^ (i - 1), 2 ^ i
    @printf("max value of a(n)/n in %6i < n < %7i = %5.3f\n", a, b, maximum(seq[a:b]))
end

# Task 3
function lastindex(val::Float64)
    r, p = 1, 0
    # Find the range of 2 power in which the maximum is < val
    seq = hcfraction(2 ^ 15)
    while maximum(seq[2^p:2^(p+1)]) > val; p += 1 end
    r = 2 ^ (p + 1)
    while seq[r] < val; r -= 1 end
    return r
end

println("You too might have won \$1000 with the mallows number of ", lastindex(0.55))


// version 1.1.2

fun main(args: Array<String>) {
    val limit = (1 shl 20) + 1
    val a = IntArray(limit)
    a[1] = 1
    a[2] = 1
    for (n in 3 until limit) {
        val p = a[n - 1]
        a[n] = a[p] + a[n - p]
    }

    println("     Range          Maximum")
    println("----------------   --------")
    var pow2 = 1
    var p = 1
    var max = a[1].toDouble()
    for (n in 2 until limit) {
        val r = a[n].toDouble() / n
        if (r > max) max = r
        if (n == pow2 * 2) {
            println("2 ^ ${"%2d".format(p - 1)} to 2 ^ ${"%2d".format(p)}   ${"%f".format(max)}")
            pow2 *= 2
            p++
            max = r
        }
    }

    var prize = 0
    for (n in limit - 1 downTo 1) {
        if (a[n].toDouble() / n >= 0.55) {
            prize = n
            break
        }
    }
    println("\nMallows' number = $prize")
}


local fmt, write=string.format,io.write
local hof=coroutine.wrap(function()
	local yield=coroutine.yield
	local a={1,1}
	yield(a[1], 1)
	yield(a[2], 2)
	local n=a[#a]
	repeat
		n=a[n]+a[1+#a-n]
		a[#a+1]=n
		yield(n, #a)
	until false
end)

local mallows, mdiv=0,0
for p=1,20 do
	local max, div, num, last, fdiv=0,0,0,0,0
	for i=2^(p-1),2^p-1 do
		h,n=hof()
		div=h/n
		if div>max then
			max=div
			num=n
		end
		if div>0.55 then
			last=n
			fdiv=div
		end
	end
	write(fmt("From 2^%-2d to 2^%-2d the max is %.4f the %6dth Hofstadter number.\n",
		p-1, p, max, num))
	if max>.55 and p>4 then
		mallows, mdiv=last, fdiv
	end
end
write("So Mallows number is ", mallows, " with ", fmt("%.4f",mdiv), ", yay, just wire me my $10000 now!\n")


 function Q = HCsequence(N)
  Q = zeros(1,N);
  Q(1:2) = 1;
  for n = 3:N,
    Q(n) = Q(Q(n-1))+Q(n-Q(n-1));
  end;
end;


import strutils

const last = 1 shl 20

var aList: array[last + 1, int]
aList[0..2] = [-50_000, 1, 1]
var
  v    = aList[2]
  k1   = 2
  lg2  = 1
  aMax = 0.0

for n in 3..last:
  v = aList[v] + aList[n-v]
  aList[n] = v
  aMax = max(aMax, v.float / n.float)
  if (k1 and n) == 0:
    echo "Maximum between 2^$# and 2^$# was $#".format(lg2, lg2+1, aMax)
    aMax = 0
    inc lg2
  k1 = n


bundle Default {
  class HofCon {
    function : Main(args : String[]) ~ Nil {
      DoSqnc(1<<20);
    }

    function : native : DoSqnc(m : Int) ~ Nil {
      a_list := Int->New[m + 1];
      max_df := 0;
      p2_max := 2;
      k1 := 2;
      lg2 := 1;
      amax := 0.0;

      a_list[0] := 1;
      a_list[1] := 1;

      v := a_list[2];

      for(n := 2; n <= m; n+=1;) {
        r := a_list[v] + a_list[n - v];
        v := r;
        a_list[n] := r;

        if(amax < v * 1.0 / n) {
          amax := v * 1.0 / n;
        };

        if(0 = (k1 and n)) {
          IO.Console->Print("Maximum between 2^")->Print(lg2)
            ->Print(" and 2^")->Print(lg2 + 1)->Print(" was ")->PrintLine(amax);
          amax := 0;
          lg2+=1;
        };
        k1 := n;
      };
    }
  }
}


: hofstadter(n)
| l i |
   ListBuffer newSize(n) dup add(1) dup add(1) ->l
   n 2 - loop: i [ l at(l last) l at(l size l last - 1+ ) + l add ]
   l dup freeze ;

: hofTask
| h m i |
   2 20 pow ->m
   hofstadter(m) m seq zipWith(#[ tuck asFloat / swap Pair new ]) ->h

   19 loop: i [
      i . "^2 ==>" .
      h extract(2 i pow , 2 i 1+ pow) reduce(#maxKey) println
      ]

   "Mallows number ==>" . h reverse detect(#[ first 0.55 >= ], true) println
;


declare
  local
     Cache = {Dictionary.new}
     Cache.1 := 1
     Cache.2 := 1
  in
     fun {A N}
        if {Not {Dictionary.member Cache N}} then
           Cache.N := {A {A N-1}} + {A N-{A N-1}}
        end
        Cache.N
     end
  end

  Float = Int.toFloat

  for I in 0..19 do
     Range = {List.number {Pow 2 I} {Pow 2 I+1} 1}
     RelativeValues = {Map Range
                       fun {$ N}
                          {Float {A N}}
                          / {Float N}
                       end}
     Maximum = {FoldL RelativeValues Max 0.0}
  in
     {System.showInfo "Max. between 2^"#I#" and 2^"#I+1#": "#Maximum}
  end


program HofStadterConway;
const
  Pot2 = 20;// tested with 30 -> 4 GB;
type
  tfeld = array[0..1 shl Pot2] of LongWord;
  tpFeld = ^tFeld;
  tMaxPos = record
              mpMax : double;
              mpValue,
              mpPos : longWord;
            end;
  tArrMaxPos = array[0..Pot2-1] of tMaxPos;
var
  a : tpFeld;
  MaxPos : tArrMaxPos;

procedure Init(a:tpFeld);
var
  n,k: LongWord;
begin
  a^[1]:= 1;
  a^[2]:= 1;
  //a[n] := a[a[n-1]]+a[n-a[n-1]];
  //k := a[n-1]
  k := a^[2];
  For n := 3 to High(a^) do
  Begin
    k := a^[k]+a^[n-k];
    a^[n] := k;
  end;
end;

function GetMax(a:tpFeld;starts,ends:LongWord):tMaxPos;
var
  posMax : LongWord;
  r,
  max : double;
Begin
  posMax:= starts;
  max := 0.0;
  repeat
    r := a^[starts]/ starts;
    IF max < r then
    Begin
      max := r;
      posMax := starts;
    end;
    inc(starts);
  until starts >= ends;
  with GetMax do
  Begin
    mpPos:= posMax;
    mpValue := a^[posMax];
    mpMax:= max;
  end;
end;

procedure SearchMax(a:tpFeld);
var
  ends,idx : LongWord;
begin
  idx := 0;
  ends := 2;
  while ends <=  High(a^) do
  Begin
    MaxPos[idx]:=GetMax(a,ends shr 1,ends);
    ends := 2*ends;
    inc(idx);
  end;
end;

procedure OutputMax;
var
  i : integer;
begin
  For i := Low(MaxPos) to High(MaxPOs)  do
    with MaxPos[i] do
    Begin
      Write('Max between 2^',i:2,' and 2^',i+1:2);
      writeln(mpMax:14:11,' at ',mpPos:9,' value :',mpValue:10);
    end;
  writeln;
end;

function SearchLastPos(a:tpFeld;limit: double):LongInt;
var
  i,l : LongInt;
Begin
  Limit := limit;
  IF (Limit>1.0 ) OR (Limit < 0.5) then
  Begin
    SearchLastPos := -1;
    EXIT;
  end;

  i := 0;
  while (i<=High(MaxPos)) AND  (MaxPos[i].mpMax > Limit) do
    inc(i);
  dec(i);
  l := MaxPos[i].mpPos;
  i := 1 shl (i+1);
  while (l< i) AND (a^[i]/i < limit)  do
    dec(i);
  SearchLastPos := i;
end;

var
  p : Pointer;
  l : double;
Begin
  //using getmem because FPCs new is limited to 2^31-1 Byte for the test 2^30 )
  getmem(p,SizeOf(tfeld));
  a := p;
  Init(a);
  SearchMax(a);
  outputMax;
  l:= 0.55;
  writeln('Mallows number with limit ',l:10:8,' at ',SearchLastPos(a,l));
  freemem(p);
end.


#!/usr/bin/perl
use warnings ;
use strict ;

my $limit = 2 ** 20 ;
my @numbers = ( 0 , 1 , 1 ) ;
my $mallows ;
my $max_i ;
foreach my $i ( 3..$limit ) {
   push ( @numbers , $numbers[ $numbers[ $i - 1 ]] + $numbers[ $i - $numbers[ $i - 1 ] ] ) ;
}
for ( my $rangelimit = 1 ; $rangelimit < 20 ; $rangelimit++ ) {
   my $max = 0 ;
   for ( my $i = 2 ** $rangelimit ; $i < ( 2 ** ( $rangelimit + 1 ) ) ; $i++ ) {
      my $rat = $numbers[ $i ] / $i ;
      $mallows = $i if $rat >= 0.55 ;
      if ( $rat > $max ) {
	 $max = $rat ;
	 $max_i = $i ;
      }
   }
   my $upperlimit = $rangelimit + 1 ;
   print "Between 2 ^ $rangelimit and 2 ^ $upperlimit the maximum value is $max at $max_i !\n" ;
}
print "The prize would have been won at $mallows !\n"


with javascript_semantics
sequence a = {1,1}

function q(integer n)
    for l=length(a)+1 to n do
        a &= a[a[l-1]]+a[l-a[l-1]]
    end for
    return a[n]
end function

integer mallows = -1, max_n
for p=0 to 19 do
    atom max_an = 0.5
    integer l = power(2,p), h=l*2
    for n=l to h do
        atom an = q(n)/n
        if an>=max_an then
            max_an = an
            max_n = n
        end if
        if an>0.55 then
            mallows = n
        end if
    end for
    printf(1,"Maximum in range %6d to %-7d occurs at %6d: %f\n",{l,h,max_n,max_an})
end for
printf(1,"Mallows number is %d\n",{mallows})


go =>
   foreach(N in 0..19)
      [Val,Ix] = argmax({a(I)/I : I in 2**N..2**(N+1)}),
      printf("Max from 2^%2d..2^%-2d is %0.8f at %d\n",N,N+1,Val,Ix+2**N-1)
   end,
   println(mallows_number=mallows_number()),
   nl.

% The sequence definition
table
a(1) = 1.
a(2) = 1.
a(N) = a(a(N-1))+a(N-a(N-1)).

% argmax: find the (first) index for the max value(s) of L.
argmax(L) = [Max,MaxIxFirst] =>
  Max = max(L),
  MaxIxFirst = {I : I in 1..L.length, L[I] == Max}.first.

% Calculate the Mallows number separately.
mallows_number() = Mallow =>
   Mallow = _,
   foreach(M in 1..19)
      Min = 2**M,
      Max = Min*2,
      MaxRatio = 0,
      NVal = 0,
      foreach(N in Min..Max)
         Ratio = a(N)/N,
         if Ratio > MaxRatio then
           MaxRatio := Ratio,
           NVal := N
         end,
         if Ratio > 0.55 then
           Mallow := N
         end
      end
  end.


(de hofcon (N)
   (cache '(NIL) N
      (if (>= 2 N)
         1
         (+
            (hofcon (hofcon (dec N)))
            (hofcon (- N (hofcon (dec N)))) ) ) ) )

(scl 20)

(de sequence (M)
   (let (Lim 4  Max 0  4k$ 0)
      (for (N 3 (>= M N) (inc N))
         (let V (*/ (hofcon N) 1.0 N)
            (setq Max (max Max V))
            (when (>= V 0.55)
               (setq 4k$ N) )
            (when (= N Lim)
               (prinl
                  "Maximum between " (/ Lim 2)
                  " and " Lim
                  " was " (format Max `*Scl) )
               (inc 'Lim Lim)
               (zero Max) ) ) )
      (prinl
         "Win with " 4k$
         " (the task requests 'n > p' now)" ) ) )

(sequence (** 2 20))


from __future__ import division

def maxandmallows(nmaxpower2):
    nmax = 2**nmaxpower2
    mx = (0.5, 2)
    mxpow2 = []
    mallows = None

    # Hofstadter-Conway sequence starts at hc[1],
    # hc[0] is not part of the series.
    hc = [None, 1, 1]

    for n in range(2, nmax + 1):
        ratio = hc[n] / n
        if ratio > mx[0]:
            mx = (ratio, n)
        if ratio >= 0.55:
            mallows = n
        if ratio == 0.5:
            print("In the region %7i < n <= %7i: max a(n)/n = %6.4f at  n = %i" %
		  (n//2, n, mx[0], mx[1]))
            mxpow2.append(mx[0])
            mx = (ratio, n)
        hc.append(hc[hc[n]] + hc[-hc[n]])

    return hc, mallows if mxpow2 and mxpow2[-1] < 0.55 and n > 4 else None

if __name__ == '__main__':
    hc, mallows = maxandmallows(20)
    if mallows:
        print("\nYou too might have won $1000 with the mallows number of %i" % mallows)


  [ $ "bigrat.qky" loadfile ] now!

  [ ' [ 1 1 ]
    swap 2 - times
      [ dup -1 peek 2dup 1 - peek
         dip [ dip dup negate peek ]
        + join ] ]                   is hof-con ( n --> [   )

  [ behead do rot
    witheach
      [ do 2over 2over v- v0<
        if 2swap
        2drop ] ]                    is maximum ( [ --> n n )

  20 dup bit 1 - hof-con
  [] swap witheach
    [ i^ 1+ join nested join ]
  swap 1 - bit times
    [ i^ 1+ dup 2dup
      say "Maximum in range " echo
      say " to " 1 << 1 - echo
      step split swap maximum
      say " at n = "
      dup echo
      say " is " 10 point$ echo$ cr ]
  drop


#lang racket/base

(define-syntax-rule (define/memoize1 (proc x) body ...)
  (define proc
    (let ([cache (make-hash)]
          [direct (lambda (x) body ...)])
      (lambda (x)
        (hash-ref! cache x (lambda () (direct x)))))))

(define/memoize1 (conway n)
  (if (< n 3)
      1
      (+ (conway (conway (sub1 n)))
         (conway (- n (conway (sub1 n)))))))


my $n = 3;
my @a = (0,1,1, -> $p { @a[$p] + @a[$n++ - $p] } ... *);
@a[2**20]; # pre-calculate sequence

my $last55;
for 1..19 -> $power {
    my @range := 2**$power .. 2**($power+1)-1;
    my @ratios = (@a[@range] Z/ @range) Z=> @range;
    my $max = @ratios.max;
    ($last55 = .value if .key >= .55 for @ratios) if $max.key >= .55;
    say $power.fmt('%2d'), @range.min.fmt("%10d"), '..', @range.max.fmt("%-10d"),
        $max.key, ' at ', $max.value;
}
say "Mallows' number would appear to be ", $last55;


/*REXX program solves the   Hofstadter─Conway  sequence  $10,000   prize  (puzzle).     */
@pref= 'Maximum of    a(n) ÷ n     between '     /*a prologue for the text of message.  */
H.=.;   H.1=1;  H.2=1;   !.=0;     @.=0          /*initialize some REXX variables.      */
win=0
      do k=0  to 20;     p.k=2**k;  maxp=p.k     /*build an array of the powers of two. */
      end   /*k*/
r=1                                              /*R:  is the range of the power of two.*/
      do n=1  for maxp;  if n> p.r  then r=r+1   /*for golf coders, same as: r=r+(n>p.r)*/
      _=H(n)/n;          if _>=.55  then win=n   /*get next seq number; if ≥.55, a win? */
                         if _<[email protected].r  then iterate /*less than previous? Then keep looking*/
      @.r=_;      !.r=n                          /*@.r and  !.r  are like ginkgo biloba.*/
      end   /*n*/                                /*  ··· or in other words, memoization.*/

      do j=1  for 20;   range= '2**'right(j-1, 2)              "───► 2**"right(  j, 2)
      say @pref  range  '(inclusive)  is '    left(@.j, 9)     "  at  n="right(!.j, 7)
      end   /*j*/
say
say 'The winning number is: '    win             /*and the money shot is  ···           */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
H: procedure expose H.; parse arg z
                        if H.z==.  then do;  m=z-1;   $=H.m;   _=z-$;   H.z=H.$+H._;   end
                        return H.z


decimals(9)
size = 15
a = list(pow(2,size))
a[1]=1
a[2]=1
power=2
p2=pow(2,power)
peak=0.5
peakpos=0
for n=3 to pow(2,size)
    a[n]=a[a[n-1]]+a[n-a[n-1]]
    r=a[n]/n
    if r>=0.55 mallows=n ok
    if r>peak peak=r peakpos=n ok
    if n=p2
       see "maximum between 2^" + (power - 1) + " and 2^" + power + " is " + peak + " at n=" + peakpos + nl
       power += 1
       p2=pow(2,power)
       peak=0.5 ok
next
see "mallows number is : " + mallows + nl


class HofstadterConway10000
  def initialize
    @sequence = [nil, 1, 1]
  end

  def [](n)
    raise ArgumentError, "n must be >= 1" if n < 1
    a = @sequence
    a.length.upto(n) {|i| a[i] = a[a[i-1]] + a[i-a[i-1]] }
    a[n]
  end
end

hc = HofstadterConway10000.new

mallows = nil
(1...20).each do |i|
  j = i + 1
  max_n, max_v = -1, -1
  (2**i .. 2**j).each do |n|
    v = hc[n].to_f / n
    max_n, max_v = n, v if v > max_v
    # Mallows number
    mallows = n if v >= 0.55
  end
  puts "maximum between 2^%2d and 2^%2d occurs at%7d: %.8f" % [i, j, max_n, max_v]
end

puts "the mallows number is #{mallows}"


struct HofstadterConway {
    current: usize,
    sequence: Vec<usize>,
}

impl HofstadterConway {
    /// Define a constructor for the struct.
    fn new() -> HofstadterConway {
        HofstadterConway {
            current: 0,
            sequence: vec![1, 1],
        }
    }
}

impl Default for HofstadterConway {
    fn default() -> Self {
        Self::new()
    }
}

/// Implement the hofstadter q iteration sequence.
impl Iterator for HofstadterConway {
    type Item = usize;

    /// This gets called to fetch the next item of the iterator.
    fn next(&mut self) -> Option<usize> {
        let max_index = self.sequence.len() - 1;
        let last_value = self.sequence[max_index];

        if self.current > max_index {
            let new_x = self.sequence[last_value - 1] + self.sequence[max_index - last_value + 1];
            self.sequence.push(new_x);
        }
        self.current += 1;
        Some(self.sequence[self.current - 1])
    }
}

#[allow(clippy::cast_precision_loss)]
fn main() {
    let mut hof = HofstadterConway::new();
    let mut winning_num = 0_usize;

    for p in 0..20 {
        let max_hof = (2_usize.pow(p)..2_usize.pow(p + 1))
            .map(|n| (n, hof.next().unwrap() as f64 / n as f64))
            .fold(f64::NAN, |a, (n, b)| {
                if b >= 0.55 {
                    winning_num = n;
                }
                a.max(b)
            });

        println!("2^{:>2}-2^{:>2}, {:>.8}", p, p + 1, max_hof);
    }

    println!("Winning number: {}", winning_num);
}


object HofstadterConway {
  def pow2(n: Int): Int = (Iterator.fill(n)(2)).product

  def makeHCSequence(max: Int): Seq[Int] =
    (0 to max - 1).foldLeft (Vector[Int]()) { (v, idx) =>
      if (idx <= 1) v :+ 1 else v :+ (v(v(idx - 1) - 1) + v(idx - v(idx - 1)))
    }

  val max = pow2(20)

  val maxSeq = makeHCSequence(max)

  def hcRatio(n: Int, seq: Seq[Int]): Double = seq(n - 1).toDouble / n

  def maximumHCRatioBetween(a: Int, b: Int): (Int, Double) =
    Iterator.range(a, b + 1) map (n => (n, hcRatio(n, maxSeq))) maxBy (_._2)

  lazy val mallowsNumber: Int =
    ((max to 1 by -1) takeWhile (hcRatio(_, maxSeq) < 0.55) last) - 1

  def main(args: Array[String]): Unit = {
    for (n <- 1 to 19) {
      val (value, ratio) = maximumHCRatioBetween(pow2(n), pow2(n+1))
      val message = "Maximum of a(n)/n between 2^%s and 2^%s was %s at %s"
      println(message.format(n, n+1, ratio, value))
    }
    println("Mallow's number = %s".format(mallowsNumber))
  }
}


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

;; maximum size of sequence to consider, as a power of 2
(define *max-power* 20)
(define *size* (expt 2 *max-power*))

;; Task 1: Generate members of the sequence
(define *seq* (make-vector (+ 1 *size*))) ; add 1, to use 1-indexing into sequence

(vector-set! *seq* 1 1)
(vector-set! *seq* 2 1)
(for-each
  (lambda (n)
    (let ((x (vector-ref *seq* (- n 1))))
      (vector-set! *seq* n (+ (vector-ref *seq* x)
                              (vector-ref *seq* (- n x))))))
  (iota (- *size* 2) 3))

;; Task 2: Show maxima of a(n)/n between successive powers of two
(for-each
  (lambda (power)
    (let ((start-idx (+ (expt 2 (- power 1)) 1))
          (end-idx (expt 2 power)))
      (do ((i start-idx (+ 1 i))
           (maximum 0 (max maximum (/ (vector-ref *seq* i)
                                      i))))
        ((> i end-idx)
         (display
           (string-append
             "Maximum between 2^" (number->string (- power 1))
             " and 2^" (number->string power)
             " = " (number->string (inexact maximum))
             "\n"))))))
  (iota (- *max-power* 1) 2))

;; Task 3: Find value of p where a(n)/n < 0.55 for all n > p (in our sequence)
(do ((idx *size* (- idx 1)))
  ((or (zero? idx) ; safety net
       (> (/ (vector-ref *seq* idx) idx)
          0.55))
    (display (string-append "\np=" (number->string idx) "\n"))))


class HofstadterConway10000 {
  has sequence = [nil, 1, 1]
  method term(n {.is_pos}) {
    var a = sequence
    {|i| a[i] = a[a[i-1]]+a[i-a[i-1]] } << a.len..n
    a[n]
  }
}

var hc = HofstadterConway10000()

var mallows = nil
for i in (1..19) {
  var j = i+1
  var (max_n, max_v) = (-1, -1)
  for n in (1<<i .. 1<<j) {
    var v = (hc.term(n) / n)
    (max_n, max_v) = (n, v) if (v > max_v)
    mallows = n if (v >= 0.55)
  }
  say ("maximum between 2^%2d and 2^%2d occurs at%7d: %.8f" % (i, j, max_n, max_v))
}

say "the mallows number is #{mallows}"


func doSqnc(m:Int) {
    var aList = [Int](count: m + 1, repeatedValue: 0)
    var k1 = 2
    var lg2 = 1
    var amax:Double = 0
    aList[0] = 1
    aList[1] = 1

    var v = aList[2]

    for n in 2...m {
        let add = aList[v] + aList[n - v]
        aList[n] = add
        v = aList[n]

        if amax < Double(v) * 1.0 / Double(n) {
            amax = Double(v) * 1.0 / Double(n)
        }

        if (k1 & n == 0) {
            println("Maximum between 2^\(lg2) and 2^\(lg2 + 1) was \(amax)")
            amax = 0
            lg2++
        }
        k1 = n
    }
}

doSqnc(1 << 20)


package require Tcl 8.5

set hofcon10k {1 1}
proc hofcon10k n {
    global hofcon10k
    if {$n < 1} {error "n must be at least 1"}
    if {$n <= [llength $hofcon10k]} {
	return [lindex $hofcon10k [expr {$n-1}]]
    }
    while {$n > [llength $hofcon10k]} {
	set i [lindex $hofcon10k end]
	set a [lindex $hofcon10k [expr {$i-1}]]
	# Don't use end-based indexing here; faster to compute manually
	set b [lindex $hofcon10k [expr {[llength $hofcon10k]-$i}]]
	lappend hofcon10k [set c [expr {$a + $b}]]
    }
    return $c
}


Public q() As Long
Sub make_q()
    ReDim q(2 ^ 20)
    q(1) = 1
    q(2) = 1
    Dim l As Long
    For l = 3 To 2 ^ 20
        q(l) = q(q(l - 1)) + q(l - q(l - 1))
    Next l
End Sub

Public Sub hcsequence()
    Dim mallows As Long: mallows = -1
    Dim max_n As Long, n As Long
    Dim l As Long, h As Long
    make_q
    For p = 0 To 19
        max_an = 0.5
        l = 2 ^ p: h = l * 2
        For n = l To h
            an = q(n) / n
            If an >= max_an Then
                max_an = an
                max_n = n
            End If
            If an > 0.55 Then
                mallows = n
            End If
        Next n
        Debug.Print "Maximum in range"; Format(l, "@@@@@@@"); " to"; h; String$(7 - Len(CStr(h)), " ");
        Debug.Print "occurs at"; Format(max_n, "@@@@@@@"); ": "; Format(max_an, "0.000000")
    Next p
    Debug.Print "Mallows number is"; mallows
End Sub


fn main() {
    mut a := [0, 1, 1] // ignore 0 element. work 1 based.
    mut x := 1  // last number in list
    mut n := 2  // index of last number in list = a.len-1
    mut mallow := 0
    for p in 1..20 {
        mut max := 0.0
        for next_pot := n*2; n < next_pot; {
            n = a.len  // advance n
            x = a[x]+a[n-x]
            a << x
            f := f64(x)/f64(n)
            if f > max {
                max = f
            }
            if f >= .55 {
                mallow = n
            }
        }
        println("max between 2^$p and 2^${p+1} was ${max:.6}")
    }
    println("winning number $mallow")
}


import "/fmt" for Fmt

var limit = 1<<20 + 1
var a = List.filled(limit, 0)
a[1] = 1
a[2] = 1
for (n in 3...limit) {
    var p = a[n-1]
    a[n] = a[p] + a[n-p]
}

System.print("     Range          Maximum")
System.print("----------------   --------")
var pow2 = 1
var p = 1
var max = a[1]
for (n in 2...limit) {
    var r = a[n] / n
    if (r > max) max = r
    if (n == pow2 * 2) {
        Fmt.print("2 ^ $2d to 2 ^ $2d   $f", p - 1, p, max)
        pow2 = pow2 * 2
        p = p + 1
        max = r
    }
}

var prize = 0
for (n in limit-1..1) {
    if (a[n]/n >= 0.55) {
        prize = n
        break
    }
}
System.print("\nMallows' number = %(prize)")


; Hofstadter-Conway $10,000 sequence
    call a.memorization
    call Mallows_Number
; ECX is the $1000 #
    int3

a.memorization:
; skip [a] to make it one based
    mov [a+1*4],1
    mov [a+2*4],1
    mov ecx,3
@@:
    mov eax,ecx
    mov edx,[a+(ecx-1)*4] ; a[n-1]
    sub eax,edx           ; n-a[n-1]
    mov eax,[a+eax*4]     ; a[n-a[n-1]]
    add eax,[a+edx*4]     ;+a[a[n-1]]
    mov [a+ecx*4],eax
    inc ecx
    cmp ecx,1 shl 20
    jnz @B
    retn

_0.55 equ ((55 shl 32)/100) ; Floor[55 * 2^N / 100], for N=32

Mallows_Number: ; $5D1
    mov ecx,1 shl 20
@@: dec ecx
    mov edx,[a+ecx*4]
    xor eax,eax
    div ecx
    cmp eax,_0.55 + 1
    jc @B
    retn

a rd 1 shl 20


fcn hofstadterConwaySequence(m){
   a:=List.createLong(m + 1,0);
   a[0]=a[1]=1;
   v,p2,lg2, amax, mallow := a[2],4,1, 0.0, Void;

   foreach n in ([2 .. m]){
      v=a[n]=a[v] + a[n - v];
      f:=1.0*v/n;
      if(f>=0.55) mallow=n;
      amax=amax.max(f);
      if(n==p2){
	 println("Max in [2^%d, 2^%d]: %f".fmt(lg2, lg2+1, amax));
	 amax,p2 = 0.0, (n+1).nextPowerOf2;
	 lg2+=1;
      }
   }
   if(mallow) println("Winning number = ",mallow);
}

hofstadterConwaySequence((2).pow(20));


T Point
   x = 0
   y = 0

   F rot(n, rx, ry)
      I !ry
         I rx
            .x = (n - 1) - .x
            .y = (n - 1) - .y

         swap(&.x, &.y)

   F calcD(n)
      V d = 0
      V s = n >> 1
      L s > 0
         V rx = ((.x [&] s) != 0)
         V ry = ((.y [&] s) != 0)
         d += s * s * ((I rx {3} E 0) (+) (I ry {1} E 0))
         .rot(s, rx, ry)
         s >>= 1
      R d

F fromD(n, d)
   V p = Point()
   V t = d
   V s = 1
   L s < n
      V rx = ((t [&] 2) != 0)
      V ry = (((t (+) (I rx {1} E 0)) [&] 1) != 0)
      p.rot(s, rx, ry)
      p.x += (I rx {s} E 0)
      p.y += (I ry {s} E 0)
      t >>= 2
      s <<= 1
   R p

F getPointsForCurve(n)
   [Point] points
   L(d) 0 .< n * n
      points [+]= fromD(n, d)
   R points

F drawCurve(points, n)
   V canvas = [[‘ ’] * (n * 3 - 2)] * n

   L(i) 1 .< points.len
      V lastPoint = points[i - 1]
      V curPoint = points[i]
      V deltaX = curPoint.x - lastPoint.x
      V deltaY = curPoint.y - lastPoint.y
      I deltaX == 0
         assert(deltaY != 0, ‘Duplicate point’)
         V row = max(curPoint.y, lastPoint.y)
         V col = curPoint.x * 3
         canvas[row][col] = ‘|’
      E
         assert(deltaY == 0, ‘Diagonal line’)
         V row = curPoint.y
         V col = min(curPoint.x, lastPoint.x) * 3 + 1
         canvas[row][col] = ‘_’
         canvas[row][col + 1] = ‘_’

   [String] lines
   L(row) canvas
      lines [+]= row.join(‘’)
   R lines

L(order) 1..5
   V n = 1 << order
   V points = getPointsForCurve(n)
   print(‘Hilbert curve, order=’order)
   V lines = drawCurve(points, n)
   L(line) lines
      print(line)
   print()


DEFINE MAXSIZE="12"

INT ARRAY
  dxStack(MAXSIZE),dyStack(MAXSIZE)
BYTE ARRAY
  depthStack(MAXSIZE),stageStack(MAXSIZE)
BYTE stacksize=[0]

BYTE FUNC IsEmpty()
  IF stacksize=0 THEN RETURN (1) FI
RETURN (0)

BYTE FUNC IsFull()
  IF stacksize=MAXSIZE THEN RETURN (1) FI
RETURN (0)

PROC Push(INT dx,dy BYTE depth,stage)
  IF IsFull() THEN Break() FI
  dxStack(stacksize)=dx dyStack(stacksize)=dy
  depthStack(stacksize)=depth
  stageStack(stackSize)=stage
  stacksize==+1
RETURN

PROC Pop(INT POINTER dx,dy BYTE POINTER depth,stage)
  IF IsEmpty() THEN Break() FI
  stacksize==-1
  dx^=dxStack(stacksize) dy^=dyStack(stacksize)
  depth^=depthStack(stacksize)
  stage^=stageStack(stacksize)
RETURN

PROC DrawHilbert(INT x BYTE y INT dx,dy BYTE depth)
  BYTE stage

  Plot(x,y)
  Push(dx,dy,depth,0)

  WHILE IsEmpty()=0
  DO
    Pop(@dx,@dy,@depth,@stage)
    IF stage<3 THEN
      Push(dx,dy,depth,stage+1)
    FI
    IF stage=0 THEN
      IF depth>1 THEN
        Push(dy,dx,depth-1,0)
      FI
    ELSEIF stage=1 THEN
      x==+dx y==+dy
      DrawTo(x,y)
      IF depth>1 THEN
        Push(dx,dy,depth-1,0)
      FI
    ELSEIF stage=2 THEN
      x==+dy y==+dx
      DrawTo(x,y)
      IF depth>1 THEN
        Push(dx,dy,depth-1,0)
      FI
    ELSEIF stage=3 THEN
      x==-dx y==-dy
      DrawTo(x,y)
      IF depth>1 THEN
        Push(-dy,-dx,depth-1,0)
      FI
    FI
  OD
RETURN

PROC Main()
  BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6

  Graphics(8+16)
  Color=1
  COLOR1=$0C
  COLOR2=$02

  DrawHilbert(64,1,0,3,6)

  DO UNTIL CH#$FF OD
  CH=$FF
RETURN


with PDF_Out;  use PDF_Out;

procedure Hilbert_Curve_PDF is

   Length  : constant := 500.0;
   Corner  : constant Point := (50.0, 300.0);

   type Rule_Type is (A, B, C, D);

   PDF   : PDF_Out.Pdf_Out_File;
   First : Boolean;

   procedure Hilbert (Order  : in Natural;
                      Rule   : in Rule_Type;
                      Length : in Real;
                      X, Y   : in Real)
   is
      L : constant Real := Length / 4.0;
   begin
      if Order = 0 then
         if First then
            First := False;
            PDF.Move (Corner + (X, Y));
         else
            PDF.Line (Corner + (X, Y));
         end if;
      else
         case Rule is
            when A =>
               Hilbert (Order - 1, D, 2.0 * L, X - L, Y + L);
               Hilbert (Order - 1, A, 2.0 * L, X - L, Y - L);
               Hilbert (Order - 1, A, 2.0 * L, X + L, Y - L);
               Hilbert (Order - 1, B, 2.0 * L, X + L, Y + L);
            when B =>
               Hilbert (Order - 1, C, 2.0 * L, X + L, Y - L);
               Hilbert (Order - 1, B, 2.0 * L, X - L, Y - L);
               Hilbert (Order - 1, B, 2.0 * L, X - L, Y + L);
               Hilbert (Order - 1, A, 2.0 * L, X + L, Y + L);
            when C =>
               Hilbert (Order - 1, B, 2.0 * L, X + L, Y - L);
               Hilbert (Order - 1, C, 2.0 * L, X + L, Y + L);
               Hilbert (Order - 1, C, 2.0 * L, X - L, Y + L);
               Hilbert (Order - 1, D, 2.0 * L, X - L, Y - L);
            when D =>
               Hilbert (Order - 1, A, 2.0 * L, X - L, Y + L);
               Hilbert (Order - 1, D, 2.0 * L, X + L, Y + L);
               Hilbert (Order - 1, D, 2.0 * L, X + L, Y - L);
               Hilbert (Order - 1, C, 2.0 * L, X - L, Y - L);
         end case;
      end if;
   end Hilbert;

   procedure Hilbert (Order : Natural; Color : Color_Type) is
   begin
      First := True;
      PDF.Stroking_Color (Color);
      Hilbert (Order, A, Length, Length / 2.0, Length / 2.0);
      PDF.Finish_Path (Close_Path => False,
                       Rendering  => Stroke,
                       Rule       => Nonzero_Winding_Number);
   end Hilbert;

begin
   PDF.Create ("hilbert.pdf");
   PDF.Page_Setup (A4_Portrait);
   PDF.Line_Width (2.0);

   PDF.Color (Black);
   PDF.Draw (Corner + (0.0, 0.0, Length, Length), Fill);

   Hilbert (6, Color => (0.9, 0.1, 0.8));
   Hilbert (5, Color => (0.0, 0.9, 0.0));

   PDF.Close;
end Hilbert_Curve_PDF;


BEGIN
  INT level = 4;    # <-- change this #

  INT side = 2**level * 2 - 2;
  [-side:1, 0:side]STRING grid;
  INT x := 0, y := 0, dir := 0;
  INT old dir := -1;
  INT e=0, n=1, w=2, s=3;

  FOR i FROM 1 LWB grid TO 1 UPB grid DO
    FOR j FROM 2 LWB grid TO 2 UPB grid DO grid[i,j] := "  "
  OD OD;

  PROC left  = VOID: dir := (dir + 1) MOD 4;
  PROC right = VOID: dir := (dir - 1) MOD 4;
  PROC move  = VOID: (
    CASE dir + 1 IN
      # e: # x +:= 1, # n: # y -:= 1, # w: # x -:= 1, # s: # y +:= 1
    ESAC
  );
  PROC forward = VOID: (
    # draw corner #
    grid[y, x] := CASE old dir + 1 IN
                   # e # CASE dir + 1 IN "──", "─╯", " ?", "─╮" ESAC,
                   # n # CASE dir + 1 IN " ╭", " │", "─╮", " ?" ESAC,
                   # w # CASE dir + 1 IN " ?", " ╰", "──", " ╭" ESAC,
                   # s # CASE dir + 1 IN " ╰", " ?", "─╯", " │" ESAC
                  OUT "  "
                  ESAC;
    move;
    # draw segment #
    grid[y, x] := IF dir = n OR dir = s THEN " │" ELSE "──" FI;
    # advance to next corner #
    move;
    old dir := dir
  );

  PROC a = (INT level)VOID:
    IF level > 0 THEN
      left; b(level-1); forward; right; a(level-1); forward;
      a(level-1); right; forward; b(level-1); left
    FI,
      b = (INT level)VOID:
    IF level > 0 THEN
      right; a(level-1); forward; left; b(level-1); forward;
      b(level-1); left; forward; a(level-1); right
    FI;

  # draw #
  a(level);

  # print #
  FOR row FROM 1 LWB grid TO 1 UPB grid DO
    print((grid[row,], new line))
  OD
END


gdip1()
HilbertX := A_ScreenWidth/2 - 100, HilbertY := A_ScreenHeight/2 - 100
Hilbert(HilbertX, HilbertY, 2**5, 5, 5, Arr:=[])
xmin := xmax := ymin := ymax := 0
for i, point in Arr
{
	xmin := A_Index = 1 ? point.x : xmin < point.x ? xmin : point.x
	xmax := point.x > xmax ? point.x : xmax
	ymin := A_Index = 1 ? point.y : ymin < point.y ? ymin : point.y
	ymax := point.y > ymax ? point.y : ymax
}
for i, point in Arr
	points .= point.x - xmin + HilbertX "," point.y - ymin + HilbertY "|"
points := Trim(points, "|")
Gdip_DrawLines(G, pPen, Points)
UpdateLayeredWindow(hwnd1, hdc, 0, 0, Width, Height)
return
; ---------------------------------------------------------------
Hilbert(x, y, lg, i1, i2, Arr) {
	if (lg = 1) {
		Arr[Arr.count()+1, "x"] := x
		Arr[Arr.count(), "y"] := y
		return
	}
	lg /= 2
	Hilbert(x+i1*lg		, y+i1*lg	, lg	, i1	, 1-i2	, Arr)
	Hilbert(x+i2*lg		, y+(1-i2)*lg	, lg	, i1	, i2	, Arr)
	Hilbert(x+(1-i1)*lg	, y+(1-i1)*lg	, lg	, i1	, i2	, Arr)
	Hilbert(x+(1-i2)*lg	, y+i2*lg	, lg	, 1-i1	, i2	, Arr)
}
; ---------------------------------------------------------------
gdip1(){
	global
	If !pToken := Gdip_Startup()
	{
		MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system
		ExitApp
	}
	OnExit, Exit
	Width := A_ScreenWidth, Height := A_ScreenHeight
	Gui, 1: -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop
	Gui, 1: Show, NA
	hwnd1 := WinExist()
	hbm := CreateDIBSection(Width, Height)
	hdc := CreateCompatibleDC()
	obm := SelectObject(hdc, hbm)
	G := Gdip_GraphicsFromHDC(hdc)
	Gdip_SetSmoothingMode(G, 4)
	pPen := Gdip_CreatePen(0xFFFF0000, 2)
}
; ---------------------------------------------------------------
gdip2(){
	global
	Gdip_DeleteBrush(pBrush)
	Gdip_DeletePen(pPen)
	SelectObject(hdc, obm)
	DeleteObject(hbm)
	DeleteDC(hdc)
	Gdip_DeleteGraphics(G)
}
; ---------------------------------------------------------------
Exit:
gdip2()
Gdip_Shutdown(pToken)
ExitApp
Return


#include <stdio.h>

#define N 32
#define K 3
#define MAX N * K

typedef struct { int x; int y; } point;

void rot(int n, point *p, int rx, int ry) {
    int t;
    if (!ry) {
        if (rx == 1) {
            p->x = n - 1 - p->x;
            p->y = n - 1 - p->y;
        }
        t = p->x;
        p->x = p->y;
        p->y = t;
    }
}

void d2pt(int n, int d, point *p) {
    int s = 1, t = d, rx, ry;
    p->x = 0;
    p->y = 0;
    while (s < n) {
        rx = 1 & (t / 2);
        ry = 1 & (t ^ rx);
        rot(s, p, rx, ry);
        p->x += s * rx;
        p->y += s * ry;
        t /= 4;
        s *= 2;
    }
}

int main() {
    int d, x, y, cx, cy, px, py;
    char pts[MAX][MAX];
    point curr, prev;
    for (x = 0; x < MAX; ++x)
        for (y = 0; y < MAX; ++y) pts[x][y] = ' ';
    prev.x = prev.y = 0;
    pts[0][0] = '.';
    for (d = 1; d < N * N; ++d) {
        d2pt(N, d, &curr);
        cx = curr.x * K;
        cy = curr.y * K;
        px = prev.x * K;
        py = prev.y * K;
        pts[cx][cy] = '.';
        if (cx == px ) {
            if (py < cy)
                for (y = py + 1; y < cy; ++y) pts[cx][y] = '|';
            else
                for (y = cy + 1; y < py; ++y) pts[cx][y] = '|';
        }
        else {
            if (px < cx)
                for (x = px + 1; x < cx; ++x) pts[x][cy] = '_';
            else
                for (x = cx + 1; x < px; ++x) pts[x][cy] = '_';
        }
        prev = curr;
    }
    for (x = 0; x < MAX; ++x) {
        for (y = 0; y < MAX; ++y) printf("%c", pts[y][x]);
        printf("\n");
    }
    return 0;
}


using System;
using System.Collections.Generic;
using System.Diagnostics;
using System.Text;

namespace HilbertCurve {
    class Program {
        static void Swap<T>(ref T a, ref T b) {
            var c = a;
            a = b;
            b = c;
        }

        struct Point {
            public int x, y;

            public Point(int x, int y) {
                this.x = x;
                this.y = y;
            }

            //rotate/flip a quadrant appropriately
            public void Rot(int n, bool rx, bool ry) {
                if (!ry) {
                    if (rx) {
                        x = (n - 1) - x;
                        y = (n - 1) - y;
                    }
                    Swap(ref x, ref y);
                }
            }

            public override string ToString() {
                return string.Format("({0}, {1})", x, y);
            }
        }

        static Point FromD(int n, int d) {
            var p = new Point(0, 0);
            int t = d;

            for (int s = 1; s < n; s <<= 1) {
                var rx = (t & 2) != 0;
                var ry = ((t ^ (rx ? 1 : 0)) & 1) != 0;
                p.Rot(s, rx, ry);
                p.x += rx ? s : 0;
                p.y += ry ? s : 0;
                t >>= 2;
            }

            return p;
        }

        static List<Point> GetPointsForCurve(int n) {
            var points = new List<Point>();
            int d = 0;
            while (d < n * n) {
                points.Add(FromD(n, d));
                d += 1;
            }
            return points;
        }

        static List<string> DrawCurve(List<Point> points, int n) {
            var canvas = new char[n, n * 3 - 2];
            for (int i = 0; i < canvas.GetLength(0); i++) {
                for (int j = 0; j < canvas.GetLength(1); j++) {
                    canvas[i, j] = ' ';
                }
            }

            for (int i = 1; i < points.Count; i++) {
                var lastPoint = points[i - 1];
                var curPoint = points[i];
                var deltaX = curPoint.x - lastPoint.x;
                var deltaY = curPoint.y - lastPoint.y;
                if (deltaX == 0) {
                    Debug.Assert(deltaY != 0, "Duplicate point");
                    //vertical line
                    int row = Math.Max(curPoint.y, lastPoint.y);
                    int col = curPoint.x * 3;
                    canvas[row, col] = '|';
                } else {
                    Debug.Assert(deltaY == 0, "Duplicate point");
                    //horizontal line
                    var row = curPoint.y;
                    var col = Math.Min(curPoint.x, lastPoint.x) * 3 + 1;
                    canvas[row, col] = '_';
                    canvas[row, col + 1] = '_';
                }
            }

            var lines = new List<string>();
            for (int i = 0; i < canvas.GetLength(0); i++) {
                var sb = new StringBuilder();
                for (int j = 0; j < canvas.GetLength(1); j++) {
                    sb.Append(canvas[i, j]);
                }
                lines.Add(sb.ToString());
            }
            return lines;
        }

        static void Main() {
            for (int order = 1; order <= 5; order++) {
                var n = 1 << order;
                var points = GetPointsForCurve(n);
                Console.WriteLine("Hilbert curve, order={0}", order);
                var lines = DrawCurve(points, n);
                foreach (var line in lines) {
                    Console.WriteLine(line);
                }
                Console.WriteLine();
            }
        }
    }
}


#include <algorithm>
#include <iostream>
#include <vector>

struct Point {
    int x, y;

    //rotate/flip a quadrant appropriately
    void rot(int n, bool rx, bool ry) {
        if (!ry) {
            if (rx) {
                x = (n - 1) - x;
                y = (n - 1) - y;
            }
            std::swap(x, y);
        }
    }
};

Point fromD(int n, int d) {
    Point p = { 0, 0 };
    bool rx, ry;
    int t = d;
    for (int s = 1; s < n; s <<= 1) {
        rx = ((t & 2) != 0);
        ry = (((t ^ (rx ? 1 : 0)) & 1) != 0);
        p.rot(s, rx, ry);
        p.x += (rx ? s : 0);
        p.y += (ry ? s : 0);
        t >>= 2;
    }
    return p;
}

std::vector<Point> getPointsForCurve(int n) {
    std::vector<Point> points;
    for (int d = 0; d < n * n; ++d) {
        points.push_back(fromD(n, d));
    }
    return points;
}

std::vector<std::string> drawCurve(const std::vector<Point> &points, int n) {
    auto canvas = new char *[n];
    for (size_t i = 0; i < n; i++) {
        canvas[i] = new char[n * 3 - 2];
        std::memset(canvas[i], ' ', n * 3 - 2);
    }

    for (int i = 1; i < points.size(); i++) {
        auto lastPoint = points[i - 1];
        auto curPoint = points[i];
        int deltaX = curPoint.x - lastPoint.x;
        int deltaY = curPoint.y - lastPoint.y;
        if (deltaX == 0) {
            // vertical line
            int row = std::max(curPoint.y, lastPoint.y);
            int col = curPoint.x * 3;
            canvas[row][col] = '|';
        } else {
            // horizontal line
            int row = curPoint.y;
            int col = std::min(curPoint.x, lastPoint.x) * 3 + 1;
            canvas[row][col] = '_';
            canvas[row][col + 1] = '_';
        }
    }

    std::vector<std::string> lines;
    for (size_t i = 0; i < n; i++) {
        std::string temp;
        temp.assign(canvas[i], n * 3 - 2);
        lines.push_back(temp);
    }
    return lines;
}

int main() {
    for (int order = 1; order < 6; order++) {
        int n = 1 << order;
        auto points = getPointsForCurve(n);
        std::cout << "Hilbert curve, order=" << order << '\n';
        auto lines = drawCurve(points, n);
        for (auto &line : lines) {
            std::cout << line << '\n';
        }
        std::cout << '\n';
    }
    return 0;
}


import std.stdio;

void main() {
    foreach (order; 1..6) {
        int n = 1 << order;
        auto points = getPointsForCurve(n);
        writeln("Hilbert curve, order=", order);
        auto lines = drawCurve(points, n);
        foreach (line; lines) {
            writeln(line);
        }
        writeln;
    }
}

struct Point {
    int x, y;

    //rotate/flip a quadrant appropriately
    void rot(int n, bool rx, bool ry) {
        if (!ry) {
            if (rx) {
                x = (n - 1) - x;
                y = (n - 1) - y;
            }

            import std.algorithm.mutation;
            swap(x, y);
        }
    }

    int calcD(int n) {
        bool rx, ry;
        int d;
        for (int s = n >>> 1; s > 0; s >>>= 1) {
            rx = ((x & s) != 0);
            ry = ((y & s) != 0);
            d += s * s * ((rx ? 3 : 0) ^ (ry ? 1 : 0));
            rot(s, rx, ry);
        }
        return d;
    }

    void toString(scope void delegate(const(char)[]) sink) const {
        import std.format : formattedWrite;

        sink("(");
        sink.formattedWrite!"%d"(x);
        sink(", ");
        sink.formattedWrite!"%d"(y);
        sink(")");
    }
}

auto fromD(int n, int d) {
    Point p;
    bool rx, ry;
    int t = d;
    for (int s = 1; s < n; s <<= 1) {
        rx = ((t & 2) != 0);
        ry = (((t ^ (rx ? 1 : 0)) & 1) != 0);
        p.rot(s, rx, ry);
        p.x += (rx ? s : 0);
        p.y += (ry ? s : 0);
        t >>>= 2;
    }
    return p;
}

auto getPointsForCurve(int n) {
    Point[] points;
    for (int d; d < n * n; ++d) {
        points ~= fromD(n, d);
    }
    return points;
}

auto drawCurve(Point[] points, int n) {
    import std.algorithm.comparison : min, max;
    import std.array : uninitializedArray;
    import std.exception : enforce;

    auto canvas = uninitializedArray!(char[][])(n, n * 3 - 2);
    foreach (line; canvas) {
        line[] =  ' ';
    }

    for (int i = 1; i < points.length; ++i) {
        auto lastPoint = points[i - 1];
        auto curPoint = points[i];
        int deltaX = curPoint.x - lastPoint.x;
        int deltaY = curPoint.y - lastPoint.y;
        if (deltaX == 0) {
            enforce(deltaY != 0, "Duplicate point");
            // vertical line
            int row = max(curPoint.y, lastPoint.y);
            int col = curPoint.x * 3;
            canvas[row][col] = '|';
        } else {
            enforce(deltaY == 0, "Diagonal line");
            // horizontal line
            int row = curPoint.y;
            int col = min(curPoint.x, lastPoint.x) * 3 + 1;
            canvas[row][col] = '_';
            canvas[row][col + 1] = '_';
        }
    }

    string[] lines;
    foreach (row; canvas) {
        lines ~= row.idup;
    }

    return lines;
}


USING: accessors L-system ui ;

: hilbert ( L-system -- L-system )
    L-parser-dialect >>commands
    [ 90 >>angle ] >>turtle-values
    "A" >>axiom
    {
        { "A" "-BF+AFA+FB-" }
        { "B" "+AF-BFB-FA+" }
    } >>rules ;

[ <L-system> hilbert "Hilbert curve" open-window ] with-ui


include lib/graphics.4th

64 constant /width                     \ hilbert curve order^2
 9 constant /length                    \ length of a line

variable origin                        \ point of origin

aka [email protected]  lg                             \ get parameters from return stack
aka r'@ i1                             \ so define some aliases
aka r"@ i2                             \ to make it a bit more readable

: origin! 65536 * + origin ! ;         ( n1 n2 --)
: [email protected] origin @ 65536 /mod ;        ( -- n1 n2)

: hilbert                              ( x y lg i1 i2 --)
  >r >r >r lg 1 = if                   \ if lg equals 1
    rdrop rdrop rdrop [email protected] 2swap    \ get point of origin
    /width swap - /length * >r /width swap - /length * r>
    2dup origin! line                  \ save origin and draw line
  ;then

  r> 2/ >r                             \ divide lg by 2
  over over i1 lg * tuck + >r + r> lg i1 1 i2 - hilbert
  over over 1 i2 - lg * + swap i2 lg * + swap lg i1 i2 hilbert
  over over 1 i1 - lg * tuck + >r + r> lg i1 i2 hilbert
  i2 lg * + swap 1 i2 - lg * + swap r> 1 r> - r> hilbert
;

585 pic_width ! 585 pic_height !       \ set canvas size
color_image 255 whiteout blue          \ paint blue on white
0 dup origin!                          \ set point of origin
0 dup /width over dup hilbert          \ hilbert curve, order=8
s" ghilbert.ppm" save_image            \ save the image


Dim Shared As Integer ancho = 64

Sub Hilbert(x As Integer, y As Integer, lg As Integer, i1 As Integer, i2 As Integer)
    If lg = 1 Then
        Line - ((ancho-x) * 10, (ancho-y) * 10)
        Return
    End If
    lg = lg / 2
    Hilbert(x+i1*lg, y+i1*lg, lg, i1, 1-i2)
    Hilbert(x+i2*lg, y+(1-i2)*lg, lg, i1, i2)
    Hilbert(x+(1-i1)*lg, y+(1-i1)*lg, lg, i1, i2)
    Hilbert(x+(1-i2)*lg, y+i2*lg, lg, 1-i1, i2)
End Sub

Screenres 655, 655

Hilbert(0, 0, ancho, 0, 0)
End


// General description:
// This code creates Lindenmayer rules via string manipulation
// It can generate many of the examples from the Wikipedia page
// discussing L-system fractals: http://en.wikipedia.org/wiki/L-system
//
// It does not support stochastic, context sensitive or parametric grammars
//
// It supports four special rules, and any number of variables in rules
// f = move forward one unit
// - = turn left one turn
// + = turn right one turn
// [ = save angle and position on a stack
// ] = restore angle and position from the stack

// The turn is how far each + or - in the final rule turns to either side
turn = 90 degrees
// This is how many times the rules get applied before we draw the result
times = 5
// This is our starting string
start = "++a"
// These are the rules we apply
rules = [["f","f"],["a","-bf+afa+fb-"], ["b","+af-bfb-fa+"]]

// L-System rules pulled from Wikipedia
// Dragon
// 90 degrees, "fx", [["f","f"],["x","x+yf"],["y","fx-y"]]

// TerDragon
// 120 degrees, "f", [["f","f+f-f"]]

// Koch curve
// 90 degrees, "f", [["f","f+f-f-f+f"]]
// use "++f" as the start to flip it over

// Sierpinski Triangle
// 60 degrees, "bf", [["f","f"],["a","bf-af-b"],["b","af+bf+a"]]

// Plant
// 25 degrees, "--x", [["f","ff"],["x","f-[[x]+x]+f[+fx]-x"]]

// Hilbert space filling curve
// 90 degrees, "++a", [["f","f"],["a","-bf+afa+fb-"], ["b","+af-bfb-fa+"]]

// Peano-Gosper curve
// 60 degrees, "x", [["f","f"],["x","x+yf++yf-fx--fxfx-yf+"], ["y","-fx+yfyf++yf+fx--fx-y"]]

// Lévy C curve
// 45 degrees, "f", [["f","+f--f+"]]

// This function will apply our rule once, using string substitutions based
// on the rules we pass it
// It does this in two passes to avoid problems with pairs of mutually referencing
// rules such as in the Sierpinski Triangle
// [email protected]@1 could replace toString[k] and the entire second loop could
// vanish without adversely affecting the Dragon or Koch curves.

apply_rules[rules, current] :=
{
   n = current
   for k = 0 to length[rules]-1
   {
      rep = subst[[email protected]@0,toString[k],"g"]
      n =~ rep
   }
   for k = 0 to length[rules]-1
   {
      rep = subst[toString[k],[email protected]@1,"g"]
      n =~ rep
   }
   return n
}

// Here we will actually apply our rules the number of times specified
current = start
for i = 0 to times - 1
{
   current = apply_rules[rules, current]
   // Uncomment this line to see the string that is being produced at each stage
   // println[current]
}

// Go ahead and plot the image now that we've worked it out
g = new graphics
g.antialiased[false]   // Comment this out for non-square rules. It looks better
theta = 0 degrees
x = 0
y = 0
stack = new array
for i = 0 to length[current]-1
{
   // This produces a nice sort of rainbow effect where most colors appear
   // comment it out for a plain black fractal
   // g.color[abs[sin[i degrees]],abs[cos[i*2 degrees]],abs[sin[i*4 degrees]]]

   cur = substrLen[current,i,1]
   if cur == "-"
      theta = theta - (turn)
   if cur == "+"
      theta = theta + (turn)
   if cur == "f" or cur == "F"
   {
      g.line[x,y,x + cos[theta],y + sin[theta]]
      x = x + cos[theta]
      y = y + sin[theta]
   }
   if cur == "["
      stack.push[[theta,x,y]]
   if cur == "]"
      [theta,x,y] = stack.pop[]
}

g.show[]
g.write["hilbert.png",512,undef]


package main

import "github.com/fogleman/gg"

var points []gg.Point

const width = 64

func hilbert(x, y, lg, i1, i2 int) {
    if lg == 1 {
        px := float64(width-x) * 10
        py := float64(width-y) * 10
        points = append(points, gg.Point{px, py})
        return
    }
    lg >>= 1
    hilbert(x+i1*lg, y+i1*lg, lg, i1, 1-i2)
    hilbert(x+i2*lg, y+(1-i2)*lg, lg, i1, i2)
    hilbert(x+(1-i1)*lg, y+(1-i1)*lg, lg, i1, i2)
    hilbert(x+(1-i2)*lg, y+i2*lg, lg, 1-i1, i2)
}

func main() {
    hilbert(0, 0, width, 0, 0)
    dc := gg.NewContext(650, 650)
    dc.SetRGB(0, 0, 0) // Black background
    dc.Clear()
    for _, p := range points {
        dc.LineTo(p.X, p.Y)
    }
    dc.SetHexColor("#90EE90") // Light green curve
    dc.SetLineWidth(1)
    dc.Stroke()
    dc.SavePNG("hilbert.png")
}


import Data.Bool (bool)
import Data.Tree

rule :: Char -> String
rule c =
  case c of
    'a' -> "daab"
    'b' -> "cbba"
    'c' -> "bccd"
    'd' -> "addc"
    _ -> []

vectors :: Char -> [(Int, Int)]
vectors c =
  case c of
    'a' -> [(-1, 1), (-1, -1), (1, -1), (1, 1)]
    'b' -> [(1, -1), (-1, -1), (-1, 1), (1, 1)]
    'c' -> [(1, -1), (1, 1), (-1, 1), (-1, -1)]
    'd' -> [(-1, 1), (1, 1), (1, -1), (-1, -1)]
    _ -> []

main :: IO ()
main = do
  let w = 1024
  putStrLn $ svgFromPoints w $ hilbertPoints w (hilbertTree 6)

hilbertTree :: Int -> Tree Char
hilbertTree n =
  let go tree =
        let c = rootLabel tree
            xs = subForest tree
        in Node c (bool (go <$> xs) (flip Node [] <$> rule c) (null xs))
      seed = Node 'a' []
  in bool seed (iterate go seed !! pred n) (0 < n)

hilbertPoints :: Int -> Tree Char -> [(Int, Int)]
hilbertPoints w tree =
  let go r xy tree =
        let d = quot r 2
            f g x = g xy + (d * g x)
            centres = ((,) . f fst) <*> f snd <$> vectors (rootLabel tree)
            xs = subForest tree
        in bool (concat $ zipWith (go d) centres xs) centres (null xs)
      r = quot w 2
  in go r (r, r) tree

svgFromPoints :: Int -> [(Int, Int)] -> String
svgFromPoints w xys =
  let sw = show w
      points =
        (unwords . fmap (((++) . show . fst) <*> ((' ' :) . show . snd))) xys
  in unlines
       [ "<svg xmlns=\"http://www.w3.org/2000/svg\""
       , unwords ["width=\"512\" height=\"512\" viewBox=\"5 5", sw, sw, "\"> "]
       , "<path d=\"M" ++ points ++ "\" "
       , "stroke-width=\"2\" stroke=\"red\" fill=\"transparent\"/>"
       , "</svg>"
       ]


100 PROGRAM "Hilbert.bas"
110 OPTION ANGLE DEGREES
120 GRAPHICS HIRES 2
130 LET N=5:LET P=1:LET S=11*2^(6-N)
140 PLOT 940,700,ANGLE 180;
150 CALL HILBERT(S,N,P)
160 DEF HILBERT(S,N,P)
170   IF N=0 THEN EXIT DEF
180   PLOT LEFT 90*P;
190   CALL HILBERT(S,N-1,-P)
200   PLOT FORWARD S;RIGHT 90*P;
210   CALL HILBERT(S,N-1,P)
220   PLOT FORWARD S;
230   CALL HILBERT(S,N-1,P)
240   PLOT RIGHT 90*P;FORWARD S;
250   CALL HILBERT(S,N-1,-P)
260   PLOT LEFT 90*P;
270 END DEF


// Translation from https://en.wikipedia.org/wiki/Hilbert_curve

import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;

public class HilbertCurve {
    public static class Point {
        public int x;
        public int y;

        public Point(int x, int y) {
            this.x = x;
            this.y = y;
        }

        public String toString() {
            return "(" + x + ", " + y + ")";
        }

        //rotate/flip a quadrant appropriately
        public void rot(int n, boolean rx, boolean ry) {
            if (!ry) {
                if (rx) {
                    x = (n - 1) - x;
                    y = (n - 1) - y;
                }

                //Swap x and y
                int t  = x;
                x = y;
                y = t;
            }

            return;
        }

        public int calcD(int n) {
            boolean rx, ry;
            int d = 0;
            for (int s = n >>> 1; s > 0; s >>>= 1) {
                rx = ((x & s) != 0);
                ry = ((y & s) != 0);
                d += s * s * ((rx ? 3 : 0) ^ (ry ? 1 : 0));
                rot(s, rx, ry);
            }

            return d;
        }

    }

    public static Point fromD(int n, int d) {
        Point p = new Point(0, 0);
        boolean rx, ry;
        int t = d;
        for (int s = 1; s < n; s <<= 1) {
            rx = ((t & 2) != 0);
            ry = (((t ^ (rx ? 1 : 0)) & 1) != 0);
            p.rot(s, rx, ry);
            p.x += (rx ? s : 0);
            p.y += (ry ? s : 0);
            t >>>= 2;
        }
        return p;
    }

    public static List<Point> getPointsForCurve(int n) {
        List<Point> points = new ArrayList<Point>();
        for (int d = 0; d < (n * n); d++) {
            Point p = fromD(n, d);
            points.add(p);
        }

        return points;
    }

    public static List<String> drawCurve(List<Point> points, int n) {
        char[][] canvas = new char[n][n * 3 - 2];
        for (char[] line : canvas) {
            Arrays.fill(line, ' ');
        }
        for (int i = 1; i < points.size(); i++) {
             Point lastPoint = points.get(i - 1);
            Point curPoint = points.get(i);
            int deltaX = curPoint.x - lastPoint.x;
            int deltaY = curPoint.y - lastPoint.y;
            if (deltaX == 0) {
                if (deltaY == 0) {
                    // A mistake has been made
                    throw new IllegalStateException("Duplicate point, deltaX=" + deltaX + ", deltaY=" + deltaY);
                }
                // Vertical line
                int row = Math.max(curPoint.y, lastPoint.y);
                int col = curPoint.x * 3;
                canvas[row][col] = '|';
            }
            else {
                if (deltaY != 0) {
                    // A mistake has been made
                    throw new IllegalStateException("Diagonal line, deltaX=" + deltaX + ", deltaY=" + deltaY);
                }
                // Horizontal line
                int row = curPoint.y;
                int col = Math.min(curPoint.x, lastPoint.x) * 3 + 1;
                canvas[row][col] = '_';
                canvas[row][col + 1] = '_';
            }

        }
        List<String> lines = new ArrayList<String>();
        for (char[] row : canvas) {
            String line = new String(row);
            lines.add(line);
        }

        return lines;
    }

    public static void main(String... args) {
        for (int order = 1; order <= 5; order++) {
            int n = (1 << order);
            List<Point> points = getPointsForCurve(n);
            System.out.println("Hilbert curve, order=" + order);
            List<String> lines = drawCurve(points, n);
            for (String line : lines) {
                System.out.println(line);
            }
            System.out.println();
        }
        return;
    }
}