Forest fire: Difference between revisions

From Rosetta Code
Content added Content deleted
(less APPLE II specific, more generic and Commodore 64)
Line 18: Line 18:
=={{header|6502 Assembly}}==
=={{header|6502 Assembly}}==
<lang asm> ORG $4357
<lang asm> ORG $4357
; SYS 17239 or CALL 17239
;
SEED0 = 6
SEED1 = 7
SEED2 = 8

PLOT = $F800
CLRSCR = $F832
GBASCALC = $F847
GBASL = $26
GBASH = $27
H2 = $2C
V2 = $2D
COLOR = $30


EMPTY2 = $00
EMPTY2 = $00
Line 36: Line 24:
FIRE2 = $99
FIRE2 = $99


; common available zero page
tablelo = $033C

tablehi = tablelo+24

GBASL = $26
GBASH = $27

SEED2 = $28
SEED0 = $29
SEED1 = $2A

H2 = $2B
V2 = $2C
PLOTC = $2D
COLOR = $2E
PAGE = $2F
TOPL = $30
TOPH = $31
MIDL = $32
MIDH = $33
BTML = $34
BTMH = $35
PLOTL = $36
PLOTH = $37
lastzp = $38


tablelo = $5000
tablehi = tablelo+25


JSR START
LDX #23 ; y coord
STA V2
LDA #$4C ; JMP instruction
STA SEED2 ; temporary JMP
LDX #$00 ; y coord
table:
table:
TXA
TXA
JSR GBASCALC
JSR SEED2 ; temporary JMP GBASCALC
LDA GBASL
LDA GBASL
STA tablelo,X
STA tablelo,X
LDA GBASH
LDA GBASH
STA tablehi,X
STA tablehi,X
LDY #$00
DEX
TYA
BPL table
clrline:
STA (GBASL),Y
INY
CPY #40
BNE clrline

INX
CPX V2
BNE table

JSR sseed0
JSR sseed2


LDX #$60
LDX #$60
STX $F9
STX PAGE
STX $01
STX TOPH
LDY #$00
LDY #$00
STY $00
STY TOPL
TYA
TYA
zero: STA ($00),Y
zero: STA (TOPL),Y
INY
INY
BNE zero
BNE zero
INX
INX
STX $01
STX TOPH
CPX #$80
CPX #$80
BNE zero
BNE zero


BIT $C056 ; low resolution
BIT $C052 ; full screen
BIT $C054 ; page one
BIT $C050 ; graphics
JSR CLRSCR ; clear entire lores screen
loop3:
loop3:
LDX #0
LDX #0
STX $0
STX TOPL
LDA #41
LDA #41
STA $2
STA MIDL
STA $FE
STA PLOTL
LDA #83
LDA #83
STA $4
STA BTML
LDA $F9
LDA PAGE
STA $01
STA TOPH
STA $03
STA MIDH
STA $05
STA BTMH
EOR #$10
EOR #$10
STA $FF
STA PLOTH
STA $F9
STA PAGE
loop2:
loop2:
TXA
TXA
Line 94: Line 117:
BCC over2
BCC over2
ADC #$E0
ADC #$E0
over2: STA $2E ; PLOT...
over2: STA PLOTC ; PLOT...
LDA tablelo,Y ; lookup instead of GBASCALC
LDA tablelo,Y ; lookup instead of GBASCALC
STA $26
STA GBASL
LDA tablehi,Y
LDA tablehi,Y
STA $27
STA GBASH
; PLP ; continue PLOT
; PLP ; continue PLOT
LDY #$01 ; x coord
LDY #$01 ; x coord
loop1:
loop1:
STY H2
STY H2
LDA ($02),Y
LDA (MIDL),Y
STA ($FE),Y
STA (PLOTL),Y
BEQ empty
BEQ empty
BPL tree
BPL tree
LDA #EMPTY2
LDA #EMPTY2
doplot: LDY H2
doplot: LDY H2
STA ($FE),Y
STA (PLOTL),Y
DEY
DEY
EOR ($26),Y
EOR (GBASL),Y
AND $2E
AND PLOTC
EOR ($26),Y
EOR (GBASL),Y
STA ($26),Y
STA (GBASL),Y
noplot:
noplot:
LDY H2
LDY H2
Line 120: Line 143:
CPY #41
CPY #41
BNE loop1
BNE loop1
LDA $2
LDA MIDL
STA $0
STA TOPL
LDA $3
LDA MIDH
STA $1
STA TOPH
LDA $4
LDA BTML
STA $2
STA MIDL
STA $FE
STA PLOTL
CLC
CLC
ADC #42
ADC #42
STA $4
STA BTML
LDA $5
LDA BTMH
EOR #$10
EOR #$10
STA $FF
STA PLOTH
EOR #$10
EOR #$10
STA $3
STA MIDH
ADC #$00
ADC #$00
STA $5
STA BTMH
LDX V2
LDX V2
INX
INX
CPX #48
CPX #48
BNE loop2
BNE loop2
JSR QUIT
BIT $C000
; BPL loop3
BMI quit
JMP loop3
JMP loop3
quit: BIT $C010
BIT $C051
RTS
empty:
empty:
DEC SEED2
DEC SEED2
BNE noplot
BNE noplot
JSR sseed2 ; probability f
LDA #$65 ; 1 in 101 (prime)
STA SEED2
LDA #TREE2
LDA #TREE2
BNE doplot
BNE doplot
Line 159: Line 176:
BNE doplot
BNE doplot
tree:
tree:
DEC SEED0 ; 1 in 10007 (prime)
DEC SEED0
BNE check
BNE check
DEC SEED1
DEC SEED1
BNE check
BNE check
JSR sseed0 ; probability p
LDA #$17
STA SEED0
LDA #$27
STA SEED1
BNE ignite
BNE ignite
check:
check:
LDA ($00),Y ; n
LDA (TOPL),Y ; n
ORA ($04),Y ; s
ORA (BTML),Y ; s
DEY
DEY
ORA ($00),Y ; nw
ORA (TOPL),Y ; nw
ORA ($02),Y ; w
ORA (MIDL),Y ; w
ORA ($04),Y ; sw
ORA (BTML),Y ; sw
INY
INY
INY
INY
ORA ($00),Y ; ne
ORA (TOPL),Y ; ne
ORA ($02),Y ; e
ORA (MIDL),Y ; e
ORA ($04),Y ; se
ORA (BTML),Y ; se
BMI ignite
BMI ignite
BPL noplot
BPL noplot

; tablelo:
sseed0:
; tablehi = tablelo+24
LDA #$17 ; 1 in 10007 (prime)
STA SEED0
LDA #$27
STA SEED1
RTS
sseed2:
LDA #$65 ; 1 in 101 (prime)
STA SEED2
RTS

default:
LDA #<GBASCALC ; setup GBASCALC
STA SEED0
LDA #>GBASCALC
STA SEED1
LDA #25 ; screen rows
RTS
GBASCALC:
LDY #$00
STY GBASH
ASL
ASL
ASL
STA GBASL
ASL
ROL GBASH
ASL
ROL GBASH
ADC GBASL
STA GBASL
LDA GBASH
ADC #$04
STA GBASH
RTS

QUIT:
LDA $E000

; APPLE II

CMP #$4C
BNE c64quit

BIT $C000 ; apple ii keypress?
BPL CONTINUE ; no keypressed then continue
BIT $C010 ; clear keyboard strobe
BIT $C051 ; text mode

; end APPLE II specific

ABORT:
PLA
PLA

LDX #GBASL
restorzp:
LDA $5100,X
STA $00,X
INX
CPX #lastzp
BNE restorzp

CONTINUE:
RTS

START:
LDX #GBASL
savezp:
LDA $00,X
STA $5100,X
INX
CPX #lastzp
BNE savezp

; machine ???

LDA $E000 ; terribly unreliable, oh well

; APPLE II

CMP #$4C ; apple ii?
BNE c64start ; nope, try another

BIT $C056 ; low resolution
BIT $C052 ; full screen
BIT $C054 ; page one
BIT $C050 ; graphics
; GBASCALC = $F847
LDA #$47
STA SEED0
LDA #$F8
STA SEED1
LDA #24 ; screen rows
RTS

; end APPLE II specific

; COMMODORE 64 specific

c64quit:

; COMMODORE 64

CMP #$85 ; commodore 64?
BNE CONTINUE ; nope, default to no keypress

LDA $C6 ; commodore keyboard buffer length
BEQ CONTINUE ; no keypressed then continue

LDA #$00
STA $C6
LDA $D016 ; Screen control register #2
AND #$EF ; Bit #4: 0 = Multicolor mode off.
STA $D016
LDA #21 ; default character set
STA $D018
BNE ABORT

c64start:

CMP #$85 ; commodore 64?
BEQ c64yes ; yes
JMP default ; no, default to boringness
c64yes:
LDA #$00 ; black
STA $D020 ; border
LDA #$00 ; black
STA $D021 ; background
LDA #$05 ; dark green
STA $D022 ; Extra background color #1
LDA #$08 ; orange
STA $D023 ; Extra background color #2
LDA $D016 ; Screen control register #2
ORA #$10 ; Bit #4: 1 = Multicolor mode on.
STA $D016

