new files

Task/Forest-fire/0DESCRIPTION

@@ -0,0 +1,17 @@
+{{wikipedia|Forest-fire model}}[[Category:Cellular automata]]
+Implement the Drossel and Schwabl definition of the [[wp:Forest-fire model|forest-fire model]].
+
+It is basically a 2D [[wp:Cellular automaton|cellular automaton]] where each cell can be in three distinct states (''empty'', ''tree'' and ''burning'') and evolves according to the following rules (as given by Wikipedia)
+
+# A burning cell turns into an empty cell
+# A tree will burn if at least one neighbor is burning
+# A tree ignites with probability ''f'' even if no neighbor is burning
+# An empty space fills with a tree with probability ''p''
+
+Neighborhood is the [[wp:Moore neighborhood|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]].

Task/Forest-fire/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Games

Task/Forest-fire/Ada/forest-fire.ada

@@ -0,0 +1,69 @@
+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;

Task/Forest-fire/C/forest-fire-1.c

@@ -0,0 +1,248 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <stdbool.h>
+#include <string.h>
+#include <pthread.h>
+
+#include <SDL.h>
+
+// defaults
+#define PROB_TREE 0.55
+#define PROB_F 0.00001
+#define PROB_P 0.001
+
+#define TIMERFREQ 100
+
+#ifndef WIDTH
+#  define WIDTH 640
+#endif
+#ifndef HEIGHT
+#  define HEIGHT 480
+#endif
+#ifndef BPP
+#  define BPP 32
+#endif
+
+#if BPP != 32
+  #warning This program could not work with BPP different from 32
+#endif
+
+uint8_t *field[2], swapu;
+double prob_f = PROB_F, prob_p = PROB_P, prob_tree = PROB_TREE;
+
+enum cell_state {
+  VOID, TREE, BURNING
+};
+
+// simplistic random func to give [0, 1)
+double prand()
+{
+  return (double)rand() / (RAND_MAX + 1.0);
+}
+
+// initialize the field
+void init_field(void)
+{
+  int i, j;
+  swapu = 0;
+  for(i = 0; i < WIDTH; i++)
+  {
+    for(j = 0; j < HEIGHT; j++)
+    {
+      *(field[0] + j*WIDTH + i) = prand() > prob_tree ? VOID : TREE;
+    }
+  }
+}
+
+// the "core" of the task: the "forest-fire CA"
+bool burning_neighbor(int, int);
+pthread_mutex_t synclock = PTHREAD_MUTEX_INITIALIZER;
+static uint32_t simulate(uint32_t iv, void *p)
+{
+  int i, j;
+
+  /*
+    Since this is called by SDL, "likely"(*) in a separated
+    thread, we try to avoid corrupted updating of the display
+    (done by the show() func): show needs the "right" swapu
+    i.e. the right complete field. (*) what if it is not so?
+    The following is an attempt to avoid unpleasant updates.
+   */
+  pthread_mutex_lock(&synclock);
+
+  for(i = 0; i < WIDTH; i++) {
+    for(j = 0; j < HEIGHT; j++) {
+      enum cell_state s = *(field[swapu] + j*WIDTH + i);
+      switch(s)
+      {
+      case BURNING:
+	*(field[swapu^1] + j*WIDTH + i) = VOID;
+	break;
+      case VOID:
+	*(field[swapu^1] + j*WIDTH + i) = prand() > prob_p ? VOID : TREE;
+	break;
+      case TREE:
+	if (burning_neighbor(i, j))
+	  *(field[swapu^1] + j*WIDTH + i) = BURNING;
+	else
+	  *(field[swapu^1] + j*WIDTH + i) = prand() > prob_f ? TREE : BURNING;
+	break;
+      default:
+	fprintf(stderr, "corrupted field\n");
+	break;
+      }
+    }
+  }
+  swapu ^= 1;
+  pthread_mutex_unlock(&synclock);
+  return iv;
+}
+
+// the field is a "part" of an infinite "void" region
+#define NB(I,J) (((I)<WIDTH)&&((I)>=0)&&((J)<HEIGHT)&&((J)>=0) \
+		 ? (*(field[swapu] + (J)*WIDTH + (I)) == BURNING) : false)
+bool burning_neighbor(int i, int j)
+{
+  return NB(i-1,j-1) || NB(i-1, j) || NB(i-1, j+1) ||
+    NB(i, j-1) || NB(i, j+1) ||
+    NB(i+1, j-1) || NB(i+1, j) || NB(i+1, j+1);
+}
+
+
+// "map" the field into gfx mem
+// burning trees are red
+// trees are green
+// "voids" are black;
+void show(SDL_Surface *s)
+{
+  int i, j;
+  uint8_t *pixels = (uint8_t *)s->pixels;
+  uint32_t color;
+  SDL_PixelFormat *f = s->format;
+
+  pthread_mutex_lock(&synclock);
+  for(i = 0; i < WIDTH; i++) {
+    for(j = 0; j < HEIGHT; j++) {
+      switch(*(field[swapu] + j*WIDTH + i)) {
+      case VOID:
+	color = SDL_MapRGBA(f, 0,0,0,255);
+	break;
+      case TREE:
+	color = SDL_MapRGBA(f, 0,255,0,255);
+	break;
+      case BURNING:
+	color = SDL_MapRGBA(f, 255,0,0,255);
+	break;
+      }
+      *(uint32_t*)(pixels + j*s->pitch + i*(BPP>>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);
+}

Task/Forest-fire/C/forest-fire-2.c

@@ -0,0 +1,65 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+enum { empty = 0, tree = 1, fire = 2 };
+const char *disp[] = {"  ", "\033[32m/\\\033[m", "\033[07;31m/\\\033[m"};
+double tree_prob = 0.01, burn_prob = 0.0001;
+
+#define for_x for (int x = 0; x < w; x++)
+#define for_y for (int y = 0; y < h; y++)
+#define for_yx for_y for_x
+#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);
+}

Task/Forest-fire/Clojure/forest-fire.clj

@@ -0,0 +1,77 @@
+(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)

Task/Forest-fire/Fortran/forest-fire-1.f

@@ -0,0 +1,183 @@
+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

Task/Forest-fire/Fortran/forest-fire-2.f

@@ -0,0 +1,18 @@
+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

Task/Forest-fire/Go/forest-fire.go

@@ -0,0 +1,84 @@
+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'
+                }
+            }
+        }
+    }
+}

