aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

5
Task/Forest-fire/00-META.yaml Normal file
View file

@ -0,0 +1,5 @@
---
category:
- Cellular automata
from: http://rosettacode.org/wiki/Forest_fire
note: Games

24
Task/Forest-fire/00-TASK.txt Normal file
View file

@ -0,0 +1,24 @@
<br>
;Task:
Implement the Drossel and Schwabl definition of the [[wp:Forest-fire model|forest-fire model]].
It is basically a 2D &nbsp; [[wp:Cellular automaton|cellular automaton]] &nbsp; 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 &nbsp; <big>''f'' </big> &nbsp; even if no neighbor is burning
# An empty space fills with a tree with probability &nbsp; <big> ''p'' </big>
<br>Neighborhood is the &nbsp; [[wp:Moore neighborhood|Moore neighborhood]]; &nbsp; 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 &nbsp; <big> ''p'' </big> &nbsp; and &nbsp; <big> ''f'' </big>) &nbsp; through a graphical or command line interface.
;Related tasks:
* &nbsp; See &nbsp; [[Conway's Game of Life]]
* &nbsp; See &nbsp; [[Wireworld]].
<br><br>

420
Task/Forest-fire/6502-Assembly/forest-fire.6502 Normal file
View file

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

189
Task/Forest-fire/8086-Assembly/forest-fire.8086 Normal file
View file

@ -0,0 +1,189 @@
;;; Simulation settings (probabilities are P/65536)
probF: equ 7 ; P(spontaneous combustion) ~= 0.0001
probP: equ 655 ; P(spontaneous growth) ~= 0.01
HSIZE: equ 320 ; Field width (320x200 fills CGA screen)
VSIZE: equ 200 ; Field height
FSIZE: equ HSIZE*VSIZE ; Field size
FPARA: equ FSIZE/16+1 ; Field size in paragraphs
;;; Field values
EMPTY: equ 0 ; Empty cell (also CGA black)
TREE: equ 1 ; Tree cell (also CGA green)
FIRE: equ 2 ; Burning cell (also CGA red)
;;; MS-DOS system calls and values
TOPSEG: equ 2 ; First unavailable segment
puts: equ 9 ; Print a string
time: equ 2Ch ; Get system time
exit: equ 4Ch ; Exit to DOS
;;; BIOS calls and values
palet: equ 0Bh ; Set CGA color pallette
vmode: equ 0Fh ; Get current video mode
keyb: equ 1 ; Get keyboard status
CGALO: equ 4 ; Low-res (4-color) CGA graphics mode
MDA: equ 7 ; MDA monochrome text mode
CGASEG: equ 0B800h ; CGA memory segment
cpu 8086
org 100h
section .text
;;; Program set-up (check memory size and set video mode)
mov sp,stack.top ; Move stack inwards
mov bp,sp ; Set BP to first available paragraph
mov cl,4
shr bp,cl
inc bp
mov dx,cs
add bp,dx
mov bx,[TOPSEG] ; Get first unavailable segment
sub bx,bp ; Get amount of available memory
cmp bx,FPARA*2 ; Enough to fit two fields?
ja mem_ok
mov dx,errmem ; If not, print error message
err: mov ah,puts
int 21h
mov ah,exit ; And stop
int 21h
mem_ok: mov ah,vmode ; Get current video mode
int 10h
push ax ; Keep on stack for later retrieval
cmp al,MDA ; MDA card does not support CGA graphics,
mov dx,errcga ; so print an error and quit.
je err
mov ax,CGALO ; Otherwise, switch to 320x200 CGA mode
int 10h
mov ah,palet ; And set the black/green/red/brown palette
mov bx,0100h
int 10h
mov ah,time ; Get the system time
int 21h
mov [rnddat],cx ; Use it as the RNG seed
mov [rnddat+2],dx
;;; Initialize the field (place trees randomly)
mov es,bp ; ES = field segment
xor di,di ; Start at first field
mov cx,FSIZE ; CX = how many cells to initialize
mov ah,TREE
ptrees: call random ; Get random byte
and al,ah ; Place a tree 50% of the time
stosb
loop ptrees
mov ds,bp ; DS = field segment
;;; Write field to CGA display
disp: xor si,si ; Start at beginning
mov dx,CGASEG ; ES = CGA memory segment
.scrn: mov es,dx
xor di,di ; Start of segment
.line: mov cx,HSIZE/8 ; 8 pixels per word
.word: xor bx,bx ; BX will hold CGA word
xor ah,ah ; Set high byte to zero
%rep 7 ; Unroll this loop for speed
lodsb ; Get cell
or bx,ax ; Put it in low 2 bits of BX
shl bx,1 ; Shift BX to make room for next field
shl bx,1
%endrep
lodsb ; No shift needed for final cell
or ax,bx
stosw ; Store word in CGA memory
loop .word ; Do next byte of line
add si,HSIZE ; Even and odd lines stored separately
cmp si,FSIZE ; Done yet?
jb .line ; If not, do next line
add dx,200h ; Move to next segment
cmp dx,CGASEG+200h ; If we still need to do the odd lines,
mov si,HSIZE ; then do them
jbe .scrn
;;; Stop the program if a key is pressed
mov ah,1 ; Check if a key is pressed
int 16h
jz calc ; If not, calculate next field state
pop ax ; Otherwise, restore the old video mode,
cbw
int 10h
mov ah,exit ; and exit to DOS.
int 21h
;;; Calculate next field state
calc: mov ax,ds ; Set ES = new field segment
add ax,FPARA
mov es,ax
xor di,di ; Start at beginning
xor si,si
.cell: lodsb ; Get cell
dec al ; A=1 = tree
jz .tree
dec al ; A=2 = fire
jz .fire
call rand16 ; An empty space fills with a tree
cmp ax,probP ; with probability P.
jc .mtree ; Otherwise it stays empty
.fire: xor al,al ; A burning tree turns into an empty cell
stosb
jmp .cnext
.mtree: mov al,TREE
stosb
.cnext: cmp si,FSIZE ; Are we there yet?
jne .cell ; If not, do next cell
push es ; Done - set ES=old field, DS=new field,
push ds
pop es
pop ds
mov cx,FSIZE/2
xor si,si
xor di,di
rep movsw ; copy the new field to the old field,
push es ; set DS to be the field to draw,
pop ds
xor di,di ; Instead of doing edge case handling in the
xor ax,ax ; Moore neighbourhood calculation, just zero
mov cx,HSIZE/2 ; out the borders for a slightly smaller image
rep stosw ; Upper border,
mov di,FSIZE-HSIZE
mov cx,HSIZE/2
rep stosw ; lower border,
mov di,HSIZE-5 ; right border.
mov cx,VSIZE-1
.bordr: stosb
add di,HSIZE-1
loop .bordr
jmp disp ; and update the display.
.tree: mov ax,[si-HSIZE-2] ; Load Moore neighbourhood
or al,[si-HSIZE]
or ax,[si-2]
or al,[si]
or ax,[si+HSIZE-2]
or al,[si+HSIZE]
or al,ah
test al,FIRE ; Are any of the trees on fire?
jnz .tburn ; Then set this tree on fire too
call rand16 ; Otherwise, spontaneous combustion?
cmp ax,probF
jc .tburn
mov al,TREE ; If not, the tree remains a tree
stosb
jmp .cnext
.tburn: mov al,FIRE ; Set the tree on fire
stosb
jmp .cnext
;;; Get a random word in AX
rand16: call random
xchg al,ah
;;; Get a random byte in AL. BX and DX destroyed.
random: mov bx,[cs:rnddat] ; BL=X BH=A
mov dx,[cs:rnddat+2] ; DL=B DH=C
inc bl ; X++
xor bh,dh ; A ^= C
xor bh,bl ; A ^= X
add dl,bh ; B += A
mov al,dl ; C' = B
shr al,1 ; C' >>= 1
add al,dh ; C' += C
xor al,bh ; C' ^= A
mov dh,al ; C = C'
mov [cs:rnddat+2],dx ; Update RNG state
mov [cs:rnddat],bx
ret
section .data
errcga: db 'CGA mode not supported.$'
errmem: db 'Not enough memory.$'
section .bss
rnddat: resb 4 ; RNG state
stack: resw 128 ; Stack space
.top: equ $

59
Task/Forest-fire/ALGOL-68/forest-fire.alg Normal file
View file

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

69
Task/Forest-fire/Ada/forest-fire.ada Normal file
View file

@ -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;

18
Task/Forest-fire/Applesoft-BASIC/forest-fire.basic Normal file
View file

@ -0,0 +1,18 @@
100 FOR I = 17239 TO 17493
110 READ B
120 NEXT
130 CALL 17239
140 END
150 DATA 162,23,138,32,71,248,165,38,157,60,3,165,39,157,84,3,202,16,239,162,96
160 DATA 134,249,134,1,160,0,132,0,152,145,0,200,208,251,232,134,1,224,128,208
170 DATA 244,44,86,192,44,82,192,44,84,192,44,80,192,32,50,248,162,0,134,0,169
180 DATA 41,133,2,133,254,169,83,133,4,165,249,133,1,133,3,133,5,73,16,133,255
190 DATA 133,249,138,134,45,74,168,169,15,144,2,105,224,133,46,185,60,3,133,38
200 DATA 185,84,3,133,39,160,1,132,44,177,2,145,254,240,79,16,93,169,0,164,44
210 DATA 145,254,136,81,38,37,46,81,38,145,38,164,44,200,192,41,208,224,165,2
220 DATA 133,0,165,3,133,1,165,4,133,2,133,254,24,105,42,133,4,165,5,73,16
230 DATA 133,255,73,16,133,3,105,0,133,5,166,45,232,224,48,208,159,44,0,192
240 DATA 48,3,76,144,67,44,16,192,44,81,192,96,198,8,208,190,169,101,133,8,169
250 DATA 68,208,169,169,153,208,165,198,6,208,14,198,7,208,10,169,23,133,6,169
260 DATA 39,133,7,208,234,177,0,17,4,136,17,0,17,2,17,4,200,200,17,0,17,2,17,4
270 DATA 48,213,16,137,41

152
Task/Forest-fire/AutoHotkey/forest-fire.ahk Normal file
View file

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

38
Task/Forest-fire/BASIC256/forest-fire.basic Normal file
View file

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

36
Task/Forest-fire/BBC-BASIC/forest-fire.basic Normal file
View file

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

116
Task/Forest-fire/Batch-File/forest-fire.bat Normal file
View file

@ -0,0 +1,116 @@
@echo off
setlocal enabledelayedexpansion
if "%1"=="" (
call:default
) else (
call:setargs %*
)
call:createarray
call:fillarray
call:display
echo.
echo -------------------
echo.
for /l %%i in (1,1,%i%) do (
echo.
echo -------------------
echo.
call:evolve
call:display
)
pause>nul
:default
set m=10
set n=11
set p=50
set f=5
set i=5
exit /b
:setargs
set m=%1
set n=%m%+1
set p=%2
set f=%3
set i=%4
exit /b
:createarray
for /l %%m in (0,1,%n%) do (
for /l %%n in (0,1,%n%) do (
set a%%m%%n=0
)
)
exit /b
:fillarray
for /l %%m in (1,1,%m%) do (
for /l %%n in (1,1,%m%) do (
set /a treerandom=!random! %% 101
if !treerandom! leq %p% set a%%m%%n=T
)
)
exit /b
:display
for /l %%m in (1,1,%m%) do (
set "line%%m="
for /l %%n in (1,1,%m%) do (
set line%%m=!line%%m! !a%%m%%n!
)
set line%%m=!line%%m:0= !
echo.!line%%m!
)
exit /b
:evolve
for /l %%m in (1,1,%m%) do (
for /l %%n in (1,1,%m%) do (
call:nexttick !a%%m%%n! %%m %%n
set newa%%m%%n=!errorlevel!
)
)
call:update
exit /b
:nexttick
if %1==0 (
set /a treerandom=!random! %% 101
if !treerandom! leq %p% exit /b 1
exit /b 0
)
if %1==T (
set /a lowerm=%2-1
set /a upperm=%2+1
set /a lowern=%3-1
set /a uppern=%3+1
set burn=0
for /l %%m in (!lowerm!,1,!upperm!) do (
for /l %%n in (!lowern!,1,!uppern!) do (
if !a%%m%%n!==# set burn=1
)
)
if !burn!==1 exit /b 2
set /a burnrandom=!random! %% 101
if !burnrandom! leq %f% exit /b 2
exit /b 1
)
if %1==# exit /b 0
:update
for /l %%m in (1,1,%m%) do (
for /l %%n in (1,1,%m%) do (
if !newa%%m%%n!==1 set newa%%m%%n=T
if !newa%%m%%n!==2 set newa%%m%%n=#
set a%%m%%n=!newa%%m%%n!
)
)
exit /b

280
Task/Forest-fire/C++/forest-fire.cpp Normal file
View file

@ -0,0 +1,280 @@
#include <windows.h>
#include <string>
//--------------------------------------------------------------------------------------------------
using namespace std;
//--------------------------------------------------------------------------------------------------
enum states { NONE, TREE, FIRE };
const int MAX_SIDE = 500;
//--------------------------------------------------------------------------------------------------
class myBitmap
{
public:
myBitmap() : pen( NULL ) {}
~myBitmap()
{
DeleteObject( pen );
DeleteDC( hdc );
DeleteObject( bmp );
}
bool create( int w, int h )
{
BITMAPINFO bi;
ZeroMemory( &bi, sizeof( bi ) );
bi.bmiHeader.biSize = sizeof( bi.bmiHeader );
bi.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
bi.bmiHeader.biCompression = BI_RGB;
bi.bmiHeader.biPlanes = 1;
bi.bmiHeader.biWidth = w;
bi.bmiHeader.biHeight = -h;
HDC dc = GetDC( GetConsoleWindow() );
bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 );
if( !bmp ) return false;
hdc = CreateCompatibleDC( dc );
SelectObject( hdc, bmp );
ReleaseDC( GetConsoleWindow(), dc );
width = w; height = h;
return true;
}
void clear()
{
ZeroMemory( pBits, width * height * sizeof( DWORD ) );
}
void setPenColor( DWORD clr )
{
if( pen ) DeleteObject( pen );
pen = CreatePen( PS_SOLID, 1, clr );
SelectObject( hdc, pen );
}
void saveBitmap( string path )
{
BITMAPFILEHEADER fileheader;
BITMAPINFO infoheader;
BITMAP bitmap;
DWORD wb;
GetObject( bmp, sizeof( bitmap ), &bitmap );
DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight];
ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) );
ZeroMemory( &infoheader, sizeof( BITMAPINFO ) );
ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) );
infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8;
infoheader.bmiHeader.biCompression = BI_RGB;
infoheader.bmiHeader.biPlanes = 1;
infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader );
infoheader.bmiHeader.biHeight = bitmap.bmHeight;
infoheader.bmiHeader.biWidth = bitmap.bmWidth;
infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD );
fileheader.bfType = 0x4D42;
fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER );
fileheader.bfSize = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage;
GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS );
HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL );
WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL );
WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL );
WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL );
CloseHandle( file );
delete [] dwpBits;
}
HDC getDC() const { return hdc; }
int getWidth() const { return width; }
int getHeight() const { return height; }
private:
HBITMAP bmp;
HDC hdc;
HPEN pen;
void *pBits;
int width, height;
};
//--------------------------------------------------------------------------------------------------
class forest
{
public:
forest()
{
_bmp.create( MAX_SIDE, MAX_SIDE );
initForest( 0.05f, 0.005f );
}
void initForest( float p, float f )
{
_p = p; _f = f;
seedForest();
}
void mainLoop()
{
display();
simulate();
}
void setHWND( HWND hwnd ) { _hwnd = hwnd; }
private:
float probRand() { return ( float )rand() / 32768.0f; }
void display()
{
HDC bdc = _bmp.getDC();
DWORD clr;
for( int y = 0; y < MAX_SIDE; y++ )
{
for( int x = 0; x < MAX_SIDE; x++ )
{
switch( _forest[x][y] )
{
case FIRE: clr = 255; break;
case TREE: clr = RGB( 0, 255, 0 ); break;
default: clr = 0;
}
SetPixel( bdc, x, y, clr );
}
}
HDC dc = GetDC( _hwnd );
BitBlt( dc, 0, 0, MAX_SIDE, MAX_SIDE, _bmp.getDC(), 0, 0, SRCCOPY );
ReleaseDC( _hwnd, dc );
}
void seedForest()
{
ZeroMemory( _forestT, sizeof( _forestT ) );
ZeroMemory( _forest, sizeof( _forest ) );
for( int y = 0; y < MAX_SIDE; y++ )
for( int x = 0; x < MAX_SIDE; x++ )
if( probRand() < _p ) _forest[x][y] = TREE;
}
bool getNeighbors( int x, int y )
{
int a, b;
for( int yy = -1; yy < 2; yy++ )
for( int xx = -1; xx < 2; xx++ )
{
if( !xx && !yy ) continue;
a = x + xx; b = y + yy;
if( a < MAX_SIDE && b < MAX_SIDE && a > -1 && b > -1 )
if( _forest[a][b] == FIRE ) return true;
}
return false;
}
void simulate()
{
for( int y = 0; y < MAX_SIDE; y++ )
{
for( int x = 0; x < MAX_SIDE; x++ )
{
switch( _forest[x][y] )
{
case FIRE: _forestT[x][y] = NONE; break;
case NONE: if( probRand() < _p ) _forestT[x][y] = TREE; break;
case TREE: if( getNeighbors( x, y ) || probRand() < _f ) _forestT[x][y] = FIRE;
}
}
}
for( int y = 0; y < MAX_SIDE; y++ )
for( int x = 0; x < MAX_SIDE; x++ )
_forest[x][y] = _forestT[x][y];
}
myBitmap _bmp;
HWND _hwnd;
BYTE _forest[MAX_SIDE][MAX_SIDE], _forestT[MAX_SIDE][MAX_SIDE];
float _p, _f;
};
//--------------------------------------------------------------------------------------------------
class wnd
{
public:
int wnd::Run( HINSTANCE hInst )
{
_hInst = hInst;
_hwnd = InitAll();
_ff.setHWND( _hwnd );
_ff.initForest( 0.02f, 0.001f );
ShowWindow( _hwnd, SW_SHOW );
UpdateWindow( _hwnd );
MSG msg;
ZeroMemory( &msg, sizeof( msg ) );
while( msg.message != WM_QUIT )
{
if( PeekMessage( &msg, NULL, 0, 0, PM_REMOVE ) != 0 )
{
TranslateMessage( &msg );
DispatchMessage( &msg );
}
else
{
_ff.mainLoop();
}
}
return UnregisterClass( "_FOREST_FIRE_", _hInst );
}
private:
static int WINAPI wnd::WndProc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam )
{
switch( msg )
{
case WM_DESTROY: PostQuitMessage( 0 ); break;
default:
return DefWindowProc( hWnd, msg, wParam, lParam );
}
return 0;
}
HWND InitAll()
{
WNDCLASSEX wcex;
ZeroMemory( &wcex, sizeof( wcex ) );
wcex.cbSize = sizeof( WNDCLASSEX );
wcex.style = CS_HREDRAW | CS_VREDRAW;
wcex.lpfnWndProc = ( WNDPROC )WndProc;
wcex.hInstance = _hInst;
wcex.hCursor = LoadCursor( NULL, IDC_ARROW );
wcex.hbrBackground = ( HBRUSH )( COLOR_WINDOW + 1 );
wcex.lpszClassName = "_FOREST_FIRE_";
RegisterClassEx( &wcex );
return CreateWindow( "_FOREST_FIRE_", ".: Forest Fire -- PJorente :.", WS_SYSMENU, CW_USEDEFAULT, 0, MAX_SIDE, MAX_SIDE, NULL, NULL, _hInst, NULL );
}
HINSTANCE _hInst;
HWND _hwnd;
forest _ff;
};
//--------------------------------------------------------------------------------------------------
int APIENTRY _tWinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPTSTR lpCmdLine, int nCmdShow )
{
srand( GetTickCount() );
wnd myWnd;
return myWnd.Run( hInstance );
}
//--------------------------------------------------------------------------------------------------