LDA #$30 ; 0011 0000 $3000 charset page
STA PLOTH
LSR
LSR
STA PLOTC ; 0000 1100 #$0C
; 53272 $D018
; POKE 53272,(PEEK(53272)AND240)+12: REM SET CHAR POINTER TO MEM. 12288
; Bits #1-#3: In text mode, pointer to character memory
; (bits #11-#13), relative to VIC bank, memory address $DD00
; %110, 6: $3000-$37FF, 12288-14335.
LDA $D018
AND #$F0
ORA PLOTC
STA $D018
; setup nine characters

; 00- 00 00
LDA #$00 ; chr(0) * 8
STA PLOTL
; --- LDA #$00 ; already zero
TAX ; LDX #$00
JSR charset

; 04- 00 55
LDA #32 ; chr(4) * 8
STA PLOTL
LDA #$55
; LDX #$00 ; already zero
JSR charset

; 09- 00 AA
LDA #72 ; chr(9) * 8
STA PLOTL
LDA #$AA
; LDX #$00 ; already zero
JSR charset

; 40- 55 00
LDA PLOTH ; 512 = chr(64) * 8
CLC
ADC #$02
STA PLOTH
LDX #$00
STX PLOTL
LDA #$00
LDX #$55
JSR charset

; 44- 55 55
LDA #32 ; chr(68) * 8
STA PLOTL
TXA ; LDA #$55
; LDX #$55 ; already 55
JSR charset

; 49- 55 AA
LDA #72 ; chr(73) * 8
STA PLOTL
LDA #$AA
; LDX #$55 ; already 55
JSR charset

; 90- AA 00
LDA PLOTH ; chr(144) * 8
CLC
ADC #$02
STA PLOTH
LDA #128
STA PLOTL
LDA #$00
LDX #$AA
JSR charset

; 94- AA 55
LDA #160 ; chr(148) * 8
STA PLOTL
LDA #$55
; LDX #$AA ; already AA
JSR charset

; 99- AA AA
LDA #200 ; chr(153) * 8
STA PLOTL
TXA ; LDA #$AA
; LDX #$AA ; already AA
JSR charset
JMP default
charset:
LDY #$00
chartop:
STA (PLOTL),Y
INY
CPY #$04
BNE chartop
TXA
charbtm:
STA (PLOTL),Y
INY
CPY #$08
BNE charbtm
RTS

; end COMMODORE 64 specific

</lang>
</lang>



Revision as of 02:41, 25 October 2012

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.

6502 Assembly

<lang asm> ORG $4357

SYS 17239 or CALL 17239

EMPTY2 = $00 TREE2 = $44 FIRE2 = $99

common available zero page


GBASL = $26 GBASH = $27

SEED2 = $28 SEED0 = $29 SEED1 = $2A

H2 = $2B V2 = $2C PLOTC = $2D COLOR = $2E PAGE = $2F TOPL = $30 TOPH = $31 MIDL = $32 MIDH = $33 BTML = $34 BTMH = $35 PLOTL = $36 PLOTH = $37 lastzp = $38

tablelo = $5000 tablehi = tablelo+25

JSR START STA V2 LDA #$4C ; JMP instruction STA SEED2 ; temporary JMP LDX #$00 ; y coord table: TXA JSR SEED2 ; temporary JMP GBASCALC LDA GBASL STA tablelo,X LDA GBASH STA tablehi,X LDY #$00 TYA clrline: STA (GBASL),Y INY CPY #40 BNE clrline

INX CPX V2 BNE table

JSR sseed0 JSR sseed2

LDX #$60 STX PAGE STX TOPH LDY #$00 STY TOPL TYA zero: STA (TOPL),Y INY BNE zero INX STX TOPH CPX #$80 BNE zero

loop3: LDX #0 STX TOPL LDA #41 STA MIDL STA PLOTL LDA #83 STA BTML LDA PAGE STA TOPH STA MIDH STA BTMH EOR #$10 STA PLOTH STA PAGE loop2: TXA STX V2 LSR  ; F800 PLOT-like... ; PHP  ; F801 TAY  ; save A in Y without touching C LDA #$0F BCC over2 ADC #$E0 over2: STA PLOTC  ; PLOT... LDA tablelo,Y ; lookup instead of GBASCALC STA GBASL LDA tablehi,Y STA GBASH ; PLP  ; continue PLOT LDY #$01 ; x coord loop1: STY H2 LDA (MIDL),Y STA (PLOTL),Y BEQ empty BPL tree LDA #EMPTY2 doplot: LDY H2 STA (PLOTL),Y DEY EOR (GBASL),Y AND PLOTC EOR (GBASL),Y STA (GBASL),Y noplot: LDY H2 INY CPY #41 BNE loop1 LDA MIDL STA TOPL LDA MIDH STA TOPH LDA BTML STA MIDL STA PLOTL CLC ADC #42 STA BTML LDA BTMH EOR #$10 STA PLOTH EOR #$10 STA MIDH ADC #$00 STA BTMH LDX V2 INX CPX #48 BNE loop2 JSR QUIT JMP loop3 empty: DEC SEED2 BNE noplot JSR sseed2 ; probability f LDA #TREE2 BNE doplot ignite: LDA #FIRE2 BNE doplot tree: DEC SEED0 BNE check DEC SEED1 BNE check JSR sseed0 ; probability p BNE ignite check: LDA (TOPL),Y ; n ORA (BTML),Y ; s DEY ORA (TOPL),Y ; nw ORA (MIDL),Y ; w ORA (BTML),Y ; sw INY INY ORA (TOPL),Y ; ne ORA (MIDL),Y ; e ORA (BTML),Y ; se BMI ignite BPL noplot

sseed0: LDA #$17 ; 1 in 10007 (prime) STA SEED0 LDA #$27 STA SEED1 RTS sseed2: LDA #$65  ; 1 in 101 (prime) STA SEED2 RTS

default: LDA #<GBASCALC ; setup GBASCALC STA SEED0 LDA #>GBASCALC STA SEED1 LDA #25 ; screen rows RTS GBASCALC: LDY #$00 STY GBASH ASL ASL ASL STA GBASL ASL ROL GBASH ASL ROL GBASH ADC GBASL STA GBASL LDA GBASH ADC #$04 STA GBASH RTS

QUIT: LDA $E000

APPLE II

CMP #$4C BNE c64quit

BIT $C000 ; apple ii keypress? BPL CONTINUE ; no keypressed then continue BIT $C010 ; clear keyboard strobe BIT $C051 ; text mode

end APPLE II specific

ABORT: PLA PLA

LDX #GBASL restorzp: LDA $5100,X STA $00,X INX CPX #lastzp BNE restorzp

CONTINUE: RTS

START: LDX #GBASL savezp: LDA $00,X STA $5100,X INX CPX #lastzp BNE savezp

machine ???

LDA $E000 ; terribly unreliable, oh well

APPLE II

CMP #$4C ; apple ii? BNE c64start ; nope, try another

BIT $C056 ; low resolution BIT $C052 ; full screen BIT $C054 ; page one BIT $C050 ; graphics

GBASCALC = $F847

LDA #$47 STA SEED0 LDA #$F8 STA SEED1 LDA #24 ; screen rows RTS

end APPLE II specific
COMMODORE 64 specific

c64quit:

COMMODORE 64

CMP #$85 ; commodore 64? BNE CONTINUE ; nope, default to no keypress

LDA $C6 ; commodore keyboard buffer length BEQ CONTINUE ; no keypressed then continue

LDA #$00 STA $C6 LDA $D016 ; Screen control register #2 AND #$EF  ; Bit #4: 0 = Multicolor mode off. STA $D016 LDA #21 ; default character set STA $D018 BNE ABORT

c64start:

CMP #$85 ; commodore 64? BEQ c64yes ; yes JMP default ; no, default to boringness c64yes: LDA #$00  ; black STA $D020 ; border LDA #$00  ; black STA $D021 ; background LDA #$05  ; dark green STA $D022 ; Extra background color #1 LDA #$08  ; orange STA $D023 ; Extra background color #2 LDA $D016 ; Screen control register #2 ORA #$10  ; Bit #4: 1 = Multicolor mode on. STA $D016

LDA #$30  ; 0011 0000 $3000 charset page STA PLOTH LSR LSR STA PLOTC ; 0000 1100 #$0C

53272 $D018
POKE 53272,(PEEK(53272)AND240)+12
REM SET CHAR POINTER TO MEM. 12288
Bits #1-#3
In text mode, pointer to character memory
(bits #11-#13), relative to VIC bank, memory address $DD00
%110, 6
$3000-$37FF, 12288-14335.

LDA $D018 AND #$F0 ORA PLOTC STA $D018

setup nine characters
00- 00 00

LDA #$00 ; chr(0) * 8 STA PLOTL ; --- LDA #$00 ; already zero TAX ; LDX #$00 JSR charset

04- 00 55

LDA #32 ; chr(4) * 8 STA PLOTL LDA #$55 ; LDX #$00 ; already zero JSR charset

09- 00 AA

LDA #72 ; chr(9) * 8 STA PLOTL LDA #$AA ; LDX #$00 ; already zero JSR charset

40- 55 00

LDA PLOTH ; 512 = chr(64) * 8 CLC ADC #$02 STA PLOTH LDX #$00 STX PLOTL LDA #$00 LDX #$55 JSR charset

44- 55 55

LDA #32 ; chr(68) * 8 STA PLOTL TXA ; LDA #$55 ; LDX #$55 ; already 55 JSR charset

49- 55 AA

LDA #72 ; chr(73) * 8 STA PLOTL LDA #$AA ; LDX #$55 ; already 55 JSR charset

90- AA 00

LDA PLOTH ; chr(144) * 8 CLC ADC #$02 STA PLOTH LDA #128 STA PLOTL LDA #$00 LDX #$AA JSR charset

94- AA 55

LDA #160 ; chr(148) * 8 STA PLOTL LDA #$55 ; LDX #$AA ; already AA JSR charset

99- AA AA

LDA #200 ; chr(153) * 8 STA PLOTL TXA ; LDA #$AA ; LDX #$AA ; already AA JSR charset JMP default charset: LDY #$00 chartop: STA (PLOTL),Y INY CPY #$04 BNE chartop TXA charbtm: STA (PLOTL),Y INY CPY #$08 BNE charbtm RTS

end COMMODORE 64 specific

</lang>

Ada

<lang Ada>with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; with Ada.Text_IO; use Ada.Text_IO;

procedure Forest_Fire is

  type Cell is (Empty, Tree, Fire);
  type Board is array (Positive range <>, Positive range <>) of Cell;
  procedure Step (S : in out Board; P, F : Float; Dice : Generator) is
     function "+" (Left : Boolean; Right : Cell) return Boolean is
     begin
        return Left or else Right = Fire;
     end "+";
     function "+" (Left, Right : Cell) return Boolean is
     begin
        return Left = Fire or else Right = Fire;
     end "+";
     Above : array (S'Range (2)) of Cell := (others => Empty);
     Left_Up, Up, Left : Cell;
  begin
     for Row in S'First (1) + 1..S'Last (1) - 1 loop
        Left_Up := Empty;
        Up      := Empty;
        Left    := Empty;
        for Column in S'First (2) + 1..S'Last (2) - 1 loop
           Left_Up := Up;
           Up      := Above (Column);
           Above (Column) := S (Row, Column);
           case S (Row, Column) is
              when Empty =>
                 if Random (Dice) < P then
                    S (Row, Column) := Tree;
                 end if;
              when Tree =>
                 if Left_Up                 + Up                  +      Above (Column + 1) +
                    Left                    + S (Row,     Column) + S (Row,     Column + 1) +
                    S (Row + 1, Column - 1) + S (Row + 1, Column) + S (Row + 1, Column + 1)
                 or else Random (Dice) < F then
                    S (Row, Column) := Fire;
                 end if;
              when Fire =>
                 S (Row, Column) := Empty;
           end case;
           Left := Above (Column);
        end loop;
     end loop;
  end Step;
  procedure Put (S : Board) is
  begin
     for Row in S'First (1) + 1..S'Last (1) - 1 loop
        for Column in S'First (2) + 1..S'Last (2) - 1 loop
           case S (Row, Column) is
              when Empty => Put (' ');
              when Tree  => Put ('Y');
              when Fire  => Put ('#');
           end case;
        end loop;
        New_Line;
     end loop;      
  end Put;
  
  Dice   : Generator;
  Forest : Board := (1..10 => (1..40 => Empty));

begin

  Reset (Dice);
  for I in 1..10 loop
     Step (Forest, 0.3, 0.1, Dice);
     Put_Line ("-------------" & Integer'Image (I) & " -------------");
     Put (Forest);
  end loop;

end Forest_Fire;</lang> Sample output:

------------- 1 -------------
Y  Y Y        Y YY   Y Y Y  Y        Y
Y Y  YYY   YY  Y      Y  Y  Y     Y
Y     YY Y  Y Y Y  Y   Y   Y   Y YY
          Y          Y Y     Y  YY
Y         YY YYY  Y Y        Y   Y   Y
Y Y         YY  Y    Y        Y    Y
       Y  Y    Y Y          Y Y Y Y
  Y   Y  Y     YYY  Y  Y  Y   Y  Y
------------- 2 -------------
Y  Y Y   YYYYY# YYY  Y Y Y  YYY  Y Y Y
YY#  YYY   YY  Y Y Y  Y  #Y Y    YY  Y
YYY   YY Y  YY# Y  YY  Y Y Y   Y YY
  Y Y     YY   Y  Y YYYY   Y Y YYY  YY
Y    Y   Y#Y YYY YYYY       YYY  Y Y Y
Y Y Y    Y YYY Y#    Y Y Y    Y    Y
       Y  Y   Y# Y   Y  Y Y Y YYY Y
  YY YY  Y  Y  YYY  YYYYY Y   Y YY  Y
------------- 3 -------------
YY # Y   YYYY#  YY#  Y Y #  YYY Y# Y Y
Y# Y YYYYY Y#  # YYY YYY  #YY Y  YY  Y
Y##  Y#Y Y  Y#  YY YY YY # Y   Y YYY
  # Y    Y##   #  YYYYYY YYY YYYYYY YY
Y Y YY   # # YY# #YYYYYY  YYYYY  YY# Y
YYY YYY Y# #YYY#     YYY Y    YY   Y
    Y  YY Y   # Y# Y YY YYY Y YYYYY
  YY #Y YYY Y  ###  YYYY# YY YYYYY YY
------------- 4 -------------
##   Y   YY## Y ## Y YYY  Y YYY #  Y Y
# Y# ###YYY#  Y  ### YYYY  #Y Y Y##  Y
#    # # #  #   #YYYY Y#  Y# YYYYYYYY
Y   YY YY#   YY Y ##YYYY ##Y YYYYY#Y#Y
YY#YYY  Y Y  Y# Y #YYYYYY YYYYY  Y#  Y
YY#YYY#Y#   ### Y YY #YY Y    YY   # Y
    #Y ## #    Y#  YYY# ##Y Y YYYYY  Y
 YYY  #YYY# YYY     YYY#  YYYYY#YY YY
------------- 5 -------------
  Y  #   Y#   Y    #YYYYY #Y#YYY  Y# Y
 Y# Y   ###   Y      Y###Y  # Y #    Y
 Y    Y Y Y      #### #   #  #YY#####
#   ## ##   Y##Y#   #Y##Y  # YYYY# # #
Y# #Y#YY#Y#Y # YY  ####Y# ##YYYY #   #
Y# ### #   Y    # ##Y ##Y#    YY  Y  Y
   Y #         #   Y##    # Y ###Y#  Y
 Y##   ###  YYY  Y  Y##   #YYY# #Y YYY
------------- 6 -------------
 Y#   YY #    Y  Y  #####Y # #Y#Y #  Y
 # Y#Y      Y YY  YYY#   #Y   #Y  Y  #
 #    # # #   Y               ##
           Y#  #   Y #  # Y  ####
# Y # ## # #Y  ## Y    # Y  #YYY   Y
#         Y#YYYY    #   #   Y ##YY#  #
 Y #    Y  Y Y    Y#        Y    # Y Y
 #  Y     Y YY# YY Y#      #Y# Y #Y#YY
------------- 7 -------------
Y# Y  YY      Y  Y       #  Y # #Y  Y#
   # # YY   # YY YY##  Y  #Y   #Y #Y
Y Y    Y Y    #Y  Y  YY     Y     Y
  Y   Y    # Y  Y YY     YYY         Y
  YY        #    YY   Y  #   ###Y  #
 Y        # ####YY       YY #   ##
Y#    Y Y  # #  Y #    YY  Y#Y     # #
  Y #     Y Y# YYYY#     Y  #  YY # #Y
------------- 8 -------------
#  #  #Y Y  Y YYYY Y   Y    Y    #  #
YYY    YY Y   ## Y#  Y Y Y #  Y #Y #Y
Y #Y  Y#YY     #Y #  #Y  Y  YY    #Y
  Y   Y      #  YYYYYY  Y##Y Y   Y   Y
YYYY   Y  Y  Y  YYY   Y Y Y Y   #   YY
 # YY  YY  Y    ##Y   YYY##Y YYY
#   Y Y Y       #Y   YY#Y  # # Y YY
  #Y Y YYY# # YY###      Y    YYY    #
------------- 9 -------------
     Y # YY YY####Y# YYYYYY #      Y
###    ## # Y    #   # Y Y    YY #  #
Y  #Y # #Y Y  Y #     # Y#  #Y Y   # Y
  #   # YYYY    ######YY#  # Y  Y#  YY
###Y  YY YYY #  ###   YY# # YY      YY
  YYY  YY  Y Y    # Y ###  # ### Y YY
    Y Y Y  Y   Y #Y  Y# #Y     Y Y#
   # Y YY#    Y#         # Y  #Y#  YY
------------- 10 -------------
  YYYY   ## Y#    #  ##YYYYY      Y#
   Y        Y       Y Y# #    YYY YY
#Y  #    # #  Y   Y  Y  # Y  # YYYY Y#
   Y   Y###Y          ##  Y Y# Y#   #Y
   #  ## YYY         Y##    ## YY   YY
  ##Y  YY YYY#      Y           Y# #Y
    # Y #  Y Y #  #  #   #     # #
 Y   YYY#     #           YY Y #   #Y

ALGOL 68

Textual version

Translation of: D

Note: This specimen retains the original D coding style.

Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

<lang algol68>LONG REAL tree prob = 0.55, # original tree probability #

         f prob =    0.01, # new combustion probability #
         p prob =    0.01; # tree creation probability #

MODE CELL = CHAR; CELL empty=" ", tree="T", burning="#"; MODE WORLD = [6, 65]CELL;

PROC has burning neighbours = (WORLD world, INT r, c)BOOL:(

 FOR row shift FROM -1 TO 1 DO
   FOR col shift FROM -1 TO 1 DO
     INT rs = r + row shift, cs = c + col shift;
     IF rs >= LWB world AND rs <= UPB world AND
         cs >= 2 LWB world AND cs <= 2 UPB world THEN
       IF world[rs, cs] = burning THEN true exit FI
     FI
   OD
 OD;
 FALSE EXIT
 true exit: TRUE

);

PROC next state = (REF WORLD world, REF WORLD next world)VOID:(

 FOR r FROM LWB world TO UPB world DO
   REF[]CELL row = world[r, ];
   FOR c FROM LWB row TO UPB row DO
     REF CELL elem = row[c];
     next world[r, c] :=
       IF elem = empty THEN
         IF random<p prob THEN tree ELSE empty FI
       ELIF elem = tree THEN
         IF has burning neighbours(world, r, c) THEN
           burning
         ELSE
           IF random<f prob THEN burning ELSE tree FI
         FI
       ELIF elem = burning THEN
         empty
       FI
   OD
 OD;
 world := next world

);

main:(

 WORLD world; # create world #
 FOR r FROM LWB world TO UPB world DO
   REF []CELL row = world[r, ];
   FOR i FROM LWB row TO UPB row DO
     REF CELL el = row[i];
     el := IF random < tree prob THEN tree ELSE empty FI
   OD
 OD;
 WORLD next world;
 FOR i FROM 0 TO 4 DO
   next state(world, next world);
   printf(($n(2 UPB world)(a)l$, world)); # show world #
   printf(($gl$, 2 UPB world * "-"))
 OD

)</lang> Output:

TTTT T TTTT TT  T T TTT TT TTT  TT TTT T TT T  T    TTT TT T   TT
 TTT TTTTT  T T    T TTTT T   T TTT  TT  T  T TT T   T T TTT  T T
T   T T T TT    T    #  T T   TTT T T  T  TTTTT T  TTT  TTTT TTTT
TT     T  TT TTTTTTTTT TT  TT  T T  TT  T TT TTT TTT TTTT TT  TTT
 TT    TTTTTT  T  T  T T T T TT TT      TT  #T TTT  TT #TTTTTTTT 
TT  TTT TTTTTTTTTT TT TTTTTT  TT T TT T TTT T TT T  TT #  T   T  
-----------------------------------------------------------------
TTTT T TTTT TT  T T TTT TT TTT  TT TTT T TT T  T    TTT TT T   TT
 TTT TTTTT  T T    T ##TT T   T TTT  TT  T  T TT T   T T TTT  T T
T   T T T TT    T       T T   TTT T T  T  TTTTT T  TTT  TTTT TTTT
TT     T  T# TTTTTTT## TT  TT  T T  TT  T T# #TT TTT T### TT  TTT
 TT    TTTTTT  T  T  T T T T TT TT      TTT  # TTT  TT  #TTTTTTT 
TT  TTT TTTTTTTTTT TT TTTTTT  TT T TT T TTT # TT T  TT    T   T  
-----------------------------------------------------------------
TTTT T TTTT TT  T T ### TT TTT  TT TTT T TT T  T    TTT TT T   TT
 TTT TTTTT  T T    T   #T T   T TTT  TT  T  T TT T   T T TT#  T T
T   T T T ##    T       T T   TTT T T  T  ##### T  TT#  ##TT TTTT
TT     T  #  TTTTTT#   TT  TT  T T  TT TT #   #T TTT #    TT  TTT
 TT    T#T###  T  T  # T T T TT TT      TT#    TTT  T#   #TTTTTT 
TT  TTT TTTTTTTTTT TT TTTTTT  TT T TT T TTT   #T T  TTT   T   T  
-----------------------------------------------------------------
TTTT T TTTT TT  T T     #T TTT  TT TTT T TT T  T    TTT TT #   TT
 TTT TTTT#  # T    #    # T   T TTT  TT  #  # ## T   # # ##   T T
T   T T T       T       # T   TTT T T  T        T  T#     ## TTTT
TT     #     #TTTT#    TT  TT  T T  TT TT      # TTT      #T  TTT
 TT    # #     T  #    T T T TT TT      T#     #TT  #     #TTTTT 
TT  TTT ######TTTT T# #TTTTT  TT T TT T T##    # T  ###   #   T  
-----------------------------------------------------------------
#TTT T T### ##  T #      # TTT  TT TTT T ## #  #    ### ##     TT
 TTT TTT#     T           T   T TTT  TT          T            T T
T   T # #       T         T   TTT T T  T       T#  #         TTTT
TT            #TT#     ##  TT  T T  TT T#        TT#       #  TTT
 TT            T       # T T TT TT      #       #T         #TTTT 
TT  TT#       #TT# #   #TTTT  TT T TT T #        T            T  
-----------------------------------------------------------------

AutoHotkey

This implementation uses AutoHotkey's pseudo-arrays to contain each cell. The size of the (square) map, probabilities, and characters which correspond to burning, tree, or empty can be edited at the beginning of the script. <lang AutoHotkey>

The array Frame1%x%_%y% holds the current frame. frame2%x%_%y%
is then calculated from this, and printed. frame2 is then copied to frame1.
Two arrays are necessary so that each cell advances at the same time
T=Tree, #=Fire, O=Empty cell
Size holds the width and height of the map and is used as the # of iterations in loops
This will save the map as forest_fire.txt in its working directory
======================================================================================


Size := 10 Generation := 0 Tree := "T" Fire := "#" Cell := "O"


--Define probabilities--
   New_Tree := 5
   ; 20 percent chance (1 in 5). A random number will be generated from 1 to New_tree. If this number is 1,
   ; A tree will be created in the current cell 
   Spontaneous := 10
   ; 10 percent chance (1 in 10). A random number will be generated from 1 to Spontaneous. If this number is 1,
   ; and the current cell contains a tree, the tree in the current cell will become fire. 


GoSub, Generate

----------------------Main Loop------------------------------

loop {

   Generation++
   GoSub, Calculate
   GoSub, Copy
   GoSub, Display
   msgbox, 4, Forest Fire, At Generation %generation%. Continue?
   IfMsgbox, No
       ExitApp

} return

-------------------------------------------------------------

Generate:  ; Randomly initializes the map. loop % size  ; % forces expression mode. { x := A_Index Loop % size { Y := A_Index Random, IsTree, 1, 2 ; -- Roughly half of the spaces will contain trees If ( IsTree = 1 ) Frame1%x%_%y% := Tree Else Frame1%x%_%y% := Cell } } return

Calculate: Loop % size { x := A_Index Loop % size { Y := A_Index If ( Frame1%x%_%y% = Cell ) { Random, tmp, 1, New_Tree If ( tmp = 1 ) Frame2%x%_%y% := tree Else Frame2%x%_%y% := Cell } Else If ( Frame1%x%_%y% = Tree ) { BoolCatch := PredictFire(x,y) If (BoolCatch) Frame2%x%_%y% := Fire Else Frame2%x%_%y% := Tree } Else If ( Frame1%x%_%y% = Fire ) Frame2%x%_%y% := Cell Else { contents := Frame1%x%_%y% Msgbox Error! Cell %x% , %y% contains %contents% ; This has never happened ExitApp } } } return

Copy: Loop % size { x := A_Index Loop % size { y := A_Index frame1%x%_%y% := Frame2%x%_%y% } } return


Display: ToPrint := "" ToPrint .= "=====Generation " . Generation . "=====`n" Loop % size { x := A_Index Loop % size { y := A_Index ToPrint .= Frame1%x%_%y% } ToPrint .= "`n" } FileAppend, %ToPrint%, Forest_Fire.txt Return


PredictFire(p_x,p_y){

   Global ; allows access to all frame1*_* variables (the pseudo-array)
   A := p_x-1
   B := p_y-1
   C := p_x+1    
   D := p_y+1
   If ( Frame1%A%_%p_Y% = fire )
       return 1
   If ( Frame1%p_X%_%B% = fire )
       return 1
   If ( Frame1%C%_%p_Y% = fire )
       return 1
   If ( Frame1%p_X%_%D% = fire )
       return 1
   If ( Frame1%A%_%B% = Fire )
       return 1
   If ( Frame1%A%_%D% = fire )
       return 1
   If ( Frame1%C%_%B% = fire )
       return 1
   If ( Frame1%C%_%D% = Fire )
       return 1
   Random, tmp, 1, spontaneous
   if ( tmp = 1 )
       return 1
   return 0

} </lang> Sample Output using the default settings:

=====Generation 1=====
OTTTOOTOOT
OTOOTTTTOT
TTOOOTTTO#
TOOTOTOOTT
OTTOTOOTTO
TOTTTTOOTO
TOTTT#OOOT
OT#OOTOOTT
TTO#TOOTTT
O#OOOTOTTT
=====Generation 2=====
OTTTOOTOOT
OTTOTTT#O#
TTOOOTTTOO
TOOTTTOT##
OTTOTTO##O
TOTT##OTTO
TO###OOOOT
T#OOO#OOTT
##TO#OOTTT
TOTOOTOTTT
=====Generation 3=====
OTT#OO#TO#
OTTOTT#OTO
TTOOOT##OO
TOOTTTT#OO
OTTO##OOOO
TO##OOO##O
#OOOOOOOOT
#OOOOOOOTT
OO#OOTOTTT
#O#TT#OTTT
=====Generation 4=====
OT#OOOO#OO
OT#O##OO#T
T#TOT#OOOO
TOO####OOT
O##OOOOOOO
#OOOOOOOOO
OOOOOOOOO#
OTOOOOOOTT
OOOOO#TTTT
OTO##OO#TT
=====Generation 5=====
O#OOOTOOOT
O#OOOOOOO#
#O#O#OOTOT
#OOOOOOOOT
OOOOOOOOOO
OTOOOOOOOO
TTOOOTOTTO
TTOOOTOO##
OOTTOO###T
OTOOOOOO#T

BASIC256

Forest fire animation: p=0.03, p/f=1000

<lang basic256>N = 150 : M = 150 : P = 0.03 : F = 0.00003

dim f(N+2,M+2) # 1 tree, 0 empty, 2 fire dim fn(N+2,M+2) graphsize N,M fastgraphics

for x = 1 to N for y = 1 to M if rand<0.5 then f[x,y] = 1 next y next x

while True for x = 1 to N for y = 1 to M if not f[x,y] and rand<P then fn[x,y]=1 if f[x,y]=2 then fn[x,y]=0 if f[x,y]=1 then fn[x,y] = 1 if f[x-1,y-1]=2 or f[x,y-1]=2 or f[x+1,y-1]=2 then fn[x,y]=2 if f[x-1,y]=2 or f[x+1,y]=2 or rand<F then fn[x,y]=2 if f[x-1,y+1]=2 or f[x,y+1]=2 or f[x+1,y+1]=2 then fn[x,y]=2 end if # Draw if fn[x,y]=0 then color black if fn[x,y]=1 then color green if fn[x,y]=2 then color yellow plot x-1,y-1 next y next x refresh for x = 1 to N for y = 1 to M f[x,y] = fn[x,y] next y next x end while</lang>

BBC BASIC

<lang bbcbasic> VDU 23,22,400;400;16,16,16,128

     OFF
     
     DIM old&(200,200), new&(200,200)
     p = 0.01
     f = 0.0001
     
     REM 0 = empty, 1 = tree, 2 = burning
     REPEAT
       WAIT 10
       FOR x% = 1 TO 199
         FOR y% = 1 TO 199
           CASE old&(x%,y%) OF
             WHEN 0:
               IF p > RND(1) THEN
                 new&(x%,y%) = 1
                 GCOL 2
                 PLOT 4*x%,4*y%
               ENDIF
             WHEN 1:
               IF f > RND(1) OR old&(x%-1,y%)=2 OR old&(x%+1,y%)=2 OR \
               \ old&(x%-1,y%-1)=2 OR old&(x%,y%-1)=2 OR old&(x%+1,y%-1)=2 OR \
               \ old&(x%-1,y%+1)=2 OR old&(x%,y%+1)=2 OR old&(x%+1,y%+1)=2 THEN
                 new&(x%,y%) = 2
                 GCOL 1
                 PLOT 4*x%,4*y%
               ENDIF
             WHEN 2:
               new&(x%,y%) = 0
               GCOL 15
               PLOT 4*x%,4*y%
           ENDCASE
         NEXT
       NEXT x%
       old&() = new&()
     UNTIL FALSE</lang>

Output:

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>>3)) = 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;

     }
   case SDL_QUIT:
     quit = true;
     break;
   }
 }
 if (running) {
   pthread_mutex_lock(&synclock);
   SDL_RemoveTimer(tid);
   pthread_mutex_unlock(&synclock);
 }
 free(field[0]); free(field[1]);
 exit(EXIT_SUCCESS);

}</lang>

