Rosetta Code

Hilbert curve: Difference between revisions

Page Discussion

Hilbert curve (view source)

Revision as of 17:56, 13 April 2024

7,729 bytes added ,  1 month ago
→‎{{header|Fōrmulæ}}: Added L-system solution
m (syntax highlighting fixup automation)
(→‎{{header|Fōrmulæ}}: Added L-system solution)
(26 intermediate revisions by 12 users not shown)
Line 472:
ExitApp
Return</syntaxhighlight>
 
=={{header|Binary Lambda Calculus}}==
 
As shown in https://www.ioccc.org/2012/tromp/hint.html, the 142+3 byte BLC program
 
<pre>0000000 18 18 18 18 11 11 54 68 06 04 15 5f f0 41 9d f9
0000020 de 16 ff fe 5f 3f ef f6 15 ff 94 68 40 58 11 7e
0000040 05 cb fe bc bf ee 86 cb 94 68 16 00 5c 0b fa cb
0000060 fb f7 1a 85 e0 5c f4 14 d5 fe 08 18 0b 04 8d 08
0000100 00 e0 78 01 64 45 ff e5 ff 7f ff fe 5f ff 2f c0
0000120 ee d9 7f 5b ff ff fb ff fc aa ff f7 81 7f fa df
0000140 76 69 54 68 06 01 57 f7 e1 60 5c 13 fe 80 b2 2c
0000160 18 58 1b fe 5c 10 42 ff 80 5d ee c0 6c 2c 0c 06
0000200 08 19 1a 00 16 7f bc bc fd f6 5f 7c 0a 20 31 32
0000220 33</pre>
 