161
Task/Forest-fire/C-sharp/forest-fire.cs Normal file
View file

@ -0,0 +1,161 @@
using System;
using System.Drawing;
using System.Drawing.Drawing2D;
using System.Threading;
using System.Windows.Forms;
namespace ForestFire
{
class Program : Form
{
private static readonly Random rand = new Random();
private Bitmap img;
public Program(int w, int h, int f, int p)
{
Size = new Size(w, h);
StartPosition = FormStartPosition.CenterScreen;
Thread t = new Thread(() => fire(f, p));
t.Start();
FormClosing += (object sender, FormClosingEventArgs e) => { t.Abort(); t = null; };
}
private void fire(int f, int p)
{
int clientWidth = ClientRectangle.Width;
int clientHeight = ClientRectangle.Height;
int cellSize = 10;
img = new Bitmap(clientWidth, clientHeight);
Graphics g = Graphics.FromImage(img);
CellState[,] state = InitializeForestFire(clientWidth, clientHeight);
uint generation = 0;
do
{
g.FillRectangle(Brushes.White, 0, 0, img.Width, img.Height);
state = StepForestFire(state, f, p);
for (int y = 0; y < clientHeight - cellSize; y += cellSize)
{
for (int x = 0; x < clientWidth - cellSize; x += cellSize)
{
switch (state[y, x])
{
case CellState.Empty:
break;
case CellState.Tree:
g.FillRectangle(Brushes.DarkGreen, x, y, cellSize, cellSize);
break;
case CellState.Burning:
g.FillRectangle(Brushes.DarkRed, x, y, cellSize, cellSize);
break;
}
}
}
Thread.Sleep(500);
Invoke((MethodInvoker)Refresh);
} while (generation < uint.MaxValue);
g.Dispose();
}
private CellState[,] InitializeForestFire(int width, int height)
{
// 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 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 numRows = state.GetLength(0);
int numCols = state.GetLength(1);
for (int r = 1; r < numRows - 1; r++)
{
for (int c = 1; c < numCols - 1; c++)
{
/*
* 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[r, c])
{
case CellState.Empty:
if (rand.Next(0, p) == 0)
newState[r, c] = CellState.Tree;
break;
case CellState.Tree:
if (NeighborHasState(state, r, c, CellState.Burning) || rand.Next(0, f) == 0)
newState[r, c] = CellState.Burning;
break;
case CellState.Burning:
newState[r, c] = CellState.Empty;
break;
}
}
}
return newState;
}
private bool NeighborHasState(CellState[,] state, int x, int y, CellState value)
{
// Check each cell within a 1 cell radius for the specified value.
for (int r = -1; r <= 1; r++)
{
for (int c = -1; c <= 1; c++)
{
if (r == 0 && c == 0)
continue;
if (state[x + r, y + c] == value)
return true;
}
}
return false;
}
protected override void OnPaint(PaintEventArgs e)
{
base.OnPaint(e);
e.Graphics.DrawImage(img, 0, 0);
}
[STAThread]
static void Main(string[] args)
{
Application.Run(new Program(w: 500, h: 500, f: 2, p: 5));
}
}
}

248
Task/Forest-fire/C/forest-fire-1.c Normal file
View file

@ -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);
}

66
Task/Forest-fire/C/forest-fire-2.c Normal file
View file

@ -0,0 +1,66 @@
#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <time.h> // For time
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("%s",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);
}

168
Task/Forest-fire/COBOL/forest-fire.cobol Normal file
View file

@ -0,0 +1,168 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. forest-fire.
DATA DIVISION.
WORKING-STORAGE SECTION.
*> Probability represents a fraction of 10000.
*> For instance, IGNITE-PROB means a tree has a 1 in 10000 chance
*> of igniting.
78 IGNITE-PROB VALUE 1.
78 NEW-TREE-PROB VALUE 100.
78 EMPTY-PROB VALUE 3333.
78 AREA-SIZE VALUE 40.
01 sim-table.
03 sim-row OCCURS AREA-SIZE TIMES INDEXED BY row-index.
05 sim-area OCCURS AREA-SIZE TIMES
INDEXED BY col-index.
07 current-status PIC 9.
*> The flags correspond to the colours they will
*> be displayed as.
88 empty VALUE 0. *> Black
88 tree VALUE 2. *> Green
88 burning VALUE 4. *> Red
07 next-status PIC 9.
88 empty VALUE 0.
88 tree VALUE 2.
88 burning VALUE 4.
01 rand-num PIC 9999.
01 next-row PIC 9(4).
01 next-col PIC 9(4).
01 neighbours-row PIC 9(4).
01 neighbours-col PIC 9(4).
PROCEDURE DIVISION.
main-line.
*> Seed RANDOM with current time.
MOVE FUNCTION RANDOM(FUNCTION CURRENT-DATE (9:8)) TO rand-num
PERFORM initialise-table
PERFORM FOREVER
PERFORM show-simulation
PERFORM step-simulation
END-PERFORM
GOBACK
.
initialise-table.
PERFORM VARYING row-index FROM 1 BY 1
UNTIL AREA-SIZE < row-index
AFTER col-index FROM 1 BY 1
UNTIL AREA-SIZE < col-index
PERFORM get-rand-num
IF rand-num <= EMPTY-PROB
SET empty OF current-status (row-index, col-index)
TO TRUE
SET empty OF next-status (row-index, col-index)
TO TRUE
ELSE
SET tree OF current-status (row-index, col-index)
TO TRUE
SET tree OF next-status (row-index, col-index)
TO TRUE
END-IF
END-PERFORM
.
show-simulation.
PERFORM VARYING row-index FROM 1 BY 1
UNTIL AREA-SIZE < row-index
AFTER col-index FROM 1 BY 1
UNTIL AREA-SIZE < col-index
DISPLAY SPACE AT LINE row-index COLUMN col-index
WITH BACKGROUND-COLOR
current-status (row-index, col-index)
END-PERFORM
.
*> Updates the simulation.
step-simulation.
PERFORM VARYING row-index FROM 1 BY 1
UNTIL AREA-SIZE < row-index
AFTER col-index FROM 1 BY 1
UNTIL AREA-SIZE < col-index
EVALUATE TRUE
WHEN empty OF current-status (row-index, col-index)
PERFORM get-rand-num
IF rand-num <= NEW-TREE-PROB
SET tree OF next-status
(row-index, col-index) TO TRUE
END-IF
WHEN tree OF current-status (row-index, col-index)
PERFORM simulate-tree
WHEN burning OF current-status
(row-index, col-index)
SET empty OF next-status (row-index, col-index)
TO TRUE
END-EVALUATE
END-PERFORM
PERFORM update-statuses.
.
*> Updates a tree tile, assuming row-index and col-index are at
*> a tree area.
simulate-tree.
*> Find the row and column of the bottom-right neighbour.
COMPUTE next-row = FUNCTION MIN(row-index + 1, AREA-SIZE)
COMPUTE next-col = FUNCTION MIN(col-index + 1, AREA-SIZE)
COMPUTE neighbours-row = FUNCTION MAX(row-index - 1, 1)
COMPUTE neighbours-col = FUNCTION MAX(col-index - 1, 1)
*> If a neighbour is burning, catch fire.
PERFORM VARYING neighbours-row FROM neighbours-row BY 1
UNTIL next-row < neighbours-row
*> Check if neighbours in a row are on fire.
PERFORM VARYING neighbours-col FROM neighbours-col BY 1
UNTIL next-col < neighbours-col
IF neighbours-row = row-index
AND neighbours-col = col-index
EXIT PERFORM CYCLE
END-IF
IF burning OF current-status
(neighbours-row, neighbours-col)
SET burning OF next-status (row-index, col-index)
TO TRUE
EXIT PARAGRAPH
END-IF
END-PERFORM
*> Move neighbours-col back to starting position
COMPUTE neighbours-col =
FUNCTION MAX(neighbours-col - 3, 1)
END-PERFORM
*> Otherwise, there is a random chance of
*> catching fire.
PERFORM get-rand-num
IF rand-num <= IGNITE-PROB
SET burning OF next-status (row-index, col-index) TO TRUE
END-IF
.
update-statuses.
PERFORM VARYING row-index FROM 1 BY 1
UNTIL AREA-SIZE < row-index
AFTER col-index FROM 1 BY 1
UNTIL AREA-SIZE < col-index
MOVE next-status (row-index, col-index)
TO current-status (row-index, col-index)
END-PERFORM
.
*> Puts a random value between 0 and 9999 in rand-num.
get-rand-num.
COMPUTE rand-num =
FUNCTION MOD(FUNCTION RANDOM * 100000, 10000)
.

124
Task/Forest-fire/Ceylon/forest-fire.ceylon Normal file
View file

@ -0,0 +1,124 @@
import ceylon.random { DefaultRandom }
abstract class Cell() of tree | dirt | burning {}
object tree extends Cell() { string => "A"; }
object dirt extends Cell() { string => " "; }
object burning extends Cell() { string => "#"; }
class Forest(Integer width, Integer height, Float f, Float p) {
value random = DefaultRandom();
function chance(Float probability) => random.nextFloat() < probability;
value sparked => chance(f);
value sprouted => chance(p);
alias Point => Integer[2];
interface Row => {Cell*};
object doubleBufferedGrid satisfies
Correspondence<Point, Cell> &
KeyedCorrespondenceMutator<Point, Cell> {
value grids = [
Array {
for (j in 0:height)
Array {
for (i in 0:width)
chance(0.5) then tree else dirt
}
},
Array {
for (j in 0:height)
Array.ofSize(width, dirt)
}
];
variable value showFirst = true;
value currentState => showFirst then grids.first else grids.last;
value nextState => showFirst then grids.last else grids.first;
shared void swapStates() => showFirst = !showFirst;
shared {Row*} rows => currentState;
shared actual Boolean defines(Point key) =>
let (x = key[0], y = key[1])
0 <= x < width && 0 <= y < height;
shared actual Cell? get(Point key) =>
let (x = key[0], y = key[1])
currentState.get(y)?.get(x);
shared actual void put(Point key, Cell cell) {
value [x, y] = key;
nextState.get(y)?.set(x, cell);
}
}
variable value evolutions = 0;
shared Integer generation => evolutions + 1;
shared void evolve() {
evolutions++;
function firesNearby(Integer x, Integer y) => {
for (j in y - 1 : 3)
for (i in x - 1 : 3)
doubleBufferedGrid[[i, j]]
}.coalesced.any(burning.equals);
for(j->row in doubleBufferedGrid.rows.indexed) {
for(i->cell in row.indexed) {
switch (cell)
case (burning) {
doubleBufferedGrid[[i, j]] = dirt;
}
case (dirt) {
doubleBufferedGrid[[i, j]] = sprouted then tree else dirt;
}
case (tree) {
doubleBufferedGrid[[i, j]] =
firesNearby(i, j) || sparked
then burning else tree;
}
}
}
doubleBufferedGrid.swapStates();
}
shared void display() {
void drawLine() => print("-".repeat(width + 2));
drawLine();
for (row in doubleBufferedGrid.rows) {
process.write("|");
for (cell in row) {
process.write(cell.string);
}
print("|");
}
drawLine();
}
}
shared void run() {
value forest = Forest(78, 38, 0.02, 0.03);
while (true) {
forest.display();
print("Generation ``forest.generation``");
print("Press enter for next generation or q and then enter to quit");
value input = process.readLine();
if (exists input, input.trimmed.lowercased == "q") {
return;
}
forest.evolve();
}
}

77
Task/Forest-fire/Clojure/forest-fire.clj Normal file
View file

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

73
Task/Forest-fire/Common-Lisp/forest-fire-1.lisp Normal file
View file

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

74
Task/Forest-fire/Common-Lisp/forest-fire-2.lisp Normal file
View file

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

54
Task/Forest-fire/D/forest-fire-1.d Normal file
View file

@ -0,0 +1,54 @@
import std.stdio, std.random, std.string, std.algorithm;
enum treeProb = 0.55; // Original tree probability.
enum fProb = 0.01; // Auto combustion probability.
enum cProb = 0.01; // Tree creation probability.
enum Cell : char { empty=' ', tree='T', fire='#' }
alias World = Cell[][];
bool hasBurningNeighbours(in World world, in ulong r, in ulong c)
pure nothrow @safe @nogc {
foreach (immutable rowShift; -1 .. 2)
foreach (immutable 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) /*nothrow*/ @safe /*@nogc*/ {
foreach (r, row; world)
foreach (c, elem; row)
final switch (elem) with (Cell) {
case empty:
nextWorld[r][c]= (uniform01 < cProb) ? tree : empty;
break;
case tree:
if (world.hasBurningNeighbours(r, c))
nextWorld[r][c] = fire;
else
nextWorld[r][c] = (uniform01 < fProb) ? fire : tree;
break;
case fire:
nextWorld[r][c] = empty;
break;
}
}
void main() @safe {
auto world = new World(8, 65);
foreach (row; world)
foreach (ref el; row)
el = (uniform01 < treeProb) ? Cell.tree : Cell.empty;
auto nextWorld = new World(world.length, world[0].length);
foreach (immutable i; 0 .. 4) {
nextState(world, nextWorld);
writefln("%(%(%c%)\n%)\n", nextWorld);
world.swap(nextWorld);
}
}

68
Task/Forest-fire/D/forest-fire-2.d Normal file
View file

@ -0,0 +1,68 @@
import std.stdio, std.random, std.algorithm, std.typetuple,
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.
enum worldSide = 600;
enum Cell : ubyte { empty, tree, burning }
alias World = Cell[worldSide][];
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) {
immutable nr = world.length;
immutable nc = world[0].length;
foreach (immutable r, const row; world)
foreach (immutable c, immutable elem; row)
START: final switch (elem) with (Cell) {
case empty:
img.putPixel(c, r, white);
nextWorld[r][c] = rnd.uniform01 < P_PROB ? tree : empty;
break;
case tree:
img.putPixel(c, r, green);
foreach (immutable rowShift; TypeTuple!(-1, 0, 1))
foreach (immutable colShift; TypeTuple!(-1, 0, 1))
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;
break START;
}
nextWorld[r][c]= rnd.uniform01 < F_PROB ? burning : tree;
break;
case burning:
img.putPixel(c, r, red);
nextWorld[r][c] = empty;
break;
}
swap(world, nextWorld);
}
void main() {
auto rnd = Xorshift(1);
auto world = new World(worldSide);
foreach (ref row; world)
foreach (ref el; row)
el = rnd.uniform01 < TREE_PROB ? Cell.tree : Cell.empty;
auto nextWorld = new World(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);
});
}

69
Task/Forest-fire/EasyLang/forest-fire.easy Normal file
View file

@ -0,0 +1,69 @@
p_fire = 0.00002
p_tree = 0.002
#
len f[] 102 * 102
len p[] len f[]
background 100
clear
for r = 0 to 99
for c = 0 to 99
i = r * 102 + c + 104
if randomf < 0.5
f[i] = 1
.
.
.
timer 0
#
subr show
for r = 0 to 99
for c = 0 to 99
i = r * 102 + c + 104
h = f[i]
if h <> p[i]
move c + 0.5 r + 0.5
if h = 0
color 100
circle 0.6
elif h = 1
color 151
circle 0.5
else
color 9 * 100 + (18 - 2 * h) * 10
circle 0.5
.
.
.
.
.
subr update
swap f[] p[]
for r = 0 to 99
for c = 0 to 99
i = r * 102 + c + 104
if p[i] = 0
f[i] = 0
if randomf < p_tree
f[i] = 1
.
elif p[i] = 1
f[i] = 1
s = p[i - 103] + p[i - 102] + p[i - 101]
s += p[i - 1] + p[i + 1]
s += p[i + 101] + p[i + 102] + p[i + 103]
if s >= 9 or randomf < p_fire
f[i] = 9
.
elif p[i] = 4
f[i] = 0
else
f[i] = p[i] - 1
.
.
.
.
on timer
call show
call update
timer 0.2
.

97
Task/Forest-fire/Emacs-Lisp/forest-fire-1.l Normal file
View file

@ -0,0 +1,97 @@
#!/usr/bin/env emacs -script
;; -*- lexical-binding: t -*-
;; run: ./forest-fire forest-fire.config
(require 'cl-lib)
;; (setq debug-on-error t)
(defmacro swap (a b)
`(setq ,b (prog1 ,a (setq ,a ,b))))
(defconst burning ?B)
(defconst tree ?t)
(cl-defstruct world rows cols data)
(defun new-world (rows cols)
;; When allocating the vector add padding so the border will always be empty.
(make-world :rows rows :cols cols :data (make-vector (* (1+ rows) (1+ cols)) nil)))
(defmacro world--rows (w)
`(1+ (world-rows ,w)))
(defmacro world--cols (w)
`(1+ (world-cols ,w)))
(defmacro world-pt (w r c)
`(+ (* (mod ,r (world--rows ,w)) (world--cols ,w))
(mod ,c (world--cols ,w))))
(defmacro world-ref (w r c)
`(aref (world-data ,w) (world-pt ,w ,r ,c)))
(defun print-world (world)
(dotimes (r (world-rows world))
(dotimes (c (world-cols world))
(let ((cell (world-ref world r c)))
(princ (format "%c" (if (not (null cell))
cell
?.)))))
(terpri)))
(defun random-probability ()
(/ (float (random 1000000)) 1000000))
(defun initialize-world (world p)
(dotimes (r (world-rows world))
(dotimes (c (world-cols world))
(setf (world-ref world r c) (if (<= (random-probability) p) tree nil)))))
(defun neighbors-burning (world row col)
(let ((n 0))
(dolist (offset '((1 . 1) (1 . 0) (1 . -1) (0 . 1) (0 . -1) (-1 . 1) (-1 . 0) (-1 . -1)))
(when (eq (world-ref world (+ row (car offset)) (+ col (cdr offset))) burning)
(setq n (1+ n))))
(> n 0)))
(defun advance (old new p f)
(dotimes (r (world-rows old))
(dotimes (c (world-cols old))
(cond
((eq (world-ref old r c) burning)
(setf (world-ref new r c) nil))
((null (world-ref old r c))
(setf (world-ref new r c) (if (<= (random-probability) p) tree nil)))
((eq (world-ref old r c) tree)
(setf (world-ref new r c) (if (or (neighbors-burning old r c)
(<= (random-probability) f))
burning
tree)))))))
(defun read-config (file-name)
(with-temp-buffer
(insert-file-contents-literally file-name)
(read (current-buffer))))
(defun get-config (key config)
(let ((val (assoc key config)))
(if (null val)
(error (format "missing value for %s" key))
(cdr val))))
(defun simulate-forest (file-name)
(let* ((config (read-config file-name))
(rows (get-config 'rows config))
(cols (get-config 'cols config))
(skip (get-config 'skip config))
(a (new-world rows cols))
(b (new-world rows cols)))
(initialize-world a (get-config 'tree config))
(dotimes (time (get-config 'time config))
(when (or (and (> skip 0) (= (mod time skip) 0))
(<= skip 0))
(princ (format "* time %d\n" time))
(print-world a))
(advance a b (get-config 'p config) (get-config 'f config))
(swap a b))))
(simulate-forest (elt command-line-args-left 0))

7
Task/Forest-fire/Emacs-Lisp/forest-fire-2.l Normal file
View file

@ -0,0 +1,7 @@
((rows . 10)
(cols . 45)
(time . 100)
(skip . 10)
(f . 0.001) ;; probability tree ignites
(p . 0.01) ;; probability empty space fills with a tree
(tree . 0.5)) ;; initial probability of tree in a new world

72
Task/Forest-fire/Erlang/forest-fire.erl Normal file
View file

@ -0,0 +1,72 @@
-module( forest_fire ).
-export( [task/0] ).
-record( state, {neighbours=[], position, probability_burn, probability_grow, tree} ).
task() ->
erlang:spawn( fun() ->
Pid_positions = forest_create( 5, 5, 0.5, 0.3, 0.2 ),
Pids = [X || {X, _} <- Pid_positions],
[X ! {tree_pid_positions, Pid_positions} || X <- Pids],
Start = forest_status( Pids ),
Histories = [Start | [forest_step( Pids ) || _X <- lists:seq(1, 2)]],
[io:fwrite("~p~n~n", [X]) || X <- Histories]
end ).
forest_create( X_max, Y_max, Init, Grow, Burn ) ->
[{tree_create(tree_init(Init, random:uniform()), X, Y, Grow, Burn), {X,Y}} || X <- lists:seq(1, X_max), Y<- lists:seq(1, Y_ma\
x)].
forest_status( Pids ) ->
[X ! {status_request, erlang:self()} || X <- Pids],
[receive {status, Tree, Position, X} -> {Tree, Position} end || X <- Pids].
forest_step( Pids ) ->
[X ! {step} || X <- Pids],
forest_status( Pids ).
is_neighbour({X, Y}, {X, Y} ) -> false; % Myself
is_neighbour({Xn, Yn}, {X, Y} ) when abs(Xn - X) =< 1, abs(Yn - Y) =< 1 -> true;
is_neighbour( _Position_neighbour, _Position ) -> false.
loop( State ) ->
receive
{tree_pid_positions, Pid_positions} ->
loop( loop_neighbour(Pid_positions, State) );
{step} ->
[X ! {tree, State#state.tree, erlang:self()} || X <- State#state.neighbours],
loop( loop_step(State) );
{status_request, Pid} ->
Pid ! {status, State#state.tree, State#state.position, erlang:self()},
loop( State )
end.
loop_neighbour( Pid_positions, State ) ->
My_position = State#state.position,
State#state{neighbours=[Pid || {Pid, Position} <- Pid_positions, is_neighbour( Position, My_position)]}.
loop_step( State ) ->
Is_burning = lists:any( fun loop_step_burning/1, [loop_step_receive(X) || X <- State#state.neighbours] ),
Tree = loop_step_next( Is_burning, random:uniform(), State ),
State#state{tree=Tree}.
loop_step_burning( Tree ) -> Tree =:= burning.
loop_step_next( _Is_burning, Probablility, #state{tree=empty, probability_grow=Grow} ) when Grow > Probablility -> tree;
loop_step_next( _Is_burning, _Probablility, #state{tree=empty} ) -> empty;
loop_step_next( _Is_burning, _Probablility, #state{tree=burning} ) -> empty;
loop_step_next( true, _Probablility, #state{tree=tree} ) -> burning;
loop_step_next( false, Probablility, #state{tree=tree, probability_burn=Burn} ) when Burn > Probablility -> burning;
loop_step_next( false, _Probablility, #state{tree=tree} ) -> tree.
loop_step_receive( Pid ) -> receive {tree, Tree, Pid} -> Tree end.
tree_create( Tree, X, Y, Grow, Burn ) ->
State = #state{position={X, Y}, probability_burn=Burn, probability_grow=Grow, tree=Tree},
erlang:spawn_link( fun() -> random:seed( X, Y, 0 ), loop( State ) end ).
tree_init( Tree_probalility, Random ) when Tree_probalility > Random -> tree;
tree_init( _Tree_probalility, _Random ) -> empty.

90
Task/Forest-fire/F-Sharp/forest-fire.fs Normal file
View file

@ -0,0 +1,90 @@
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
#if INTERACTIVE
ForestFire.main [|""|]
#else
[<System.STAThread>]
[<EntryPoint>]
let main args = ForestFire.main args
#endif

85
Task/Forest-fire/Factor/forest-fire.factor Normal file
View file

@ -0,0 +1,85 @@
USING: combinators grouping kernel literals math math.matrices
math.vectors prettyprint random raylib.ffi sequences ;
IN: rosetta-code.forest-fire
! The following private vocab builds up to a useful combinator,
! matrix-map-neighbors, which takes a matrix, a quotation, and
! inside the quotation makes available each element of the
! matrix as well as its neighbors, mapping the result of the
! quotation to a new matrix.
<PRIVATE
CONSTANT: neighbors {
{ -1 -1 } { -1 0 } { -1 1 }
{ 0 -1 } { 0 1 }
{ 1 -1 } { 1 0 } { 1 1 }
}
: ?i,j ( i j matrix -- elt/f ) swapd ?nth ?nth ;
: ?i,jths ( seq matrix -- newseq )
[ [ first2 ] dip ?i,j ] curry map ;
: neighbor-coords ( loc -- seq )
[ neighbors ] dip [ v+ ] curry map ;
: get-neighbors ( loc matrix -- seq )
[ neighbor-coords ] dip ?i,jths ;
: matrix>neighbors ( matrix -- seq )
dup dim matrix-coordinates concat
[ swap get-neighbors sift ] with map ;
: matrix-map-neighbors ( ... matrix quot: ( ... neighbors elt -- ... newelt ) -- ... newmatrix )
[ [ dim first ] [ matrix>neighbors ] [ concat ] tri ] dip
2map swap group ; inline
PRIVATE>
! ##### Simulation code #####
! In our forest,
! 0 = empty
! 1 = tree
! 2 = fire
CONSTANT: ignite-probability 1/12000
CONSTANT: grow-probability 1/100
: make-forest ( m n probability -- matrix )
[ random-unit > 1 0 ? ] curry make-matrix ;
: ?ignite ( -- 1/2 ) ignite-probability random-unit > 2 1 ? ;
: ?grow ( -- 0/1 ) grow-probability random-unit > 1 0 ? ;
: next-plot ( neighbors elt -- n )
{
{ [ dup 2 = ] [ 2drop 0 ] }
{ [ 2dup [ [ 2 = ] any? ] [ 1 = ] bi* and ] [ 2drop 2 ] }
{ [ 1 = ] [ drop ?ignite ] }
[ drop ?grow ]
} cond ;
: next-forest ( forest -- newforest )
[ next-plot ] matrix-map-neighbors ;
! ##### Display code #####
CONSTANT: colors ${ GRAY GREEN RED }
: draw-forest ( matrix -- )
dup dim matrix-coordinates [ concat ] bi@ swap [
[ first2 [ 5 * ] bi@ 5 5 ] dip colors nth draw-rectangle
] 2each ;
500 500 "Forest Fire" init-window 100 100 1/2 make-forest
60 set-target-fps
[ window-should-close ] [
begin-drawing
BLACK clear-background dup draw-forest
end-drawing
next-forest
] until drop close-window

64
Task/Forest-fire/Forth/forest-fire.fth Normal file
View file

@ -0,0 +1,64 @@
30 CONSTANT WIDTH
30 CONSTANT HEIGHT
WIDTH HEIGHT * CONSTANT SIZE
1 VALUE SEED
: (RAND) ( -- u) \ xorshift generator
SEED DUP 13 LSHIFT XOR
DUP 17 RSHIFT XOR
DUP 5 LSHIFT XOR
DUP TO SEED ;
10000 CONSTANT RANGE
100 CONSTANT GROW
1 CONSTANT BURN
: RAND ( -- u) (RAND) RANGE MOD ;
\ Create buffers for world state
CREATE A SIZE ALLOT A SIZE ERASE
CREATE B SIZE ALLOT B SIZE ERASE
0 CONSTANT NONE 1 CONSTANT TREE 2 CONSTANT FIRE
: NEARBY-FIRE? ( addr u -- t|f)
2 -1 DO
2 -1 DO
J WIDTH * I + OVER + \ calculate an offset
DUP 0> OVER SIZE < AND IF
>R OVER R> + C@ \ fetch state of the offset cell
FIRE = IF UNLOOP UNLOOP DROP DROP TRUE EXIT THEN
ELSE DROP THEN
LOOP
LOOP DROP DROP FALSE ;
: GROW? RAND GROW <= ; \ spontaneously sprout?
: BURN? RAND BURN <= ; \ spontaneously combust?
: STEP ( prev next --) \ Given state in PREV, put next in NEXT
>R 0 BEGIN DUP SIZE <
WHILE
2DUP + C@ CASE
FIRE OF NONE ENDOF
TREE OF 2DUP NEARBY-FIRE? BURN? OR IF FIRE ELSE TREE THEN ENDOF
NONE OF GROW? IF TREE ELSE NONE THEN ENDOF
ENDCASE
( i next-cell-state) OVER R@ + C! \ commit to next
1+ REPEAT R> DROP DROP DROP ;
: (ESCAPE) 27 EMIT [CHAR] [ EMIT ;
: ESCAPE" POSTPONE (ESCAPE) POSTPONE S" POSTPONE TYPE ; IMMEDIATE
: CLEAR ESCAPE" H" ;
: RETURN ESCAPE" E" ;
: RESET ESCAPE" m" ;
: .FOREST ( addr --) CLEAR
HEIGHT 0 DO
WIDTH 0 DO
DUP C@ CASE
NONE OF SPACE ENDOF
TREE OF ESCAPE" 32m" [CHAR] T EMIT RESET ENDOF
FIRE OF ESCAPE" 31m" [CHAR] # EMIT RESET ENDOF
ENDCASE 1+
LOOP RETURN
LOOP RESET DROP ;
: (GO) ( buffer buffer' -- buffer' buffer)
2DUP STEP \ step the simulation
DUP .FOREST \ print the current state
SWAP ; \ prepare for next iteration
: GO A B BEGIN (GO) AGAIN ;

183
Task/Forest-fire/Fortran/forest-fire-1.f Normal file
View file

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

18
Task/Forest-fire/Fortran/forest-fire-2.f Normal file
View file

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

108
Task/Forest-fire/FreeBASIC/forest-fire.basic Normal file
View file

@ -0,0 +1,108 @@
'[RC] Forest Fire
'written for FreeBASIC
'Program code based on BASIC256 from Rosettacode website
'http://rosettacode.org/wiki/Forest_fire#BASIC256
'06-10-2016 updated/tweaked the code
'compile with fbc -s gui
#Define M 400
#Define N 640
Dim As Double p = 0.003
Dim As Double fire = 0.00003
'Dim As Double number1
Dim As Integer gen, x, y
Dim As String press
'f0() and fn() use memory from the memory pool
Dim As UByte f0(), fn()
ReDim f0(-1 To N +2, -1 To M +2)
ReDim fn(-1 To N +2, -1 To M +2)
Dim As UByte white = 15 'color 15 is white
Dim As UByte yellow = 14 'color 14 is yellow
Dim As UByte black = 0 'color 0 is black
Dim As UByte green = 2 'color 2 is green
Dim As UByte red = 4 'color 4 is red
Screen 18 'Resolution 640x480 with at least 256 colors
Randomize Timer
Locate 28,1
Beep
Print " Welcome to Forest Fire"
Locate 29,1
Print " press any key to start"
Sleep
'Locate 28,1
'Print " Welcome to Forest Fire"
Locate 29,1
Print " "
' 1 tree, 0 empty, 2 fire
Color green ' this is green color for trees
For x = 1 To N
For y = 1 To M
If Rnd < 0.5 Then 'populate original tree density
f0(x,y) = 1
PSet (x,y)
End If
Next y
Next x
Color white
Locate 29,1
Print " Press any key to continue "
Sleep
Locate 29,1
Print " Press 'space bar' to continue/pause, ESC to stop "
Do
press = InKey
ScreenLock
For x = 1 To N
For y = 1 To M
If Not f0(x,y) And Rnd<P Then fn(x,y)=1
If f0(x,y)=2 Then fn(x,y)=0
If f0(x,y)=1 Then
fn(x,y) = 1
If f0(x-1,y-1)=2 OrElse f0(x,y-1)=2 OrElse f0(x+1,y-1)=2 Then fn(x,y)=2
If f0(x-1,y)=2 OrElse f0(x+1,y)=2 OrElse Rnd<fire Then fn(x,y)=2
If f0(x-1,y+1)=2 OrElse f0(x,y+1)=2 OrElse f0(x+1,y+1)=2 Then fn(x,y)=2
End If
'set up color and drawing
'0 empty (black), 1 tree (green), 2 fire (white)
If fn(x,y)=0 Then Color black 'empty
If fn(x,y)=1 Then Color green 'tree
If fn(x,y)=2 Then Color red 'fire
'plot x-1,y-1
PSet (x-1,y-1)
Next y
Next x
'print generation number
gen = gen + 1
Locate 28,1
Color white 'this is white color
Print " Generation number # ";gen
'transfer new generation to current generation
For x = 1 To N
For y = 1 To M
f0(x,y) = fn(x,y)
Next y
Next x
ScreenUnlock
' amount for sleep is in milliseconds, 1 = ignore key press
Sleep 50, 1 ' slow down a little ... goes too fast otherwise
If press = " " Then Sleep : press = InKey
If press = "s" Then Sleep
' return to do loop up top until "esc" key is pressed.
' clicking close windows "X", closes the window immediately
Loop Until press = Chr(27) OrElse press = Chr(255)+"k"
If press = Chr(255) + "k" Then End
Locate 28,1
Color white
Print " You entered ESC - goodbye "
Print " Press any key to exit "
Sleep

138
Task/Forest-fire/GFA-Basic/forest-fire.basic Normal file
View file

@ -0,0 +1,138 @@
width%=80
height%=50
DIM world%(width%+2,height%+2,2)
clock%=0
'
empty%=0 ! some mnemonic codes for the different states
burning%=1
tree%=2
'
f=0.0003
p=0.03
max_clock%=100
'
@open_window
@setup_world
DO
clock%=clock%+1
EXIT IF clock%>max_clock%
@display_world
@update_world
LOOP
@close_window
'
' Setup the world
'
PROCEDURE setup_world
LOCAL i%,j%
'
RANDOMIZE 0
ARRAYFILL world%(),empty%
' with Probability 0.5, create tree in cells
FOR i%=1 TO width%
FOR j%=1 TO height%
IF RND>0.5
world%(i%,j%,0)=tree%
ENDIF
NEXT j%
NEXT i%
'
cur%=0
new%=1
RETURN
'
' Display world on window
'
PROCEDURE display_world
LOCAL size%,i%,j%,offsetx%,offsety%,x%,y%
'
size%=5
offsetx%=10
offsety%=20
'
VSETCOLOR 0,15,15,15 ! colour for empty
VSETCOLOR 1,15,0,0 ! colour for burning
VSETCOLOR 2,0,15,0 ! colour for tree
VSETCOLOR 3,0,0,0 ! colour for text
DEFTEXT 3
PRINT AT(1,1);"Clock: ";clock%
'
FOR i%=1 TO width%
FOR j%=1 TO height%
x%=offsetx%+size%*i%
y%=offsety%+size%*j%
SELECT world%(i%,j%,cur%)
CASE empty%
DEFFILL 0
CASE tree%
DEFFILL 2
CASE burning%
DEFFILL 1
ENDSELECT
PBOX x%,y%,x%+size%,y%+size%
NEXT j%
NEXT i%
RETURN
'
' Check if a neighbour is burning
'
FUNCTION neighbour_burning(i%,j%)
LOCAL x%
'
IF world%(i%,j%-1,cur%)=burning%
RETURN TRUE
ENDIF
IF world%(i%,j%+1,cur%)=burning%
RETURN TRUE
ENDIF
FOR x%=-1 TO 1
IF world%(i%-1,j%+x%,cur%)=burning% OR world%(i%+1,j%+x%,cur%)=burning%
RETURN TRUE
ENDIF
NEXT x%
RETURN FALSE
ENDFUNC
'
' Update the world state
'
PROCEDURE update_world
LOCAL i%,j%
'
FOR i%=1 TO width%
FOR j%=1 TO height%
world%(i%,j%,new%)=world%(i%,j%,cur%)
SELECT world%(i%,j%,cur%)
CASE empty%
IF RND>1-p
world%(i%,j%,new%)=tree%
ENDIF
CASE tree%
IF @neighbour_burning(i%,j%) OR RND>1-f
world%(i%,j%,new%)=burning%
ENDIF
CASE burning%
world%(i%,j%,new%)=empty%
ENDSELECT
NEXT j%
NEXT i%
'
cur%=1-cur%
new%=1-new%
RETURN
'
' open and clear window
'
PROCEDURE open_window
OPENW 1
CLEARW 1
VSETCOLOR 4,8,8,0
DEFFILL 4
PBOX 0,0,500,400
RETURN
'
' close the window after keypress
'
PROCEDURE close_window
~INP(2)
CLOSEW 1
RETURN

84
Task/Forest-fire/Go/forest-fire.go Normal file
View file

@ -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'
}
}
}
}
}

59
Task/Forest-fire/Haskell/forest-fire.hs Normal file
View file

@ -0,0 +1,59 @@
import Control.Monad (replicateM, unless)
import Data.List (tails, transpose)
import System.Random (randomRIO)
data Cell
= Empty
| Tree
| Fire
deriving (Eq)
instance Show Cell where
show Empty = " "
show Tree = "T"
show Fire = "$"
randomCell :: IO Cell
randomCell = fmap ([Empty, Tree] !!) (randomRIO (0, 1) :: IO Int)
randomChance :: IO Double
randomChance = randomRIO (0, 1.0) :: IO Double
rim :: a -> [[a]] -> [[a]]
rim b = fmap (fb b) . (fb =<< rb)
where
fb = (.) <$> (:) <*> (flip (++) . return)
rb = fst . unzip . zip (repeat b) . head
take3x3 :: [[a]] -> [[[a]]]
take3x3 = concatMap (transpose . fmap take3) . take3
where
take3 = init . init . takeWhile (not . null) . fmap (take 3) . tails
list2Mat :: Int -> [a] -> [[a]]
list2Mat n = takeWhile (not . null) . fmap (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
main :: IO ()
main = evolveForest 6 50 3

73
Task/Forest-fire/Icon/forest-fire.icon Normal file
View file

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

21
Task/Forest-fire/J/forest-fire-1.j Normal file
View file

@ -0,0 +1,21 @@
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.
)

20
Task/Forest-fire/J/forest-fire-2.j Normal file
View file

@ -0,0 +1,20 @@
run 2
##### #
# #
### ####
# # # #
##### #
## # #
# #
o## #
##### #
# #
### ####
# # # #
##### #
## # #
o #
o# #

17
Task/Forest-fire/JAMES-II-Rule-based-Cellular-Automata/forest-fire.james Normal file
View file

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

137
Task/Forest-fire/Java/forest-fire.java Normal file
View file

@ -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);
}
}

67
Task/Forest-fire/JavaScript/forest-fire-1.js Normal file
View file

@ -0,0 +1,67 @@
"use strict"
const _ = require('lodash');
const WIDTH_ARGUMENT_POSITION = 2;
const HEIGHT_ARGUMENT_POSITION = 3;
const TREE_PROBABILITY = 0.5;
const NEW_TREE_PROBABILITY = 0.01;
const BURN_PROBABILITY = 0.0001;
const CONSOLE_RED = '\x1b[31m';
const CONSOLE_GREEN = '\x1b[32m';
const CONSOLE_COLOR_CLOSE = '\x1b[91m';
const CONSOLE_CLEAR = '\u001B[2J\u001B[0;0f';
const NEIGHBOURS = [
[-1, -1],
[-1, 0],
[-1, 1],
[ 0, -1],
[ 0, 1],
[ 1, -1],
[ 1, 0],
[ 1, 1]
];
const PRINT_DECODE = {
' ': ' ',
'T': `${CONSOLE_GREEN}T${CONSOLE_COLOR_CLOSE}`,
'B': `${CONSOLE_RED}T${CONSOLE_COLOR_CLOSE}`,
};
const CONDITIONS = {
'T': (forest, y, x) => Math.random() < BURN_PROBABILITY || burningNeighbour(forest, y, x) ? 'B' : 'T',
' ': () => Math.random() < NEW_TREE_PROBABILITY ? 'T' : ' ',
'B': () => ' '
};
const WIDTH = process.argv[WIDTH_ARGUMENT_POSITION] || 20;
const HEIGHT = process.argv[HEIGHT_ARGUMENT_POSITION] || 10;
const update = forest => {
return _.map(forest, (c, ci) => {
return _.map(c, (r, ri) => {
return CONDITIONS[r](forest, ci, ri);
});
});
}
const printForest = forest => {
process.stdout.write(CONSOLE_CLEAR);
_.each(forest, c => {
_.each(c, r => {
process.stdout.write(PRINT_DECODE[r]);
});
process.stdout.write('\n');
})
}
const burningNeighbour = (forest, y, x) => {
return _(NEIGHBOURS)
.map(n => _.isUndefined(forest[y + n[0]]) ? null : forest[y + n[0]][x + n[1]])
.any(_.partial(_.isEqual, 'B'));
};
let forest = _.times(HEIGHT, () => _.times(WIDTH, () => Math.random() < TREE_PROBABILITY ? 'T' : ' '));
setInterval(() => {
forest = update(forest);
printForest(forest)
}, 20);

63
Task/Forest-fire/JavaScript/forest-fire-2.js Normal file
View file

@ -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);

14
Task/Forest-fire/JavaScript/forest-fire-3.js Normal file
View file

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

61
Task/Forest-fire/Julia/forest-fire.julia Normal file
View file

@ -0,0 +1,61 @@
using Printf
@enum State empty tree fire
function evolution(nepoch::Int=100, init::Matrix{State}=fill(tree, 30, 50))
# Single evolution
function evolve!(forest::Matrix{State}; f::Float64=0.12, p::Float64=0.5)
dir = [-1 -1; -1 0; -1 1; 0 -1; 0 1; 1 -1; 1 0; 1 1]
# A tree will burn if at least one neighbor is burning
for i in 1:size(forest, 1), j in 1:size(forest, 2)
for k in 1:size(dir, 1)
if checkbounds(Bool, forest, i + dir[k, 1], j + dir[k, 2]) &&
get(forest, i + dir[k, 1], j + dir[k, 2]) == fire
forest[i, j] = fire
break
end
end
end
for i in LinearIndices(forest)
# A burning cell turns into an empty cell
if forest[i] == fire forest[i] = empty end
# A tree ignites with probability f even if no neighbor is burning
if forest[i] == tree && rand() < f forest[i] = fire end
# An empty space fills with a tree with probability p
if forest[i] == empty && rand() < p forest[i] = tree end
end
end
# Print functions
function printforest(f::Matrix{State})
for i in 1:size(f, 1)
for j in 1:size(f, 2)
print(f[i, j] == empty ? ' ' : f[i, j] == tree ? '🌲' : '🔥')
end
println()
end
end
function printstats(f::Matrix{State})
tot = length(f)
nt = count(x -> x in (tree, fire), f)
nb = count(x -> x == fire, f)
@printf("\n%6i cell(s), %6i tree(s), %6i currently burning (%6.2f%%, %6.2f%%)\n",
tot, nt, nb, nt / tot * 100, nb / nt * 100)
end
# Main
printforest(init)
printstats(init)
for i in 1:nepoch
# println("\33[2J")
evolve!(init)
# printforest(init)
# printstats(init)
# sleep(1)
end
printforest(init)
printstats(init)
end
evolution()

97
Task/Forest-fire/Lua/forest-fire.lua Normal file
View file

@ -0,0 +1,97 @@
-- ForestFire automaton implementation
-- Rules: at each step:
-- 1) a burning tree disappears
-- 2) a non-burning tree starts burning if any of its neighbours is
-- 3) an empty spot may generate a tree with prob P
-- 4) a non-burning tree may ignite with prob F
local socket = require 'socket' -- needed for socket.sleep
local curses = require 'curses'
local p_spawn, p_ignite = 0.005, 0.0002
local naptime = 0.03 -- seconds
local forest_x, forest_y = 60, 30
local forest = (function (x, y)
local wrl = {}
for i = 1, y do
wrl[i] = {}
for j = 1, x do
local rand = math.random()
wrl[i][j] = (rand < 0.5) and 1 or 0
end
end
return wrl
end)(forest_x, forest_y)
math.randomseed(os.time())
forest.step = function (self)
for i = 1, #self do
for j = 1, #self[i] do
if self[i][j] == 0 then
if math.random() < p_spawn then self[i][j] = 1 end
elseif self[i][j] == 1 then
if self:ignite(i, j) or math.random() < p_ignite then self[i][j] = 2 end
elseif self[i][j] == 2 then self[i][j] = 0
else error("Error: forest[" .. i .. "][" .. j .. "] is " .. self[i][j] .. "!")
end
end
end
end
forest.draw = function (self)
for i = 1, #self do
for j = 1, #self[i] do
if self[i][j] == 0 then win:mvaddch(i,j," ")
elseif self[i][j] == 1 then
win:attron(curses.color_pair(1))
win:mvaddch(i,j,"Y")
win:attroff(curses.color_pair(1))
elseif self[i][j] == 2 then
win:attron(curses.color_pair(2))
win:mvaddch(i,j,"#")
win:attroff(curses.color_pair(2))
else error("self[" .. i .. "][" .. j .. "] is " .. self[i][j] .. "!")
end
end
end
end
forest.ignite = function (self, i, j)
for k = i - 1, i + 1 do
if k < 1 or k > #self then goto continue1 end
for l = j - 1, j + 1 do
if l < 1 or
l > #self[i] or
math.abs((k - i) + (l - j)) ~= 1
then
goto continue2
end
if self[k][l] == 2 then return true end
::continue2::
end
::continue1::
end
return false
end
local it = 1
curses.initscr()
curses.start_color()
curses.echo(false)
curses.init_pair(1, curses.COLOR_GREEN, curses.COLOR_BLACK)
curses.init_pair(2, curses.COLOR_RED, curses.COLOR_BLACK)
win = curses.newwin(forest_y + 2, forest_x, 0, 0)
win:clear()
win:mvaddstr(forest_y + 1, 0, "p_spawn = " .. p_spawn .. ", p_ignite = " .. p_ignite)
repeat
forest:draw()
win:move(forest_y, 0)
win:clrtoeol()
win:addstr("Iteration: " .. it .. ", nap = " .. naptime*1000 .. "ms")
win:refresh()
forest:step()
it = it + 1
socket.sleep(naptime)
until false

29
Task/Forest-fire/MATLAB/forest-fire.m Normal file
View file

@ -0,0 +1,29 @@
function forest_fire(f,p,N,M)
% Forest fire
if nargin<4;
M=200;
end
if nargin<3;
N=200;
end
if nargin<2;
p=.03;
end
if nargin<1;
f=p*.0001;
end
% initialize;
F = (rand(M,N) < p)+1; % tree with probability p
S = ones(3); S(2,2)=0; % surrounding
textmap = ' T#';
colormap([.5,.5,.5;0,1,0;1,0,0]);
while(1)
image(F); pause(.1) % uncomment for graphical output
% disp(textmap(F)); pause; % uncomment for textual output
G = ((F==1).*((rand(M,N)<p)+1)); % grow tree
G = G + (F==2) .* ((filter2(S,F==3)>0) + (rand(M,N)<f) + 2); % burn tree if neighbor is burning or by chance f
G = G + (F==3); % empty after burn
F = G;
end;

8
Task/Forest-fire/Mathematica/forest-fire.math Normal file
View file

@ -0,0 +1,8 @@
evolve[nbhd_List, k_] := 0 /; nbhd[[2, 2]] == 2 (*burning->empty*)
evolve[nbhd_List, k_] := 2 /; nbhd[[2, 2]] == 1 && Max@nbhd == 2 (*near_burning&nonempty->burning*)
evolve[nbhd_List, k_] := RandomChoice[{f, 1 - f} -> {2, nbhd[[2, 2]]}] /; nbhd[[2, 2]] == 1 && Max@nbhd < 2 (*spontaneously combusting tree*)
evolve[nbhd_List, k_] := RandomChoice[{p, 1 - p} -> {1, nbhd[[2, 2]]}] /; nbhd[[2, 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]

54
Task/Forest-fire/Nim/forest-fire.nim Normal file
View file

@ -0,0 +1,54 @@
import random, os, sequtils, strutils
randomize()
type State {.pure.} = enum Empty, Tree, Fire
const
Disp: array[State, string] = [" ", "\e[32m/\\\e[m", "\e[07;31m/\\\e[m"]
TreeProb = 0.01
BurnProb = 0.001
proc chance(prob: float): bool {.inline.} = rand(1.0) < prob
# Set the size
var w, h: int
if paramCount() >= 2:
w = paramStr(1).parseInt
h = paramStr(2).parseInt
if w <= 0: w = 30
if h <= 0: h = 30
iterator fields(a = (0, 0), b = (h-1, w-1)): tuple[y, x: int] =
## Iterate over fields in the universe
for y in max(a[0], 0) .. min(b[0], h-1):
for x in max(a[1], 0) .. min(b[1], w-1):
yield (y, x)
# Initialize
var univ, univNew = newSeqWith(h, newSeq[State](w))
while true:
# Show.
stdout.write "\e[H"
for y, x in fields():
stdout.write Disp[univ[y][x]]
if x == 0: stdout.write "\e[E"
stdout.flushFile
# Evolve.
for y, x in fields():
case univ[y][x]
of Fire:
univNew[y][x] = Empty
of Empty:
if chance(TreeProb): univNew[y][x] = Tree
of Tree:
for y1, x1 in fields((y-1, x-1), (y+1, x+1)):
if univ[y1][x1] == Fire:
univNew[y][x] = Fire
break
if chance(BurnProb): univNew[y][x] = Fire
univ = univNew
sleep 200

73
Task/Forest-fire/OCaml/forest-fire.ocaml Normal file
View file

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

52
Task/Forest-fire/Ol/forest-fire.ol Normal file
View file

@ -0,0 +1,52 @@
(import (lib gl))
(import (otus random!))
(define WIDTH 170)
(define HEIGHT 96)
; probabilities
(define p 20)
(define f 1000)
(gl:set-window-title "Drossel and Schwabl 'forest-fire'")
(import (OpenGL version-1-0))
(glShadeModel GL_SMOOTH)
(glClearColor 0.11 0.11 0.11 1)
(glOrtho 0 WIDTH 0 HEIGHT 0 1)
(gl:set-userdata (make-vector (map (lambda (-) (make-vector (map (lambda (-) (rand! 2)) (iota WIDTH)))) (iota HEIGHT))))
(gl:set-renderer (lambda (mouse)
(let ((forest (gl:get-userdata))
(step (make-vector (map (lambda (-) (make-vector (repeat 0 WIDTH))) (iota HEIGHT)))))
(glClear GL_COLOR_BUFFER_BIT)
(glPointSize (/ 854 WIDTH))
(glBegin GL_POINTS)
(for-each (lambda (y)
(for-each (lambda (x)
(case (ref (ref forest y) x)
(0 ; An empty space fills with a tree with probability "p"
(if (zero? (rand! p))
(set-ref! (ref step y) x 1)))
(1
(glColor3f 0.2 0.7 0.2)
(glVertex2f x y)
; A tree will burn if at least one neighbor is burning
; A tree ignites with probability "f" even if no neighbor is burning
(if (or (eq? (ref (ref forest (- y 1)) (- x 1)) 2) (eq? (ref (ref forest (- y 1)) x) 2) (eq? (ref (ref forest (- y 1)) (+ x 1)) 2)
(eq? (ref (ref forest y ) (- x 1)) 2) (eq? (ref (ref forest y ) (+ x 1)) 2)
(eq? (ref (ref forest (+ y 1)) (- x 1)) 2) (eq? (ref (ref forest (+ y 1)) x) 2) (eq? (ref (ref forest (+ y 1)) (+ x 1)) 2)
(zero? (rand! f)))
(set-ref! (ref step y) x 2)
(set-ref! (ref step y) x 1)))
(2
(glColor3f 0.7 0.7 0.1)
(glVertex2f x y))
; A burning cell turns into an empty cell
(set-ref! (ref step y) x 0)))
(iota WIDTH)))
(iota HEIGHT))
(glEnd)
(gl:set-userdata step))))

25
Task/Forest-fire/PARI-GP/forest-fire.parigp Normal file
View file

@ -0,0 +1,25 @@
step(M,p,f)={
my(m=matsize(M)[1],n=matsize(M)[2]);
matrix(m,n,i,j,
if(M[i,j]=="*",
" "
,
if(M[i,j]=="t",
my(nbr="t");
for(x=max(1,i-1),min(m,i+1),
for(y=max(1,j-1),min(n,j+1),
if(M[x,y]=="*",nbr="*";break(2))
)
);
if(random(1.)<f,"*",nbr)
,
if(random(1.)<p,"t"," ")
)
)
)
};
burn(n,p,f)={
my(M=matrix(n,n,i,j,if(random(2)," ","t")),N);
while(1,print(M=step(M,p,f)))
};
burn(5,.1,.03)

112
Task/Forest-fire/PHP/forest-fire.php Normal file
View file

@ -0,0 +1,112 @@
<?php
define('WIDTH', 10);
define('HEIGHT', 10);
define('GEN_CNT', 10);
define('PAUSE', 250000);
define('TREE_PROB', 50);
define('GROW_PROB', 5);
define('FIRE_PROB', 1);
define('BARE', ' ');
define('TREE', 'A');
define('BURN', '/');
$forest = makeNewForest();
for ($i = 0; $i < GEN_CNT; $i++) {
displayForest($forest, $i);
$forest = getNextForest($forest);
}
displayForest($forest, 'done');
exit;
function makeNewForest() {
return mapForest([
'func' => function(){
return isProb(TREE_PROB) ? TREE : BARE;
}
]);
}
function displayForest($forest, $generationNum) {
system("clear");
echo PHP_EOL . "Generation: $generationNum" . PHP_EOL;
mapForest(['forest' => $forest, 'func' => function($f, $x, $y){
echo $f[$y][$x] . ($x == WIDTH - 1 ? PHP_EOL : '');
}
]);
echo PHP_EOL;
usleep(PAUSE);
}
function getNextForest($oldForest) {
return mapForest(['forest' => $oldForest, 'func' => function($f, $x, $y){
switch ($f[$y][$x]) {
case BURN:
return BARE;
case BARE:
return isProb(GROW_PROB) ? TREE : BARE;
case TREE:
$caughtFire = isProb(FIRE_PROB);
$ablaze = $caughtFire ? true : getNumBurningNeighbors($f, $x, $y) > 0;
return $ablaze ? BURN : TREE;
}
}
]);
}
function getNumBurningNeighbors($forest, $x, $y) {
$burningNeighbors = mapForest([
'forest' => $forest,
'x1' => $x - 1, 'x2' => $x + 2,
'y1' => $y - 1, 'y2' => $y + 2,
'default' => 0,
'func' => function($f, $x, $y){
return $f[$y][$x] == BURN ? 1 : 0;
}
]);
$numOnFire = 0;
foreach ($burningNeighbors as $row) {
$numOnFire += array_sum($row);
}
return $numOnFire;
}
function mapForest($params) {
$p = array_merge([
'forest' => [],
'func' => function(){echo "default\n";},
'x1' => 0,
'x2' => WIDTH,
'y1' => 0,
'y2' => HEIGHT,
'default' => BARE
], $params);
$newForest = [];
for ($y = $p['y1']; $y < $p['y2']; $y++) {
$newRow = [];
for ($x = $p['x1']; $x < $p['x2']; $x++) {
$inBounds = ($x >= 0 && $x < WIDTH && $y >= 0 && $y < HEIGHT);
$newRow[] = ($inBounds ? $p['func']($p['forest'], $x, $y) : $p['default']);
}
$newForest[] = $newRow;
}
return $newForest;
}
function isProb($prob) {
return rand(0, 100) < $prob;
}

63
Task/Forest-fire/Perl/forest-fire-1.pl Normal file
View file

@ -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);

22
Task/Forest-fire/Perl/forest-fire-2.pl Normal file
View file

@ -0,0 +1,22 @@
use strict;
use warnings;
use feature 'bitwise';
my $p = 0.01; # probability of empty -> tree
my $f = 0.0001; # probability of tree -> burning
my ($high, $wide) = split ' ', qx(stty size); # 135 174 tiny font in xterm
my $mask = 0 x $wide . (0 . 7 x ($wide - 2) . 0) x ($high - 5) . 0 x $wide;
my $forest = $mask =~ s/7/ rand() < 0.5 ? 2 : 1 /ger;
for( 1 .. 1e3 )
{ # 0=border 1=empty 2=tree 3=burning
print "\e[H", $forest =~ tr/0123/ ^#/r, "\n"; # ^=tree #=burning tree
my $n = $forest =~ tr/123/004/r; # 4=a neighbor is burning
$forest |.= 0 x $_ . $n |. substr $n, $_ for 1, $wide - 1 .. $wide + 1;
$forest &.= $mask; # clear borders and trim
$forest =~ tr/1-7/et10e31/; # step to next generation
$forest =~ s/t/ rand() < $f ? 3 : 2 /ge; # rule 3) tree cell to burning
$forest =~ s/e/ rand() < $p ? 2 : 1 /ge; # rule 4) empty cell to tree
select undef, undef, undef, 0.1; # comment out for full speed
}

110
Task/Forest-fire/Phix/forest-fire.phix Normal file
View file

@ -0,0 +1,110 @@
(phixonline)-->
<span style="color: #000080;font-style:italic;">--
-- demo\rosetta\Forest_fire.exw
-- ============================
--
-- 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
--
-- Draws bigger "pixels" when it feels the need to.
--</span>
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">include</span> <span style="color: #000000;">pGUI</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
<span style="color: #004080;">Ihandle</span> <span style="color: #000000;">dlg</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">canvas</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">hTimer</span>
<span style="color: #004080;">cdCanvas</span> <span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cdcanvas</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">TITLE</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"Forest Fire"</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">P</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0.03</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- probability of new tree growing</span>
<span style="color: #000000;">F</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0.00003</span> <span style="color: #000080;font-style:italic;">-- probability of new fire starting</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">EMPTY</span><span style="color: #0000FF;">,</span><span style="color: #000000;">TREE</span><span style="color: #0000FF;">,</span><span style="color: #000000;">FIRE</span> <span style="color: #000080;font-style:italic;">-- (1,2,3)</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">colours</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #004600;">CD_BLACK</span><span style="color: #0000FF;">,</span><span style="color: #004600;">CD_GREEN</span><span style="color: #0000FF;">,</span><span style="color: #004600;">CD_YELLOW</span><span style="color: #0000FF;">}</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">f</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span> <span style="color: #000080;font-style:italic;">-- the forest</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">randomf</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">return</span> <span style="color: #7060A8;">rand</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1000000</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">1000000</span> <span style="color: #000080;font-style:italic;">-- returns 0.000001..1.000000</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">redraw_cb</span><span style="color: #0000FF;">(</span><span style="color: #004080;">Ihandle</span> <span style="color: #000080;font-style:italic;">/*ih*/</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">width</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">height</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">IupGetIntInt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">canvas</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"DRAWSIZE"</span><span style="color: #0000FF;">),</span>
<span style="color: #000080;font-style:italic;">-- limit to 40K cells, otherwise it gets too slow.
-- n here is the cell size in pixels (min of 1x1)
-- Note you still get some setTimeout violations
-- in js even with the limit reduced to just 5K..</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">ceil</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">sqrt</span><span style="color: #0000FF;">(</span><span style="color: #000000;">width</span><span style="color: #0000FF;">*</span><span style="color: #000000;">height</span><span style="color: #0000FF;">/</span><span style="color: #000000;">40000</span><span style="color: #0000FF;">)),</span>
<span style="color: #000000;">w</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">width</span><span style="color: #0000FF;">/</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #000080;font-style:italic;">-- (see cx below)</span>
<span style="color: #000000;">h</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">height</span><span style="color: #0000FF;">/</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">2</span>
<span style="color: #7060A8;">cdCanvasActivate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">)!=</span><span style="color: #000000;">w</span>
<span style="color: #008080;">or</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])!=</span><span style="color: #000000;">h</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">f</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_rand</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #000000;">h</span><span style="color: #0000FF;">),</span><span style="color: #000000;">w</span><span style="color: #0000FF;">))</span> <span style="color: #000080;font-style:italic;">-- (EMPTY or TREE)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">fn</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">f</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">--
-- There is a "dead border" of 1 cell all around the edge of f (& fn) which
-- we never display or update. If we have got this right/an exact fit, then
-- w*n should be exactly 2n too wide, whereas in the worst case there is an
-- (2n-1) pixel border, which we split between left and right, ditto cy.
--</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">cx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">floor</span><span style="color: #0000FF;">((</span><span style="color: #000000;">width</span><span style="color: #0000FF;">-</span><span style="color: #000000;">w</span><span style="color: #0000FF;">*</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">w</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">cy</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">+</span><span style="color: #7060A8;">floor</span><span style="color: #0000FF;">((</span><span style="color: #000000;">height</span><span style="color: #0000FF;">-</span><span style="color: #000000;">h</span><span style="color: #0000FF;">*</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">y</span><span style="color: #0000FF;">=</span><span style="color: #000000;">2</span> <span style="color: #008080;">to</span> <span style="color: #000000;">h</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">fnxy</span>
<span style="color: #008080;">switch</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">EMPTY</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">fnxy</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">EMPTY</span><span style="color: #0000FF;">+(</span><span style="color: #000000;">randomf</span><span style="color: #0000FF;">()<</span><span style="color: #000000;">P</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (EMPTY or TREE)</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">TREE</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">fnxy</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">TREE</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span> <span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span> <span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span>
<span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span> <span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span> <span style="color: #008080;">or</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">randomf</span><span style="color: #0000FF;">()<</span><span style="color: #000000;">F</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span> <span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span>
<span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span> <span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span> <span style="color: #008080;">or</span> <span style="color: #000000;">f</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">FIRE</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">fnxy</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">FIRE</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">case</span> <span style="color: #000000;">FIRE</span><span style="color: #0000FF;">:</span>
<span style="color: #000000;">fnxy</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">EMPTY</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">switch</span>
<span style="color: #000000;">fn</span><span style="color: #0000FF;">[</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">fnxy</span>
<span style="color: #7060A8;">cdCanvasSetForeground</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span><span style="color: #000000;">colours</span><span style="color: #0000FF;">[</span><span style="color: #000000;">fnxy</span><span style="color: #0000FF;">])</span>
<span style="color: #7060A8;">cdCanvasBox</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cx</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cx</span><span style="color: #0000FF;">+</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cy</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cy</span><span style="color: #0000FF;">+</span><span style="color: #000000;">n</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">cy</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">cx</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">n</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">f</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">fn</span>
<span style="color: #7060A8;">cdCanvasFlush</span><span style="color: #0000FF;">(</span><span style="color: #000000;">cddbuffer</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">IUP_DEFAULT</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">map_cb</span><span style="color: #0000FF;">(</span><span style="color: #004080;">Ihandle</span> <span style="color: #000000;">ih</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">cdcanvas</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">cdCreateCanvas</span><span style="color: #0000FF;">(</span><span style="color: #004600;">CD_IUP</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">ih</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">cddbuffer</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">cdCreateCanvas</span><span style="color: #0000FF;">(</span><span style="color: #004600;">CD_DBUFFER</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">cdcanvas</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">IUP_DEFAULT</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">timer_cb</span><span style="color: #0000FF;">(</span><span style="color: #004080;">Ihandle</span> <span style="color: #000080;font-style:italic;">/*ih*/</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">IupUpdate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">canvas</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">return</span> <span style="color: #004600;">IUP_IGNORE</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">main</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">IupOpen</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">canvas</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">IupCanvas</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"RASTERSIZE=225x100"</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">IupSetCallbacks</span><span style="color: #0000FF;">(</span><span style="color: #000000;">canvas</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"MAP_CB"</span><span style="color: #0000FF;">,</span> <span style="color: #7060A8;">Icallback</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"map_cb"</span><span style="color: #0000FF;">),</span>
<span style="color: #008000;">"ACTION"</span><span style="color: #0000FF;">,</span> <span style="color: #7060A8;">Icallback</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"redraw_cb"</span><span style="color: #0000FF;">)})</span>
<span style="color: #000000;">dlg</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">IupDialog</span><span style="color: #0000FF;">(</span><span style="color: #000000;">canvas</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">`TITLE="%s", MINSIZE=245x140`</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">TITLE</span><span style="color: #0000FF;">})</span>
<span style="color: #000080;font-style:italic;">-- (above MINSIZE prevents the title from getting squished)</span>
<span style="color: #7060A8;">IupShow</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dlg</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">hTimer</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">IupTimer</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">Icallback</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"timer_cb"</span><span style="color: #0000FF;">),</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- (10 fps)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">JS</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">IupMainLoop</span><span style="color: #0000FF;">()</span>
<span style="color: #7060A8;">IupClose</span><span style="color: #0000FF;">()</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">main</span><span style="color: #0000FF;">()</span>
<!--

43
Task/Forest-fire/PicoLisp/forest-fire.l Normal file
View file

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

64
Task/Forest-fire/PostScript/forest-fire.ps Normal file
View file

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

167
Task/Forest-fire/PureBasic/forest-fire.basic Normal file
View file

@ -0,0 +1,167 @@
; 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
#f = 1e-6
#p = 1e-2
#SeedATree = 0.005
#Width = 400
#Height = 400
; Setting up colours
#Fire = $080CF7
#BackGround = $BFD5D3
#YoungTree = $00E300
#NormalTree = $00AC00
#MatureTree = $009500
#OldTree = $007600
#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.
#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

83
Task/Forest-fire/Python/forest-fire.py Normal file
View file

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

65
Task/Forest-fire/REALbasic/forest-fire-1.basic Normal file
View file

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

11
Task/Forest-fire/REALbasic/forest-fire-2.basic Normal file
View file

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

50
Task/Forest-fire/REXX/forest-fire.rexx Normal file
View file

@ -0,0 +1,50 @@
/*REXX program grows and displays a forest (with growth and fires caused by lightning).*/
parse value scrSize() with sd sw . /*the size of the terminal display. */
parse arg generations birth lightning rSeed . /*obtain the optional arguments from CL*/
if datatype(rSeed,'W') then call random ,,rSeed /*do we want RANDOM BIF repeatability?*/
generations = p(generations 100) /*maybe use one hundred generations. */
birth = p(strip(birth , ,'%') 50 ) *100 /*calculate the percentage for births. */
lightning = p(strip(lightning, ,'%') 1/8) *100 /* " " " " lightning*/
bare! = ' ' /*the glyph used to show a bare place. */
fire! = '▒' /*glyph is close to a conflagration. */
tree! = '↑' /*this is an up─arrow [↑] glyph (tree).*/
rows = max(12, sd-2) /*shrink the usable screen rows by two.*/
cols = max(79, sw-1) /* " " " " cols " one.*/
every = 999999999 /*shows a snapshot every Nth generation*/
field = min(100000, rows*cols) /*the size of the forest area (field). */
$.=bare! /*forest: it is now a treeless field. */
@.=$. /*ditto, for the "shadow" forest. */
gens=abs(generations) /*use this for convenience. */
signal on halt /*handle any forest life interruptus. */
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒observe the forest grow and/or burn. */
do life=1 for gens /*simulate a forest's life cycle. */
do r=1 for rows; rank=bare! /*start a forest rank as being bare. */
do c=2 for cols; ?=substr($.r, c, 1); ??=?
select /*select the most likeliest choice 1st.*/
when ?==tree! then if ignite?() then ??=fire! /*on fire ? */
when ?==bare! then if random(1, field)<=birth then ??=tree! /*new growth.*/
otherwise ??=bare! /*it's barren*/
end /*select*/ /* [↑] when (↑) if ≡ short circuit.*/
rank=rank || ?? /*build rank: 1 forest "row" at a time*/
end /*c*/ /*ignore column one, start with col two*/
@.r=rank /*and assign rank to alternate forest. */
end /*r*/ /* [↓] ··· and, later, yet back again.*/
do r=1 for rows; $.r=@.r; end /*r*/ /*assign alternate cells ──► real cells*/
if \(life//every==0 | generations>0 | life==gens) then iterate
'CLS' /* ◄─── change this command for your OS*/
do r=rows by -1 for rows; say strip(substr($.r, 2), 'T') /*a row of trees*/
end /*r*/ /* [↑] display forest to the terminal.*/
say right(copies('▒', cols)life, cols) /*show and tell for a stand of trees. */
end /*life*/
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒stop observing the forest evolve. */
halt: if life-1\==gens then say 'Forest simulation interrupted.' /*was this pgm HALTed?*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
ignite?: if substr($.r, c+1, 1) == fire! then return 1 /*is east on fire? */
cm=c-1; if substr($.r, cm , 1) == fire! then return 1 /* " west " " */
rm=r-1; rp=r+1 /*test north & south*/
if pos(fire!, substr($.rm, cm, 3)substr($.rp, cm, 3)) \== 0 then return 1
return random(1, field) <= lightning /*lightning ignition*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
p: return word(arg(1), 1) /*pick─a─word: first or second word.*/

60
Task/Forest-fire/Racket/forest-fire.rkt Normal file
View file

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

71
Task/Forest-fire/Raku/forest-fire-1.raku Normal file
View file

@ -0,0 +1,71 @@
my $RED = "\e[1;31m";
my $YELLOW = "\e[1;33m";
my $GREEN = "\e[1;32m";
my $CLEAR = "\e[0m";
enum Cell-State <Empty Tree Heating Burning>;
my @pix = ' ', $GREEN ~ '木', $YELLOW ~ '木', $RED ~ '木';
class Forest {
has Rat $.p = 0.01;
has Rat $.f = 0.001;
has Int $!height;
has Int $!width;
has @!coords;
has @!spot;
has @!neighbors;
method BUILD (Int :$!height, Int :$!width) {
@!coords = ^$!height X ^$!width;
@!spot = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;
self!init-neighbors;
}
method !init-neighbors {
for @!coords -> ($i, $j) {
@!neighbors[$i][$j] = eager gather for
[-1,-1],[+0,-1],[+1,-1],
[-1,+0], [+1,+0],
[-1,+1],[+0,+1],[+1,+1]
{
take-rw @!spot[$i + .[0]][$j + .[1]] // next;
}
}
}
method step {
my @heat;
for @!coords -> ($i, $j) {
given @!spot[$i][$j] {
when Empty { $_ = Tree if rand < $!p }
when Tree { $_ = Heating if rand < $!f }
when Heating { $_ = Burning; push @heat, ($i, $j); }
when Burning { $_ = Empty }
}
}
for @heat -> ($i,$j) {
$_ = Heating for @!neighbors[$i][$j].grep(Tree);
}
}
method show {
for ^$!height -> $i {
say @pix[@!spot[$i].list].join;
}
}
}
my ($ROWS, $COLS) = qx/stty size/.words;
signal(SIGINT).act: { print "\e[H\e[2J"; exit }
sub MAIN (Int $height = $ROWS - 2, Int $width = +$COLS div 2 - 1) {
my Forest $forest .= new(:$height, :$width);
print "\e[2J"; # ANSI clear screen
loop {
print "\e[H"; # ANSI home
say $++;
$forest.show;
$forest.step;
}
}

127
Task/Forest-fire/Raku/forest-fire-2.raku Normal file
View file

@ -0,0 +1,127 @@
use NativeCall;
use SDL2::Raw;
my ($width, $height) = 900, 900;
SDL_Init(VIDEO);
my SDL_Window $window = SDL_CreateWindow(
"Forest Fire - Raku",
SDL_WINDOWPOS_CENTERED_MASK, SDL_WINDOWPOS_CENTERED_MASK,
$width, $height,
RESIZABLE
);
my SDL_Renderer $renderer = SDL_CreateRenderer( $window, -1, ACCELERATED +| PRESENTVSYNC );
SDL_ClearError();
my int ($w, $h) = 200, 200;
my $forest_texture = SDL_CreateTexture($renderer, %PIXELFORMAT<RGB332>, STREAMING, $w, $h);
my $pixdatabuf = CArray[int64].new(0, $w, $h, $w);
my $work-buffer = CArray[int64].new(0, $w, $h, $w);
my int $bare = 0; # Black
my int $tree = 8; # Green
my int $heating = -120; # Orange ( 132 but it's being passed into an int8 )
my int $burning = 128; # Red
my int $buf = $w * $h;
my $humidity = .7; # Chance that a tree next to a burning tree will resist catching fire
my $tree-spawn = .75; # Initial probability that a space will contain a tree. Probability
# will be adjusted (way down) once rendering starts.
sub render {
# work-around to pass the pointer-pointer.
my $pixdata = nativecast(Pointer[int64], $pixdatabuf);
SDL_LockTexture($forest_texture, SDL_Rect, $pixdata, my int $pitch);
$pixdata = nativecast(CArray[int8], Pointer.new($pixdatabuf[0]));
loop (my int $row; $row < $h; $row = $row + 1) {
my int $rs = $row * $w; # row start
my int $re = $rs + $w; # row end
loop (my int $idx = $rs; $idx < $re; $idx = $idx + 1) {
# Skip it if it is a tree
next if $pixdata[$idx] == $tree;
if $pixdata[$idx] == $bare {
# Maybe spawn a tree on bare ground
$work-buffer[$idx] = rand < $tree-spawn ?? $tree !! $bare;
} elsif $pixdata[$idx] == $heating {
# Check if there are trees around a hot spot and light them if humidity is low enough
$work-buffer[$idx - $w - 1] = $heating if rand > $humidity && $pixdata[$idx - $w - 1] && $row > 0;
$work-buffer[$idx - $w ] = $heating if rand > $humidity && $pixdata[$idx - $w ] && $row > 0;
$work-buffer[$idx - $w + 1] = $heating if rand > $humidity && $pixdata[$idx - $w + 1] && $row > 0;
$work-buffer[$idx - 1 ] = $heating if rand > $humidity && $pixdata[$idx - 1 ];
$work-buffer[$idx + $w - 1] = $heating if rand > $humidity && $pixdata[$idx + $w - 1];
$work-buffer[$idx + $w ] = $heating if rand > $humidity && $pixdata[$idx + $w ];
$work-buffer[$idx + $w + 1] = $heating if rand > $humidity && $pixdata[$idx + $w + 1];
$work-buffer[$idx + 1 ] = $heating if rand > $humidity && $pixdata[$idx + 1 ];
# Hotspot becomes a flame
$work-buffer[$idx] = $burning
} else {
# Extinguish a flame after fuel is gone
$work-buffer[$idx] = $bare;
}
}
}
# copy working buffer to main texture buffer
loop (my int $i; $i < $buf; $i = $i + 1) { $pixdata[$i] = $work-buffer[$i] }
# start a fire maybe
$pixdata[$buf.rand] = $heating if rand < .1;
SDL_UnlockTexture($forest_texture);
SDL_RenderCopy($renderer, $forest_texture, SDL_Rect, SDL_Rect.new(:x(0), :y(0), :w($width), :h($height)));
SDL_RenderPresent($renderer);
once $tree-spawn = .005;
}
my $event = SDL_Event.new;
enum KEY_CODES ( K_Q => 20 );
main: loop {
while SDL_PollEvent($event) {
my $casted_event = SDL_CastEvent($event);
given $casted_event {
when *.type == QUIT {
last main;
}
when *.type == KEYDOWN {
if KEY_CODES(.scancode) -> $comm {
given $comm {
when 'K_Q' { last main }
}
}
}
when *.type == WINDOWEVENT {
if .event == RESIZED {
$width = .data1;
$height = .data2;
}
}
}
}
render();
print fps;
}
say '';
sub fps {
state $fps-frames = 0;
state $fps-now = now;
state $fps = '';
$fps-frames++;
if now - $fps-now >= 1 {
$fps = [~] "\b" x 40, ' ' x 20, "\b" x 20 ,
sprintf "FPS: %5.2f ", ($fps-frames / (now - $fps-now)).round(.01);
$fps-frames = 0;
$fps-now = now;
}
$fps
}

84
Task/Forest-fire/Ring/forest-fire.ring Normal file
View file

@ -0,0 +1,84 @@
# Project : Forest fire
load "guilib.ring"
load "stdlib.ring"
paint = null
new qapp
{
win1 = new qwidget() {
setwindowtitle("Forest fire")
setgeometry(100,100,500,600)
label1 = new qlabel(win1) {
setgeometry(10,10,400,400)
settext("")
}
new qpushbutton(win1) {
setgeometry(150,500,100,30)
settext("draw")
setclickevent("draw()")
}
show()
}
exec()
}
func draw
p1 = new qpicture()
color = new qcolor() {
setrgb(0,0,255,255)
}
pen = new qpen() {
setcolor(color)
setwidth(1)
}
paint = new qpainter() {
begin(p1)
setpen(pen)
pregen = newlist(200,200)
newgen = newlist(200,200)
for gen = 1 to 20
see "gen = " + gen + nl
for x = 1 to 199
for y = 1 to 199
switch pregen[x][y]
on 0
if random(9)/10 > 0.099
newgen[x][y] = 1
color = new qcolor()
color.setrgb(0,128,0,255)
pen.setcolor(color)
setpen(pen)
drawpoint(x,y)
ok
on 2
newgen[x][y] = 0
color = new qcolor()
color.setrgb(165,42,42,255)
pen.setcolor(color)
setpen(pen)
drawpoint(x,y)
on 1
if pregen[x][y] = 2 or pregen[x][y] = 2 or pregen[x][y+1] = 2 or
pregen[x][y] = 2 or pregen[x][y+1] = 2 or pregen[x+1][y] = 2 or
pregen[x+1][y] = 2 or pregen[x+1][y+1] = 2 or random(9)/10 > 0.0999
color = new qcolor()
color.setrgb(255,0,0,255)
pen.setcolor(color)
setpen(pen)
drawpoint(x,y)
newgen[x][y] = 2
ok
off
pregen[x][y] = newgen[x][y]
next
next
next
endpaint()
}
label1 { setpicture(p1) show() }
return

44
Task/Forest-fire/Ruby/forest-fire.rb Normal file
View file

@ -0,0 +1,44 @@
class Forest_Fire
Neighborhood = [-1,0,1].product([-1,0,1]) - [0,0]
States = {empty:" ", tree:"T", fire:"#"}
def initialize(xsize, ysize=xsize, p=0.5, f=0.01)
@xsize, @ysize, @p, @f = xsize, ysize, p, f
@field = Array.new(xsize+1) {|i| Array.new(ysize+1, :empty)}
@generation = 0
end
def evolve
@generation += 1
work = @field.map{|row| row.map{|cell| cell}}
for i in 0...@xsize
for j in 0...@ysize
case cell=@field[i][j]
when :empty
cell = :tree if rand < @p
when :tree
cell = :fire if fire?(i,j)
else
cell = :empty
end
work[i][j] = cell
end
end
@field = work
end
def fire?(i,j)
rand < @f or Neighborhood.any? {|di,dj| @field[i+di][j+dj] == :fire}
end
def display
puts "Generation : #@generation"
puts @xsize.times.map{|i| @ysize.times.map{|j| States[@field[i][j]]}.join}
end
end
forest = Forest_Fire.new(10,30)
10.times do |i|
forest.evolve
forest.display
end

25
Task/Forest-fire/Run-BASIC/forest-fire.basic Normal file
View file

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

158
Task/Forest-fire/Rust/forest-fire.rust Normal file
View file

@ -0,0 +1,158 @@
extern crate rand;
extern crate ansi_term;
#[derive(Copy, Clone, PartialEq)]
enum Tile {
Empty,
Tree,
Burning,
Heating,
}
impl fmt::Display for Tile {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
let output = match *self {
Empty => Black.paint(" "),
Tree => Green.bold().paint("T"),
Burning => Red.bold().paint("B"),
Heating => Yellow.bold().paint("T"),
};
write!(f, "{}", output)
}
}
// This has been added to the nightly rust build as of March 24, 2016
// Remove when in stable branch!
trait Contains<T> {
fn contains(&self, T) -> bool;
}
impl<T: PartialOrd> Contains<T> for std::ops::Range<T> {
fn contains(&self, elt: T) -> bool {
self.start <= elt && elt < self.end
}
}
const NEW_TREE_PROB: f32 = 0.01;
const INITIAL_TREE_PROB: f32 = 0.5;
const FIRE_PROB: f32 = 0.001;
const FOREST_WIDTH: usize = 60;
const FOREST_HEIGHT: usize = 30;
const SLEEP_MILLIS: u64 = 25;
use std::fmt;
use std::io;
use std::io::prelude::*;
use std::io::BufWriter;
use std::io::Stdout;
use std::process::Command;
use std::time::Duration;
use rand::Rng;
use ansi_term::Colour::*;
use Tile::{Empty, Tree, Burning, Heating};
fn main() {
let sleep_duration = Duration::from_millis(SLEEP_MILLIS);
let mut forest = [[Tile::Empty; FOREST_WIDTH]; FOREST_HEIGHT];
prepopulate_forest(&mut forest);
print_forest(forest, 0);
std::thread::sleep(sleep_duration);
for generation in 1.. {
for row in forest.iter_mut() {
for tile in row.iter_mut() {
update_tile(tile);
}
}
for y in 0..FOREST_HEIGHT {
for x in 0..FOREST_WIDTH {
if forest[y][x] == Burning {
heat_neighbors(&mut forest, y, x);
}
}
}
print_forest(forest, generation);
std::thread::sleep(sleep_duration);
}
}
fn prepopulate_forest(forest: &mut [[Tile; FOREST_WIDTH]; FOREST_HEIGHT]) {
for row in forest.iter_mut() {
for tile in row.iter_mut() {
*tile = if prob_check(INITIAL_TREE_PROB) {
Tree
} else {
Empty
};
}
}
}
fn update_tile(tile: &mut Tile) {
*tile = match *tile {
Empty => {
if prob_check(NEW_TREE_PROB) == true {
Tree
} else {
Empty
}
}
Tree => {
if prob_check(FIRE_PROB) == true {
Burning
} else {
Tree
}
}
Burning => Empty,
Heating => Burning,
}
}
fn heat_neighbors(forest: &mut [[Tile; FOREST_WIDTH]; FOREST_HEIGHT], y: usize, x: usize) {
let neighbors = [(-1, -1), (-1, 0), (-1, 1), (0, -1), (0, 1), (1, -1), (1, 0), (1, 1)];
for &(xoff, yoff) in neighbors.iter() {
let nx: i32 = (x as i32) + xoff;
let ny: i32 = (y as i32) + yoff;
if (0..FOREST_WIDTH as i32).contains(nx) && (0..FOREST_HEIGHT as i32).contains(ny) &&
forest[ny as usize][nx as usize] == Tree {
forest[ny as usize][nx as usize] = Heating
}
}
}
fn prob_check(chance: f32) -> bool {
let roll = rand::thread_rng().gen::<f32>();
if chance - roll > 0.0 {
true
} else {
false
}
}
fn print_forest(forest: [[Tile; FOREST_WIDTH]; FOREST_HEIGHT], generation: u32) {
let mut writer = BufWriter::new(io::stdout());
clear_screen(&mut writer);
writeln!(writer, "Generation: {}", generation + 1).unwrap();
for row in forest.iter() {
for tree in row.iter() {
write!(writer, "{}", tree).unwrap();
}
writer.write(b"\n").unwrap();
}
}
fn clear_screen(writer: &mut BufWriter<Stdout>) {
let output = Command::new("clear").output().unwrap();
write!(writer, "{}", String::from_utf8_lossy(&output.stdout)).unwrap();
}

196
Task/Forest-fire/Sather/forest-fire.sa Normal file
View file

@ -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;

28
Task/Forest-fire/Scala/forest-fire-1.scala Normal file
View file

@ -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))
}

9
Task/Forest-fire/Scala/forest-fire-2.scala Normal file
View file

@ -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
}
}
}

61
Task/Forest-fire/Sidef/forest-fire-1.sidef Normal file
View file

@ -0,0 +1,61 @@
define w = `tput cols`.to_i-1
define h = `tput lines`.to_i-1
define r = "\033[H"
define red = "\033[31m"
define green = "\033[32m"
define yellow = "\033[33m"
define chars = [' ', green+'*', yellow+'&', red+'&']
define tree_prob = 0.05
define burn_prob = 0.0002
enum |Empty, Tree, Heating, Burning|
define dirs = [
%n(-1 -1), %n(-1 0), %n(-1 1), %n(0 -1),
%n(0 1), %n(1 -1), %n(1 0), %n(1 1),
]
var forest = h.of { w.of { 1.rand < tree_prob ? Tree : Empty } }
var range_h = h.range
var range_w = w.range
func iterate {
var new = h.of{ w.of(0) }
for i in range_h {
for j in range_w {
given (new[i][j] = forest[i][j]) {
when (Tree) {
1.rand < burn_prob && (new[i][j] = Heating; next)
dirs.each { |pair|
var y = pair[0]+i
range_h.contains(y) || next
var x = pair[1]+j
range_w.contains(x) || next
forest[y][x] == Heating && (new[i][j] = Heating; break)
}
}
when (Heating) { new[i][j] = Burning }
when (Burning) { new[i][j] = Empty }
case (1.rand < tree_prob) { new[i][j] = Tree }
}
}
}
forest = new
}
STDOUT.autoflush(true)
func init_forest {
print r
forest.each { |row|
print chars[row]
print "\033[E\033[1G"
}
iterate()
}
loop { init_forest() }

72
Task/Forest-fire/Sidef/forest-fire-2.sidef Normal file
View file

@ -0,0 +1,72 @@
define RED = "\e[1;31m"
define YELLOW = "\e[1;33m"
define GREEN = "\e[1;32m"
 
define DIRS = [
[-1, -1], [0, -1], [1, -1],
[-1, 0], [1, 0],
[-1, 1], [0, 1], [1, 1],
]
 
enum (Empty, Tree, Heating, Burning)
define pix = [' ', GREEN + "*", YELLOW + "*", RED + "*"]
 
class Forest(p=0.01, f=0.001, height, width) {
 
has coords = []
has spot = []
has neighbors = []
 
method init {
coords = (0..height ~X 0..width)
spot = height.of { width.of { [true, false].pick ? Tree : Empty } }
self.init_neighbors
}
 
method init_neighbors {
for i,j in coords {
neighbors[i][j] = gather {
for dir in DIRS {
take(\(spot[i + dir[0]][j + dir[1]] \\ next))
}
}
}
}
 
method step {
var heat = []
 
for i,j in coords {
given (spot[i][j]) {
when Empty { spot[i][j] = Tree if (1.rand < p) }
when Tree { spot[i][j] = Heating if (1.rand < f) }
when Heating { spot[i][j] = Burning; heat << [i, j] }
when Burning { spot[i][j] = Empty }
}
}
 
for i,j in heat {
neighbors[i][j].each { |ref|
*ref = Heating if (*ref == Tree)
}
}
}
 
method show {
for i in ^height {
say pix[spot[i]]
}
}
}
STDOUT.autoflush(true)
var(height, width) = `stty size`.nums.map{.dec}...
 
var forest = Forest(height: height, width: width)
print "\e[2J"
loop {
print "\e[H"
forest.show
forest.step
}

72
Task/Forest-fire/Sinclair-ZX81-BASIC/forest-fire.basic Normal file
View file

@ -0,0 +1,72 @@
10 DIM F$(20,30)
20 DIM N$(20,30)
30 LET INIT=.5
40 LET F=.02
50 LET P=.05
60 PRINT AT 0,1;"[FOREST FIRE FOR ROSETTA CODE]"
70 FOR I=0 TO 21
80 PRINT AT I,0;"[ ]"
90 PRINT AT I,31;"[ ]"
100 NEXT I
110 FOR I=1 TO 30
120 PRINT AT 21,I;"[ ]"
130 NEXT I
140 LET G=0
150 LET T=0
160 PRINT AT 21,1;"[GENERATION 0]"
170 PRINT AT 21,20;"[COVER]"
180 FOR I=1 TO 20
190 FOR J=1 TO 30
200 IF RND>=INIT THEN GOTO 240
210 PRINT AT I,J;"0"
220 LET F$(I,J)="0"
230 LET T=T+1
240 NEXT J
250 NEXT I
300 PRINT AT 21,26;"[ ]"
310 LET N=INT (.5+T/6)
320 GOSUB 1000
330 PRINT AT 21,26;I$;"[ PC]"
340 FOR I=1 TO 20
350 PRINT AT I,0;"[>]"
360 FOR J=1 TO 30
380 IF F$(I,J)<>"[a]" THEN GOTO 410
390 LET N$(I,J)=" "
400 GOTO 530
410 IF F$(I,J)<>" " THEN GOTO 433
420 IF RND<=P THEN LET N$(I,J)="0"
430 GOTO 530
433 LET N$(I,J)=CHR$ (1+CODE F$(I,J))
437 IF N$(I,J)>"Z" THEN LET N$(I,J)="£"
440 FOR K=I-1 TO I+1
450 FOR L=J-1 TO J+1
460 IF K=0 OR L=0 OR K=21 OR L=21 THEN GOTO 480
470 IF F$(K,L)="[a]" THEN GOTO 510
480 NEXT L
490 NEXT K
500 GOTO 520
510 LET N$(I,J)="[a]"
520 IF RND<=F THEN LET N$(I,J)="[a]"
530 NEXT J
540 PRINT AT I,0;"[ ]"
550 NEXT I
552 LET G=G+1
554 LET N=G
556 GOSUB 1000
558 PRINT AT 21,12;I$
560 LET T=0
570 FOR I=1 TO 20
575 PRINT AT I,31;"[<]"
580 FOR J=1 TO 30
590 IF N$(I,J)<>"[a]" AND N$(I,J)<>" " THEN LET T=T+1
600 NEXT J
610 LET F$(I)=N$(I)
620 PRINT AT I,1;F$(I)
625 PRINT AT I,31;"[ ]"
630 GOTO 300
1000 LET S$=STR$ N
1010 LET I$=""
1020 FOR K=1 TO LEN S$
1030 LET I$=I$+CHR$ (128+CODE S$(K))
1040 NEXT K
1050 RETURN

78
Task/Forest-fire/Tcl/forest-fire.tcl Normal file
View file

@ -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
}

84
Task/Forest-fire/V-(Vlang)/forest-fire.v Normal file
View file

@ -0,0 +1,84 @@
import rand
import strings
import os
const (
rows = 20
cols = 30
p = .01
f = .001
)
const rx = rows + 2
const cx = cols + 2
fn main() {
mut odd := []string{len: rx*cx}
mut even := []string{len: rx*cx}
for r := 1; r <= rows; r++ {
for c := 1; c <= cols; c++ {
if rand.intn(2) or {1} == 1 {
odd[r*cx+c] = 'T'
}
}
}
mut _ := ''
for {
print_row(odd)
step(mut even, odd)
_ = os.input('')
print_row(even)
step(mut odd, even)
_ = os.input('')
}
}
fn print_row(model []string) {
println(strings.repeat_string("__", cols))
println('')
for r := 1; r <= rows; r++ {
for c := 1; c <= cols; c++ {
if model[r*cx+c] == '0' {
print(" ")
} else {
print(" ${model[r*cx+c]}")
}
}
println('')
}
}
fn step(mut dst []string, src []string) {
for r := 1; r <= rows; r++ {
for c := 1; c <= cols; c++ {
x := r*cx + c
dst[x] = src[x]
match dst[x] {
'#' {
// rule 1. A burning cell turns into an empty cell
dst[x] = '0'
}
'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.f64() < f {
dst[x] = '#'
}
}
else {
// rule 4. An empty space fills with a tree with probability p
if rand.f64() < p {
dst[x] = 'T'
}
}
}
}
}
}

75
Task/Forest-fire/Vedit-macro-language/forest-fire.vedit Normal file
View file

@ -0,0 +1,75 @@
#1 = 25 // height of the grid
#2 = 60 // width of the grid
#3 = 2 // probability of random fire, per 1000
#4 = 40 // probability of new tree, per 1000
#5 = #2+2+Newline_Chars // total length of a line
#90 = Time_Tick // seed for random number generator
#91 = 1000 // get random numbers in range 0 to 999
// Fill the grid and draw border
Buf_Switch(Buf_Free)
Ins_Char('-', COUNT, #2+2)
Ins_Newline
for (#11=0; #11<#1; #11++) {
Ins_Char('|')
for (#12=0; #12<#2; #12++) {
Call("RANDOM")
if (Return_Value < 500) { // 50% propability for a tree
Ins_Char('♠')
} else {
Ins_Char(' ')
}
}
Ins_Char('|')
Ins_Newline
}
Ins_Char('-', COUNT, #2+2)
#8=1
Repeat(10) {
BOF
Update()
// calculate one generation
for (#11=1; #11<#1+2; #11++) {
Goto_Line(#11)
for (#12=1; #12<#2+2; #12++) {
Goto_Col(#12)
#14=Cur_Pos
Call("RANDOM")
#10 = Return_Value
if (Cur_Char == '♠') { // tree?
if (#10 < #3) {
Ins_Char('*', OVERWRITE) // random combustion
} else {
if (Search_Block("░", CP-#5-1, CP+#5+2, COLUMN+BEGIN+NOERR)) {
Goto_Pos(#14)
Ins_Char('*', OVERWRITE) // combustion
}
}
} else {
if (Cur_Char == ' ') { // empty space?
if (#10 < #4) {
Ins_Char('+', OVERWRITE) // new tree
}
}
}
}
}
// convert tmp symbols
Replace("░"," ", BEGIN+ALL+NOERR) // old fire goes out
Replace("*","░", BEGIN+ALL+NOERR) // new fire
Replace("+","♠", BEGIN+ALL+NOERR) // new tree
}
Return
//--------------------------------------------------------------
// Generate random numbers in range 0 <= Return_Value < #91
// #90 = Seed (0 to 0x7fffffff)
// #91 = Scaling (0 to 0xffff)
:RANDOM:
#92 = 0x7fffffff / 48271
#93 = 0x7fffffff % 48271
#90 = (48271 * (#90 % #92) - #93 * (#90 / #92)) & 0x7fffffff
return ((#90 & 0xffff) * #91 / 0x10000)

104
Task/Forest-fire/Visual-Basic-.NET/forest-fire.vb Normal file
View file

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

63
Task/Forest-fire/Wren/forest-fire.wren Normal file
View file

@ -0,0 +1,63 @@
import "random" for Random
import "io" for Stdin
var rand = Random.new()
var rows = 20
var cols = 30
var p = 0.01
var f = 0.001
var rx = rows + 2
var cx = cols + 2
var step = Fn.new { |dst, src|
for (r in 1..rows) {
for (c in 1..cols) {
var x = r*cx + c
dst[x] = src[x]
if (dst[x] == "#") {
// rule 1. A burning cell turns into an empty cell
dst[x] = " "
} else if(dst[x] == "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.float() < f) {
dst[x] = "#"
}
} else {
// rule 4. An empty space fills with a tree with probability p
if (rand.float() < p) dst[x] = "T"
}
}
}
}
var print = Fn.new { |model|
System.print("__" * cols)
System.print()
for (r in 1..rows) {
for (c in 1..cols) System.write(" %(model[r*cx+c])")
System.print()
}
}
var odd = List.filled(rx*cx, " ")
var even = List.filled(rx*cx, " ")
for (r in 1 ..rows) {
for (c in 1..cols) {
if (rand.int(2) == 1) odd[r*cx+c] = "T"
}
}
while (true) {
print.call(odd)
step.call(even, odd)
Stdin.readLine()
print.call(even)
step.call(odd, even)
Stdin.readLine()
}

56
Task/Forest-fire/ZX-Spectrum-Basic/forest-fire.basic Normal file
View file

@ -0,0 +1,56 @@
10 PAPER 6: CLS
20 DIM n$(20,30)
30 LET init=.5
40 LET f=.02
50 LET p=.05
60 PAPER 0
70 FOR i=0 TO 31
80 PRINT AT 0,i;" "
90 PRINT AT 21,i;" "
100 NEXT i
110 FOR i=0 TO 21
120 PRINT AT i,0;" "
130 PRINT AT i,31;" "
140 NEXT i
150 INK 7
160 PRINT AT 0,1;"FOREST FIRE for Rosetta Code"
170 LET generation=0
180 PRINT AT 21,1;"Generation 0"
190 LET trees=0
200 PRINT AT 21,22;"Cover"
210 FOR i=1 TO 20
220 FOR j=1 TO 30
230 IF RND<init THEN PAPER 4: INK 7: PRINT AT i,j;"T": LET trees=trees+1
240 NEXT j
250 NEXT i
260 LET generation=generation+1
270 INK 7
280 PAPER 0
290 PRINT AT 21,12;generation
300 PRINT AT 21,28;" "
310 PRINT AT 21,28;INT (trees/6+.5);"%"
320 FOR i=1 TO 20
330 FOR j=1 TO 30
340 LET n$(i,j)=SCREEN$ (i,j)
350 IF SCREEN$ (i,j)="B" THEN LET n$(i,j)=" ": GO TO 450
360 IF SCREEN$ (i,j)="T" THEN GO TO 390
370 IF RND<=p THEN LET n$(i,j)="T"
380 GO TO 450
390 FOR k=i-1 TO i+1
400 FOR l=j-1 TO j+1
410 IF SCREEN$ (k,l)="B" THEN LET n$(i,j)="B": LET k=i+2: LET l=j+2
420 NEXT l
430 NEXT k
440 IF RND<=f THEN LET n$(i,j)="B"
450 NEXT j
460 NEXT i
470 LET trees=0
480 FOR i=1 TO 20
490 FOR j=1 TO 30
500 IF n$(i,j)="T" THEN INK 7: PAPER 4: PRINT AT i,j;"T": LET trees=trees+1: GO TO 540
510 IF n$(i,j)="B" THEN INK 6: PAPER 2: PRINT AT i,j;"B": GO TO 540
520 PAPER 6
530 PRINT AT i,j;" "
540 NEXT j
550 NEXT i
560 GO TO 260