Console version

C99. Uncomment srand() for variaty, usleep() for slower speed. <lang C>#include <stdio.h>

  1. include <stdlib.h>
  2. include <unistd.h>

enum { empty = 0, tree = 1, fire = 2 }; char *disp[] = {" ", "\033[32m/\\\033[m", "\033[07;31m/\\\033[m"}; double tree_prob = 0.01, burn_prob = 0.0001;

  1. define for_x for (int x = 0; x < w; x++)
  2. define for_y for (int y = 0; y < h; y++)
  3. define for_yx for_y for_x
  4. define chance(x) (rand() < RAND_MAX * x)

void evolve(int w, int h) { unsigned univ[h][w], new[h][w]; for_yx new[y][x] = univ[y][x] = chance(tree_prob) ? tree : empty;

show: printf("\033[H"); for_y { for_x printf(disp[univ[y][x]]); printf("\033[E"); } fflush(stdout);

for_yx { switch (univ[y][x]) { case fire: new[y][x] = empty; break; case empty: if (chance(tree_prob)) new[y][x] = tree; break; default: for (int y1 = y - 1; y1 <= y + 1; y1++) { if (y1 < 0 || y1 >= h) continue; for (int x1 = x - 1; x1 <= x + 1; x1++) { if (x1 < 0 || x1 >= w) continue; if (univ[y1][x1] != fire) continue;

new[y][x] = fire; goto burn; } }

burn: if (new[y][x] == tree && chance(burn_prob)) new[y][x] = fire; } }

for_yx { univ[y][x] = new[y][x]; } //usleep(100000); goto show; }

int main(int c, char **v) { //srand(time(0)); int w = 0, h = 0;

if (c > 1) w = atoi(v[1]); if (c > 2) h = atoi(v[2]); if (w <= 0) w = 30; if (h <= 0) h = 30;

evolve(w, h); }</lang>

C#

<lang c sharp>using System;

namespace ForestFire {

   internal class Program
   {
       private static void Main(string[] args)
       {
           Console.Write("Height? ");
           int height = int.Parse(Console.ReadLine());
           Console.Write("Width? ");
           int width = int.Parse(Console.ReadLine());
           Console.Write("Probability of a tree spontaneously combusting? 1/");
           int f = int.Parse(Console.ReadLine());
           Console.Write("Probability of a tree growing? 1/");
           int p = int.Parse(Console.ReadLine());
           Console.Clear();
           var state = InitializeForestFire(height, width);
           uint generation = 0;
           do
           {
               state = StepForestFire(state, f, p);
               Console.SetCursorPosition(0, 0);
               Console.ResetColor();
               Console.WriteLine("Generation " + ++generation);
               for (int y = 0; y < height; y++)
               {
                   for (int x = 0; x < width; x++)
                   {
                       switch (state[y, x])
                       {
                           case CellState.Empty:
                               Console.Write(' ');
                               break;
                           case CellState.Tree:
                               Console.ForegroundColor = ConsoleColor.DarkGreen;
                               Console.Write('T');
                               break;
                           case CellState.Burning:
                               Console.ForegroundColor = ConsoleColor.DarkRed;
                               Console.Write('F');
                               break;
                       }
                   }
                   Console.WriteLine();
               }
           } while (Console.ReadKey(true).Key != ConsoleKey.Q && generation < uint.MaxValue);
       }
       private static CellState[,] InitializeForestFire(int height, int width)
       {
           // Create our state array, initialize all indices as Empty, and return it.
           var state = new CellState[height, width];
           state.Initialize();
           return state;
       }
       private enum CellState : byte
       {
           Empty = 0,
           Tree = 1,
           Burning = 2
       }
       private static readonly Random Random = new Random();
       private static CellState[,] StepForestFire(CellState[,] state, int f, int p)
       {
           /* Clone our old state, so we can write to our new state
            * without changing any values in the old state. */
           var newState = (CellState[,]) state.Clone();
           int height = state.GetLength(0);
           int width = state.GetLength(1);
           for (int i = 1; i < height - 1; i++)
           {
               for (int o = 1; o < width - 1; o++)
               {
                   /* 
                    * Check the current cell.
                    * 
                    * If it's empty, give it a 1/p chance of becoming a tree.
                    * 
                    * If it's a tree, check to see if any neighbors are burning.
                    * If so, set the cell's state to burning, otherwise give it
                    * a 1/f chance of combusting.
                    * 
                    * If it's burning, set it to empty.
                    */
                   switch (state[i, o])
                   {
                       case CellState.Empty:
                           if (Random.Next(0, p) == 0)
                               newState[i, o] = CellState.Tree;
                           break;
                       case CellState.Tree:
                           if (IsNeighbor(state, i, o, CellState.Burning) ||
                               Random.Next(0, f) == 0)
                               newState[i, o] = CellState.Burning;
                           break;
                       case CellState.Burning:
                           newState[i, o] = CellState.Empty;
                           break;
                   }
               }
           }
           return newState;
       }
       private static bool IsNeighbor(CellState[,] state, int x, int y, CellState value)
       {
           // Check each cell within a 1 cell radius for the specified value.
           for (int i = -1; i <= 1; i++)
           {
               for (int o = -1; o <= 1; o++)
               {
                   if (i == 0 && o == 0)
                       continue;
                   if (state[x + i, y + o] == value)
                       return true;
               }
           }
           return false;
       }
   }

}</lang>

Sample Output

Generation 10

 T  T  T  T  TF     F T
  TFTFFTTTFTF F    TT
  F FTTTTTT  TF   F FFT
   FFTT TTFFT  T FF  F T
 FF  T  F  F TF  T  FFF
    TTTT   T TFTF  F   F
  T TT TFT F TTT     TT
 TTTTTTTT  F      FTFT F
 TTTTF     F TF FF  F FF
 TTTT F    F  F  F   T
 TTTT TTFFF  T    TFFTT
 TTTTTTT T   T  F  F TTT
 TTTTTTFFTF FTFFFFFFTT T
 FTT TT TFFFFFTFTTTTTT T
   TFFT FF FF   FTTTTT
  T F T   FFT   T T  T
 TF FTFFT FTF TF    T
   F F F  FTF T  T FT FF
 FTFTTFT   TTFTTTTT    F
 TT F    TT  TTTFFFF T F
 TTTF   T  TFTFTF  TFT F
 T TFFFFF T F FT   FF  F
 TTTTTTTT TT  FTFT  F  F

Clojure

<lang Clojure> (def burn-prob 0.1) (def new-tree-prob 0.5)

(defn grow-new-tree? [] (> new-tree-prob (rand))) (defn burn-tree? [] (> burn-prob (rand))) (defn tree-maker [] (if (grow-new-tree?) :tree :grass))

(defn make-forest

 ([] (make-forest 5))
 ([size]
 (take size (repeatedly #(take size (repeatedly tree-maker))))))

(defn tree-at [forest row col] (try (-> forest

                                  (nth row)
                                  (nth col))
                                   (catch Exception _ false)))

(defn neighbores-burning? [forest row col]

 (letfn [(burnt? [row col] (= :burnt (tree-at forest row col)))]
   (or
    (burnt? (inc row) col)
    (burnt? (dec row) col)
    (burnt? row (inc col))
    (burnt? row (dec col)))))

(defn lightning-strike [forest]

 (map (fn [forest-row]
        (map #(if (and (= % :tree) (burn-tree?))
                :fire!
                %)
             forest-row)
        )
      forest))

(defn burn-out-trees [forest]

 (map (fn [forest-row]
        (map #(case %
             :burnt :grass
             :fire! :burnt
             %)
             forest-row))
      forest))

(defn burn-neighbores [forest]

 (let [forest-size (count forest)
       indicies (partition forest-size (for [row (range forest-size) col (range forest-size)] (cons row (list col))))]
   (map (fn [forest-row indicies-row]
          (map #(if (and
                      (= :tree %)
                      (neighbores-burning? forest (first %2) (second %2)))
                   :fire!
                   %)
               forest-row indicies-row))
        forest indicies)))
                   

(defn grow-new-trees [forest] (map (fn [forest-row]

                                    (map #(if (= % :grass)
                                            (tree-maker)
                                            %)
                                         forest-row))
                                    forest))