Task/Forest-fire/Haskell/forest-fire-1.hs

@@ -0,0 +1,47 @@
+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

Task/Forest-fire/Haskell/forest-fire-2.hs

@@ -0,0 +1,25 @@
+*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

Task/Forest-fire/Java/forest-fire.java

@@ -0,0 +1,137 @@
+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);
+	}
+}

Task/Forest-fire/JavaScript/forest-fire-1.js

@@ -0,0 +1,63 @@
+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);

Task/Forest-fire/JavaScript/forest-fire-2.js

@@ -0,0 +1,14 @@
+<!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>

Task/Forest-fire/Perl/forest-fire.pl

@@ -0,0 +1,63 @@
+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);

Task/Forest-fire/PicoLisp/forest-fire.l

@@ -0,0 +1,43 @@
+(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) ) ) ) ) ) )

Task/Forest-fire/Python/forest-fire.py

@@ -0,0 +1,83 @@
+'''
+Forest-Fire Cellular automation
+ See: http://en.wikipedia.org/wiki/Forest-fire_model
+'''
+
+L = 15
+# d = 2 # Fixed
+initial_trees = 0.55
+p = 0.01
+f = 0.001
+
+try:
+    raw_input
+except:
+    raw_input = input
+
+import random
+
+
+tree, burning, space = 'TB.'
+hood = ((-1,-1), (-1,0), (-1,1),
+        (0,-1),          (0, 1),
+        (1,-1),  (1,0),  (1,1))
+
+def initialise():
+    grid = {(x,y): (tree if random.random()<= initial_trees else space)
+            for x in range(L)
+            for y in range(L) }
+    return grid
+
+def gprint(grid):
+    txt = '\n'.join(''.join(grid[(x,y)] for x in range(L))
+                    for y in range(L))
+    print(txt)
+
+def quickprint(grid):
+    t = b = 0
+    ll = L * L
+    for x in range(L):
+        for y in range(L):
+            if grid[(x,y)] in (tree, burning):
+                t += 1
+                if grid[(x,y)] == burning:
+                    b += 1
+    print(('Of %6i cells, %6i are trees of which %6i are currently burning.'
+          + ' (%6.3f%%, %6.3f%%)')
+          % (ll, t, b, 100. * t / ll, 100. * b / ll))
+
+
+def gnew(grid):
+    newgrid = {}
+    for x in range(L):
+        for y in range(L):
+            if grid[(x,y)] == burning:
+                newgrid[(x,y)] = space
+            elif grid[(x,y)] == space:
+                newgrid[(x,y)] = tree if random.random()<= p else space
+            elif grid[(x,y)] == tree:
+                newgrid[(x,y)] = (burning
+                                   if any(grid.get((x+dx,y+dy),space) == burning
+                                            for dx,dy in hood)
+                                        or random.random()<= f
+                                   else tree)
+    return newgrid
+
+if __name__ == '__main__':
+    grid = initialise()
+    iter = 0
+    while True:
+        quickprint(grid)
+        inp = raw_input('Print/Quit/<int>/<return> %6i: ' % iter).lower().strip()
+        if inp:
+            if inp[0] == 'p':
+                gprint(grid)
+            elif inp.isdigit():
+                for i in range(int(inp)):
+                    iter +=1
+                    grid = gnew(grid)
+                    quickprint(grid)
+            elif inp[0] == 'q':
+                break
+        grid = gnew(grid)
+        iter +=1

Task/Forest-fire/REXX/forest-fire.rexx

