Brownian tree: Difference between revisions

m (→‎{{header|Perl}}: modernized code style a bit)
Line 255:
14 HGR : POKE 49234,0
15 ROT= 0: SCALE= 1: RETURN</syntaxhighlight>
=={{header|ATS}}==
 
[[File:Brownian tree.2023.05.07.18.48.00.png|thumb|alt=A brownian tree, black on white.]]
[[File:Brownian tree.2023.05.07.18.48.25.png|thumb|alt=A brownian tree, black on white.]]
[[File:Brownian tree.2023.05.07.18.49.01.png|thumb|alt=A brownian tree, black on white.]]
[[File:Brownian tree.2023.05.07.18.49.34.png|thumb|alt=A brownian tree, black on white.]]
 
The program outputs a Portable Arbitrary Map. Shown are some examples for 10000 particles on 300x300 grid.
 
<syntaxhighlight lang="ats">
(* This program pours all the particles onto the square at once, with
one of them as seed, and then lets the particles move around.
 
Compile with
patscc -std=gnu2x -D_GNU_SOURCE -g -O3 -DATS_MEMALLOC_LIBC brownian_tree_task.dats
 
You may need the -D_GNU_SOURCE to get a declaration of the
random(3) function. *)
(*------------------------------------------------------------------*)
 
%{^
#include <stdlib.h>
%}
 
#include "share/atspre_staload.hats"
 
#define NIL list_nil ()
#define :: list_cons
 
extern castfn lint2int : {i : int} lint i -<> int i
implement g1int2int<lintknd,intknd> i = lint2int i
 
extern fn random () : [i : nat] lint i = "mac#random"
extern fn srandom (seed : uint) : void = "mac#srandom"
extern fn atoi (s : string) : int = "mac#atoi"
 
(*------------------------------------------------------------------*)
 
datatype grid_position =
| Wall
| Empty
| Sticky
| Freely_moving
 
fn {}
grid_position_equal
(x : grid_position,
y : grid_position)
:<> bool =
case+ x of
| Wall () => (case+ y of Wall () => true | _ => false)
| Empty () => (case+ y of Empty () => true | _ => false)
| Sticky () => (case+ y of Sticky () => true | _ => false)
| Freely_moving () =>
(case+ y of Freely_moving () => true | _ => false)
 
fn {}
grid_position_notequal
(x : grid_position,
y : grid_position)
:<> bool =
~grid_position_equal (x, y)
 
overload = with grid_position_equal
overload <> with grid_position_notequal
 
(*------------------------------------------------------------------*)
 
abstype container (w : int, h : int) = ptr
 
local
 
typedef _container (w : int, h : int) =
'{M = matrixref (grid_position, w, h),
w = int w,
h = int h}
 
in (* local *)
 
assume container (w, h) = _container (w, h)
 
fn {}
container_make
{w, h : pos}
(w : int w,
h : int h)
: container (w, h) =
'{M = matrixref_make_elt<grid_position> (i2sz w, i2sz h, Empty),
w = w, h = h}
 
fn {}
container_width
{w, h : pos}
(C : container (w, h))
: int w =
C.w
 
fn {}
container_height
{w, h : pos}
(C : container (w, h))
: int h =
C.h
 
fn {}
container_get_at
{w, h : pos}
(C : container (w, h),
x : intBtwe (~1, w),
y : intBtwe (~1, h))
: grid_position =
let
macdef M = C.M
in
if (0 <= x) * (x < C.w) * (0 <= y) * (y < C.h) then
M[x, C.h, y]
else
Wall
end
 
fn
container_set_at
{w, h : pos}
(C : container (w, h),
x : intBtw (0, w),
y : intBtw (0, h),
gpos : grid_position)
: void =
let
macdef M = C.M
in
M[x, C.h, y] := gpos
end
 
end (* local *)
 
overload width with container_width
overload height with container_height
overload [] with container_get_at
overload [] with container_set_at
 
(*------------------------------------------------------------------*)
 