(consisting of the 142 byte binary prefix https://github.com/tromp/AIT/blob/master/hilbert followed by "123") outputs the 3rd order Hilbert curve
 
<pre> _ _ _ _
| |_| | | |_| |
|_ _| |_ _|
_| |_____| |_
| ___ ___ |
|_| _| |_ |_|
_ |_ _| _
| |___| |___| |</pre>
 
=={{header|BQN}}==
Line 1,106 ⟶ 1,132:
| __ | | __ | | __ | | __ | | __ | | __ | | __ | | __ |
|__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__| |__|</pre>
 
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
This is a very fancy version of the Hilbert curve. It allows you to draw multiple levels and you have the option of superimposing each level on top of the others. You can choose four different pen colors that alternate according to the level. The pen thickness can vary according to the level and can be increments or decremented according to the settings.
 
<syntaxhighlight lang="Delphi">
 
procedure ClearBackground(Image: TImage; Color: TColor);
{Clear image with specified color}
begin
Image.Canvas.Brush.Color:=Color;
Image.Canvas.Pen.Color:=Color;
Image.Canvas.Rectangle(Image.ClientRect);
end;
 
{Array of colors used in display}
 
type TColorArray = array of TColor;
 
{Option controls the size of lines for each level}
 
type TPenMode = (pmNormal,pmIncrement,pmDecrement);
 
{Combined structure controls the Hilbert display}
 
type TCurveOptions = record
Order: integer;
SuperImposed: boolean;
PenMode: TPenMode;
ColorArray: TColorArray;
end;
 
 
procedure DrawHillbertCurve(Canvas: TCanvas; Width,Height: integer; Options: TCurveOptions);
{ Hilbert Curve}
var X,Y,X0,Y0,H,H0,StartX,StartY: double;
var I,Inx: integer;
 
procedure LeftUpRight(I: integer); forward;
procedure DownRightUp(I: integer); forward;
procedure RightDownLeft(I: integer); forward;
procedure UpLeftDown(I: integer); forward;
 
 
procedure DrawRealLine(var X,Y: double);
begin
Canvas.LineTo(Trunc(X),Trunc(Y));
end;
 
procedure LeftUpRight(I: integer);
begin
if I>0 then
begin
UpLeftDown(I-1);
X:=X-H;
DrawRealLine(X,Y);
LeftUpRight(I-1);
Y:=Y-H;
DrawRealLine(X,Y);
LeftUpRight(I-1);
X:=X+H;
DrawRealLine(X,Y);
DownRightUp(I-1);
end;
end;
 
procedure DownRightUp(I: integer);
begin
if I>0 then
begin
RightDownLeft(I-1);
Y:=Y+H;
DrawRealLine(X,Y);
DownRightUp(I-1);
X:=X+H;
DrawRealLine(X,Y);
DownRightUp(I-1);
Y:=Y-H;
DrawRealLine(X,Y);
LeftUpRight(I-1);
end;
end;
 
procedure RightDownLeft(I: integer);
begin
if I>0 then
begin
DownRightUp(I-1);
X:=X+H;
DrawRealLine(X,Y);
RightDownLeft(I-1);
Y:=Y+H;
DrawRealLine(X,Y);
RightDownLeft(I-1);
X:=X-H;
DrawRealLine(X,Y);
UpLeftDown(I-1);
end;
end;
 
procedure UpLeftDown(I: integer);
begin
if I>0 then
begin
LeftUpRight(I-1);
Y:=Y-H;
DrawRealLine(X,Y);
UpLeftDown(I-1);
X:=X-H;
DrawRealLine(X,Y);
UpLeftDown(I-1);
Y:=Y+H;
DrawRealLine(X,Y);
RightDownLeft(I-1);
end;
end;
 
begin
if Height<Width then H0:=Height else H0:=Width;
STARTX:=Width div 2;
STARTY:=Height div 2;
H:=H0;
X0:=STARTX;
Y0:=STARTY;
 
for I:=1 to Options.Order do
begin
case Options.PenMode of
pmDecrement: Canvas.Pen.Width:=(Options.Order - I) + 1;
pmIncrement: Canvas.Pen.Width:=I;
end;
Inx:=(I-1) mod Length(Options.ColorArray);
Canvas.Pen.Color:=Options.ColorArray[Inx];
H:=H / 2;
X0:=X0+(H / 2);
Y0:=Y0+(H / 2);
X:=X0;
Y:=Y0;
if not Options.SuperImposed and (Options.Order<>I) then continue;
Canvas.MoveTo(Trunc(X),Trunc(Y));
 
{ Draw Curve Of Order I }
LeftUpRight(I);
end;
end;
 
procedure ShowHilbertCurve(Image: TImage);
{Setup parameter and draw Hilbert curve on canvas}
var CA: TColorArray;
var Options: TCurveOptions;
begin
ClearBackground(Image,clWhite);
Image.Canvas.Pen.Width:=1;
SetLength(CA,4);
CA[0]:=clBlack;
CA[1]:=clGray;
CA[2]:=clSilver;
CA[3]:=clGray;
Options.Order:=5;
Options.SuperImposed:=True;
Options.PenMode:=pmNormal;
Options.ColorArray:=CA;
 
DrawHillbertCurve(Image.Canvas,Image.Width,Image.Height,Options);
end;
 
 
</syntaxhighlight>
{{out}}
[[File:DelphiHilbertCurve.png|thumb|none]]
<pre>
 
</pre>
 
=={{header|EasyLang}}==
 
{{trans|FutureBasic}}
 
[https://easylang.dev/show/#cod=jVBLDoIwEN33FG9JMSCtxp2HUajSpAFTUeH2zlAKRDa2TTPz5n2atr4yHmecjsLZxnxs1dU4aOzR8kQ8y4szNFdFETFkU5eENg2wFA/flqituxrfoccAd4dVsBo5cgHA3hgiM25ocWJ0ydBLsgp5MzbM2CTxpnv5hpvRcbSjq7JvaAaW+B1npzwcVnV4kiJru+XrhZ8EilyrtorAUvJXp/7S6ZUuZtMJDqzKRRQVtMOfUCW+ Run it]
 
<syntaxhighlight lang="easylang">
order = 64
linewidth 32 / order
scale = 100 / order - 100 / (order * order)
proc hilbert x y lg i1 i2 . .
if lg = 1
line (order - x) * scale (order - y) * scale
return
.
lg = lg div 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
.
hilbert 0 0 order 0 0
</syntaxhighlight>
 
=={{header|F_Sharp|F#}}==
<syntaxhighlight lang="fsharp">
// Hilbert curve. Nigel Galloway: September 18th., 2023
type C= |At|Cl|Ab|Cr
type D= |Z|U|D|L|R
let fD=function Z->0,0 |U->0,1 |D->0,-1 |L-> -1,0 |R->1,0
let fC=function At->[fD D;fD R;fD U] |Cl->[fD R;fD D;fD L] |Ab->[fD U;fD L;fD D] |Cr->[fD L;fD U;fD R]
let order(n,g)=match g with At->[n,Cl;D,At;R,At;U,Cr]
|Cl->[n,At;R,Cl;D,Cl;L,Ab]
|Ab->[n,Cr;U,Ab;L,Ab;D,Cl]
|Cr->[n,Ab;L,Cr;U,Cr;R,At]
let hilbert=Seq.unfold(fun n->Some(n,n|>List.collect order))[Z,At]
hilbert|>Seq.take 7|>Seq.iteri(fun n g->Chart.Line(g|>Seq.collect(fun(n,g)->(fD n)::(fC g))|>Seq.scan(fun(x,y)(n,g)->(x+n,y+g))(0,0))|>Chart.withTitle(sprintf "Hilbert order %d" n)|>Chart.show)
</syntaxhighlight>
{{out}}
[[File:Hilbert0.png]]
[[File:Hilbert1.png]]
[[File:Hilbert2.png]]
[[File:Hilbert3.png]]
[[File:Hilbert4.png]]
[[File:Hilbert5.png]]
[[File:Hilbert6.png]]
 
=={{header|Factor}}==
Line 1,155 ⟶ 1,402:
=={{header|Forth}}==
{{trans|Yabasic}}
{{works with|4tH |v3.62}}
<syntaxhighlight lang="forth">include lib/graphics.4th
 
64 constant /width \ hilbertHilbert curve order^2
9 constant /length \ length of a line
 
Line 1,187 ⟶ 1,434:
color_image 255 whiteout blue \ paint blue on white
0 dup origin! \ set point of origin
0 dup /width over dup hilbert \ hilbertHilbert curve, order=8
s" ghilbert.ppm" save_image \ save the image
</syntaxhighlight>
Line 1,218 ⟶ 1,465:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Hilbert_curve}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
'''Solution'''
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
 
=== Recursive ===
In '''[https://formulae.org/?example=Hilbert_curve this]''' page you can see the program(s) related to this task and their results.
 
The following defines a function that creates a graphics of the Hilbert curve of a given order and size:
 
[[File:Fōrmulæ - Hilbert curve 01.png]]
 
'''Test cases'''
 
The following creates a table with Hilbert curves for orders 1 to 5:
 
[[File:Fōrmulæ - Hilbert curve 02.png]]
 
[[File:Fōrmulæ - Hilbert curve 03.png|279px]]
 
=== L-system ===
 
There are generic functions written in Fōrmulæ to compute an L-system in the page [[L-system#Fōrmulæ | L-system]].
 
The program that creates a Hilbert curve is:
 
[[File:Fōrmulæ - L-system - Hilbert curve 01.png]]
 
[[File:Fōrmulæ - L-system - Hilbert curve 02.png]]
 
=={{header|Frink}}==
Line 1,342 ⟶ 1,611:
</syntaxhighlight>
 
=={{header|FutureBasic}}==
Hilbert Curve Order 64
<syntaxhighlight lang="futurebasic">
#define ORDER 64
 
_window = 1
 
void local fn BuildWindow
CGRect r = fn CGRectMake( 0, 0, 651, 661 )
window _window, @"Order 64 Hilbert Curve In FutureBasic", r, NSWindowStyleMaskTitled
WindowSetBackgroundColor( _window, fn ColorBlack )
end fn
 
void local fn HilbertCurve( x as long, y as long, lg as long, i1 as long, i2 as long )
if ( lg == 1 )
line to ( ORDER-x ) * 10, ( ORDER-y ) * 10
exit fn
end if
lg = lg / 2
fn HilbertCurve( x+i1*lg, y+i1*lg, lg, i1, 1-i2 )
pen 2.0
fn HilbertCurve( x+i2*lg, y+(1-i2)*lg, lg, i1, i2 )
fn HilbertCurve( x+(1-i1)*lg, y+(1-i1)*lg, lg, i1, i2 )
fn HilbertCurve( x+(1-i2)*lg, y+i2*lg, lg, 1-i1, i2 )
end fn
 
fn BuildWindow
pen -2.0, fn ColorGreen
fn HilbertCurve( 0, 0, ORDER, 0, 0 )
 
HandleEvents
</syntaxhighlight>
{{output}}
[[File:Hilbert_Curve_FutureBasic.png]]
 
=={{header|Go}}==
Line 1,391 ⟶ 1,694:
and folded to a list of points in a square of given size.
 
<syntaxhighlight lang="haskell">import Data.BoolTree (boolTree (..))
 
import Data.Tree
---------------------- HILBERT CURVE ---------------------
 
hilbertTree :: Int -> Tree Char
hilbertTree n
| 0 < n = iterate go seed !! pred n
| otherwise = seed
where
seed = Node 'a' []
go tree
| null xs = Node c (flip Node [] <$> rule c)
| otherwise = Node c (go <$> xs)
where
c = rootLabel tree
xs = subForest tree
 
 
hilbertPoints :: Int -> Tree Char -> [(Int, Int)]
hilbertPoints w = go r (r, r)
where
r = quot w 2
go r xy tree
| null xs = centres
| otherwise = concat $ zipWith (go d) centres xs
where
d = quot r 2
f g x = g xy + (d * g x)
centres =
((,) . f fst)
<*> f snd <$> vectors (rootLabel tree)
xs = subForest tree
 
 
--------------------- PRODUCTION RULE --------------------
 
rule :: Char -> String
Line 1,411 ⟶ 1,747:
'd' -> [(-1, 1), (1, 1), (1, -1), (-1, -1)]
_ -> []
 
 
--------------------------- TEST -------------------------
 
main :: IO ()
Line 1,416 ⟶ 1,755:
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
Line 1,441 ⟶ 1,760:
let sw = show w
points =
(unwords . fmap (((++<>) . show . fst) <*> ((' ' :) . show . snd))) xys
in unlines
[ "<svg xmlns=\"http://www.w3.org/2000/svg\"",
unwords
, unwords ["width=\"512\" height=\"512\" viewBox=\"5 5", sw, sw, "\"> "]
, ["width=\"512\"<path dheight=\"M512\" ++viewBox=\"5 points5", ++sw, sw, "\"> "],
, "stroke-width<path d=\"2\M" stroke=\++ points ++ "red\" fill=\"transparent\"/>",
"stroke-width=\"2\" stroke=\"red\" fill=\"transparent\"/>",
, "</svg>"
] "</syntaxhighlightsvg>"
]</syntaxhighlight>
 
=={{header|IS-BASIC}}==
Line 1,799 ⟶ 2,119:
 
// hilbertCurve :: Dict Char [(Int, Int)] ->
// Dict Char [Char] -> Int -> Int -> SVG string
const hilbertCurve = dictVector =>
dictRule => nwidth => {compose(
const w = 1024;svgFromPoints(width),
hilbertPoints(dictVector)(width),
 
return svgFromPointshilbertTree(wdictRule)(
);
hilbertPoints(dictVector)(w)(
hilbertTree(dictRule)(n)
)
);
};
 
 
// hilbertTree :: Dict Char [Char] -> Int -> Tree Char
const hilbertTree = rule => n => {
const go = treen => {
const xsgo = tree.nest; => {
const xs = tree.nest;
 
return Node(tree.root)(
Boolean( 0 < xs.length) ? (
? xs.map(go)
) : rule[tree.root].map(
flip(Node)([])
)
);
};
const seed = Node("a")([]);
 
return 0 < n
? take(n)(
iterate(go)(seed)
)
.slice(-1);[0]
: seed;
};
const seed = Node("a")([]);
 
return Boolean(n) ? (
take(n)(iterate(go)(seed))
.slice(-1)[0]
) : seed;
};
 
 
Line 1,847 ⟶ 2,166:
]);
 
return Boolean(0 < t.nest.length) ? (
? zipWith(go(r))(centres)(t.nest)
.flat go(r)
) : )(centres;)(t.nest).flat()
: centres;
};
const d = Math.floor(w / 2);
Line 1,901 ⟶ 2,221:
c: ["b", "c", "c", "d"],
d: ["a", "d", "d", "c"]
})(1024)(6);
 
 
Line 1,916 ⟶ 2,236:
nest: xs || []
});
 
 
// compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
const compose = (...fs) =>
// A function defined by the right-to-left
// composition of all the functions in fs.
fs.reduce(
(f, g) => x => f(g(x)),
x => x
);
 
 
// flip :: (a -> b -> c) -> b -> a -> c
const flip = op =>
// The binary function op with
// its arguments reversed.
1 !== op.length ? (
? (a, b) => op(b, a)
) : (a => b => op(b)(a));
 
 
Line 1,949 ⟶ 2,279:
"GeneratorFunction" !== xs.constructor
.constructor.name ? (
xs.length
) : Infinity;
 
 
Line 1,960 ⟶ 2,290:
xs => "GeneratorFunction" !== xs
.constructor.constructor.name ? (
xs.slice(0, n)
) : Array.from({
length: n
}, () => {
const x = xs.next();
 
return x.done ? [] : [x.value];
}).flat();
 
 
Line 1,982 ⟶ 2,312:
}, (_, i) => f(as[i], bs[i]));
};
 
 
// MAIN ---
Line 3,128 ⟶ 3,459:
turtle
10 frames
witheach
[ switch
Line 3,133 ⟶ 3,465:
char L case [ -1 4 turn ]
char R case [ 1 4 turn ]
otherwise ( ignore ) ] ] </syntaxhighlight>
1 frames</syntaxhighlight>
 
{{output}}
 
[[File:Quackery Hilbert curve.png]]
https://imgur.com/pkEAauf
 
=={{header|Racket}}==
Line 3,512 ⟶ 3,845:
 
{{out}}
[[Media:Hilbert_curve_rust.svg]]
See: [https://slack-files.com/T0CNUL56D-F016PFXV0SZ-e88b2585b5 hilbert_curve.svg] (offsite SVG image)
 
=={{header|Scala}}==
Line 4,219 ⟶ 4,552:
{{trans|Go}}
{{libheader|DOME}}
<syntaxhighlight lang="ecmascriptwren">import "graphics" for Canvas, Color, Point
import "dome" for Window
 
Line 4,257 ⟶ 4,590:
static draw(dt) {}
}</syntaxhighlight>
 
{{out}}
[[File:Wren-Hilbert_curve.png|400px]]
 
=={{header|XPL0}}==
Laurence
2,120

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/327688...363554"