@@ -0,0 +1,67 @@
+/*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)

Task/Forest-fire/Racket/forest-fire.rkt

@@ -0,0 +1,60 @@
+#lang racket
+(require 2htdp/universe)
+(require 2htdp/image)
+
+(define (initial-forest w p-tree)
+  (for/vector #:length w ((rw w))
+    (for/vector #:length w ((cl w))
+      (if (< (random) p-tree) #\T #\_))))
+
+(define (has-burning-neighbour? forest r# c# w)
+  ;; note, this will check r# c#, too but it's not
+  ;; worth checking that r=r# and c=c# each time in
+  ;; this case
+  (for*/first
+      ((r (in-range (- r# 1) (+ r# 2)))
+       #:when (< 0 r w)
+       (c (in-range (- c# 1) (+ c# 2)))
+       #:when (< 0 c w)
+       #:when (equal? #\* (vector-ref (vector-ref forest r) c)))
+    #t))
+
+(define (fire-tick forest p-sprout f-combust w)
+  (for/vector #:length w ((rw forest) (r# (in-naturals)))
+    (for/vector #:length w ((cl rw) (c# (in-naturals)))
+      (case cl
+        ((#\_) (if (< (random) p-sprout) #\T #\_))
+        ((#\*) #\_)
+        ((#\T)
+         (cond
+           [(has-burning-neighbour? forest r# c# w) #\*]
+           [(< (random) f-combust) #\*]
+           [else #\T]))))))
+
+(define (render-forest state)
+  (for/fold
+      ((scn (empty-scene
+             (* (vector-length state) 8)
+             (* (vector-length (vector-ref state 0)) 8)
+             'black)))
+
+    ((rw state) (r# (in-naturals)))
+    (for/fold
+        ((scn scn))
+      ((cl rw) (c# (in-naturals)))
+      (place-image (circle 4 'solid
+                           (case cl
+                             ((#\_) 'brown)
+                             ((#\T) 'green)
+                             ((#\*) 'red)))
+                   (+ 4 (* c# 8)) (+ 4 (* r# 8)) scn))))
+
+(define (forest-fire p-tree p-sprout f-combust w)
+  (big-bang
+   (initial-forest w p-tree) ;; initial state
+   [on-tick (lambda (state)
+              ;(displayln state)
+              (fire-tick state p-sprout f-combust w))]
+   [to-draw render-forest]))
+
+(forest-fire 0 1/8 1/1024 50)

Task/Forest-fire/Ruby/forest-fire.rb

@@ -0,0 +1,60 @@
+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
+
+# 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"

Task/Forest-fire/Sather/forest-fire.sa

@@ -0,0 +1,196 @@
+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;

Task/Forest-fire/Scala/forest-fire-1.scala

@@ -0,0 +1,28 @@
+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))
+}

Task/Forest-fire/Scala/forest-fire-2.scala

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

Task/Forest-fire/Tcl/forest-fire.tcl

@@ -0,0 +1,78 @@
+package require Tcl 8.5
+
+# Build a grid
+proc makeGrid {w h {treeProbability 0.5}} {
+    global grid gridW gridH
+    set gridW $w
+    set gridH $h
+    set grid [lrepeat $h [lrepeat $w " "]]
+    for {set x 0} {$x < $w} {incr x} {
+	for {set y 0} {$y < $h} {incr y} {
+	    if {rand() < $treeProbability} {
+		lset grid $y $x "#"
+	    }
+	}
+    }
+}
+
+# Evolve the grid (builds a copy, then overwrites)
+proc evolveGrid {{fireProbability 0.01} {plantProbability 0.05}} {
+    global grid gridW gridH
+    set newGrid {}
+    for {set y 0} {$y < $gridH} {incr y} {
+	set row {}
+	for {set x 0} {$x < $gridW} {incr x} {
+	    switch -exact -- [set s [lindex $grid $y $x]] {
+		" " {
+		    if {rand() < $plantProbability} {
+			set s "#"
+		    }
+		}
+		"#" {
+		    if {[burningNeighbour? $x $y] || rand() < $fireProbability} {
+			set s "o"
+		    }
+		}
+		"o" {
+		    set s " "
+		}
+	    }
+	    lappend row $s
+	}
+	lappend newGrid $row
+    }
+    set grid $newGrid
+}
+
+# We supply the neighbourhood model as an optional parameter (not used...)
+proc burningNeighbour? {
+    x y
+    {neighbourhoodModel {-1 -1  -1 0  -1 1  0 -1  0 1  1 -1  1 0  1 1}}
+} {
+    global grid gridW gridH
+    foreach {dx dy} $neighbourhoodModel {
+	set i [expr {$x + $dx}]
+	if {$i < 0 || $i >= $gridW} continue
+	set j [expr {$y + $dy}]
+	if {$j < 0 || $j >= $gridH} continue
+	if {[lindex $grid $j $i] eq "o"} {
+	    return 1
+	}
+    }
+    return 0
+}
+
+proc printGrid {} {
+    global grid
+    foreach row $grid {
+	puts [join $row ""]
+    }
+}
+
+# Simple main loop; press Return for the next step or send an EOF to stop
+makeGrid 70 8
+while 1 {
+    evolveGrid
+    printGrid
+    if {[gets stdin line] < 0} break
+}