fn
random_direction () :
@(intBtwe (~1, 1), intBtwe (~1, 1)) =
let
val r1 = random ()
val r2 = random ()
val dx : intBtwe (0, 2) = g1i2i (r1 \nmod 3)
and dy : intBtwe (0, 2) = g1i2i (r2 \nmod 3)
in
@(pred dx, pred dy)
end
 
fn
in_sticky_position
{w, h : pos}
(C : container (w, h),
x : intBtw (0, w),
y : intBtw (0, h))
: bool =
(C[pred x, pred y] = Sticky () ||
C[pred x, y] = Sticky () ||
C[pred x, succ y] = Sticky () ||
C[succ x, pred y] = Sticky () ||
C[succ x, y] = Sticky () ||
C[succ x, succ y] = Sticky () ||
C[x, pred y] = Sticky () ||
C[x, succ y] = Sticky ())
 
fn
find_placement_for_another_particle
{w, h : pos}
(C : container (w, h))
: @(intBtw (0, w), intBtw (0, h)) =
let
val w = width C and h = height C
 
fun
loop () : @(intBtw (0, w), intBtw (0, h)) =
let
val r1 = random ()
val r2 = random ()
val x : intBtw (0, w) = g1i2i (r1 \nmod w)
and y : intBtw (0, h) = g1i2i (r2 \nmod h)
in
if C[x, y] <> Empty () then
loop ()
else
@(x, y)
end
in
loop ()
end
 
fn
move_particles
{w, h : pos}
(C : container (w, h),
particles : &List0 @(intBtw (0, w), intBtw (0, h)) >> _)
: void =
let
typedef coords = @(intBtw (0, w), intBtw (0, h))
 
fun
loop {n : nat} .<n>.
(particles : list (coords, n),
new_lst : List0 coords)
: List0 coords =
case+ particles of
| NIL => new_lst
| @(x0, y0) :: tl =>
let
val @(dx, dy) = random_direction ()
val x1 = x0 + dx and y1 = y0 + dy
in
if C[x1, y1] = Empty () then
let
val () = assertloc (0 <= x1)
val () = assertloc (x1 < width C)
val () = assertloc (0 <= y1)
val () = assertloc (y1 < height C)
in
C[x1, y1] := C[x0, y0];
C[x0, y0] := Empty ();
loop (tl, @(x1, y1) :: new_lst)
end
else
(* Our rule is: if there is anything where it WOULD have
moved to, then the particle does not move. *)
loop (tl, @(x0, y0) :: new_lst)
end
in
particles := loop (particles, NIL)
end
 
fn
find_which_particles_are_stuck
{w, h : pos}
(C : container (w, h),
particles : &List0 @(intBtw (0, w), intBtw (0, h)) >> _)
: void =
(* Our rule is: if a particle is next to something that ALREADY was
stuck, then it too is stuck. Otherwise it remains free. *)
let
typedef coords = @(intBtw (0, w), intBtw (0, h))
 
fun
loop {n : nat} .<n>.
(particles : list (coords, n),
new_lst : List0 coords)
: List0 coords =
case+ particles of
| NIL => new_lst
| @(x, y) :: tl =>
if in_sticky_position (C, x, y) then
begin
C[x, y] := Sticky ();
loop (tl, new_lst)
end
else
loop (tl, @(x, y) :: new_lst)
in
particles := loop (particles, NIL)
end
 
fn
pour_particles
{w, h : pos}
{n : nat}
(C : container (w, h),
n : int n,
free_particles : &List0 @(intBtw (0, w), intBtw (0, h))?
>> List0 @(intBtw (0, w), intBtw (0, h)))
: void =
if n = 0 then
free_particles := NIL
else
let
typedef coords = @(intBtw (0, w), intBtw (0, h))
 
fun
loop {i : nat | i <= n - 1}
.<(n - 1) - i>.
(particles : list (coords, i),
i : int i)
: list (coords, n - 1) =
if i = pred n then
particles
else
let
val @(x, y) = find_placement_for_another_particle C
in
C[x, y] := Freely_moving;
loop (@(x, y) :: particles, succ i)
end
 
