

 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)



Task

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.



Related tasks

   See   Conway's Game of Life 
   See   Wireworld.


--
-- demo\rosetta\Forest_fire.exw
-- ============================
--
--  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
--
--  Draws bigger "pixels" when it feels the need to.
--
with javascript_semantics
include pGUI.e
Ihandle dlg, canvas, hTimer
cdCanvas cddbuffer, cdcanvas

constant TITLE = "Forest Fire",
         P = 0.03,      -- probability of new tree growing
         F = 0.00003    -- probability of new fire starting

enum EMPTY,TREE,FIRE    -- (1,2,3)
constant colours = {CD_BLACK,CD_GREEN,CD_YELLOW}

sequence f = {}     -- the forest

function randomf()
    return rand(1000000)/1000000    -- returns 0.000001..1.000000
end function

function redraw_cb(Ihandle /*ih*/)
    integer {width, height} = IupGetIntInt(canvas, "DRAWSIZE"),
            -- limit to 40K cells, otherwise it gets too slow.
            -- n here is the cell size in pixels (min of 1x1)
            -- Note you still get some setTimeout violations 
            -- in js even with the limit reduced to just 5K..
            n = ceil(sqrt(width*height/40000)),
            w = floor(width/n)+2, -- (see cx below)
            h = floor(height/n)+2

    cdCanvasActivate(cddbuffer)
    if length(f)!=w
    or length(f[1])!=h then
        f = sq_rand(repeat(repeat(2,h),w))  -- (EMPTY or TREE)
    end if
    sequence fn = deep_copy(f)
    --
    -- There is a "dead border" of 1 cell all around the edge of f (& fn) which
    -- we never display or update. If we have got this right/an exact fit, then 
    -- w*n should be exactly 2n too wide, whereas in the worst case there is an
    -- (2n-1) pixel border, which we split between left and right, ditto cy.
    --
    integer cx = n+floor((width-w*n)/2)
    for x=2 to w-1 do
        integer cy = n+floor((height-h*n)/2)
        for y=2 to h-1 do
            integer fnxy
            switch f[x,y] do
                case EMPTY:
                    fnxy = EMPTY+(randomf()<P)  -- (EMPTY or TREE)
                case TREE:
                    fnxy = TREE
                    if f[x-1,y-1]=FIRE or f[x,y-1]=FIRE or f[x+1,y-1]=FIRE 
                    or f[x-1,y  ]=FIRE or (randomf()<F) or f[x+1,y  ]=FIRE
                    or f[x-1,y+1]=FIRE or f[x,y+1]=FIRE or f[x+1,y+1]=FIRE then
                        fnxy = FIRE
                    end if
                case FIRE:
                    fnxy = EMPTY
            end switch
            fn[x,y] = fnxy
            cdCanvasSetForeground(cddbuffer,colours[fnxy])
            cdCanvasBox(cddbuffer, cx, cx+n-1, cy, cy+n-1)
            cy += n
        end for
        cx += n
    end for
    f = fn
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    return IUP_DEFAULT
end function

function timer_cb(Ihandle /*ih*/)
    IupUpdate(canvas)
    return IUP_IGNORE
end function

procedure main()
    IupOpen()
    canvas = IupCanvas("RASTERSIZE=225x100")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})
    dlg = IupDialog(canvas, `TITLE="%s", MINSIZE=245x140`, {TITLE})
        -- (above MINSIZE prevents the title from getting squished)
    IupShow(dlg)
    hTimer = IupTimer(Icallback("timer_cb"), 100)   -- (10 fps)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()
