Task: Forest fire







Python: 

L = 15

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




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 

contains

  
  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)) 
    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
  
  
  subroutine forestfire_destroy(f)
    type(forestfire), intent(inout) :: f

    if ( allocated(f%field) ) deallocate(f%field)
    
  end subroutine forestfire_destroy

  
  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

  
  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