Data update
This commit is contained in:
Ingy döt Net
parent
4bb20c9b71
commit
cbaf4c4b64
12390 changed files with 318560 additions and 27248 deletions
69
Task/Forest-fire/Ada/forest-fire.adb
Normal file
69
Task/Forest-fire/Ada/forest-fire.adb
Normal 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;
|
||||
168
Task/Forest-fire/COBOL/forest-fire.cob
Normal file
168
Task/Forest-fire/COBOL/forest-fire.cob
Normal 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)
|
||||
.
|
||||
97
Task/Forest-fire/Emacs-Lisp/forest-fire-1.el
Normal file
97
Task/Forest-fire/Emacs-Lisp/forest-fire-1.el
Normal 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.el
Normal file
7
Task/Forest-fire/Emacs-Lisp/forest-fire-2.el
Normal 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
|
||||
222
Task/Forest-fire/FutureBasic/forest-fire.basic
Normal file
222
Task/Forest-fire/FutureBasic/forest-fire.basic
Normal file
|
|
@ -0,0 +1,222 @@
|
|||
//
|
||||
// FOREST FIRE SIMULATION
|
||||
//
|
||||
// Using FutureBasic 7.0.34
|
||||
// August 2025, R.W.
|
||||
//
|
||||
Boolean running
|
||||
BlockOperationRef dCode
|
||||
OperationQueueRef cQueue
|
||||
OperationQueueRef opQueue
|
||||
|
||||
long N, M
|
||||
double pfire, ptree, generation
|
||||
long dimx, dimy
|
||||
long f(142,142) // the forest
|
||||
long future(142,142) // the predicted future
|
||||
CFStringRef gen
|
||||
CGFloat red, green, blue
|
||||
colorRef colR
|
||||
float rndf
|
||||
pfire=0.00002: ptree=0.002 //probabilities
|
||||
|
||||
begin enum 1
|
||||
_window
|
||||
_generation
|
||||
_toggle
|
||||
end enum
|
||||
|
||||
// Build window
|
||||
|
||||
void local fn BuildWindow
|
||||
CGRect r = fn CGRectMake( 0, 0, 570, 570 )
|
||||
window _window, @"Forest Fire Simulation", r, NSWindowStyleMaskTitled + ¬
|
||||
NSWindowStyleMaskClosable
|
||||
WindowSetBackgroundColor( _window, fn ColorBlack) //ColorWindowBackground )
|
||||
ViewSetFlipped( _WindowContentViewTag, YES )
|
||||
WindowSubclassContentView(_Window)
|
||||
ViewSetNeedsDisplay( _windowContentViewTag )
|
||||
windowcenter (_Window)
|
||||
AppSetAppearance(fn AppearanceNamed(NSAppearanceNameDarkAqua))
|
||||
WindowMakeFirstResponder( _Window, _windowContentViewTag )
|
||||
ViewSetAcceptsFirstResponder( _Window, _true )
|
||||
end fn
|
||||
|
||||
void local fn DrawControls
|
||||
gen = @""
|
||||
CGRect r = fn CGRectMake( 10, 532, 220, 32 )
|
||||
textlabel _generation, gen,r,_window
|
||||
r = fn CGRectMake( 450, 530, 100, 24 )
|
||||
button _toggle,,, @"Start", r, , , _Window
|
||||
end fn
|
||||
|
||||
//
|
||||
// Populate the array with empty and tree cells according to a
|
||||
// specific probability
|
||||
// (e.g. a cell has the probability 0.5 to be a tree)
|
||||
|
||||
void local fn buildForest
|
||||
int x, y
|
||||
// Initialize forest with trees (1) or empty (0)
|
||||
for y = 1 to N
|
||||
for x = 1 to M
|
||||
rndf = (rnd(65536)-1)/65536.0
|
||||
// a cell has the probability 0.5 to be a tree
|
||||
if rndf < 0.5 then f(x,y) = 1 else f(x,y) = 0
|
||||
next
|
||||
next
|
||||
end fn
|
||||
|
||||
//
|
||||
// Draw the forest
|
||||
|
||||
local fn DrawForest
|
||||
int x, y
|
||||
cls
|
||||
for y = 1 to N
|
||||
for x = 1 to M
|
||||
red = 0.0: green = 0.0: blue = 0.0 //black
|
||||
if f(x,y) == 1
|
||||
red = 0: green = 0.50: blue = 0 //green
|
||||
else
|
||||
if f(x,y) == 2
|
||||
red = 0.97: green = 0.49: blue = 0 //red
|
||||
end if
|
||||
end if
|
||||
Colr = fn ColorWithRGB(red,green,blue,1.0)
|
||||
pen 1, colr
|
||||
oval fill (x*4,y*4,3.2,3.2), colr
|
||||
next
|
||||
next
|
||||
end fn
|
||||
|
||||
//
|
||||
// Simulates the forest fire
|
||||
|
||||
local fn simulate
|
||||
|
||||
int x, y, xx, yy, localfire
|
||||
|
||||
// A burning cell turns into an empty cell
|
||||
// A tree will burn if at least one neighbor is burning
|
||||
// A tree ignites with probability pfire even if no neighbor is burning
|
||||
// An empty space grows a tree with probability ptree
|
||||
//
|
||||
for y = 1 to N
|
||||
for x = 1 to M
|
||||
rndf = (rnd(65536)-1)/65536.0
|
||||
select case f(x,y)
|
||||
case 0 // empty
|
||||
if rndf < ptree
|
||||
future(x,y) = 1
|
||||
else
|
||||
future(x,y) = 0
|
||||
end if
|
||||
case 1 // tree
|
||||
if rndf < pfire
|
||||
future(x,y) = 2 // probability of ignition
|
||||
else
|
||||
// check neighbors for fire
|
||||
localFire = 0
|
||||
for yy = y-1 to y+1
|
||||
for xx = x-1 to x+1
|
||||
if f(xx,yy) == 2 then localFire = 1
|
||||
next
|
||||
next
|
||||
if localFire == 1
|
||||
future(x,y) = 2
|
||||
else
|
||||
future(x,y) = 1
|
||||
end if
|
||||
end if
|
||||
case 2 // burning
|
||||
future(x,y) = 0
|
||||
end select
|
||||
next
|
||||
next
|
||||
|
||||
// Copy future to forest
|
||||
for y = 1 to N
|
||||
for x = 1 to M
|
||||
f(x,y) = future(x,y)
|
||||
next
|
||||
next
|
||||
generation++
|
||||
end fn
|
||||
|
||||
//
|
||||
// Executed as long as we are running
|
||||
//
|
||||
local fn tillTheCowsComeHome (dPtr as Ptr)
|
||||
while running
|
||||
dispatchmain
|
||||
fn drawforest
|
||||
dispatchend
|
||||
fn Simulate
|
||||
delay 110
|
||||
wend
|
||||
// callback canned
|
||||
OperationCancel (dCode )
|
||||
end fn
|
||||
|
||||
// Begin animation
|
||||
void local fn Animate
|
||||
// setup dispatch queue w/ callback
|
||||
dCode = fn BlockOperationWithCallback( @fn tillTheCowsComeHome, NULL )
|
||||
cQueue = fn OperationQueueInit // Init queue
|
||||
OperationQueueSetMaxConcurrentOperationCount( cQueue, 1 ) // serial only
|
||||
OperationQueueAddOperations( cQueue, @[dCode], NO ) // add to queue
|
||||
end fn
|
||||
|
||||
//
|
||||
// App Event handler
|
||||
//
|
||||
void local fn DoAppEvent( ev as long )
|
||||
select ( ev )
|
||||
case _appWillTerminate
|
||||
if running then OperationCancel (dCode )
|
||||
end select
|
||||
end fn
|
||||
|
||||
//
|
||||
// Dialog handler
|
||||
|
||||
void local fn DoDialog( ev as long, tag as long, wnd as long, obj as CFTypeRef )
|
||||
select ( ev )
|
||||
case _btnClick
|
||||
select ( tag )
|
||||
case _toggle
|
||||
running = !running // toggles run status
|
||||
if running
|
||||
button _toggle,,, @"Stop"
|
||||
fn Animate
|
||||
textlabel _generation, @""
|
||||
else
|
||||
button _toggle,,, @"Start"
|
||||
gen = concat(@"Stopped at Generation: ",str(generation))
|
||||
textlabel _generation, gen
|
||||
end if
|
||||
end select
|
||||
case _windowShouldClose
|
||||
if running then OperationCancel (dCode )
|
||||
end
|
||||
end select
|
||||
end fn
|
||||
//==========================================
|
||||
|
||||
on dialog fn DoDialog
|
||||
|
||||
fn BuildWindow
|
||||
fn DrawControls
|
||||
|
||||
randomize
|
||||
|
||||
N = 130 // number of rows
|
||||
M = 140 // number of columns
|
||||
generation = 1
|
||||
running = _False
|
||||
|
||||
fn buildForest
|
||||
fn drawForest
|
||||
|
||||
handleEvents
|
||||
Loading…
Add table
Add a link
Reference in a new issue