Forest fire: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|PureBasic}}: add SmartWindowRefresh())
Line 734: Line 734:


If OpenWindow(0,10,30,#Width,#Height, Title$)
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)
If CreateImage(1, #Width, #Height)
Define Event, freq
Define Event, freq

Revision as of 09:48, 18 July 2010

Task
Forest fire
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)

  1. A burning cell turns into an empty cell
  2. A tree will burn if at least one neighbor is burning
  3. A tree ignites with probability f even if no neighbor is burning
  4. 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

Works with: POSIX
Library: SDL

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <stdint.h>
  3. include <stdbool.h>
  4. include <string.h>
  5. include <pthread.h>
  1. include <SDL.h>

// defaults

  1. define PROB_TREE 0.55
  2. define PROB_F 0.00001
  3. define PROB_P 0.001
  1. define TIMERFREQ 100
  1. ifndef WIDTH
  2. define WIDTH 640
  3. endif
  4. ifndef HEIGHT
  5. define HEIGHT 480
  6. endif
  7. ifndef BPP
  8. define BPP 32
  9. endif
  1. if BPP != 32
 #warning This program could not work with BPP different from 32
  1. 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

  1. 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

Works with: Fortran version 95 and later

<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
  1. f = 3e-6
  2. p = 1e-2
  3. SeedATree = 0.005
  4. Width = 400
  5. Height = 400
Setting up colours
  1. Fire = $080CF7
  2. BackGround = $BFD5D3
  3. YoungTree = $00E300
  4. NormalTree = $00AC00
  5. MatureTree = $009500
  6. OldTree = $007600
  7. Black = $000000
If your CPU load is too high, set this to '1'
  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

EndIf</lang>

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

  1. 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

  1. 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 "#" } } 

   }

}

  1. 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

}

  1. 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 ""] 

   }

}

  1. 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  # ## #     #
Retrieved from "https://rosettacode.org/wiki/Forest_fire?oldid=151357"