val @(xseed, yseed) = find_placement_for_another_particle C
in
C[xseed, yseed] := Sticky ();
free_particles := loop (NIL, 0)
end
 
fn
go_until_all_particles_are_stuck
{w, h : pos}
(C : container (w, h),
free_particles : List0 @(intBtw (0, w), intBtw (0, h)))
: void =
let
typedef coords = @(intBtw (0, w), intBtw (0, h))
 
fun
loop (free_particles : &List0 coords >> _) : void =
case+ free_particles of
| NIL => ()
| _ :: _ =>
begin
move_particles (C, free_particles);
find_which_particles_are_stuck (C, free_particles);
loop free_particles
end
 
var free_particles : List0 coords = free_particles
in
find_which_particles_are_stuck (C, free_particles);
loop free_particles
end
 
fn
build_a_tree {w, h : pos}
{n : nat}
(w : int w,
h : int h,
n : int n)
: container (w, h) =
let
val C = container_make (w, h)
var free_particles : List0 @(intBtw (0, w), intBtw (0, h))
in
pour_particles (C, n, free_particles);
go_until_all_particles_are_stuck (C, free_particles);
C
end
 
fn
write_a_PAM_image
{w, h : pos}
(outf : FILEref,
C : container (w, h),
seed : uint)
: void =
let
val w = width C and h = height C
 
fun
count_particles
{x, y : nat | x <= w; y <= h}
.<h - y, w - x>.
(x : int x,
y : int y,
n : int)
: int =
if y = h then
n
else if x = w then
count_particles (0, succ y, n)
else if C[x, y] = Empty () then
count_particles (succ x, y, n)
else
count_particles (succ x, y, succ n)
 
fun
loop {x, y : nat | x <= w; y <= h}
.<h - y, w - x>.
(x : int x,
y : int y)
: void =
if y = h then
()
else if x = w then
loop (0, succ y)
else
begin
fprint_val<char>
(outf, if C[x, y] = Empty () then '\1' else '\0');
loop (succ x, y)
end
in
fprintln! (outf, "P7");
fprintln! (outf, "# Number of particles = ",
count_particles (0, 0, 0));
fprintln! (outf, "# Seed = ", seed);
fprintln! (outf, "WIDTH ", width C);
fprintln! (outf, "HEIGHT ", height C);
fprintln! (outf, "DEPTH 1");
fprintln! (outf, "MAXVAL 1");
fprintln! (outf, "TUPLTYPE BLACKANDWHITE");
fprintln! (outf, "ENDHDR");
loop (0, 0)
end
 
(*------------------------------------------------------------------*)
 
implement
main0 (argc, argv) =
let
val args = list_vt2t (listize_argc_argv (argc, argv))
val nargs = argc
in
if nargs <> 5 then
begin
fprintln! (stderr_ref, "Usage: ", args[0],
" width height num_particles seed");
exit 1
end
else
let
val w = g1ofg0 (atoi (args[1]))
and h = g1ofg0 (atoi (args[2]))
and num_particles = g1ofg0 (atoi (args[3]))
and seed = g1ofg0 (atoi (args[4]))
in
if (w < 1) + (h < 1) + (num_particles < 0) + (seed < 0) then
begin
fprintln! (stderr_ref, "Illegal command line argument.");
exit 1
end
else
let
val seed : uint = g0i2u seed
val () = srandom seed
val C = build_a_tree (w, h, num_particles)
in
write_a_PAM_image (stdout_ref, C, seed)
end
end
end
 
(*------------------------------------------------------------------*)
</syntaxhighlight>
 
=={{header|AutoHotkey}}==
{{works with|AutoHotkey_L}}
Line 312 ⟶ 755:
return r
}</syntaxhighlight>Sample output file [http://www.autohotkey.net/~crazyfirex/Images/brownian.png here]
 
=={{header|BBC BASIC}}==
{{works with|BBC BASIC for Windows}}
1,448

edits