Rosetta Code

Brownian tree: Difference between revisions

Page Discussion

Brownian tree (view source)

Revision as of 12:55, 6 April 2024

15,211 bytes added ,  1 month ago
m
→‎{{header|Uiua}}: layout
(1-based index)
 
(14 intermediate revisions by 7 users not shown)
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}}
Line 1,003 ⟶ 1,447:
=={{header|EasyLang}}==
 
[https://easylang.dev/show/#cod=dZHLboMwEEX3/oqzLoqxiahUCfIjiAUlRrVK7IjQFv6+snmkqpKFrfH1eM6dcet7PxxRaLTojaOrajKleAm7uPhvQ67IlRhMO6JkHpboKr3lkKCVqinRwlHyppQSPx+2N1gKnIDBXE0zCoCJkqFxZ+vG+PiAjvr8RP9yo+3pqnmHTQFYU5xihhSwwHR0EBmekmkpG8J5JSd3xJED2Qp+KNuOiQKFH5i3YOJURhdRXOKYDe+DaT5XvtwqPLC9eYQ42smTkgWb6QoO0/oz6EXqqtnfK/n/pWzoYT90WC7+jH6lZPMH7frTMiPBkuLin2/Xt96Y654un7QlhRS/ Run it]
[https://easylang.online/apps/_brownian-tree.html Run it]
 
<syntaxhighlight lang="text">
color3 0 1 1
len f[] 200 * 200
Line 1,014 ⟶ 1,458:
while i < n
repeat
x = randomrandint 200 - 1
y = randomrandint 200 - 1
until f[y * 200 + x + 1] <> 1
.
Line 1,021 ⟶ 1,465:
xo = x
yo = y
x += randomrandint 3 - 2
y += randomrandint 3 - 2
if x < 0 or y < 0 or x >= 200 or y >= 200
break 1
Line 1,039 ⟶ 1,483:
.
.
</syntaxhighlight>
 
=={{header|Evaldraw}}==
 
Based on the C version. Shows the brownian tree animate. Color each particle based on the time it settled. Dont overwrite existing particles.
 
[[File:Brownian tree from initial particle at center.gif|thumb|alt=Brownian trees form patterns similar to dendrites in nature|Animated brownian tree over the coarse of circa 1000 frames]]
 
<syntaxhighlight lang="c">
enum{SIZE=256, PARTICLES_PER_FRAME=10, PARTICLE_OK, GIVE_UP};
static world[SIZE][SIZE];
()
{
// set the seed
if (numframes==0) world[SIZE/2][SIZE/2] = 1;
t = klock();
simulate_brownian_tree(t);
 
cls(0);
for (y = 0; y < SIZE; y++){
for (x = 0; x < SIZE; x++){
cell = world[y][x];
if ( cell ) {
s = 100; // color scale
setcol(128+(s*cell % 128), 128+(s*.7*cell % 128), 128+(s*.1*cell % 128) );
setpix(x,y);
}
}
}
moveto(0,SIZE+15);
setcol(0xffffff);
printf("%g frames", numframes);
}
 
plop_particle(&px, &py) {
for (try=0; try<1000; try++) {
px = int(rnd*SIZE);
py = int(rnd*SIZE);
if (world[py][px] == 0) return PARTICLE_OK;
}
return GIVE_UP;
}
 
simulate_brownian_tree(time){
for(iter=0; iter<PARTICLES_PER_FRAME; iter++) // Rate of particle creation
{
// set particle's initial position
px=0; py=0;
if ( plop_particle(px,py) == GIVE_UP ) return;
 
while (1) { // Keep iterating until we bump into a solid particle
// randomly choose a direction
dx = int(rnd * 3) - 1;
dy = int(rnd * 3) - 1;
if (dx + px < 0 || dx + px >= SIZE || dy + py < 0 || dy + py >= SIZE)
{
// Restart if outside of screen
if ( plop_particle(px,py) == GIVE_UP ) return;
}else if (world[py + dy][px + dx]){
// bumped into something
world[py][px] = time;
break;
}else{
py += dy;
px += dx;
}
}
}
}
 
</syntaxhighlight>
 
=={{header|Factor}}==
This example sets four spawn points, one in each corner of the image, giving the result a vague x-shaped appearance. For visual reasons, movement is restricted to diagonals. So be careful if you change the seed or spawns — they should all fall on the same diagonal.
<syntaxhighlight lang="factor">USINGheaderUSING: accessors images images.loader kernel literals math
math.vectors random sets ;
FROM: sets => in? ;
Line 2,790 ⟶ 3,306:
 
Code runs until the tree reached specified radius. Output is written to "test.eps" of wherever the current directory is.
<syntaxhighlight lang="perl">subuse PI() { atan2(1,1) * 4 } # The, er, pistrict;
use warnings;
sub STEP() { .5 } # How far does the particle move each step. Affects
 
# both speed and accuracy greatly
use constant PI => 2*atan2(1,0); # π
sub STOP_RADIUS() { 100 } # When the tree reaches this far from center, end
use constant STEP => 0.5; # How far particle moves each step. Affects both speed and accuracy greatly
use constant STOP_RADIUS => 100; # When the tree reaches this far from center, end
 
# At each step, move this much towards center. Bigger numbers help the speed because
# particles are less likely to wander off, but greatly affects tree shape.
# Should be between 0 and 1 ish. Set to 0 for pain.
subuse constant ATTRACT() {=> 0.2 };
 
my @particles = map([ map([], 0 .. 2 * STOP_RADIUS) ], 0 .. 2 * STOP_RADIUS);
push @{ $particles[STOP_RADIUS][STOP_RADIUS] }, [0, 0];
my($r_start, $max_dist) = (3, 0);
 
my $r_start = 3;
my $max_dist = 0;
 
sub dist2 {
no warnings 'uninitialized';
my ($dx, $dy) = ($_[0][0] - $_[1][0], $_[0][1] - $_[1][1]);
$dx * $dx + $dy * $dy
Line 2,890 ⟶ 3,407:
 
my $count;
PARTICLE: while (1) {
my $a = rand(2 * PI);
my $p = [ $r_start * cos($a), $r_start * sin($a) ];
while (my $m = move( $p)) {
if ($m == 1) { next }
elsif ($m == 2) { $count++; last; }
elsif ($m == 3) { last PARTICLE }
else { last }
}
print STDERR "$count $max_dist/@{[int($r_start)]}/@{[STOP_RADIUS]}\r" unless $count% 7;
Line 2,904 ⟶ 3,421:
sub write_eps {
my $size = 128;
my $p = $size / (STOP_RADIUS * 1.05);
my $b = STOP_RADIUS * $p;
if ($p < 1) {
$size = STOP_RADIUS * 1.05;
$bp = STOP_RADIUS1;
$pb = 1STOP_RADIUS;
}
 
my $hp = $p / 2;
 
open OUT, "'>"', "'test.eps"';
print OUT <<~"HEAD";
 
# print EPS to standard%!PS-Adobe-3.0 outEPSF-3.0
%%BoundingBox: 0 0 @{[$size*2, $size*2]}
print OUT <<"HEAD";
$size $size translate
%!PS-Adobe-3.0 EPSF-3.0
/l{ rlineto }def
%%BoundingBox: 0 0 @{[$size*2, $size*2]}
/c{ $hp 0 360 arc fill }def
$size $size translate
-$size -$size moveto
/l{ rlineto }def
$size 2 mul 0 l
/c{ $hp 0 360 arc fill }def
-$size - 0 $size moveto2 mul l
-$size 2 mul 0 l
closepath
0 $size 2 mul l
0 setgray fill
-$size 2 mul 0 l
0 setlinewidth .1 setgray 0 0 $b 0 360 arc stroke
closepath
.8 setgray /TimesRoman findfont 16 scalefont setfont
0 setgray fill
-$size 10 add $size -16 add moveto
0 setlinewidth .1 setgray 0 0 $b 0 360 arc stroke
(Step = @{[STEP]} Attract = @{[ATTRACT]}) show
.8 setgray /TimesRoman findfont 16 scalefont setfont
0 1 0 setrgbcolor newpath
-$size 10 add $size -16 add moveto
HEAD
(Step = @{[STEP]} Attract = @{[ATTRACT]}) show
0 1 0 setrgbcolor newpath
HEAD
 
for (@particles) {
Line 2,945 ⟶ 3,459:
}
 
write_eps();</syntaxhighlight>
 
=={{header|Phix}}==
As-is, runs in about 2s, but can be very slow when bigger or (even worse) resize-able.
Line 4,444 ⟶ 4,959:
world[py][px] := 1;
rect(SCALE * pred(px), SCALE * pred(py), SCALE, SCALE, white);
DRAW_FLUSHflushGraphic;
bumped := TRUE;
else
Line 4,452 ⟶ 4,967:
until bumped;
end for;
end func;
const proc: main is func
begin
screen(SIZE * SCALE, SIZE * SCALE);
KEYBOARD := GRAPH_KEYBOARD;
genBrownianTree(SIZE, 20000);
readln(KEYBOARD);
end func;</syntaxhighlight>
 
Original source: [http://seed7.sourceforge.net/algorith/graphic.htm#brownian_tree]
 
=={{header|SequenceL}}==
'''SequenceL Code:'''<br>
Line 4,911 ⟶ 5,419:
:Pause
:RecallGDB 0</syntaxhighlight>
 
=={{header|Uiua}}==
Uiua Pad will show well-shaped arrays as images directly. If running locally you can uncomment the final few lines to save it as a file instead. (Running local is ~10 times faster too.)
 
The main move loop passes round a pair of points: here and previous position, so when we hit a set cell we can just back up one.
 
<syntaxhighlight lang="Uiua">
S ← 80
# Create SxS grid, and set the centre point as seed.
⍜⊡(+1)↯2⌊÷2S ↯ S_S 0
 
RandInt ← ⌊×⚂
RandPoint ← ([⍥(RandInt S)2])
# Update the pair to be a new adjacent [[Here] [Last]]
Move ← ⊟∵(-1+⌊RandInt 3).⊢
In ← /××⊃(≥0)(<S) # Is this point in bounds?
# Given a grid return a free point pair and that grid.
SeedPair ← ⊟.⍢(RandPoint ◌)(=1⊡) RandPoint
# Find next adjacent position, or new seed if out of bounds.
Next ← ⟨SeedPair ◌|∘⟩:⟜(In ⊢)Move
# Start from a new Seed Pair and move until you hit the tree. Add the prior pos to the tree.
JoinTree ← ⍜⊡(+1)◌°⊟⍢Next (=0⊡⊢) SeedPair
# Do it multiple times.
⍜now⍥JoinTree500
 
# ◌
# &ime "png"
# &fwa "BrownianTree.png"
</syntaxhighlight>
 
Or if you like your code terse :-)
 
<syntaxhighlight lang="Uiua">
S ← 80
⍜⊡(+1)↯2⌊÷2S↯S_S0
Rp ← (⊟⍥(⌊×⚂S)2)
Sd ← ⊟.⍢(Rp◌)(=1⊡) Rp
Nx ← ⟨Sd◌|∘⟩:⟜(/××⊃(≥0)(<S)⊢)⊟∵(-1+⌊×⚂3).⊢
⍜now⍥(⍜⊡(+1)◌°⊟⍢Nx(=0⊡⊢)Sd)500
</syntaxhighlight>
{{out}}
[[File:UiuaBrownianTree.png|thumb|center||Sample with higher values than provided code]]
 
=={{header|Visual Basic .NET}}==
Windows Forms Application.
Line 5,051 ⟶ 5,602:
{{trans|Go}}
As you'd expect, not very fast so have halved Go's parameters to draw the tree in around 45 seconds.
<syntaxhighlight lang="ecmascriptwren">import "graphics" for Canvas, Color
import "dome" for Window
import "random" for Random
Line 5,142 ⟶ 5,693:
 
var Game = BrownianTree.new(200, 150, 7500)</syntaxhighlight>
 
=={{header|XPL0}}==
[[File:BrownXPL0.gif|right]]
Midaz
67

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/332496...363328"