(defn forest-fire

 ([] (forest-fire 5))
 ([forest-size]
 (loop
     [forest (make-forest forest-size)]
   (pprint forest)
   (Thread/sleep 300)
   (-> forest
       (burn-out-trees)
       (lightning-strike)
       (burn-neighbores)
       (grow-new-trees)
       (recur)))))

(forest-fire)

</lang>

example output

((:tree :tree :grass :tree :tree)
 (:tree :grass :tree :tree :tree)
 (:fire! :tree :tree :grass :tree)
 (:fire! :fire! :tree :tree :tree)
 (:burnt :tree :tree :fire! :grass))

((:tree :tree :grass :tree :tree)
 (:fire! :tree :tree :fire! :tree)
 (:burnt :fire! :tree :grass :tree)
 (:burnt :burnt :fire! :fire! :tree)
 (:grass :fire! :fire! :burnt :tree))

Common Lisp

<lang lisp>(defvar *dims* '(10 10)) (defvar *prob-t* 0.5) (defvar *prob-f* 0.1) (defvar *prob-p* 0.01)

(defmacro with-gensyms (names &body body)

 `(let ,(mapcar (lambda (n) (list n '(gensym))) names)

,@body))

(defmacro traverse-grid (grid rowvar colvar (&rest after-cols) &body body)

 (with-gensyms (dims rows cols)

`(let* ((,dims (array-dimensions ,grid)) (,rows (car ,dims)) (,cols (cadr ,dims))) (dotimes (,rowvar ,rows ,grid) (dotimes (,colvar ,cols ,after-cols) ,@body)))))

