

 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.


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;