Task: Forest fire





Java: import java.util.Arrays;
import java.util.LinkedList;
import java.util.List;

public class Fire {
	private static final char BURNING = 'w'; 
	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){
				rowAbove = null;
				rowBelow = land.get(i + 1);
			}else if(i == land.size() - 1){
				rowBelow = null;
				rowAbove = land.get(i - 1);
			}else{
				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){
					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){
					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{
					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--){
			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;
	}
	
	
	public static void processN(List<String> land, int n){
		for(int i = 0;i < n; i++){
			land = process(land);
		}
	}
	
	
	public static void processNPrint(List<String> land, int n){
		for(int i = 0;i < n; i++){
			land = process(land);
			print(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);
	}
}






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