(defun make-new-forest (&optional (dims *dims*))

 (let ((forest (make-array dims :element-type 'symbol :initial-element 'void)))

(traverse-grid forest row col nil (if (<= (random 1.0) *prob-t*) (setf (aref forest row col) 'tree)))))

(defun print-forest (forest)

 (traverse-grid forest row col (terpri)

(ecase (aref forest row col) ((void) (write-char #\space)) ((tree) (write-char #\T)) ((fire) (write-char #\#))))

 (values))

(defvar *neighboring* '((-1 . -1) (-1 . 0) (-1 . 1) (0 . -1) (0 . 1) (1 . -1) (1 . 0) (1 . 1)))

(defun neighbors (forest row col)

 (loop for n in *neighboring*

for nrow = (+ row (car n))

       for ncol = (+ col (cdr n))

when (array-in-bounds-p forest nrow ncol) collect (aref forest nrow ncol)))

(defun evolve-tree (forest row col)

 (let ((tree (aref forest row col)))

(cond ((eq tree 'fire) ;; if the tree was on fire, it's dead Jim 'void) ((and (eq tree 'tree) ;; if a neighbor is on fire, it's on fire too (find 'fire (neighbors forest row col) :test #'eq)) 'fire) ((and (eq tree 'tree) ;; random chance of fire happening (<= (random 1.0) *prob-f*)) 'fire) ((and (eq tree 'void) ;; random chance of empty space becoming a tree (<= (random 1.0) *prob-p*)) 'tree) (t tree))))

(defun evolve-forest (forest)

 (let* ((dims (array-dimensions forest))

(new (make-array dims :element-type 'symbol :initial-element 'void))) (traverse-grid forest row col nil (setf (aref new row col) (evolve-tree forest row col))) new))

(defun simulate (forest n &optional (print-all t))

 (format t "------ Initial forest ------~%")
 (print-forest forest)
 (dotimes (i n)
   (setf forest (evolve-forest forest))
   (when print-all
     (progn (format t "~%------ Generation ~d ------~%" (1+ i))
	(print-forest forest)))))

</lang> Example results: <lang lisp>CL-USER>(defparameter *forest* (make-new-forest)) CL-USER>(simulate *forest* 5)


Initial forest ------

TTTTT TT

  TTT  TT
TT T  T  
TTTT T TT

T TT T T

   T  TTT
 TTTT TTT
T        
T T T T  

TTT TTT T


Generation 1 ------

TTTTT TT

  TTT  TT
TT T  T  
TTTT T TT

T TT T T

   T  TTT
 TTTT TTT
T        
T T T T  

TTT TTT T


Generation 2 ------

TTTTT TT

  TTT  TT
TT T  T  
TTTT T TT

TTTT T T

   T  TTT
 TTT# TTT
T        
T T T T  

TTT TTT T


Generation 3 ------

TTTTT TT

  TTT  TT
TT T  T  
TTTT T TT

TTTT T T

   #  TTT
 TT#  TTT
T        
T T T T  

TTT TTT T


Generation 4 ------

TTTTT TT

  TTT  TT
TT T  TT 
TTTT T TT

TTT# T T

      TTT
 T#   TTT
T        
T T T T  

TTT TTT T


Generation 5 ------

TTTTT TT

  TTT  TT
TT T  TT 
T### T TT

TT# T T

      TTT
 #    TTT
T        
T T T T  

TTT TTT T NIL </lang>

D

Textual Version

<lang d>import std.stdio, std.random, std.string, std.algorithm;

enum TREE_PROB = 0.55; // original tree probability enum F_PROB = 0.01; // auto combustion probability enum P_PROB = 0.01; // tree creation probability

enum Cell : char { empty=' ', tree='T', fire='#' } alias Cell[][] World;

bool hasBurningNeighbours(in World world, in int r, in int c) pure nothrow {

 foreach (rowShift; -1 .. 2)
   foreach (colShift; -1 .. 2)
     if ((r + rowShift) >= 0 && (r + rowShift) < world.length &&
         (c + colShift) >= 0 && (c + colShift) < world[0].length &&
       world[r + rowShift][c + colShift] == Cell.fire)
     return true;
 return false;

}

void nextState(in World world, World nextWorld) {

 foreach (r, row; world)
   foreach (c, elem; row)
     final switch (elem) {
       case Cell.empty:
         nextWorld[r][c]= uniform(0.,1.)<P_PROB?Cell.tree:Cell.empty;
         break;
       case Cell.tree:
         if (world.hasBurningNeighbours(r, c))
           nextWorld[r][c] = Cell.fire;
         else
           nextWorld[r][c]=uniform(0.,1.)<F_PROB?Cell.fire:Cell.tree;
         break;
       case Cell.fire:
         nextWorld[r][c] = Cell.empty;
         break;
     }

}

void main() {

 auto world = new World(8, 65);
 foreach (row; world)
   foreach (ref el; row)
     el = uniform(0.0, 1.0) < TREE_PROB ? Cell.tree : Cell.empty;
 auto nextWorld = new World(world.length, world[0].length);
 foreach (i; 0 .. 4) {
   nextState(world, nextWorld);
   writeln(join(cast(string[])nextWorld, "\n"), "\n");
   swap(world, nextWorld);
 }

}</lang>

Output:
  T    T T#TT  T   TT  TT TTTT TT TTT T TT T# T T TT TT     TTTTT
T TT  TT T    TTTTTTTTTT T TTT T T    T    TT    TTTTTTTT TTTT #T
TT  T  TTTTTT TTTTT       TTT TTTT TTTT TTT T  T T T T  TT T TT  
T TT T TT T TT T  TTTT   T T TT TTT    T  TT     T T   T TT    T 
 TTT   T  TTTT  T#  T T T  TTT  TT  TTTTT T      T  TT  T  T TT T
 TT TTTT  TTT  TTTTT T T T  T  TT  T TTT   T  T T   TT    TTT T T
 T  TTT T TT   T TTT#TT  T TT  TTTTTTTT  TTTT  TTTTT TTTT TTT    
TT TTTTT TTTTTT TT  TT T TT T   TT  T   TT T TT TT  TTTT   TTTTT 

  T    T # #T  T   TT  TT TTTT TT TTT T TT #  T T TT TT     TT###
T TT  TT #    TTTTTTTTTT T TTT T T    T    ##    TTTTTTTT TTTT  #
TT  T  TTTTTT TTTTT       TTT TTTT TTTT TTT #  T T T T  TT T T#  
T TT T TT T TT T  #TTT   T T TT TTT    T  TT     T T   T TTT   T 
 TTT   T  TTTT  #   T T T  TTT  TT  TTTTT T      T  TT  T  T TT T
 TT TTTT  TTT  T#### # T T  T  TT  T TTT   T  T T   TT    TTT T T
 T  TTT T TT   T TT# #T  T TT  TTTTTTTT  TTTT  TTTTT TTTT TTT    
TT TTTTT TTTTTT TT  ## T TT T   TT  T   TT T TT TT  TTTT   TTTTT 

  T    T    #  T   TT  TT TTTT TT TTT T TT    T T TT TT     T#   
T TT  TT      TTTTTTTTTT T TTT T T    T          TTTTTTTT TTT#   
TT  T  T###TT TTT##       TTT TTTT TTTT TT#    T T T T  #T T #   
T TT T TT T TT #   #TT   T T TT TTT    T  T#     T T   T TTT   # 
 TTT   T  TTTT      # # T  TTT  TT  TTTTT T      T  TT  T  T TT T
 TT TTTT  TTT  #       T T  #  TT  T TTT   T  T T   TT    TTT T T
 T  TTT T TT   # ##   #  T TT  TTTTTTTT  TTTT  TTTTT TTTT TTT    
TT TTTTT TT#TTT TT     T TT T   TT  T   TT T TT TT  TTTT   TTTTT 

  T    T       T   TT  TT TTTT TT TTT T TT    T T TT TT     #    
T TT  T#      TT####TTTT T TTT T T    T          TTTTTT## TT#    
TT  T  #   #T ###         TTT TTTT TTTT T#     T T T T   # T     
T TT T ## # TT      ##   T T TT TTT    T  #      T T   # #TT     
 TTT   T  TTTT          T  ###  TT  TTTTT #      T  TT  T  T T# #
 TT TTTT  TTT          # T     TT  T TTT   T  T T   TT    TTT T T
 T  TTT T ##             T ##  TTTTTTTT  TTTT  TTTTT TTTT TTT    
TT TTTTT T# #T# ##     # TT T   TT  T   TT T TT TT  TTTT   TTTTT 

Graphical Version

Library: simpledisplay

(With Image class made final).

<lang d>import std.stdio, std.random, std.string, std.algorithm, simpledisplay;

enum double TREE_PROB = 0.55; // original tree probability enum double F_PROB = 0.01; // auto combustion probability enum double P_PROB = 0.01; // tree creation probability

template TypeTuple(T...) { alias T TypeTuple; } alias TypeTuple!(-1, 0, 1) sp;

enum Cell : char { empty=' ', tree='T', burning='#' } alias Cell[][] World;

immutable white = Color(255, 255, 255),

         red = Color(255, 0, 0),
         green = Color(0, 255, 0);

void nextState(ref World world, ref World nextWorld,

              ref Xorshift rnd, Image img) {
 enum double div = cast(double)typeof(rnd.front()).max;
 immutable nr = world.length;
 immutable nc = world[0].length;
 foreach (r, row; world)
   foreach (c, elem; row)
     final switch (elem) {
       case Cell.empty:
         img.putPixel(c, r, white);
         nextWorld[r][c] = (rnd.front()/div)<P_PROB ? Cell.tree : Cell.empty;
         rnd.popFront();
         break;
       case Cell.tree:
         img.putPixel(c, r, green);
         foreach (rowShift; sp)
           foreach (colShift; sp)
             if ((r + rowShift) >= 0 && (r + rowShift) < nr &&
                 (c + colShift) >= 0 && (c + colShift) < nc &&
                 world[r + rowShift][c + colShift] == Cell.burning) {
               nextWorld[r][c] = Cell.burning;
               goto END;
             }
         nextWorld[r][c]=(rnd.front()/div)<F_PROB ? Cell.burning : Cell.tree;
         rnd.popFront();
         END: break;
       case Cell.burning:
         img.putPixel(c, r, red);
         nextWorld[r][c] = Cell.empty;
         break;
     }
 swap(world, nextWorld);

}

void main() {

 auto rnd = Xorshift(1);
 auto world = new World(600, 600); // create world
 foreach (row; world)
   foreach (ref el; row)
     el = uniform(0.0, 1.0, rnd) < TREE_PROB ? Cell.tree : Cell.empty;
 auto nextWorld = new World(world.length, world[0].length);
 auto w= new SimpleWindow(world.length,world[0].length,"ForestFire");
 auto img = new Image(w.width, w.height);
 w.eventLoop(1, {
   auto painter = w.draw();
   nextState(world, nextWorld, rnd, img);
   painter.drawImage(Point(0, 0), img);
 });

}</lang> About 34 FPS, 600x600 cells.

F#

This implementation can be compiled or run in the interactive F# shell. <lang fsharp>open System open System.Diagnostics open System.Drawing open System.Drawing.Imaging open System.Runtime.InteropServices open System.Windows.Forms

module ForestFire =

   type Cell = Empty | Tree | Fire
   let rnd = new System.Random()
   let initial_factor = 0.35
   let ignition_factor = 1e-5 // rate of lightning strikes (f)
   let growth_factor = 2e-3   // rate of regrowth (p)
   let width = 640            // width of the forest region
   let height = 480           // height of the forest region
   let make_forest =
       Array2D.init height width 
           (fun _ _ -> if rnd.NextDouble() < initial_factor then Tree else Empty)
   
   let count (forest:Cell[,]) row col =
       let mutable n = 0
       let h,w = forest.GetLength 0, forest.GetLength 1
       for r in row-1 .. row+1 do
           for c in col-1 .. col+1 do
               if r >= 0 && r < h && c >= 0 && c < w && forest.[r,c] = Fire then
                   n <- n + 1
       if forest.[row,col] = Fire then n-1 else n
   let burn (forest:Cell[,]) r c =
       match forest.[r,c] with
       | Fire -> Empty
       | Tree -> if rnd.NextDouble() < ignition_factor then Fire
                   else if (count forest r c) > 0 then Fire else Tree
       | Empty -> if rnd.NextDouble() < growth_factor then Tree else Empty
   // All the functions below this point are drawing the generated images to screen.
   let make_image (pixels:int[]) =
       let bmp = new Bitmap(width, height)
       let bits = bmp.LockBits(Rectangle(0,0,width,height), ImageLockMode.WriteOnly, PixelFormat.Format32bppArgb)
       Marshal.Copy(pixels, 0, bits.Scan0, bits.Height*bits.Width) |> ignore
       bmp.UnlockBits(bits)
       bmp
   // This function is run asynchronously to avoid blocking the main GUI thread.
   let run (box:PictureBox) (label:Label) = async {
       let timer = new Stopwatch()
       let forest = make_forest |> ref
       let pixel = Array.create (height*width) (Color.Black.ToArgb())
       let rec update gen =
           timer.Start()
           forest := burn !forest |> Array2D.init height width
           for y in 0..height-1 do
               for x in 0..width-1 do
                   pixel.[x+y*width] <- match (!forest).[y,x] with
                                           | Empty -> Color.Gray.ToArgb()
                                           | Tree -> Color.Green.ToArgb()
                                           | Fire -> Color.Red.ToArgb()
           let img = make_image pixel
           box.Invoke(MethodInvoker(fun () -> box.Image <- img)) |> ignore
           let msg = sprintf "generation %d @ %.1f fps" gen (1000./timer.Elapsed.TotalMilliseconds)
           label.Invoke(MethodInvoker(fun () -> label.Text <- msg )) |> ignore
           timer.Reset()
           update (gen + 1)
       update 0 }
   let main args =
       let form = new Form(AutoSize=true,
                           Size=new Size(800,600),
                           Text="Forest fire cellular automata")
       let box = new PictureBox(Dock=DockStyle.Fill,Location=new Point(0,0),SizeMode=PictureBoxSizeMode.StretchImage)
       let label = new Label(Dock=DockStyle.Bottom, Text="Ready")
       form.FormClosed.Add(fun eventArgs -> Async.CancelDefaultToken()
                                            Application.Exit())
       form.Controls.Add(box)
       form.Controls.Add(label)
       run box label |> Async.Start
       form.Show()
       Application.Run()
       0
  1. if INTERACTIVE

ForestFire.main [|""|]

  1. else

[<System.STAThread>] [<EntryPoint>] let main args = ForestFire.main args

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

Go

Text. The program prints the configuration, waits for the Enter key, and prints the next. It makes a pretty good animation to just hold down the Enter key. <lang go>package main

import (

   "fmt"
   "math/rand"
   "strings"

)

const (

   rows = 20
   cols = 30
   p    = .01
   f    = .001

)

const rx = rows + 2 const cx = cols + 2

func main() {

   odd := make([]byte, rx*cx)
   even := make([]byte, rx*cx)
   for r := 1; r <= rows; r++ {
       for c := 1; c <= cols; c++ {
           if rand.Intn(2) == 1 {
               odd[r*cx+c] = 'T'
           }
       }
   }
   for {
       print(odd)
       step(even, odd)
       fmt.Scanln()
       print(even)
       step(odd, even)
       fmt.Scanln()
   }

}

func print(model []byte) {

   fmt.Println(strings.Repeat("__", cols))
   fmt.Println()
   for r := 1; r <= rows; r++ {
       for c := 1; c <= cols; c++ {
           if model[r*cx+c] == 0 {
               fmt.Print("  ")
           } else {
               fmt.Printf(" %c", model[r*cx+c])
           }
       }
       fmt.Println()
   }

}

func step(dst, src []byte) {

   for r := 1; r <= rows; r++ {
       for c := 1; c <= cols; c++ {
           x := r*cx + c
           dst[x] = src[x]
           switch dst[x] {
           case '#':
               // rule 1. A burning cell turns into an empty cell
               dst[x] = 0
           case 'T':
               // rule 2. A tree will burn if at least one neighbor is burning
               if src[x-cx-1]=='#'  || src[x-cx]=='#' || src[x-cx+1]=='#' ||
                   src[x-1] == '#'  ||                   src[x+1] == '#'  ||
                   src[x+cx-1]=='#' || src[x+cx]=='#' || src[x+cx+1] == '#' {
                   dst[x] = '#'
                   // rule 3. A tree ignites with probability f
                   // even if no neighbor is burning
               } else if rand.Float64() < f {
                   dst[x] = '#'
               }
           default:
               // rule 4. An empty space fills with a tree with probability p
               if rand.Float64() < p {
                   dst[x] = 'T'
               }
           }
       }
   }

}</lang>

Haskell

<lang haskell>import Data.List import Control.Arrow import Control.Monad import System.Random

data Cell = Empty | Tree | Fire deriving (Eq)

instance Show Cell where

 show Empty   = " "
 show Tree    = "T"
 show Fire    = "$"

randomCell = liftM ([Empty, Tree] !!) (randomRIO (0,1) :: IO Int) randomChance = randomRIO (0,1.0) :: IO Double

rim b = map (fb b). (fb =<< rb) where

   fb = liftM2 (.) (:) (flip (++) . return)
   rb = fst. unzip. zip (repeat b). head

take3x3 = concatMap (transpose. map take3). take3 where

take3 = init. init. takeWhile (not.null). map(take 3). tails

list2Mat n = takeWhile(not.null). map(take n). iterate(drop n)

evolveForest :: Int -> Int -> Int -> IO () evolveForest m n k = do

 let s = m*n
 fs <- replicateM s randomCell
 let nextState xs = do
       ts <- replicateM s randomChance
       vs <- replicateM s randomChance
       let rv [r1,[l,c,r],r3] newTree fire
             | c == Fire                                      = Empty
             | c == Tree && Fire `elem` concat [r1,[l,r],r3]  = Fire
             | c == Tree && 0.01 >= fire                      = Fire
             | c == Empty && 0.1 >= newTree                   = Tree
             | otherwise                                      = c
       return $ zipWith3 rv xs ts vs
     evolve i xs = unless (i > k) $
       do  let nfs = nextState $ take3x3 $ rim Empty $ list2Mat n xs
           putStrLn ("\n>>>>>> " ++ show i ++ ":")
           mapM_ (putStrLn. concatMap show) $ list2Mat n xs
           nfs >>= evolve (i+1)
 evolve 1 fs</lang>

A run: <lang haskell>*Main> evolveForest 6 50 3

>>>>>> 1:

    T T    T TTTTTTTTT TT   TT T  T   T TT  TT
TTT  TT T TT TTTT T   T  TT T T T  T T T  TTTTT T
T  TT T TTT T  TTTTT TTTTTTTT      T TTT  TTTT TT
  TT TT T TT T TTT T T T TTTT T TTT   TT  T    TT
TT  TT  TT  TT T T  T T   TT   T   T TT T T TTTTT
T  TT T     T T  TTTTTT T T T  T T TT       T  TT

>>>>>> 2:

    T T    T TTTTTTTTT TT   TT TT T   $ TT  TT
TTT  TT T TT TTTT T   T  TT T T T  T T T  TTTTT T
TT TTTT TT$ T TTTTTT TTTTT$TT      T T$T  TTTT TT
  TT TT T TT T TTTTTTT T TTTT T TTT   TT  T    TT
TT  TT  TT  TT T T  T T   TT   T   T TT T T TTTTT

TTT TT TT T T TTTTTT T T T T T TT TT TT

>>>>>> 3:

   TTTTT   T TTTTTTTTT TT   TT TT T     TT  TT
TTTT TT T $$ TTTT T   T  $$ T T T  T $ $  TTTTT T
TTTTTTT T$  T TTTTTT TTTT$ $T      T $ $ TTTTT TT
  TT TT T $$ T TTTTTTT T $$$T T TTT   $$  T T TTT
TT  TT  TT TTT T T TT TT  TT   T   T TT T T TTTTT

TTT TT TT T T T TTTTTT T T T T T TT TT TT</lang>

Icon and Unicon

Forest fire 400 x 400 rounds=500 p.initial=0.100000 p/f=0.010000/0.000200 fps=1.495256

<lang Icon>link graphics,printf

$define EDGE 0 $define EMPTY 1 $define TREE 2 $define FIRE 3

global Colours,Width,Height,ProbTree,ProbFire,ProbInitialTree,Forest,oldForest

procedure main() # forest fire

   Height := 400            # Window height 
   Width := 400             # Window width
   ProbInitialTree := .10   # intial probability of trees
   ProbTree := .01          # ongoing probability of trees
   ProbFire := ProbTree/50. # probability of fire
   Rounds := 500            # rounds to evolve
   
   setup_forest()
   every 1 to Rounds do {
      show_forest()
      evolve_forest()
      }
   printf("Forest fire %d x %d rounds=%d p.initial=%r p/f=%r/%r fps=%r\n",
          Width,Height,Rounds,ProbInitialTree,ProbTree,ProbFire,
          Rounds/(&time/1000.))  # stats
   WDone()

end

procedure setup_forest() #: setup the forest

   Colours := table()       # define colours
   Colours[EDGE]  := "black"
   Colours[EMPTY] := "grey"
   Colours[TREE]  := "green"
   Colours[FIRE]  := "red"
   
   WOpen("label=Forest Fire", "bg=black",
         "size=" || Width+2 || "," || Height+2) | # add for border
            stop("Unable to open Window")
   every !(Forest := list(Height)) := list(Width,EMPTY)  # default
   every ( Forest[1,1 to Width]  | Forest[Height,1 to Width] | 
           Forest[1 to Height,1] | Forest[1 to Height,Width] ) := EDGE
   every r := 2 to Height-1 & c := 2 to Width-1 do 
      if probability(ProbInitialTree) then Forest[r,c] := TREE

end

procedure show_forest() #: show Forest - drawn changes only

  every r := 2 to *Forest-1 & c := 2 to *Forest[r]-1 do
     if /oldForest | oldForest[r,c] ~= Forest[r,c] then {
        WAttrib("fg=" || Colours[Forest[r,c]]) 
        DrawPoint(r,c)
     }

end

procedure evolve_forest() #: evolve forest

   old := oldForest := list(*Forest)     # freeze copy 
   every old[i := 1 to *Forest] := copy(Forest[i])  # deep copy
   every r := 2 to *Forest-1 & c := 2 to *Forest[r]-1 do 
      Forest[r,c] := case old[r,c] of {   # apply rules 
         FIRE : EMPTY
         TREE : if probability(ProbFire) | 
                 ( old[r-1, c-1 to c+1] | 
                   old[r,c-1|c+1] | 
                   old[r+1,c-1 to c+1] ) = FIRE then FIRE
         EMPTY: if probability(ProbTree) then TREE
         }      

end

procedure probability(P) #: succeed with probability P if ?0 <= P then return end</lang>

printf.icn provides printf graphics.icn provides graphics

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

Java

Works with: Java version 1.5+

Text

<lang java5>import java.util.Arrays; import java.util.LinkedList; import java.util.List;

public class Fire { private static final char BURNING = 'w'; //w looks like fire, right? private static final char TREE = 'T'; private static final char EMPTY = '.'; private static final double F = 0.2; private static final double P = 0.4; private static final double TREE_PROB = 0.5;

private static List<String> process(List<String> land){ List<String> newLand = new LinkedList<String>(); for(int i = 0; i < land.size(); i++){ String rowAbove, thisRow = land.get(i), rowBelow; if(i == 0){//first row rowAbove = null; rowBelow = land.get(i + 1); }else if(i == land.size() - 1){//last row rowBelow = null; rowAbove = land.get(i - 1); }else{//middle rowBelow = land.get(i + 1); rowAbove = land.get(i - 1); } newLand.add(processRows(rowAbove, thisRow, rowBelow)); } return newLand; }

private static String processRows(String rowAbove, String thisRow, String rowBelow){ String newRow = ""; for(int i = 0; i < thisRow.length();i++){ switch(thisRow.charAt(i)){ case BURNING: newRow+= EMPTY; break; case EMPTY: newRow+= Math.random() < P ? TREE : EMPTY; break; case TREE: String neighbors = ""; if(i == 0){//first char neighbors+= rowAbove == null ? "" : rowAbove.substring(i, i + 2); neighbors+= thisRow.charAt(i + 1); neighbors+= rowBelow == null ? "" : rowBelow.substring(i, i + 2); if(neighbors.contains(Character.toString(BURNING))){ newRow+= BURNING; break; } }else if(i == thisRow.length() - 1){//last char neighbors+= rowAbove == null ? "" : rowAbove.substring(i - 1, i + 1); neighbors+= thisRow.charAt(i - 1); neighbors+= rowBelow == null ? "" : rowBelow.substring(i - 1, i + 1); if(neighbors.contains(Character.toString(BURNING))){ newRow+= BURNING; break; } }else{//middle neighbors+= rowAbove == null ? "" : rowAbove.substring(i - 1, i + 2); neighbors+= thisRow.charAt(i + 1); neighbors+= thisRow.charAt(i - 1); neighbors+= rowBelow == null ? "" : rowBelow.substring(i - 1, i + 2); if(neighbors.contains(Character.toString(BURNING))){ newRow+= BURNING; break; } } newRow+= Math.random() < F ? BURNING : TREE; } } return newRow; }

public static List<String> populate(int width, int height){ List<String> land = new LinkedList<String>(); for(;height > 0; height--){//height is just a copy anyway StringBuilder line = new StringBuilder(width); for(int i = width; i > 0; i--){ line.append((Math.random() < TREE_PROB) ? TREE : EMPTY); } land.add(line.toString()); } return land; }

//process the land n times public static void processN(List<String> land, int n){ for(int i = 0;i < n; i++){ land = process(land); } }

//process the land n times and print each step along the way public static void processNPrint(List<String> land, int n){ for(int i = 0;i < n; i++){ land = process(land); print(land); } }

//print the land public static void print(List<String> land){ for(String row: land){ System.out.println(row); } System.out.println(); }

public static void main(String[] args){ List<String> land = Arrays.asList(".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", "......TwTTT...T", "..T....TTTTTTTT", ".T.T.T....TT..."); print(land); processNPrint(land, 10);

System.out.println("Random land test:");

land = populate(10, 10); print(land); processNPrint(land, 10); } }</lang>

Graphics

See: Forest fire/Java/Graphics

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.

JavaScript

<lang javascript>var forest = {

   X: 50,
   Y: 50,
   propTree: 0.5,
   propTree2: 0.01,
   propBurn: 0.0001,
   t: [],
   c: ['rgb(255,255,255)', 'rgb(0,255,0)', 'rgb(255,0,0)']

};

for(var i = 0; i < forest.Y; i++) {

   forest.t[i] = [];
   for(var j = 0; j < forest.Y; j++) {
       forest.t[i][j] = Math.random() < forest.propTree ? 1 : 0;
   }

}

function afterLoad(forest) {

   var canvas = document.getElementById('canvas');
   var c = canvas.getContext('2d');
   for(var i = 0; i < forest.X; i++) {
       for(var j = 0; j < forest.Y; j++) {
           c.fillStyle = forest.c[forest.t[i][j]];
           c.fillRect(10*j, 10*i, 10*j+9, 10*i+9);
       }
   }

}

function doStep(forest) {

   var to = [];
   for(var i = 0; i < forest.Y; i++) {
       to[i] = forest.t[i].slice(0);
   }
   //indices outside the array are undefined; which converts to 0=empty on forced typecast
   for(var i = 0; i < forest.Y; i++) {
       for(var j = 0; j < forest.Y; j++) {
           if(0 == to[i][j]) {
               forest.t[i][j] = Math.random() < forest.propTree2 ? 1 : 0;
           } else if(1 == to[i][j]) {
               if(
                   ((i>0) && (2 == to[i-1][j])) ||
                   ((i<forest.Y-1) && (2 == to[i+1][j])) ||
                   ((j>0) && (2 == to[i][j-1])) ||
                   ((j<forest.X-1) && (2 == to[i][j+1]))
                   ) {
                   forest.t[i][j] = 2;
               } else {
                   forest.t[i][j] = Math.random() < forest.propBurn ? 2 : 1;
               }
           } else if(2 == to[i][j]) {
               //If it burns, it gets empty ...
               forest.t[i][j] = 0;
           }
       }
   }

}

window.setInterval(function(){

   doStep(forest);
   afterLoad(forest);

}, 100); </lang>

To actually see it work we need a small demo page with HTML5 compliant code:

<lang html5><!DOCTYPE html> <html> <head> <title>Forest Fire</title> </head> <body> <canvas id="canvas" width="500" height="500"> Your browser doesn't support HTML5 Canvas. </canvas> <script language="JavaScript">//<![CDATA[ HERE COMES THE SCRIPT FROM ABOVE <-- //-->]]></script> </body> </html> </lang>

The output is a (mostly fluent) animation of the area.

Liberty BASIC

<lang lb>'[RC] Forest Fire

   dim oldgen(200,200), newgen(200,200)
   p          =0.99
   f          =0.9999
   nomainwin
   WindowWidth  = 200
   WindowHeight = 200
   open "Forest Fire" for graphics_nsb_nf as #1
   #1  "trapclose [quit]"
   #1  "down ; fill brown ; flush"
   p          =0.99
   f          =0.9999
   for generation = 1 to 200
       for x = 1 to 199
           for y = 1 to 199
               scan 'we can break early
               select case oldgen(x,y)
                   case 0
                       if rnd(0) > p then newgen(x,y) = 1 : #1 "color green ; set "; x; " "; y
                   case 2
                       newgen(x,y) = 0 : #1 "color brown ; set "; x; " "; y
                   case 1
                       if oldgen(x-1,y-1) = 2 or oldgen(x-1,y) = 2 or oldgen(x-1,y+1) = 2_
                           or oldgen(x,y-1) = 2 or oldgen(x,y+1) = 2 or oldgen(x+1,y-1) = 2_
                           or oldgen(x+1,y) = 2 or oldgen(x+1,y+1) = 2 or rnd(0) > f then
                               #1 "color red ; set "; x; " "; y
                               newgen(x,y) = 2
                       end if
               end select
               oldgen(x-1,y-1)=newgen(x-1,y-1)
           next y
       next x
   next generation


   [quit]
   close #1
   end</lang>

Mathematica

Mathematica is good at working with cellular automata -- especially 2-color 1-dimensional cellular automata. The automaton function is awkward yet very powerful. This code implements a 3-color 2-dimensional cellular automaton with 9-cell neighbourhoods using a custom cell evolution function. There is probably a rule number specification that can replace the custom evolution function and make this simpler and faster. But this works well enough. The last line of code plots the state of the forest after the 300th step.

<lang Mathematica>evolve[nbhd_List, k_] := 0 /; nbhd2, 2 == 2 (*burning->empty*) evolve[nbhd_List, k_] := 2 /; nbhd2, 2 == 1 && Max@nbhd == 2 (*near_burning&nonempty->burning*) evolve[nbhd_List, k_] := RandomChoice[{f, 1 - f} -> {2, nbhd2, 2}] /; nbhd2, 2 == 1 && Max@nbhd < 2 (*spontaneously combusting tree*) evolve[nbhd_List, k_] := RandomChoice[{p, 1 - p} -> {1, nbhd2, 2}] /; nbhd2, 2 == 0 (*random tree growth*)

r = 100; c = 100; p = 10^-2; f = 10^-4; init = RandomInteger[BernoulliDistribution[0.05], {r, c}]; MatrixPlot[CellularAutomaton[{evolve, {}, {1, 1}}, {init, 0}, {{{300}}}], ColorRules -> {0 -> White, 1 -> Green, 2 -> Red}, Frame -> False]</lang>

OCaml

Library: curses

This example uses a curses display (with the ocaml-curses bindings).

<lang ocaml>open Curses

let ignite_prob = 0.02 let sprout_prob = 0.01

type cell = Empty | Burning | Tree

let get w x y =

 try w.(x).(y)
 with Invalid_argument _ -> Empty

let neighborhood_burning w x y =

 try
   for _x = pred x to succ x do
     for _y = pred y to succ y do
       if get w _x _y = Burning then raise Exit
     done
   done
   ; false
 with Exit -> true

let evolves w x y =

 match w.(x).(y) with
 | Burning -> Empty
 | Tree ->
     if neighborhood_burning w x y
     then Burning
     else begin
       if (Random.float 1.0) < ignite_prob
       then Burning
       else Tree
     end
 | Empty ->
     if (Random.float 1.0) < sprout_prob
     then Tree
     else Empty

let step width height w =

 for x = 0 to pred width do
   for y = 0 to pred height do
     w.(x).(y) <- evolves w x y
   done
 done

let i = int_of_char let repr = function

 | Empty -> i ' ' | Burning -> i '#' | Tree -> i 't'

let draw width height w =

 for x = 0 to pred width do
   for y = 0 to pred height do
     ignore(move y x);
     ignore(delch ());
     ignore(insch (repr w.(x).(y)));
   done;
 done;
 ignore(refresh ())

let () =

 Random.self_init ();
 let wnd = initscr () in
 ignore(cbreak ());
 ignore(noecho ());
 let height, width = getmaxyx wnd in
 let w = Array.make_matrix width height Empty in
 clear ();
 ignore(refresh ());
 while true do
   draw width height w;
   step width height w;
   Unix.sleep 1;
 done;
 endwin()</lang>

You can execute this script with:

$ ocaml unix.cma -I +curses curses.cma forest.ml

Perl

Requires terminal that understands ANSI escape sequences:<lang Perl> use 5.10.0;

my $w = `tput cols` - 1; my $h = `tput lines` - 1; my $r = "\033[H";

my ($green, $red, $yellow, $norm) = ("\033[32m", "\033[31m", "\033[33m", "\033[m");

my $tree_prob = .05; my $burn_prob = .0002;

my @forest = map([ map((rand(1) < $tree_prob) ? 1 : 0, 1 .. $w) ], 1 .. $h);

sub iterate { my @new = map([ map(0, 1 .. $w) ], 1 .. $h); for my $i (0 .. $h - 1) { for my $j (0 .. $w - 1) { $new[$i][$j] = $forest[$i][$j]; if ($forest[$i][$j] == 2) { $new[$i][$j] = 3; next; } elsif ($forest[$i][$j] == 1) { if (rand() < $burn_prob) { $new[$i][$j] = 2; next; } for ( [-1, -1], [-1, 0], [-1, 1], [ 0, -1], [ 0, 1], [ 1, -1], [ 1, 0], [ 1, 1] ) { my $y = $_->[0] + $i; next if $y < 0 || $y >= $h; my $x = $_->[1] + $j; next if $x < 0 || $x >= $w; if ($forest[$y][$x] == 2) { $new[$i][$j] = 2; last; } } } elsif (rand() < $tree_prob) { $new[$i][$j] = 1; } elsif ($forest[$i][$j] == 3) { $new[$i][$j] = 0; } }} @forest = @new; }

sub forest { print $r; for (@forest) { for (@$_) { when(0) { print " "; } when(1) { print "${green}*"} when(2) { print "${red}&" } when(3) { print "${yellow}&" } } print "\033[E\033[1G"; } iterate; }

forest while (1);</lang>

Perl 6

<lang perl6>my $RED = "\e[1;31m"; my $CLEAR = "\e[0m";

enum Cell-State <Empty Tree Burning>; my @show = (' ', '木', $RED ~ '木' ~ $CLEAR);

class Forest {

   has Cell-State @!grid;
   has @!neighbors;
   has Int $.height;
   has Int $.width;
   has $.p;
   has $.f;

   method new(Int $height, Int $width, $p=0.01, $f=0.001) {
       my $c = self.bless(*, :$height, :$width, :$p, :$f);
       $c!init-grid;
       $c!init-neighbors;
       return $c;
   }

   method !init-grid {

@!grid = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;

   }

   method !init-neighbors {
       for ^$!height X ^$!width -> $i, $j {
           @!neighbors[$i][$j] = gather for
                   [-1,-1],[+0,-1],[+1,-1],
                   [-1,+0],(     ),[+1,+0],
                   [-1,+1],[+0,+1],[+1,+1]

{ take-rw @!grid[$i + .[0]][$j + .[1]] // next; }

       }
   }

   method step {
       my @new;
       for ^$!height X ^$!width -> $i, $j {
           given @!grid[$i][$j] {
               when Empty   { @new[$i][$j] = rand < $!p ?? Tree !! Empty }
               when Tree    { @new[$i][$j] = 
                    (@!neighbors[$i][$j].any === Burning or rand < $!f) ?? Burning !! Tree;
               }
               when Burning { @new[$i][$j] = Empty }
           }
       }
       for ^$!height X ^$!width -> $i, $j {
           @!grid[$i][$j] = @new[$i][$j];
       }
   }

   method Str {
       join , gather for ^$!height -> $i {
           take @show[@!grid[$i].list], "\n";
       }
   }

}

my Forest $f .= new(20,30); print "\e[2J"; # ANSI clear screen

my $i = 0; loop {

   print "\e[H";   # ANSI home
   say $i++;
   say $f.Str;
   $f.step;

}</lang>

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)

PostScript

<lang PostScript>%!PS-Adobe-3.0 %%BoundingBox: 0 0 400 400

/size 400 def

/rand1 { rand 2147483647 div } def

/m { moveto } bind def /l { rlineto} bind def /drawforest {

       0 1 n 1 sub { /y exch def
       0 1 n 1 sub { /x exch def
               forest x get y get dup 0 eq { pop } {
                       1 eq { 0 1 0 } { 1 0 0 } ifelse setrgbcolor
                       x c mul y c mul m
                       c 0 l 0 c l c neg 0 l closepath fill
               } ifelse
       } for
       } for

} def

/r1n { dup 0 ge exch n lt and } def

/neighbors { /y exch def /x exch def /cnt 0 def

       [
       y 1 sub 1 y 1 add { /y1 exch def
               y1 r1n {
                       x 1 sub 1 x 1 add { /x1 exch def
                               x1 r1n { forest x1 get y1 get } if
                       } for
               } if
       } for]

} def

/iter {

       /nf [ n {[ n {0} repeat]} repeat ] def
       0 1 n 1 sub { /x exch def
       0 1 n 1 sub { /y exch def
               nf x get y
               forest x get y get dup
               0 eq { pop rand1 treeprob le {1}{0} ifelse
               } {
                       1 eq {  /fire false def
                               x y neighbors {
                                       -1 eq { /fire true def } if
                               } forall
                               fire {-1}{
                                       rand1 burnprob lt {-1}{1} ifelse
                               } ifelse
                       }{0} ifelse
               } ifelse
               put
       } for } for
       /forest nf def

} def

/n 200 def /treeprob .05 def /burnprob .0001 def /c size n div def /forest [ n {[ n { rand1 treeprob le {1}{0} ifelse } repeat]} repeat ] def

1000 { drawforest showpage iter } repeat %%EOF</lang>

PureBasic

<lang PureBasic>; Some systems reports high CPU-load while running this code.

This may likely be due to the graphic driver used in the
2D-function Plot().
If experiencing this problem, please reduce the #Width & #Height
or activate the parameter #UnLoadCPU below with a parameter 1 or 2.
This code should work with the demo version of PureBasic on both PC & Linux
General parameters for the world
  1. f = 1e-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
Depending on your hardware, use this to control the speed/CPU-load.
0 = No load reduction
1 = Only active about every second frame
2 = '1' & release the CPU after each horizontal line.
  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
   CompilerIf #UnLoadCPU>1
     Delay(1)
   CompilerEndIf
 Next
 StopDrawing()
 ImageGadget(1, 0, 0, #Width, #Height, ImageID(1))

EndProcedure

If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget)

 SmartWindowRefresh(0, 1)
 If CreateImage(1, #Width, #Height)
   Define Event, freq
   If ExamineDesktops() And DesktopFrequency(0)
     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: 


REALbasic

This example puts all of the forestry logic into a Thread class. This allows the UI to remain responsive while the Thread does all the work in the background. We create a Thread by subclassing the Thread object in the IDE, in this case creating forestfire as a subclass of the Thread object and put the following code in its Run() event: <lang realbasic> Sub Run()

 //Handy named constants
 Const empty = 0
 Const tree = 1
 Const fire = 2
 Const ablaze = &cFF0000    //Using the &c numeric operator to indicate a color in hex
 Const alive = &c00FF00
 Const dead = &c804040
 
 //Our forest
 Dim worldPic As New Picture(480, 480, 32)
 Dim newWorld(120, 120) As Integer
 Dim oldWorld(120, 120) As Integer
 
 //Initialize forest
 Dim rand As New Random
 For x as Integer = 0 to 119
   For y as Integer = 0 to 119
     if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then
       newWorld(x, y) = empty
       worldPic.Graphics.ForeColor = dead
       worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
     Else
       newWorld(x, y) = tree
       worldPic.Graphics.ForeColor = alive
       worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
     end if
   Next
 Next
 oldWorld = newWorld
 
 //Burn, baby burn!
 While Window1.stop = False
   For x as Integer = 0 To 119
     For y As Integer = 0 to 119
       Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value)
       Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value)
       if x = 119 or y = 119 or x = 0 or y = 0 Then
         Continue
       end if
       Select Case oldWorld(x, y)
       Case empty
         If willGrow = (Window1.growProb.Value) Then
           newWorld(x, y) = tree
           worldPic.Graphics.ForeColor = alive
           worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
         end if
       Case tree
         if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then
           newWorld(x, y) = fire
           worldPic.Graphics.ForeColor = ablaze
           worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
         end if
       Case fire
         newWorld(x, y) = empty
         worldPic.Graphics.ForeColor = dead
         worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
       End Select
     Next
   Next
   Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0)
   oldWorld = newWorld
   me.Sleep(Window1.speed.Value)
 Wend

End Sub </lang> As you can see, this Thread is expecting a Window object called Window1 with several other objects within it. The IDE will automatically create a Window object called Window1 when a new GUI application is created. Our Window1 has 5 objects (widgets) in it: a Canvas (for displaying graphics), three sliders, and a pushbutton. <lang realbasic> Sub Open()

 //First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it.
 Dim fire As New forestFire
 fire.Run()

End Sub

stop As Boolean //a globally accessible property of Window1. Boolean properties default to False.

Sub Pushbutton1.Action()

 stop = True

End Sub </lang>

REXX

This version has been elided, otherwise the size of the program (with all it's options and optional formatting) would
probably be on the big side for general viewing, and maybe a wee bit complex to demonstrate how to program for this task.

If repeatable results are desired, the RANDSEED variable can be set to a positive integer.

Glyphs were chosen in an attempt to pictorialize a tree (↑) and also a fire (▒).
The choice of glyphs within the DOS code page (under Windoes) is rather limited.

There are two dependencies: the LINESIZE function is used (some REXXes don't have it), and the RYO
version that I wrote was wasn't included here. Also, the CLS (DOS) command is used to clear the screen. <lang rexx>/*REXX program grows and displays a forest (with growth and lightning).

  ┌───────────────────────────elided version─────────────────────────┐
  ├─── full version has many more options and enhanced displays. ────┤
  └──────────────────────────────────────────────────────────────────┘ */

signal on syntax; signal on novalue /*handle REXX program errors. */ signal on halt /*handle cell growth interruptus.*/ parse arg peeps '(' generations rows cols bare! life! clearscreen every @abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU

     blank = 'BLANK'

generations = p(generations 100)

      rows = p(rows                   3)
      cols = p(cols                   3)
     bare! = pickchar(bare!           blank)

clearscreen = p(clearscreen 0)

     every = p(every                  999999999)
     life! = pickchar(life!           '☼')

fents=max(79,cols) /*fence width shown after display*/ $.=bare! /*the universe is new, and barren*/ gens=abs(generations) /*use this for convenience. */ x=space(peeps) /*remove superfluous spaces. */ if x== then x='2,1 2,2 2,3'

       do  while x \==
       parse var x p x; parse var p r ',' c .; $.r=overlay(life!,$.r,c+1)
       end

life=0;  !.=0; call showCells /*show initial state of the cells*/ /*─────────────────────────────────────watch cell colony grow/live/die. */

 do  life=1 for gens
   do   r=1 for rows;     rank=bare!
     do c=2 for cols;     ?=substr($.r,c,1);       ??=?;    n=neighbors()
         select                       /*select da quickest choice first*/
         when ?==bare!    then  if n==3       then ??=life!
         otherwise              if n<2 | n>3  then ??=bare!
         end   /*select*/
     rank=rank || ??
     end       /*c*/
   @.r=rank
   end         /*c*/
      do r=1 for rows; $.r=@.r; end   /*assign alternate cells ──► real*/
 if life//every==0 | generations>0 | life==gens then call showCells
 end           /*life*/

/*─────────────────────────────────────stop watching the universe (life)*/ halt: cycles=life-1; if cycles\==gens then say 'REXX program interrupted.' exit /*stick a fork in it, we're done.*/ /*───────────────────────────────SHOWCELLS subroutine─-─────────────────*/ showCells: if clearscreen then 'CLS' /* ◄─── change this for your OS.*/ _=; do r=rows by -1 for rows /*show the forest in proper order*/

     z=strip(substr($.r,2),'T')       /*pick off the meat of the row.  */
     say z;   _=_ || z                /*be neat about trailing blanks. */
     end   /*r*/

say right(copies('═',fents)life,fents) /*show&tell for a stand of trees.*/ if _== then exit /*if no life, then stop the run. */ if !._ then do; say 'repeating ...'; exit; end !._=1 /*assign a state & compare later.*/ return /*───────────────────────────────NEIGHBORS subroutine───────────────────*/ neighbors: rp=r+1; cp=c+1; rm=r-1; cm=c-1 /*count 8 neighbors of a cell*/ return (substr($.rm,cm,1)==life!) + (substr($.rm,c ,1)==life!) + ,

         (substr($.rm,cp,1)==life!)   +   (substr($.r ,cm,1)==life!)  + ,
         (substr($.r ,cp,1)==life!)   +   (substr($.rp,cm,1)==life!)  + ,
         (substr($.rp,c ,1)==life!)   +   (substr($.rp,cp,1)==life!)

/*───────────────────────────────1-liner subroutines────────────────────*/ err: say;say;say center(' error! ',max(40,linesize()%2),"*");say;do j=1 for arg();say arg(j);say;end;say;exit 13 novalue: syntax: call err 'REXX program' condition('C') "error",condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl) pickchar: _=p(arg(1));if translate(_)==blank then _=' ';if length(_) ==3 then _=d2c(_);if length(_) ==2 then _=x2c(_);return _ p: return word(arg(1),1)</lang> output when using the defaults of:

  • generations = 100
  • rows = 39
  • columns = 79 (one less than the window size)
  • lightning rate = ½%
  • new growth rate = 6%
  • bare character = blank
  • fire character = ▒
  • tree character = ↑


This is the 7th generation (out of 100).

↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒▒▒ ↑↑↑↑↑↑  ▒↑↑↑↑▒     ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒     ▒↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒↑↑↑
↑↑↑↑↑↑↑↑▒         ↑↑↑↑↑↑↑ ▒↑↑↑↑▒ ↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑   ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
↑↑↑↑↑↑↑↑▒ ↑ ↑     ↑↑↑↑↑↑  ▒↑↑↑↑▒     ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑↑↑ ▒↑↑▒▒▒▒▒▒▒▒▒▒▒▒▒▒↑↑↑
↑↑↑↑↑↑↑↑▒  ↑↑↑↑  ↑↑  ↑↑↑↑ ▒↑↑↑↑▒ ↑↑↑ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑   ▒▒▒▒            ▒↑↑↑
↑↑↑↑↑↑↑↑▒  ↑↑↑↑↑↑ ↑       ▒↑↑↑↑▒     ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒            ↑↑   ↑   ▒↑↑↑
↑↑↑↑↑↑↑↑▒ ↑↑↑↑↑↑↑↑↑ ▒▒▒▒▒▒▒↑↑↑↑▒▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒  ↑↑  ↑↑ ↑↑↑↑▒   ↑  ▒▒↑↑
↑↑↑↑↑↑↑↑▒   ↑↑↑↑↑↑↑ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒▒▒▒▒▒  ↑↑↑↑↑↑↑   ↑▒ ▒↑↑↑  ▒↑↑
↑↑↑↑↑↑↑↑▒ ↑↑↑↑↑↑↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒            ↑↑↑↑↑↑ ↑ ↑ ↑▒  ▒↑↑↑ ▒↑↑
↑↑↑↑↑↑↑↑▒ ↑↑↑↑↑↑↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑  ↑↑↑↑↑↑  ↑↑↑↑↑↑ ↑↑▒▒▒ ↑   ↑↑ ▒↑↑
↑↑↑↑↑↑↑↑▒  ↑↑▒▒▒↑↑↑ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑↑↑↑↑  ↑ ↑↑ ↑↑↑↑↑ ↑↑▒  ▒▒▒  ↑  ▒▒▒
↑↑▒↑↑↑↑↑▒  ▒▒▒ ▒ ↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ↑  ▒▒▒↑▒↑▒↑ ↑↑ ↑ ↑ ▒   ↑  ↑ ↑
↑↑↑↑↑↑↑↑▒    ▒↑↑ ▒↑ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑↑▒  ↑    ▒ ↑  ↑↑ ↑↑▒     ▒↑   ↑
▒▒▒▒▒▒▒▒▒  ↑▒▒  ▒↑↑ ▒▒▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒     ▒↑  ↑ ▒↑       ↑   ↑   ↑↑↑↑ ↑↑
           ↑ ▒▒▒▒↑         ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ▒ ↑↑ ▒▒  ▒   ▒▒   ▒▒      ↑ ↑↑↑↑↑
 ↑ ↑↑  ↑  ↑↑▒ ↑↑↑↑↑↑↑↑↑↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ▒▒ ▒↑   ▒ ↑↑ ▒▒  ▒ ▒ ▒▒↑▒▒↑↑↑ ↑↑↑
↑↑↑↑↑↑      ↑↑ ↑↑  ↑↑  ↑ ↑ ▒↑↑↑↑↑↑↑↑ ↑↑↑↑↑↑▒  ↑↑ ↑↑   ▒↑↑↑ ▒▒  ▒▒ ↑▒↑↑ ↑↑↑↑↑↑↑↑
↑ ↑↑↑▒ ▒  ↑↑▒▒▒ ▒↑↑↑↑↑↑    ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ↑▒   ▒▒▒▒↑↑↑ ▒▒   ↑↑ ▒↑↑↑ ↑↑↑↑↑↑↑
 ↑▒▒ ↑  ↑↑ ▒ ↑▒ ▒▒▒↑       ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ↑▒▒▒↑▒↑↑ ↑↑  ▒▒   ↑↑▒▒↑↑↑ ↑↑↑↑↑↑↑
↑ ▒ ↑▒ ▒↑↑ ▒   ↑  ▒ ▒↑↑ ▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑↑ ↑↑↑↑↑↑↑↑↑  ▒▒▒ ↑↑  ▒↑↑↑↑↑↑↑↑↑↑
  ▒  ↑ ▒↑↑↑↑   ↑↑↑ ▒ ↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ↑↑↑↑↑ ↑ ↑↑↑  ▒↑▒  ↑▒ ↑↑↑↑↑↑↑
↑↑↑▒   ▒↑↑↑▒▒  ▒▒       ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ↑↑↑ ↑↑↑ ↑↑↑  ▒↑▒  ↑↑↑↑↑↑↑↑↑
↑↑↑▒▒▒▒↑↑  ↑▒ ↑↑ ▒↑  ↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒              ▒▒↑▒  ↑ ↑↑ ↑↑↑↑  ▒▒▒▒
↑↑↑↑↑↑↑↑ ↑↑↑     ↑↑  ↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒↑↑▒ ↑↑↑↑↑↑↑↑↑↑  ▒↑↑↑
↑↑↑↑↑↑ ↑ ↑↑↑▒▒▒ ▒↑  ▒   ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑  ↑↑↑ ↑↑↑  ▒↑↑↑
↑↑↑↑↑↑↑↑↑  ↑↑↑▒ ↑ ↑▒ ↑  ▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒      ↑↑   ↑ ▒↑↑↑
↑↑↑↑↑↑    ↑ ↑↑↑▒ ▒ ↑↑ ↑    ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒            ▒↑↑↑
↑↑↑↑↑   ↑      ↑   ↑       ▒↑↑▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒▒▒▒▒▒▒▒↑↑↑
↑↑↑↑ ↑  ↑↑↑            ▒   ▒↑↑▒ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
↑↑ ↑↑↑      ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒↑↑▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
 ↑ ↑↑       ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
       ▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
▒▒▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒↑↑↑↑↑▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑↑
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒                    ▒▒↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒▒▒▒↑↑↑↑↑↑▒     ▒↑↑↑↑↑↑↑↑↑↑
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑↑↑    ↑↑↑↑  ↑↑ ↑   ▒↑↑↑↑↑↑↑↑↑↑↑▒     ▒▒▒▒▒▒▒▒ ↑   ▒↑↑↑↑↑↑↑↑↑↑
▒▒▒▒▒▒▒▒↑↑↑↑↑↑↑▒  ↑↑↑↑↑ ↑ ↑↑  ↑↑↑▒   ▒↑↑↑↑↑↑↑↑↑↑↑▒  ↑           ↑↑  ▒↑↑↑↑↑↑↑↑↑↑
       ▒↑↑↑↑↑↑↑▒  ↑↑↑   ↑↑↑↑    ↑↑▒↑ ▒↑↑↑↑↑↑↑↑↑↑↑▒ ↑↑↑    ↑  ↑  ↑↑  ▒↑▒▒▒▒▒▒▒↑↑
 ↑↑ ↑  ▒↑↑↑↑↑↑↑▒  ↑↑↑↑↑↑↑↑↑   ↑↑↑↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑▒ ↑  ↑ ↑↑↑ ↑ ↑↑↑   ▒↑▒     ▒↑↑
  ↑ ↑↑ ▒↑↑↑↑↑↑↑▒ ↑↑  ↑ ↑  ↑   ↑↑↑↑↑↑ ▒↑↑↑↑↑↑↑↑↑↑↑▒     ↑ ↑↑↑↑↑↑↑  ▒▒▒↑▒↑  ↑ ▒↑↑
  ↑ ↑  ▒▒▒▒↑↑↑↑▒ ↑↑↑ ↑↑      ↑↑↑ ↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑▒▒▒▒   ↑↑ ↑↑↑↑↑  ▒↑↑↑▒ ↑↑↑ ▒↑↑
 ↑↑↑↑     ▒↑↑↑↑▒  ↑↑↑  ↑ ▒▒▒ ↑   ↑↑↑ ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒   ↑ ↑↑↑↑↑↑  ▒↑↑↑▒  ↑  ▒↑↑
 ↑↑↑      ▒↑↑↑↑▒         ▒↑▒         ▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒▒▒  ↑↑↑↑↑↑↑  ▒↑↑↑▒     ▒↑↑
          ▒↑↑↑↑▒▒▒▒▒▒▒▒▒▒▒↑▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑▒  ↑ ↑↑↑↑ ↑ ▒↑↑↑▒▒▒▒▒▒▒↑↑
▒▒▒▒▒▒▒▒▒▒▒↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒     ▒↑▒▒▒↑↑↑↑↑▒   ↑ ↑↑↑↑  ▒↑↑↑↑↑↑↑↑↑↑↑↑
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒  ↑  ▒↑▒ ▒↑↑↑↑↑▒ ↑↑  ↑ ↑   ▒↑↑↑ ↑↑↑↑↑↑↑↑
↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑▒ ↑   ▒↑▒▒▒↑↑↑↑↑▒           ▒↑↑↑↑↑↑↑↑↑↑↑↑
═════════════════════════════════════════════════════════════════════════════10

Ruby

<lang ruby>require 'enumerator'

def transition arr, tree_prob, fire_prob

 arr.enum_with_index.map do |cell, i|
   if i == 0 or i == arr.length - 1
     # boundary conditions: cells are always empty here
     :empty
   else
     case cell
     when :fire
       # burning cells become empty
       :empty
     when :empty
       # empty cells grow a tree with probability tree_prob
       rand < tree_prob ? :tree : :empty
     when :tree
       # check my neighbouring cells, are they on fire?
       if arr[i - 1] == :fire or arr[i + 1] == :fire
         :fire
       else
         # neighbours not on fire, but catch fire at random
         rand < fire_prob ? :fire : :tree
       end
     end
   end
 end

end

def pretty_print arr

 # colour the trees green, the fires red, and the empty spaces black
 print(arr.map { |cell|
   "\e[3" + 
     case cell
     when :tree
       "2mT"
     when :fire
       "1mF"
     when :empty
       "0m "
     end + "\e[0m"
 }.join)

end

N = 20 # 20 trees P = 0.5 # probability of growing a tree F = 0.1 # probability of catching on fire

srand Time.now.to_i

  1. each cell has a 50/50 chance of being a tree

array = (1..N).map { rand < 0.5 ? :tree : :empty } array[0] = array[-1] = :empty # boundary conditions pretty_print array puts

begin

 array = transition(array, P, F)
 pretty_print array

end while gets.chomp.downcase != "q"</lang>Sample Output:

Run BASIC

<lang runbasic>graphic #g, 200,200 dim preGen(200,200) dim newGen(200,200)

for gen = 1 to 200

 for x = 1 to 199
   for y = 1 to 199
     select case preGen(x,y)
       case 0
         if rnd(0) > .99 then newGen(x,y) = 1  : #g "color green ; set "; x; " "; y
       case 2
         newGen(x,y) = 0                       : #g "color brown ; set "; x; " "; y
       case 1
         if preGen(x-1,y-1) = 2 or preGen(x-1,y)   = 2 or preGen(x-1,y+1) = 2 _
         or preGen(x,y-1)   = 2 or preGen(x,y+1)   = 2 or preGen(x+1,y-1) = 2 _
         or preGen(x+1,y)   = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then
             #g "color red ; set "; x; " "; y
             newGen(x,y) = 2
         end if
     end select
     preGen(x-1,y-1) = newGen(x-1,y-1)
   next y
 next x

next gen render #g</lang>

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>

Scala

<lang scala>import scala.util.Random

class Forest(matrix:Array[Array[Char]]){

 import Forest._
 val f=0.01;	 // auto combustion probability
 val p=0.1;	 // tree creation probability
 val rows=matrix.size
 val cols=matrix(0).size
 def evolve():Forest=new Forest(Array.tabulate(rows, cols){(y,x)=>
   matrix(y)(x) match {
     case EMPTY => if (Random.nextDouble<p) TREE else EMPTY
     case BURNING => EMPTY
     case TREE => if (neighbours(x, y).exists(_==BURNING)) BURNING 
                 else if (Random.nextDouble<f) BURNING else TREE
   }
 })
 
 def neighbours(x:Int, y:Int)=matrix slice(y-1, y+2) map(_.slice(x-1, x+2)) flatten
 override def toString()=matrix map (_.mkString("")) mkString "\n"

}

object Forest{

 val TREE='T'
 val BURNING='#'
 val EMPTY='.'
 def apply(x:Int=30, y:Int=15)=new Forest(Array.tabulate(y, x)((y,x)=> if (Random.nextDouble<0.5) TREE else EMPTY))

}</lang>

<lang scala>object ForestFire{

 def main(args: Array[String]): Unit = {
   var l=Forest()
   for(i <- 0 until 20){
     println(l+"\n-----------------------")
     l=l.evolve
   }
 }

}</lang> Sample output:

.T..TTT.TT    .T..TTT.TT    TT..TTT.TT    TT..TTTTTT    TT..TTTTTT
TTT.TTTT..    TTT.TTTTT.    TTT.TTTTT.    TTT.TTTTT.    TTT.TTTTT.
.T...T..T.    .TT..T..T.    .TT..T.TT.    .TT.TT.TTT    .TT.##.TTT
T...TT.T.T    T...TT.T.T    T...TT.T.T    T.TT##.T.T    T.T#...T.T
.T..TTTTTT    .T..TTTTTT    .T..#TTTTT    .T...#TTTT    .T....#TTT
TTT..TTTT.    TTT..TTTT.    TTT..TTTT.    TTT..#TTT.    ###...##T.
TT.TTTTTTT    TT.TTTTTTT    TT.TTTTTTT    ##.TTT#TTT    ...###.#TT
......TT..    T.....TT..    #.T.TTTT..    .T#.TTTT..    .#..####..
.TTT.TTTTT    .#TT.TTTTT    ..#T.TTTTT    ...#.TTTTT    .....TTTTT
T.T.TTT.T.    TTT.TTT.T.    ###.TTT.T.    ...TTTT.T.    T..##TT.T.

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  # ## #     #

Visual Basic .NET

This program sits behind a Windows form with fixed borders, the only component of which is a timer (named Timer1, set to something like 50 or 100ms depending on the speed the user wants to see it). Other constant values (the probabilities and the window dimensions) can be set at the top of the code.

<lang VisualBasic.NET>Public Class ForestFire

   Private _forest(,) As ForestState
   Private _isBuilding As Boolean
   Private _bm As Bitmap
   Private _gen As Integer
   Private _sw As Stopwatch
   Private Const _treeStart As Double = 0.5
   Private Const _f As Double = 0.00001
   Private Const _p As Double = 0.001
   Private Const _winWidth As Integer = 300
   Private Const _winHeight As Integer = 300
   Private Enum ForestState
       Empty
       Burning
       Tree
   End Enum
   Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
       Me.ClientSize = New Size(_winWidth, _winHeight)
       ReDim _forest(_winWidth, _winHeight)
       Dim rnd As New Random()
       For i As Integer = 0 To _winHeight - 1
           For j As Integer = 0 To _winWidth - 1
               _forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty)
           Next
       Next
       _sw = New Stopwatch
       _sw.Start()
       DrawForest()
       Timer1.Start()
   End Sub
   Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
       If _isBuilding Then Exit Sub
       _isBuilding = True
       GetNextGeneration()
       DrawForest()
       _isBuilding = False
   End Sub
   Private Sub GetNextGeneration()
       Dim forestCache(_winWidth, _winHeight) As ForestState
       Dim rnd As New Random()
       For i As Integer = 0 To _winHeight - 1
           For j As Integer = 0 To _winWidth - 1
               Select Case _forest(j, i)
                   Case ForestState.Tree
                       If forestCache(j, i) <> ForestState.Burning Then
                           forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree)
                       End If
                   Case ForestState.Burning
                       For i2 As Integer = i - 1 To i + 1
                           If i2 = -1 OrElse i2 >= _winHeight Then Continue For
                           For j2 As Integer = j - 1 To j + 1
                               If j2 = -1 OrElse i2 >= _winWidth Then Continue For
                               If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning
                           Next
                       Next
                       forestCache(j, i) = ForestState.Empty
                   Case Else
                       forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty)
               End Select
           Next
       Next
       _forest = forestCache
       _gen += 1
   End Sub
   Private Sub DrawForest()
       Dim bmCache As New Bitmap(_winWidth, _winHeight)
       For i As Integer = 0 To _winHeight - 1
           For j As Integer = 0 To _winWidth - 1
               Select Case _forest(j, i)
                   Case ForestState.Tree
                       bmCache.SetPixel(j, i, Color.Green)
                   Case ForestState.Burning
                       bmCache.SetPixel(j, i, Color.Red)
               End Select
           Next
       Next
       _bm = bmCache
       Me.Refresh()
   End Sub
   Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
       e.Graphics.DrawImage(_bm, 0, 0)
       Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire"
   End Sub

End Class</lang>