Forest fire: Difference between revisions
m (→{{header|PureBasic}}: add SmartWindowRefresh()) |
|||
Line 734:
If OpenWindow(0,10,30,#Width,#Height, Title$)
SmartWindowRefresh(0, 1) ; This function just try to help with the flickering problems...
; http://www.purebasic.com/documentation/window/smartwindowrefresh.html
If CreateImage(1, #Width, #Height)
Define Event, freq
|
Revision as of 09:48, 18 July 2010
You are encouraged to solve this task according to the task description, using any language you may know.
This page uses content from Wikipedia. The original article was at Forest-fire model. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance) |
Implement the Drossel and Schwabl definition of the forest-fire model.
It is basically a 2D cellular automaton where each cell can be in three distinct states (empty, tree and burning) and evolves according to the following rules (as given by Wikipedia)
- A burning cell turns into an empty cell
- A tree will burn if at least one neighbor is burning
- A tree ignites with probability f even if no neighbor is burning
- An empty space fills with a tree with probability p
Neighborhood is the Moore neighborhood; boundary conditions are so that on the boundary the cells are always empty ("fixed" boundary condition).
At the beginning, populate the lattice with empty and tree cells according to a specific probability (e.g. a cell has the probability 0.5 to be a tree). Then, let the system evolve.
Task's requirements do not include graphical display or the ability to change parameters (probabilities p and f) through a graphical or command line interface.
See also Conway's Game of Life and Wireworld.
C
<lang c>#include <stdio.h>
- include <stdlib.h>
- include <stdint.h>
- include <stdbool.h>
- include <string.h>
- include <pthread.h>
- include <SDL.h>
// defaults
- define PROB_TREE 0.55
- define PROB_F 0.00001
- define PROB_P 0.001
- define TIMERFREQ 100
- ifndef WIDTH
- define WIDTH 640
- endif
- ifndef HEIGHT
- define HEIGHT 480
- endif
- ifndef BPP
- define BPP 32
- endif
- if BPP != 32
#warning This program could not work with BPP different from 32
- endif
uint8_t *field[2], swapu; double prob_f = PROB_F, prob_p = PROB_P, prob_tree = PROB_TREE;
enum cell_state {
VOID, TREE, BURNING
};
// simplistic random func to give [0, 1) double prand() {
return (double)rand() / (RAND_MAX + 1.0);
}
// initialize the field void init_field(void) {
int i, j; swapu = 0; for(i = 0; i < WIDTH; i++) { for(j = 0; j < HEIGHT; j++) { *(field[0] + j*WIDTH + i) = prand() > prob_tree ? VOID : TREE; } }
}
// the "core" of the task: the "forest-fire CA" bool burning_neighbor(int, int); pthread_mutex_t synclock = PTHREAD_MUTEX_INITIALIZER; static uint32_t simulate(uint32_t iv, void *p) {
int i, j;
/* Since this is called by SDL, "likely"(*) in a separated thread, we try to avoid corrupted updating of the display (done by the show() func): show needs the "right" swapu i.e. the right complete field. (*) what if it is not so? The following is an attempt to avoid unpleasant updates. */ pthread_mutex_lock(&synclock);
for(i = 0; i < WIDTH; i++) { for(j = 0; j < HEIGHT; j++) { enum cell_state s = *(field[swapu] + j*WIDTH + i); switch(s) { case BURNING:
*(field[swapu^1] + j*WIDTH + i) = VOID; break;
case VOID:
*(field[swapu^1] + j*WIDTH + i) = prand() > prob_p ? VOID : TREE; break;
case TREE:
if (burning_neighbor(i, j)) *(field[swapu^1] + j*WIDTH + i) = BURNING; else *(field[swapu^1] + j*WIDTH + i) = prand() > prob_f ? TREE : BURNING; break;
default:
fprintf(stderr, "corrupted field\n"); break;
} } } swapu ^= 1; pthread_mutex_unlock(&synclock); return iv;
}
// the field is a "part" of an infinite "void" region
- define NB(I,J) (((I)<WIDTH)&&((I)>=0)&&((J)<HEIGHT)&&((J)>=0) \
? (*(field[swapu] + (J)*WIDTH + (I)) == BURNING) : false) bool burning_neighbor(int i, int j) {
return NB(i-1,j-1) || NB(i-1, j) || NB(i-1, j+1) || NB(i, j-1) || NB(i, j+1) || NB(i+1, j-1) || NB(i+1, j) || NB(i+1, j+1);
}
// "map" the field into gfx mem
// burning trees are red
// trees are green
// "voids" are black;
void show(SDL_Surface *s)
{
int i, j; uint8_t *pixels = (uint8_t *)s->pixels; uint32_t color; SDL_PixelFormat *f = s->format;
pthread_mutex_lock(&synclock); for(i = 0; i < WIDTH; i++) { for(j = 0; j < HEIGHT; j++) { switch(*(field[swapu] + j*WIDTH + i)) { case VOID:
color = SDL_MapRGBA(f, 0,0,0,255); break;
case TREE:
color = SDL_MapRGBA(f, 0,255,0,255); break;
case BURNING:
color = SDL_MapRGBA(f, 255,0,0,255); break;
} *(uint32_t*)(pixels + j*s->pitch + i*(BPP>>2)) = color; } } pthread_mutex_unlock(&synclock);
}
int main(int argc, char **argv) {
SDL_Surface *scr = NULL; SDL_Event event[1]; bool quit = false, running = false; SDL_TimerID tid;
// add variability to the simulation srand(time(NULL));
// we can change prob_f and prob_p // prob_f prob of spontaneous ignition // prob_p prob of birth of a tree double *p; for(argv++, argc--; argc > 0; argc--, argv++) { if ( strcmp(*argv, "prob_f") == 0 && argc > 1 ) { p = &prob_f; } else if ( strcmp(*argv, "prob_p") == 0 && argc > 1 ) { p = &prob_p; } else if ( strcmp(*argv, "prob_tree") == 0 && argc > 1 ) { p = &prob_tree; } else continue;
argv++; argc--; char *s = NULL; double t = strtod(*argv, &s); if (s != *argv) *p = t; }
printf("prob_f %lf\nprob_p %lf\nratio %lf\nprob_tree %lf\n",
prob_f, prob_p, prob_p/prob_f, prob_tree);
if ( SDL_Init(SDL_INIT_VIDEO|SDL_INIT_TIMER) != 0 ) return EXIT_FAILURE; atexit(SDL_Quit);
field[0] = malloc(WIDTH*HEIGHT); if (field[0] == NULL) exit(EXIT_FAILURE); field[1] = malloc(WIDTH*HEIGHT); if (field[1] == NULL) { free(field[0]); exit(EXIT_FAILURE); }
scr = SDL_SetVideoMode(WIDTH, HEIGHT, BPP, SDL_HWSURFACE|SDL_DOUBLEBUF); if (scr == NULL) { fprintf(stderr, "SDL_SetVideoMode: %s\n", SDL_GetError()); free(field[0]); free(field[1]); exit(EXIT_FAILURE); }
init_field();
tid = SDL_AddTimer(TIMERFREQ, simulate, NULL); // suppose success running = true;
event->type = SDL_VIDEOEXPOSE; SDL_PushEvent(event);
while(SDL_WaitEvent(event) && !quit) { switch(event->type) { case SDL_VIDEOEXPOSE: while(SDL_LockSurface(scr) != 0) SDL_Delay(1); show(scr); SDL_UnlockSurface(scr); SDL_Flip(scr); event->type = SDL_VIDEOEXPOSE; SDL_PushEvent(event); break; case SDL_KEYDOWN: switch(event->key.keysym.sym) { case SDLK_q:
quit = true; break;
case SDLK_p:
if (running) { running = false; pthread_mutex_lock(&synclock); SDL_RemoveTimer(tid); // ignore failure... pthread_mutex_unlock(&synclock); } else { running = true; tid = SDL_AddTimer(TIMERFREQ, simulate, NULL); // suppose success... } break;
} } }
if (running) { pthread_mutex_lock(&synclock); SDL_RemoveTimer(tid); pthread_mutex_unlock(&synclock); } free(field[0]); free(field[1]); exit(EXIT_SUCCESS);
}</lang>
Fortran
<lang fortran>module ForestFireModel
implicit none
type :: forestfire integer, dimension(:,:,:), allocatable :: field integer :: width, height integer :: swapu real :: prob_tree, prob_f, prob_p end type forestfire
integer, parameter :: & empty = 0, & tree = 1, & burning = 2
private :: bcheck, set, oget, burning_neighbor ! cset, get
contains
! create and initialize the field(s) function forestfire_new(w, h, pt, pf, pp) result(res) type(forestfire) :: res integer, intent(in) :: w, h real, intent(in), optional :: pt, pf, pp
integer :: i, j real :: r
allocate(res%field(2,w,h)) ! no error check res%prob_tree = 0.5 res%prob_f = 0.00001 res%prob_p = 0.001 if ( present(pt) ) res%prob_tree = pt if ( present(pf) ) res%prob_f = pf if ( present(pp) ) res%prob_p = pp
res%width = w res%height = h res%swapu = 0
res%field = empty
do i = 1,w do j = 1,h call random_number(r) if ( r <= res%prob_tree ) call cset(res, i, j, tree) end do end do end function forestfire_new ! destroy the field(s) subroutine forestfire_destroy(f) type(forestfire), intent(inout) :: f
if ( allocated(f%field) ) deallocate(f%field) end subroutine forestfire_destroy
! evolution subroutine forestfire_evolve(f) type(forestfire), intent(inout) :: f
integer :: i, j real :: r
do i = 1, f%width do j = 1, f%height select case ( get(f, i, j) ) case (burning) call set(f, i, j, empty) case (empty) call random_number(r) if ( r > f%prob_p ) then call set(f, i, j, empty) else call set(f, i, j, tree) end if case (tree) if ( burning_neighbor(f, i, j) ) then call set(f, i, j, burning) else call random_number(r) if ( r > f%prob_f ) then call set(f, i, j, tree) else call set(f, i, j, burning) end if end if end select end do end do f%swapu = ieor(f%swapu, 1) end subroutine forestfire_evolve
! helper funcs/subs subroutine set(f, i, j, t) type(forestfire), intent(inout) :: f integer, intent(in) :: i, j, t
if ( bcheck(f, i, j) ) then f%field(ieor(f%swapu,1), i, j) = t end if end subroutine set
subroutine cset(f, i, j, t) type(forestfire), intent(inout) :: f integer, intent(in) :: i, j, t
if ( bcheck(f, i, j) ) then f%field(f%swapu, i, j) = t end if end subroutine cset
function bcheck(f, i, j) logical :: bcheck type(forestfire), intent(in) :: f integer, intent(in) :: i, j bcheck = .false. if ( (i >= 1) .and. (i <= f%width) .and. & (j >= 1) .and. (j <= f%height) ) bcheck = .true. end function bcheck
function get(f, i, j) result(r) integer :: r type(forestfire), intent(in) :: f integer, intent(in) :: i, j if ( .not. bcheck(f, i, j) ) then r = empty else r = f%field(f%swapu, i, j) end if end function get
function oget(f, i, j) result(r) integer :: r type(forestfire), intent(in) :: f integer, intent(in) :: i, j if ( .not. bcheck(f, i, j) ) then r = empty else r = f%field(ieor(f%swapu,1), i, j) end if end function oget
function burning_neighbor(f, i, j) result(r) logical :: r type(forestfire), intent(in) :: f integer, intent(in) :: i, j
integer, dimension(3,3) :: s s = f%field(f%swapu, i-1:i+1, j-1:j+1) s(2,2) = empty r = any(s == burning) end function burning_neighbor
subroutine forestfire_print(f) type(forestfire), intent(in) :: f
integer :: i, j
do j = 1, f%height do i = 1, f%width select case(get(f, i, j)) case (empty) write(*,'(A)', advance='no') '.' case (tree) write(*,'(A)', advance='no') 'Y' case (burning) write(*,'(A)', advance='no') '*' end select end do write(*,*) end do end subroutine forestfire_print
end module ForestFireModel</lang>
<lang fortran>program ForestFireTest
use ForestFireModel implicit none
type(forestfire) :: f integer :: i
f = forestfire_new(74, 40)
do i = 1, 1001 write(*,'(A)', advance='no') achar(z'1b') // '[H' // achar(z'1b') // '[2J' call forestfire_print(f) call forestfire_evolve(f) end do call forestfire_destroy(f)
end program ForestFireTest</lang>
J
<lang j>NB. states: 0 empty, 1 tree, _1 fire dims =:10 10
tessellate=: 0,0,~0,.0,.~ 3 3 >./@,;._3 ] mask=: tessellate dims$1 chance=: 1 :'(> ? bind (dims$0)) bind (mask*m)'
start=: 0.5 chance grow =: 0.01 chance fire =: 0.001 chance
spread=: [: tessellate 0&>
step=: grow [`]@.(|@])"0 >.&0 * _1 ^ fire +. spread
run=:3 :0 forest=. start for.i.y do. smoutput ' #o' {~ forest=. step forest end. )</lang>
Example use:
<lang j> run 2
##### # # # ### #### # # # # ##### # ## # # # # o## # ##### # # # ### #### # # # # ##### # ## # # o # o# # </lang>
Note that I have used an artificially small grid here, and that I ran this several times until I could find one that had a fire from the start. Also, the current revision of this code does not show the starting state, though that would be easily changed.
Also, currently the parameters defining the size of the forest, and the probabilities are hard coded into the program and you need to rerun the program's script when they change.
Finally note that the grid size includes the one cell "border" which are blank. If the border cells are meant to be outside of the represented dimensions, you can add 2 to them (or change the code to do so).
JAMES II/Rule-based Cellular Automata
<lang j2carules>@caversion 1;
dimensions 2;
state EMPTY, TREE, BURNING;
// an empty cell grows a tree with a chance of p = 5 % rule{EMPTY} [0.05] : -> TREE;
// a burning cell turns to a burned cell rule{BURNING}: -> EMPTY;
// a tree starts burning if there is at least one neighbor burning rule{TREE} : BURNING{1,} -> BURNING;
// a tree is hit by lightning with a change of f = 0.006 % rule{TREE} [0.00006] : -> BURNING;</lang> The starting configuration cannot be given in the modeling language since the concepts of the model and its parameters (which includes the starting configuration) are separate in JAMES II.
PicoLisp
<lang PicoLisp>(load "@lib/simul.l")
(scl 3)
(de forestFire (Dim ProbT ProbP ProbF)
(let Grid (grid Dim Dim) (for Col Grid (for This Col (=: tree (> ProbT (rand 0 1.0))) ) ) (loop (disp Grid NIL '((This) (cond ((: burn) "# ") ((: tree) "T ") (T ". ") ) ) ) (wait 1000) (for Col Grid (for This Col (=: next (cond ((: burn) NIL) ((: tree) (if (or (find # Neighbor burning? '((Dir) (get (Dir This) 'burn)) (quote west east south north ((X) (south (west X))) ((X) (north (west X))) ((X) (south (east X))) ((X) (north (east X))) ) ) (> ProbF (rand 0 1.0)) ) 'burn 'tree ) ) (T (and (> ProbP (rand 0 1.0)) 'tree)) ) ) ) ) (for Col Grid (for This Col (if (: next) (put This @ T) (=: burn) (=: tree) ) ) ) ) ) )</lang>
Use:
(forestFire 26 0.5 0.01 0.001)
PureBasic
<lang PureBasic>; Some systems reports high CPU-load while running this code.
- This may likely be either due to the graphic driver used in
- the 2D-function Plot() or the large amounts of Random() calls.
- If experiencing this problem, please reduce the #With & #Height
- or activate the parameter #UnLoadCPU below.
- This code should work with the demo version of PureBasic on both PC & Linux
- General parameters for the world
- f = 3e-6
- p = 1e-2
- SeedATree = 0.005
- Width = 400
- Height = 400
- Setting up colours
- Fire = $080CF7
- BackGround = $BFD5D3
- YoungTree = $00E300
- NormalTree = $00AC00
- MatureTree = $009500
- OldTree = $007600
- Black = $000000
- If your CPU load is too high, set this to '1'
- UnLoadCPU = 0
Enumeration
#Empty =0 #Ignited #Burning #Tree #Old=#Tree+20
EndEnumeration
Global Dim Forest.i(#Width, #Height) Global Title$="Forest fire in PureBasic" Global Cnt
Macro Rnd()
(Random(2147483647)/2147483647.0)
EndMacro
Procedure Limit(n, min, max)
If n<min n=min ElseIf n>max n=max EndIf ProcedureReturn n
EndProcedure
Procedure SpreadFire(x,y)
Protected cnt=0, i, j For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width) For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height) If Forest(i,j)>=#Tree Forest(i,j)=#Ignited EndIf Next Next
EndProcedure
Procedure InitMap()
Protected x, y, type For y=1 To #Height For x=1 To #Width If Rnd()<=#SeedATree type=#Tree Else type=#Empty EndIf Forest(x,y)=type Next Next
EndProcedure
Procedure UpdateMap()
Protected x, y For y=1 To #Height For x=1 To #Width Select Forest(x,y) Case #Burning Forest(x,y)=#Empty SpreadFire(x,y) Case #Ignited Forest(x,y)=#Burning Case #Empty If Rnd()<=#p Forest(x,y)=#Tree EndIf Default If Rnd()<=#f Forest(x,y)=#Burning Else Forest(x,y)+1 EndIf EndSelect Next Next
EndProcedure
Procedure PresentMap()
Protected x, y, c cnt+1 SetWindowTitle(0,Title$+", time frame="+Str(cnt)) StartDrawing(ImageOutput(1)) For y=0 To OutputHeight()-1 For x=0 To OutputWidth()-1 Select Forest(x,y) Case #Empty c=#BackGround Case #Burning, #Ignited c=#Fire Default If Forest(x,y)<#Tree+#Old c=#YoungTree ElseIf Forest(x,y)<#Tree+2*#Old c=#NormalTree ElseIf Forest(x,y)<#Tree+3*#Old c=#MatureTree ElseIf Forest(x,y)<#Tree+4*#Old c=#OldTree Else ; Tree died of old age Forest(x,y)=#Empty c=#Black EndIf EndSelect Plot(x,y,c) Next Next StopDrawing() ImageGadget(1, 0, 0, #Width, #Height, ImageID(1))
EndProcedure
If OpenWindow(0,10,30,#Width,#Height, Title$)
SmartWindowRefresh(0, 1) ; This function just try to help with the flickering problems... ; http://www.purebasic.com/documentation/window/smartwindowrefresh.html If CreateImage(1, #Width, #Height) Define Event, freq If ExamineDesktops() freq=DesktopFrequency(0) Else freq=60 EndIf AddWindowTimer(0,0,5000/freq) InitMap() Repeat Event = WaitWindowEvent() Select Event Case #PB_Event_CloseWindow End Case #PB_Event_Timer CompilerIf #UnLoadCPU<>0 Delay(25) CompilerEndIf UpdateMap() PresentMap() EndSelect ForEver EndIf
Python
Just hit return to advance the simulation, or enter an integer to advance that integer amount of 'frames'. Entering 'p' will print the grid, and 'q' will quit. A summary of the grids status is printed before each prompt for input. <lang python> Forest-Fire Cellular automation
See: http://en.wikipedia.org/wiki/Forest-fire_model
L = 15
- d = 2 # Fixed
initial_trees = 0.55 p = 0.01 f = 0.001
try:
raw_input
except:
raw_input = input
import random
tree, burning, space = 'TB.'
hood = ((-1,-1), (-1,0), (-1,1),
(0,-1), (0, 1), (1,-1), (1,0), (1,1))
def initialise():
grid = {(x,y): (tree if random.random()<= initial_trees else space) for x in range(L) for y in range(L) } return grid
def gprint(grid):
txt = '\n'.join(.join(grid[(x,y)] for x in range(L)) for y in range(L)) print(txt)
def quickprint(grid):
t = b = 0 ll = L * L for x in range(L): for y in range(L): if grid[(x,y)] in (tree, burning): t += 1 if grid[(x,y)] == burning: b += 1 print(('Of %6i cells, %6i are trees of which %6i are currently burning.' + ' (%6.3f%%, %6.3f%%)') % (ll, t, b, 100. * t / ll, 100. * b / ll))
def gnew(grid):
newgrid = {} for x in range(L): for y in range(L): if grid[(x,y)] == burning: newgrid[(x,y)] = space elif grid[(x,y)] == space: newgrid[(x,y)] = tree if random.random()<= p else space elif grid[(x,y)] == tree: newgrid[(x,y)] = (burning if any(grid.get((x+dx,y+dy),space) == burning for dx,dy in hood) or random.random()<= f else tree) return newgrid
if __name__ == '__main__':
grid = initialise() iter = 0 while True: quickprint(grid) inp = raw_input('Print/Quit/<int>/<return> %6i: ' % iter).lower().strip() if inp: if inp[0] == 'p': gprint(grid) elif inp.isdigit(): for i in range(int(inp)): iter +=1 grid = gnew(grid) quickprint(grid) elif inp[0] == 'q': break grid = gnew(grid) iter +=1</lang>
Sample output
Of 225 cells, 108 are trees of which 0 are currently burning. (48.000%, 0.000%) Print/Quit/<int>/<return> 0: Of 225 cells, 114 are trees of which 1 are currently burning. (50.667%, 0.444%) Print/Quit/<int>/<return> 1: p .TTT.T.T.TTTT.T T.T.T.TT..T.T.. TT.TTTT...T.TT. TTT..TTTTT.T..T .T.TTT....TT.TT ...T..TTT.TT.T. .TT.TT...TT..TT .TT.T.T..T.T.T. ..TTT.TT.T..T.. .T....T.....TTT T..TTT..T..T... TTT....TTTTTT.T ......TBTTT...T ..T....TTTTTTTT .T.T.T....TT... Of 225 cells, 115 are trees of which 6 are currently burning. (51.111%, 2.667%) Print/Quit/<int>/<return> 2: p .TTT.TTT.TTTT.T T.T.T.TT..T.T.. TT.TTTT...T.TT. TTT..TTTTT.T..T .T.TTT....TT.TT ...T..TTT.TT.T. .TT.TT...TT..TT .TT.T.T..T.T.T. ..TTT.TT.T..T.. .T....T.....TTT T..TTT..T..T... TTT....BBTTTT.T ....T.B.BTT...T ..T....BBTTTTTT .T.T.T....TT... Of 225 cells, 113 are trees of which 4 are currently burning. (50.222%, 1.778%) Print/Quit/<int>/<return> 3: p .TTT.TTT.TTTT.T T.T.T.TT..T.T.. TT.TTTT...T.TT. TTT..TTTTT.T..T .T.TTT...TTT.TT ...T..TTT.TTTTT .TT.TT...TT..TT .TT.T.T..T.T.T. ..TTT.TT.T..T.. .T.T..T.....TTT T..TTT..B..T... TTT......BTTT.T ....T....BT...T ..T......BTTTTT .T.T.T....TT... Of 225 cells, 110 are trees of which 4 are currently burning. (48.889%, 1.778%) Print/Quit/<int>/<return> 4:
Sather
<lang sather>class FORESTFIRE is
private attr fields:ARRAY{ARRAY{INT}}; private attr swapu:INT; private attr rnd:RND; private attr verbose:BOOL; private attr generation:INT; readonly attr width, height:INT; const empty:INT := 0; const tree:INT := 1; const burning:INT := 2;
attr prob_tree, prob_p, prob_f :FLT;
create(w, h:INT, v:BOOL):SAME is res:FORESTFIRE := new; res.fields := #(2); res.fields[0] := #(w*h); res.fields[1] := #(w*h); res.width := w; res.height := h; res.swapu := 0; res.prob_tree := 0.55; res.prob_p := 0.001; res.prob_f := 0.00001; res.rnd := #RND; res.verbose := v; res.generation := 0; res.initfield; return res; end;
-- to give variability seed(i:INT) is rnd.seed(i); end;
create(w, h:INT):SAME is res ::= create(w, h, false); return res; end;
initfield is n ::= 0; swapu := 0; if verbose and generation > 0 then #ERR + "Previous generation " + generation + "\n"; end; generation := 0; loop i ::= 0.upto!(width-1); loop j ::= 0.upto!(height-1); if rnd.uniform > prob_tree.fltd then cset(i, j, empty); else
n := n + 1;
cset(i, j, tree); end; end; end; if verbose then #ERR + #FMT("Field size is %dx%d (%d)", width, height, size) + "\n"; #ERR + "There are " + n + " trees (" + (100.0*n.flt/size.flt) + "%)\n"; #ERR + "prob_tree = " + prob_tree + "\n"; #ERR + "prob_f = " + prob_f + "\n"; #ERR + "prob_p = " + prob_p + "\n"; #ERR + "ratio = " + prob_p/prob_f + "\n"; end; end;
field:ARRAY{INT} is return fields[swapu]; end;
ofield:ARRAY{INT} is return fields[swapu.bxor(1)]; end; size:INT is return width*height; end;
set(i, j, t:INT) pre bcheck(i, j) is ofield[j*width + i] := t; end;
cset(i, j, t:INT) pre bcheck(i, j) is field[j*width + i] := t; end;
private bcheck(i, j:INT):BOOL is if i.is_between(0, width-1) and j.is_between(0, height-1) then return true; -- is inside else return false; -- is outside end; end;
get(i, j:INT):INT is if ~bcheck(i, j) then return empty; end; return field[j*width + i]; end;
oget(i, j:INT):INT is if ~bcheck(i, j) then return empty; end; return ofield[j*width + i]; end;
burning_neighbor(i, j:INT):BOOL is loop x ::= (-1).upto!(1); loop y ::= (-1).upto!(1); if x /= y then if get(i+x, j+y) = burning then return true; end; end; end; end; return false; end;
evolve is bp ::= 0; loop i ::= 0.upto!(width-1); loop j ::= 0.upto!(height-1);
case get(i, j)
when burning then set(i, j, empty); bp := bp + 1; when empty then if rnd.uniform > prob_p.fltd then set(i, j, empty); else set(i, j, tree); end; when tree then if burning_neighbor(i, j) then set(i, j, burning); else if rnd.uniform > prob_f.fltd then set(i, j, tree); else set(i, j, burning); end; end; else #ERR + "corrupted field\n"; end; end; end; generation := generation + 1; if verbose then if bp > 0 then #ERR + #FMT("Burning at gen %d: %d\n", generation-1, bp); end; end; swapu := swapu.bxor(1); end;
str:STR is s ::= ""; loop j ::= 0.upto!(height -1); loop i ::= 0.upto!(width -1); case get(i, j) when empty then s := s + "."; when tree then s := s + "Y"; when burning then s := s + "*"; end; end; s := s + "\n"; end; s := s + "\n"; return s; end;
end;
class MAIN is
main is forestfire ::= #FORESTFIRE(74, 40); -- #FORESTFIRE(74, 40, true) to have some extra info -- (redirecting stderr to a file is a good idea!)
#OUT + forestfire.str; -- evolve 1000 times loop i ::= 1000.times!; forestfire.evolve; -- ANSI clear screen sequence #OUT + 0x1b.char + "[H" + 0x1b.char + "[2J"; #OUT + forestfire.str; end; end;
end;</lang>
Tcl
<lang tcl>package require Tcl 8.5
- Build a grid
proc makeGrid {w h {treeProbability 0.5}} {
global grid gridW gridH set gridW $w set gridH $h set grid [lrepeat $h [lrepeat $w " "]] for {set x 0} {$x < $w} {incr x} {
for {set y 0} {$y < $h} {incr y} { if {rand() < $treeProbability} { lset grid $y $x "#" } }
}
}
- Evolve the grid (builds a copy, then overwrites)
proc evolveGrid {{fireProbability 0.01} {plantProbability 0.05}} {
global grid gridW gridH set newGrid {} for {set y 0} {$y < $gridH} {incr y} {
set row {} for {set x 0} {$x < $gridW} {incr x} { switch -exact -- [set s [lindex $grid $y $x]] { " " { if {rand() < $plantProbability} { set s "#" } } "#" { if {[burningNeighbour? $x $y] || rand() < $fireProbability} { set s "o" } } "o" { set s " " } } lappend row $s } lappend newGrid $row
} set grid $newGrid
}
- We supply the neighbourhood model as an optional parameter (not used...)
proc burningNeighbour? {
x y {neighbourhoodModel {-1 -1 -1 0 -1 1 0 -1 0 1 1 -1 1 0 1 1}}
} {
global grid gridW gridH foreach {dx dy} $neighbourhoodModel {
set i [expr {$x + $dx}] if {$i < 0 || $i >= $gridW} continue set j [expr {$y + $dy}] if {$j < 0 || $j >= $gridH} continue if {[lindex $grid $j $i] eq "o"} { return 1 }
} return 0
}
proc printGrid {} {
global grid foreach row $grid {
puts [join $row ""]
}
}
- Simple main loop; press Return for the next step or send an EOF to stop
makeGrid 70 8 while 1 {
evolveGrid printGrid if {[gets stdin line] < 0} break
}</lang> Sample output:
### # ####### ## # ## ##### # # # ### ## # # # ## # ##### # ## # # ## o ### # # #### # # #### # # ####### ### ##### ### #### ####### ### ## ## #### # ## # ### ## #### # ## # # #### # ### # # ## ##### # # ## # ##### ### # ## # ## ###### # #### ## # # ### ### # ##### # ### ## # ### # ####### #### # # # # # # # # # # # #### ### # ## ## ### # ## # # # # # ## # ## ## ##### ## ## # # # # ## # ## ### # # # ### ## ## # ### # # ### # ### ##### # # ####### ## # #o o#### # # # ### ## # # # # #o # ##### # ## ## # ## ### # # #### # # #### # # ####### ### ##### ### #### #####oo ### ### ## #### # ## # ### ## #### # ## # # #### # ### # # ## ##### # # ## # ##### ### # ## # ## ###### # #o## ## # # ### ### # ###### # ### ## # ### # ####### #### # # # # # # # # # # # #### ### # ## ## ### # ## # # # # # ## # ## ## o#### ## ## # # # # ## # ## ### # # # ### ## # ## # ### # # ### # #oo o#### # # ######## ## # o o### ## # # #o# ## # # # # o # ##### # ## ## # ## o## # # #### # # ##o# # # ######o ### ##### #### #### ####o ### # ### ## #### ## ## ##### ## #### # ## # # o o### # ### o # ## ##### # # ## ## ##### ### # ## # ## ###### # o o# ## # # ### ##### ###### # ### ## # ### # ####### #### o o # # # o # o # # # # #### ##### ## ### ### # ## # # # # # ## # ## ## o### ## ## # # # # ## # ## ### # ### ### ## # ## # #o# # # ### # o o### # # ######## ## # o## ## # # o o oo## # # # # # # ##### # ## ## # ## o# # # #### o o #o o # # #####o ### ##### #### #### ###o o## ####o o# #### #o o# ##### #o o### # ### # # o## # ##o # ## ###### # # ## ## ##### ### # ## # ## oooo## # o oo # # ### ##### ###### ##### ## # ### # ####### #### # # o # # # # # #### ##### ## ### ### # ## # # # # o### # oo ## o## ## ## # # # # ## # o# ### # ### ###### # ## # o o # # #### # o## # # ######## ## # o# ## # # # o# # # # o # o ##### # ## ## # #o o # o ooo# o # # # ####o ### ##### o### #### ##o # o# ##oo o oooo#o o# ###### o o## # # ### # # oo # #o o ## ooooo# # # oo o# # ##### ### # ## # ## o# #o # # # ### ##### ###### ##### ## # ### # oooooo# #### o # # o o # # # #### ##### ## ### o## # ## # # # # o## o# #o# o# ## ## # # # # ## ## o ### # ### # #####o # ## # #