Wireworld: Difference between revisions
m J: modularize, slightly |
|||
Line 1,320:
)</lang>
The 'most' powerful part is contained in the following iterating sentence, namely the dyad cut ;. [http://www.jsoftware.com/help/dictionary/d331.htm ]. In this way verb nwS can work on all the 3x3 matrices containing each cell surrounded by its 8 relevant neighbors.
<lang J> process=: (3 3 nwS;. _3 board)^:
(<10) process circuit</lang>
Example run:
<pre style="height:30ex;overflow:scroll">
tH........
. .
Line 1,388 ⟶ 1,389:
<lang j>require'viewmat'
viewmat"2 ' .tH'i.
(This example opens 10 windows, one for each generation.)
|
Revision as of 16:05, 18 November 2010
You are encouraged to solve this task according to the task description, using any language you may know.
Wireworld is a cellular automaton with some similarities to Conway's Game of Life. It is capable of doing sophisticated computations (e.g., calculating primeness!) with appropriate programs, and is much simpler to program for.
A wireworld arena consists of a cartesian grid of cells, each of which can be in one of four states. All cell transitions happen simultaneously. The cell transition rules are this:
Input State | Output State | Condition |
---|---|---|
empty | empty | |
electron head | electron tail | |
electron tail | conductor | |
conductor | electron head | if 1 or 2 cells in the neighborhood of the cell are in the state “electron head” |
conductor | conductor | otherwise |
To implement this task, create a program that reads a wireworld program from a file and displays an animation of the processing. Here is a sample description file (using "H" for an electron head, "t" for a tail, "." for a conductor and a space for empty) you may wish to test with, which demonstrates two cycle-3 generators and an inhibit gate:
tH......... . . ... . . Ht.. ......
While text-only implementations of this task are possible, mapping cells to pixels is advisable if you wish to be able to display large designs. The logic is not significantly more complex.
Ada
<lang Ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Wireworld is
type Cell is (' ', 'H', 't', '.'); type Board is array (Positive range <>, Positive range <>) of Cell; -- Perform one transition of the cellular automation procedure Wireworld (State : in out Board) is function "abs" (Left : Cell) return Natural is begin if Left = 'H' then return 1; else return 0; end if; end "abs"; Above : array (State'Range (2)) of Cell := (others => ' '); Left : Cell := ' '; Current : Cell; begin for I in State'First (1) + 1..State'Last (1) - 1 loop for J in State'First (2) + 1..State'Last (2) - 1 loop Current := State (I, J); case Current is when ' ' => null; when 'H' => State (I, J) := 't'; when 't' => State (I, J) := '.'; when '.' => if abs Above ( J - 1) + abs Above ( J) + abs Above ( J + 1) + abs Left + abs State (I, J + 1) + abs State (I + 1, J - 1) + abs State (I + 1, J) + abs State (I + 1, J + 1) in 1..2 then State (I, J) := 'H'; else State (I, J) := '.'; end if; end case; Above (J - 1) := Left; Left := Current; end loop; end loop; end Wireworld; -- Print state of the automation procedure Put (State : Board) is begin for I in State'First (1) + 1..State'Last (1) - 1 loop for J in State'First (2) + 1..State'Last (2) - 1 loop case State (I, J) is when ' ' => Put (' '); when 'H' => Put ('H'); when 't' => Put ('t'); when '.' => Put ('.'); end case; end loop; New_Line; end loop; end Put; Oscillator : Board := (" ", " tH ", " . .... ", " .. ", " ");
begin
for Step in 0..9 loop Put_Line ("Step" & Integer'Image (Step) & " ---------"); Put (Oscillator); Wireworld (Oscillator); end loop;
end Test_Wireworld;</lang> The solution assumes that the border of the board is empty. When transition is performed these cells are not changed. Automation transition is an in-place operation that allocates memory for to keep one row of the board size.
Step 0 --------- tH . .... .. Step 1 --------- .t . H... .. Step 2 --------- .. . tH.. .H Step 3 --------- .. . .tH. Ht Step 4 --------- .. H ..tH t. Step 5 --------- H. t ...t .. Step 6 --------- tH . .... .. Step 7 --------- .t . H... .. Step 8 --------- .. . tH.. .H Step 9 --------- .. . .tH. Ht
ALGOL 68
- note: This specimen retains the original python coding style.
<lang algol68>CO Wireworld implementation. CO
PROC exception = ([]STRING args)VOID:(
putf(stand error, ($"Exception"$, $", "g$, args, $l$)); stop
);
PROC assertion error = (STRING message)VOID:exception(("assertion error", message));
MODE CELL = CHAR; MODE WORLD = FLEX[0, 0]CELL; CELL head="H", tail="t", conductor=".", empty = " "; STRING all states := empty;
BOOL wrap = FALSE; # is the world round? #
STRING nl := REPR 10;
STRING in string :=
"tH........."+nl+ ". ."+nl+ " ..."+nl+ ". ."+nl+ "Ht.. ......"+nl
OP +:= = (REF FLEX[]FLEX[]CELL lines, FLEX[]CELL line)VOID:(
[UPB lines + 1]FLEX[0]CELL new lines; new lines[:UPB lines]:=lines; lines := new lines; lines[UPB lines]:=line
);
PROC read file = (REF FILE in file)WORLD: (
# file > initial world configuration" # FLEX[0]CELL line; FLEX[0]FLEX[0]CELL lines; INT upb x:=0, upb y := 0; BEGIN # on physical file end(in file, exit read line); # make term(in file, nl); FOR x TO 5 DO get(in file, (line, new line)); upb x := x; IF UPB line > upb y THEN upb y := UPB line FI; lines +:= line OD; exit read line: SKIP END; [upb x, upb y]CELL out; FOR x TO UPB out DO out[x,]:=lines[x]+" "*(upb y-UPB lines[x]) OD; out
);
PROC new cell = (WORLD current world, INT x, y)CELL: (
CELL istate := current world[x, y]; IF INT pos; char in string (istate, pos, all states); pos IS REF INT(NIL) THEN assertion error("Wireworld cell set to unknown value "+istate) FI; IF istate = head THEN tail ELIF istate = tail THEN conductor ELIF istate = empty THEN empty ELSE # istate = conductor # [][]INT dxy list = ( (-1,-1), (-1,+0), (-1,+1), (+0,-1), (+0,+1), (+1,-1), (+1,+0), (+1,+1) ); INT n := 0; FOR enum dxy TO UPB dxy list DO []INT dxy = dxy list[enum dxy]; IF wrap THEN INT px = ( x + dxy[1] - 1 ) MOD 1 UPB current world + 1; INT py = ( y + dxy[2] - 1 ) MOD 2 UPB current world + 1; n +:= ABS (current world[px, py] = head) ELSE INT px = x + dxy[1]; INT py = y + dxy[2]; IF px >= 1 LWB current world AND px <= 1 UPB current world AND py >= 2 LWB current world AND py <= 2 UPB current world THEN n +:= ABS (current world[px, py] = head) FI FI OD; IF 1 <= n AND n <= 2 THEN head ELSE conductor FI FI
);
PROC next gen = (WORLD world)WORLD:(
# compute next generation of wireworld # WORLD new world := world; FOR x TO 1 UPB world DO FOR y TO 2 UPB world DO new world[x,y] := new cell(world, x, y) OD OD; new world
);
PROC world2string = (WORLD world) STRING:(
STRING out:=""; FOR x TO UPB world DO out +:= world[x,]+nl OD; out
);
FILE in file; associate(in file, in string);
WORLD ww := read file(in file); close(in file);
FOR gen TO 10 DO
printf ( ($lg(-3)" "$, gen-1, $g$,"="* (2 UPB ww-4), $l$)); print ( world2string(ww) ); ww := next gen(ww)
OD</lang>
Output:
0 ======= tH......... . . ... . . Ht.. ...... 1 ======= .tH........ H . ... H . t... ...... 2 ======= H.tH....... t . ... t . .H.. ...... 3 ======= tH.tH...... . H ... . . HtH. ...... 4 ======= .tH.tH..... H t HHH H . t.tH ...... 5 ======= H.tH.tH.... t . ttt t . .H.t ...... 6 ======= tH.tH.tH... . H ... . . HtH. ...... 7 ======= .tH.tH.tH.. H t HHH H . t.tH ...... 8 ======= H.tH.tH.tH. t . ttt t . .H.t ...... 9 ======= tH.tH.tH.tH . H ... . . HtH. ......
C
See: Wireworld/C
C++
(for graphics)
(for usleep)
<lang cpp>#include <ggi/ggi.h>
- include <set>
- include <map>
- include <utility>
- include <iostream>
- include <fstream>
- include <string>
- include <unistd.h> // for usleep
enum cell_type { none, wire, head, tail };
// ***************** // * display class * // *****************
// this is just a small wrapper for the ggi interface
class display { public:
display(int sizex, int sizey, int pixsizex, int pixsizey, ggi_color* colors); ~display() { ggiClose(visual); ggiExit(); }
void flush(); bool keypressed() { return ggiKbhit(visual); } void clear(); void putpixel(int x, int y, cell_type c);
private:
ggi_visual_t visual; int size_x, size_y; int pixel_size_x, pixel_size_y; ggi_pixel pixels[4];
};
display::display(int sizex, int sizey, int pixsizex, int pixsizey,
ggi_color* colors): pixel_size_x(pixsizex), pixel_size_y(pixsizey)
{
if (ggiInit() < 0) { std::cerr << "couldn't open ggi\n"; exit(1); }
visual = ggiOpen(NULL); if (!visual) { ggiPanic("couldn't open visual\n"); }
ggi_mode mode; if (ggiCheckGraphMode(visual, sizex, sizey, GGI_AUTO, GGI_AUTO, GT_4BIT, &mode) != 0) { if (GT_DEPTH(mode.graphtype) < 2) // we need 4 colors! ggiPanic("low-color displays are not supported!\n"); } if (ggiSetMode(visual, &mode) != 0) { ggiPanic("couldn't set graph mode\n"); } ggiAddFlags(visual, GGIFLAG_ASYNC);
size_x = mode.virt.x; size_y = mode.virt.y;
for (int i = 0; i < 4; ++i) pixels[i] = ggiMapColor(visual, colors+i);
}
void display::flush() {
// set the current display frame to the one we have drawn to ggiSetDisplayFrame(visual, ggiGetWriteFrame(visual));
// flush the current visual ggiFlush(visual);
// try to set a different frame for drawing (errors are ignored; if // setting the new frame fails, the current one will be drawn upon, // with the only adverse effect being some flickering). ggiSetWriteFrame(visual, 1-ggiGetDisplayFrame(visual));
}
void display::clear() {
ggiSetGCForeground(visual, pixels[0]); ggiDrawBox(visual, 0, 0, size_x, size_y);
}
void display::putpixel(int x, int y, cell_type cell) {
// this draws a logical pixel (i.e. a rectangle of size pixel_size_x // times pixel_size_y), not a physical pixel ggiSetGCForeground(visual, pixels[cell]); ggiDrawBox(visual, x*pixel_size_x, y*pixel_size_y, pixel_size_x, pixel_size_y);
}
// ***************** // * the wireworld * // *****************
// initialized to an empty wireworld class wireworld { public:
void set(int posx, int posy, cell_type type); void draw(display& destination); void step();
private:
typedef std::pair<int, int> position; typedef std::set<position> position_set; typedef position_set::iterator positer; position_set wires, heads, tails;
};
void wireworld::set(int posx, int posy, cell_type type) {
position p(posx, posy); wires.erase(p); heads.erase(p); tails.erase(p); switch(type) { case head: heads.insert(p); break; case tail: tails.insert(p); break; case wire: wires.insert(p); break; }
}
void wireworld::draw(display& destination) {
destination.clear(); for (positer i = heads.begin(); i != heads.end(); ++i) destination.putpixel(i->first, i->second, head); for (positer i = tails.begin(); i != tails.end(); ++i) destination.putpixel(i->first, i->second, tail); for (positer i = wires.begin(); i != wires.end(); ++i) destination.putpixel(i->first, i->second, wire); destination.flush();
}
void wireworld::step() {
std::map<position, int> new_heads; for (positer i = heads.begin(); i != heads.end(); ++i) for (int dx = -1; dx <= 1; ++dx) for (int dy = -1; dy <= 1; ++dy) { position pos(i->first + dx, i->second + dy); if (wires.count(pos)) new_heads[pos]++; } wires.insert(tails.begin(), tails.end()); tails.swap(heads); heads.clear(); for (std::map<position, int>::iterator i = new_heads.begin(); i != new_heads.end(); ++i) {
// std::cout << i->second;
if (i->second < 3) { wires.erase(i->first); heads.insert(i->first); } }
}
ggi_color colors[4] =
{{ 0x0000, 0x0000, 0x0000 }, // background: black { 0x8000, 0x8000, 0x8000 }, // wire: white { 0xffff, 0xffff, 0x0000 }, // electron head: yellow { 0xffff, 0x0000, 0x0000 }}; // electron tail: red
int main(int argc, char* argv[]) {
int display_x = 800; int display_y = 600; int pixel_x = 5; int pixel_y = 5;
if (argc < 2) { std::cerr << "No file name given!\n"; return 1; }
// assume that the first argument is the name of a file to parse std::ifstream f(argv[1]); wireworld w; std::string line; int line_number = 0; while (std::getline(f, line)) { for (int col = 0; col < line.size(); ++col) { switch (line[col]) { case 'h': case 'H': w.set(col, line_number, head); break; case 't': case 'T': w.set(col, line_number, tail); break; case 'w': case 'W': case '.': w.set(col, line_number, wire); break; default: std::cerr << "unrecognized character: " << line[col] << "\n"; return 1; case ' ': ; // no need to explicitly set this, so do nothing } } ++line_number; }
display d(display_x, display_y, pixel_x, pixel_y, colors);
w.draw(d);
while (!d.keypressed()) { usleep(100000); w.step(); w.draw(d); } std::cout << std::endl;
}</lang>
Common Lisp
<lang lisp>(defun electron-neighbors (wireworld row col)
(destructuring-bind (rows cols) (array-dimensions wireworld) (loop for off-row from (max 0 (1- row)) to (min (1- rows) (1+ row)) sum (loop for off-col from (max 0 (1- col)) to (min (1- cols) (1+ col)) count (and (not (and (= off-row row) (= off-col col))) (eq 'electron-head (aref wireworld off-row off-col)))))))
(defun wireworld-next-generation (wireworld)
(destructuring-bind (rows cols) (array-dimensions wireworld) (let ((backing (make-array (list rows cols)))) (do ((c 0 (if (= c (1- cols)) 0 (1+ c))) (r 0 (if (= c (1- cols)) (1+ r) r))) ((= r rows)) (setf (aref backing r c) (aref wireworld r c))) (do ((c 0 (if (= c (1- cols)) 0 (1+ c))) (r 0 (if (= c (1- cols)) (1+ r) r))) ((= r rows)) (setf (aref wireworld r c) (case (aref backing r c) (electron-head 'electron-tail) (electron-tail 'conductor) (conductor (case (electron-neighbors backing r c) ((1 2) 'electron-head) (otherwise 'conductor))) (otherwise nil)))))))
(defun print-wireworld (wireworld)
(destructuring-bind (rows cols) (array-dimensions wireworld) (do ((r 0 (1+ r))) ((= r rows)) (do ((c 0 (1+ c))) ((= c cols)) (format t "~C" (case (aref wireworld r c) (electron-head #\H) (electron-tail #\t) (conductor #\.) (otherwise #\Space)))) (format t "~&"))))
(defun wireworld-show-gens (wireworld n)
(dotimes (m n) (terpri) (wireworld-next-generation wireworld) (print-wireworld wireworld)))
(defun ww-char-to-symbol (char)
(ecase char (#\Space 'nil) (#\. 'conductor) (#\t 'electron-tail) (#\H 'electron-head)))
(defun make-wireworld (image)
"Make a wireworld grid from a list of strings (rows) of equal length
(columns), each character being ' ', '.', 'H', or 't'."
(make-array (list (length image) (length (first image))) :initial-contents (mapcar (lambda (s) (map 'list #'ww-char-to-symbol s)) image)))
(defun make-rosetta-wireworld ()
(make-wireworld '("tH........." ". . " " ... " ". . " "Ht.. ......")))</lang>
Output:
CL-USER> (wireworld-show-gens (make-rosetta-wireworld) 12) .tH........ H . ... H . t... ...... H.tH....... t . ... t . .H.. ...... tH.tH...... . H ... . . HtH. ...... .tH.tH..... H t HHH H . t.tH ...... H.tH.tH.... t . ttt t . .H.t ...... tH.tH.tH... . H ... . . HtH. ...... .tH.tH.tH.. H t HHH H . t.tH ...... H.tH.tH.tH. t . ttt t . .H.t ...... tH.tH.tH.tH . H ... . . HtH. ...... .tH.tH.tH.t H t HHH H . t.tH ...... H.tH.tH.tH. t . ttt t . .H.t ...... tH.tH.tH.tH . H ... . . HtH. ......
D
<lang d>import std.stdio ; import std.string ; import std.algorithm ;
class World {
int[] w ; int width, height ; this(int x, int y) { w = new int[]((x+2)*(y+2)) ; width = x ; height = y ; } int opIndex(int x, int y) { return w[(y+1)*(width+2) + x+1] ; } void opIndexAssign(int st, int x, int y) { w[(y+1)*(width+2) + x+1] = st ; } int mooreNeighbor(int x, int y, int neighbor) { int sum = 0 ; foreach(dx ; [-1,0,1]) foreach(dy ; [-1,0,1]) if(!(dx == 0 && dy == 0) && (opIndex(x+dx, y+dy) == neighbor)) sum++ ; return sum ; }
}
class WireWorld {
enum {BORDER, EMPTY, HEAD, TAIL, LEAD} ; const int[] StChange = [BORDER, EMPTY, TAIL, LEAD, LEAD] ; const string REP = "X Ht." ;
World w ;
this(string initState) { auto s = split(chomp(initState), "\n") ; auto height = s.length ; auto width = reduce!"a > b? a : b"(0, map!"a.length"(s)) ; w = new World(width, height) ; for(int j = 0 ; j < height ; j++) for(int i = 0 ; i < width ; i++) { if(i >= s[j].length) w[i,j] = EMPTY ; else { auto state = std.algorithm.indexOf(REP, s[j][i]) ; w[i,j] = (state == -1) ? EMPTY : state ; } } } WireWorld runNext() { auto nextw = new World(w.width, w.height) ; for(int j = 0 ; j < w.height ; j++) for(int i = 0 ; i < w.width ; i++) if(w[i,j] != LEAD) // deterministic change // nextw[i,j] = StChange[w[i,j]] ; else { // special case for LEAD // auto n = w.mooreNeighbor(i,j, HEAD) ; nextw[i,j] = (n == 1 || n == 2) ? HEAD : LEAD ; } w = nextw ; return this ; } string toString() { string s ; for(int j = 0 ; j < w.height ; j++) { for(int i = 0 ; i < w.width ; i++) s ~= REP[w[i,j]] ; s ~= "\n" ; } return s ; }
}
void main() {
auto w = new WireWorld(q"EOS
tH......... . .
...
. . Ht.. ...... EOS") ;
writefln("initial:\n------\n%s", w) ; foreach(turn ; 1..8) writefln("turn:%d\n------\n%s", turn, w.runNext()) ;
}</lang>
Forth
<lang forth>16 constant w
8 constant h
- rows w * 2* ;
1 rows constant row h rows constant size
create world size allot world value old old w + value new
- init world size erase ;
- age new old to new to old ;
- foreachrow ( xt -- )
size 0 do I over execute row +loop drop ;
0 constant EMPTY 1 constant HEAD 2 constant TAIL 3 constant WIRE create cstate bl c, char H c, char t c, char . c,
- showrow ( i -- ) cr
old + w over + swap do I c@ cstate + c@ emit loop ;
- show ['] showrow foreachrow ;
- line ( row addr len -- )
bounds do i c@ case bl of EMPTY over c! endof 'H of HEAD over c! endof 't of TAIL over c! endof '. of WIRE over c! endof endcase 1+ loop drop ;
- load ( filename -- )
r/o open-file throw init old row + 1+ ( file row ) begin over pad 80 rot read-line throw while over pad rot line row + repeat 2drop close-file throw show cr ;
- +head ( sum i -- sum )
old + c@ HEAD = if 1+ then ;
- conductor ( i WIRE -- i HEAD|WIRE )
drop 0 over 1- row - +head over row - +head over 1+ row - +head over 1- +head over 1+ +head over 1- row + +head over row + +head over 1+ row + +head 1 3 within if HEAD else WIRE then ;
\ before: empty head tail wire
create transition ' noop , ' 1+ , ' 1+ , ' conductor ,
\ after: empty tail wire head|wire
- new-state ( i -- )
dup old + c@ dup cells transition + @ execute swap new + c! ;
- newrow ( i -- )
w over + swap do I new-state loop ;
- gen ['] newrow foreachrow age ;
- wireworld begin gen 0 0 at-xy show key? until ;</lang>
Output:
s" wireworld.diode" load .. tH...... .Ht .. ok gen show .. .tH..... Ht. .. ok gen show .H ..tH.... t.. .H ok gen show Ht ...tH..H ... Ht ok gen show t. ....tH.t ... t. ok gen show .. .....tH. ... .. ok gen show H. ......tH ... H. ok gen show tH .......t ... tH ok gen show .t ........ H.. .t ok gen show .. ........ tH. .. ok gen show .. ........ .tH .. ok gen show .. ........ ..t .. ok gen show .. ........ ... .. ok
Fortran
<lang fortran>program Wireworld
implicit none integer, parameter :: max_generations = 12 integer :: nrows = 0, ncols = 0, maxcols = 0 integer :: gen, ierr = 0 integer :: i, j character(1), allocatable :: cells(:,:) character(10) :: form, sub character(80) :: buff
! open input file
open(unit=8, file="wwinput.txt")
! find numbers of rows and columns in data
do read(8, "(a)", iostat=ierr) buff if(ierr /= 0) exit nrows = nrows + 1 ncols = len_trim(buff) if(ncols > maxcols) maxcols = ncols end do
! allcate enough space to hold the data
allocate(cells(0:nrows+1, 0:maxcols+1)) cells = " "
! load data
rewind(8) do i = 1, nrows read(8, "(a)", iostat=ierr) buff if(ierr /= 0) exit do j = 1, maxcols cells(i, j) = buff(j:j) end do end do close(8)
! calculate format string for write statement
write(sub, "(i8)") maxcols form = "(" // trim(adjustl(sub)) // "a1)" do gen = 0, max_generations write(*, "(/a, i0)") "Generation ", gen do i = 1, nrows write(*, form) cells(i, 1:maxcols) end do call nextgen(cells) end do deallocate(cells) contains subroutine Nextgen(cells) character, intent(in out) :: cells(0:,0:) character :: buffer(0:size(cells, 1)-1, 0:size(cells, 2)-1) integer :: i, j, h buffer = cells ! Store current status do i = 1, size(cells, 1)-2 do j = 1, size(cells, 2)-2 select case (buffer(i, j)) case(" ") ! no Change case("H") ! If a head change to tail cells(i, j) = "t" case("t") ! if a tail change to conductor cells(i, j) = "." case (".") ! Count number of electron heads in surrounding eight cells. ! We can ignore that fact that we count the centre cell as ! well because we already know it contains a conductor. ! If surrounded by 1 or 2 heads change to a head h = sum(count(buffer(i-1:i+1, j-1:j+1) == "H", 1)) if(h == 1 .or. h == 2) cells(i, j) = "H" end select end do end do end subroutine Nextgen
end program Wireworld</lang> Output
Generation 0 tH... . . ....... ...... . . tH... Generation 1 .tH.. . . ....... ...... . . .tH.. Generation 2 ..tH. . . ....... ...... . . ..tH. Generation 3 ...tH . . ....... ...... . . ...tH Generation 4 ....t . H ....... ...... . H ....t Generation 5 ..... . t ......H H..... . t ..... Generation 6 ..... . . .....Ht tH.... . . ..... Generation 7 ..... . . ....Ht. .tH... . . ..... Generation 8 ..... . . ...Ht.. ..tH.. . . ..... Generation 9 ..... . . ..Ht... ...tH. . . ..... Generation 10 ..... H . .Ht.... ....tH H . ..... Generation 11 H.... t . .t..... .....t t . H.... Generation 12 tH... . . ....... ...... . . tH...
Haskell
<lang Haskell>import Data.List import Control.Monad import Control.Arrow import Data.Maybe
states=" Ht." shiftS=" t.."
borden bc xs = bs: (map (\x -> bc:(x++[bc])) xs) ++ [bs]
where r = length $ head xs bs = replicate (r+2) bc
take3x3 = ap ((.). taken. length) (taken. length. head) `ap` borden '*'
where taken n = transpose. map (take n.map (take 3)).map tails
nwState xs | e =='.' && noH>0 && noH<3 = 'H'
| otherwise = shiftS !! (fromJust $ elemIndex e states) where e = xs!!1!!1 noH = length $ filter (=='H') $ concat xs
runCircuit = iterate (map(map nwState).take3x3)</lang> Example executed in GHCi: <lang Haskell>oscillator= [" tH ",
". ....", " .. " ]
example = mapM_ (mapM_ putStrLn) .map (borden ' ').take 9 $ runCircuit oscillator</lang> Ouptput:
*Main> example tH . .... .. .t . H... .. .. . tH.. .H .. . .tH. Ht .. H ..tH t. H. t ...t .. tH . .... .. .t . H... .. .. . tH.. .H (0.01 secs, 541764 bytes)
J
The example circuit:<lang J>circ0=:}: ] ;. _1 LF, 0 : 0 tH........ . .
...
. . Ht.. ..... )</lang> A 'boarding' verb board and the next cell state verb nwS: <lang J>board=: ' ' ,.~ ' ' ,. ' ' , ' ' ,~ ]
nwS=: 3 : 0
e=. (<1 1){y if. ('.'=e)*. e.&1 2 +/'H'=,y do. 'H' return. end. ' t..' {~ ' Ht.' i. e
)</lang> The 'most' powerful part is contained in the following iterating sentence, namely the dyad cut ;. [1]. In this way verb nwS can work on all the 3x3 matrices containing each cell surrounded by its 8 relevant neighbors. <lang J> process=: (3 3 nwS;. _3 board)^: (<10) process circuit</lang> Example run:
(<10) process circ0 tH........ . . ... . . Ht.. ..... .tH....... H . ... H . t... ..... H.tH...... t . ... t . .H.. ..... tH.tH..... . H ... . . HtH. ..... .tH.tH.... H t HHH H . t.tH ..... H.tH.tH... t . ttt t . .H.t ..... tH.tH.tH.. . H ... . . HtH. ..... .tH.tH.tH. H t HHH H . t.tH ..... H.tH.tH.tH t . ttt t . .H.t ..... tH.tH.tH.t . H ... . . HtH. .....
Note also that a graphical presentation can be achieved using viewmat. For example:
<lang j>require'viewmat' viewmat"2 ' .tH'i. (<10) process circ0</lang>
(This example opens 10 windows, one for each generation.)
Java
See: Wireworld/Java
OCaml
<lang ocaml>let w = [|
" ......tH "; " . ...... "; " ...Ht... . "; " .... "; " . ..... "; " .... "; " tH...... . "; " . ...... "; " ...Ht... "; |]
let is_head w x y =
try if w.(x).[y] = 'H' then 1 else 0 with _ -> 0
let neighborhood_heads w x y =
let n = ref 0 in for _x = pred x to succ x do for _y = pred y to succ y do n := !n + (is_head w _x _y) done; done; (!n)
let step w =
let n = Array.init (Array.length w) (fun i -> String.copy w.(i)) in let width = Array.length w and height = String.length w.(0) in for x = 0 to pred width do for y = 0 to pred height do n.(x).[y] <- ( match w.(x).[y] with | ' ' -> ' ' | 'H' -> 't' | 't' -> '.' | '.' -> (match neighborhood_heads w x y with | 1 | 2 -> 'H' | _ -> '.') | _ -> assert false) done; done; (n)
let print = (Array.iter print_endline)
let () =
let rec aux w = Unix.sleep 1; let n = step w in print n; aux n in aux w</lang>
Oz
Includes a simple animation, using a text widget. <lang oz>declare
Rules = [rule(& & ) rule(&H &t) rule(&t &.) rule(&. &H when:fun {$ Neighbours} fun {IsHead X} X == &H end Hs = {Filter Neighbours IsHead} Len = {Length Hs} in Len == 1 orelse Len == 2 end) rule(&. &.)]
Init = ["tH........." ". . " " ... " ". . " "Ht.. ......"]
MaxGen = 100
%% G(i) -> G(i+1) fun {Evolve Gi} fun {Get X#Y} Row = {CondSelect Gi Y unit} in {CondSelect Row X & } %% cells beyond boundaries are empty end fun {GetNeighbors X Y} {Map [X-1#Y-1 X#Y-1 X+1#Y-1 X-1#Y X+1#Y X-1#Y+1 X#Y+1 X+1#Y+1] Get} end in {Record.mapInd Gi fun {$ Y Row} {Record.mapInd Row fun {$ X C} for Rule in Rules return:Return do if C == Rule.1 then
When = {CondSelect Rule when {Const true}} in if {When {GetNeighbors X Y}} then {Return Rule.2} end end end
end} end} end
%% Create an arena from a list of strings. fun {ReadArena LinesList} {List.toTuple '#' {Map LinesList fun {$ Line} {List.toTuple row Line} end}} end %% Converts an arena to a virtual string fun {ShowArena G} {Record.map G fun {$ L} {Record.toList L}#"\n" end} end
%% helpers fun lazy {Iterate F V} V|{Iterate F {F V}} end fun {Const X} fun {$ _} X end end %% prepare GUI [QTk]={Module.link ["x-oz://system/wp/QTk.ozf"]} GenDisplay Field GUI = td(label(handle:GenDisplay) label(handle:Field font:{QTk.newFont font(family:'Courier')}) ) {{QTk.build GUI} show}
G0 = {ReadArena Init} Gn = {Iterate Evolve G0}
in
for Gi in Gn I in 0..MaxGen do {GenDisplay set(text:"Gen. "#I)} {Field set(text:{ShowArena Gi})} {Delay 500} end</lang>
Perl 6
<lang perl6>class Grid {
has $.width; has $.height; has @.matrix;
multi method new (@m) { Grid.bless(*, width => @m[0].elems, height => @m.elems, matrix => @m); }
multi method new (Str $o) { my @m = $o.lines.map({ [ .comb ] }); Grid.new(@m); }
method clone { Grid.new( @.matrix.map({[ .clone ]}) ); }
method Str { join , do for ^@.height -> $i { @.matrix[$i][^$.width], "\n"; } }
method postcircumfix:<[ ]> ($i) { @.matrix[$i]; }
method neighbors($i,$j) { [$i + .[0], $j + .[1]]
if 0 <= $i + .[0] < $.width && 0 <= $j + .[1] < $.height for [-1,-1],[+0,-1],[+1,-1], [-1,+0],( ),[+1,+0], [-1,+1],[+0,+1],[+1,+1];
}
method step { my $d = self.clone; for ^$.width X ^$.height -> $i, $j { given $d[$i][$j] { when 'H' { @.matrix[$i][$j] = 't' } when 't' { @.matrix[$i][$j] = '.' } when '.' { @.matrix[$i][$j] = 'H'
if any(1,2) == [+] $d.neighbors($i,$j).map: {$d[.[0]][.[1]] eq 'H'} }
} } }
}
my $str = "tH......... . .
...
. . Ht.. ......";
my $g = Grid.new($str);
- my $g = Grid.new( (open "filename").slurp ); # from a file
for ^10 {
say $g; $g.step;
}</lang>
PicoLisp
This example uses 'grid' from "lib/simul.l", which maintains a two-dimensional structure. <lang PicoLisp>(load "@lib/simul.l")
(let
(Data (in "wire.data" (make (while (line) (link @)))) Grid (grid (length (car Data)) (length Data)) ) (mapc '((G D) (mapc put G '(val .) D)) Grid (apply mapcar (flip Data) list) ) (loop (disp Grid T '((This) (pack " " (: val) " ")) ) (wait 1000) (for Col Grid (for This Col (case (=: next (: val)) ("H" (=: next "t")) ("t" (=: next ".")) ("." (when (>= 2 (cnt # Count neighbors '((Dir) (= "H" (get (Dir This) 'val))) (quote west east south north ((X) (south (west X))) ((X) (north (west X))) ((X) (south (east X))) ((X) (north (east X))) ) ) 1 ) (=: next "H") ) ) ) ) ) (for Col Grid # Update (for This Col (=: val (: next)) ) ) (prinl) ) )</lang>
Output:
+---+---+---+---+---+---+---+---+---+---+---+ 5 | t | H | . | . | . | . | . | . | . | . | . | +---+---+---+---+---+---+---+---+---+---+---+ 4 | . | | | | . | | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 3 | | | | . | . | . | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 2 | . | | | | . | | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 1 | H | t | . | . | | . | . | . | . | . | . | +---+---+---+---+---+---+---+---+---+---+---+ a b c d e f g h i j k +---+---+---+---+---+---+---+---+---+---+---+ 5 | . | t | H | . | . | . | . | . | . | . | . | +---+---+---+---+---+---+---+---+---+---+---+ 4 | H | | | | . | | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 3 | | | | . | . | . | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 2 | H | | | | . | | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 1 | t | . | . | . | | . | . | . | . | . | . | +---+---+---+---+---+---+---+---+---+---+---+ a b c d e f g h i j k +---+---+---+---+---+---+---+---+---+---+---+ 5 | H | . | t | H | . | . | . | . | . | . | . | +---+---+---+---+---+---+---+---+---+---+---+ 4 | t | | | | . | | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 3 | | | | . | . | . | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 2 | t | | | | . | | | | | | | +---+---+---+---+---+---+---+---+---+---+---+ 1 | . | H | . | . | | . | . | . | . | . | . | +---+---+---+---+---+---+---+---+---+---+---+ a b c d e f g h i j k
PureBasic
Standalone version
<lang PureBasic>Enumeration
#Empty #Electron_head #Electron_tail #Conductor
EndEnumeration
- Delay=100
- XSize=23
- YSize=12
Procedure Limit(n, min, max)
If n<min n=min ElseIf n>max n=max EndIf ProcedureReturn n
EndProcedure
Procedure Moore_neighborhood(Array World(2),x,y)
Protected cnt=0, i, j For i=Limit(x-1, 0, #XSize) To Limit(x+1, 0, #XSize) For j=Limit(y-1, 0, #YSize) To Limit(y+1, 0, #YSize) If World(i,j)=#Electron_head cnt+1 EndIf Next Next ProcedureReturn cnt
EndProcedure
Procedure PresentWireWorld(Array World(2))
Protected x,y ;ClearConsole() For y=0 To #YSize For x=0 To #XSize ConsoleLocate(x,y) Select World(x,y) Case #Electron_head ConsoleColor(12,0): Print("#") Case #Electron_tail ConsoleColor(4,0): Print("#") Case #Conductor ConsoleColor(6,0): Print("#") Default ConsoleColor(15,0): Print(" ") EndSelect Next PrintN("") Next
EndProcedure
Procedure UpdateWireWorld(Array World(2))
Dim NewArray(#XSize,#YSize) Protected i, j For i=0 To #XSize For j=0 To #YSize Select World(i,j) Case #Electron_head NewArray(i,j)=#Electron_tail Case #Electron_tail NewArray(i,j)=#Conductor Case #Conductor Define m=Moore_neighborhood(World(),i,j) If m=1 Or m=2 NewArray(i,j)=#Electron_head Else NewArray(i,j)=#Conductor EndIf Default ; e.g. should be Empty NewArray(i,j)=#Empty EndSelect Next Next CopyArray(NewArray(),World())
EndProcedure
If OpenConsole()
EnableGraphicalConsole(#True) ConsoleTitle("XOR() WireWorld") ;- Set up the WireWorld Dim WW.i(#XSize,#YSize) Define x, y Restore StartWW For y=0 To #YSize For x=0 To #XSize Read.i WW(x,y) Next Next ;- Start the WireWorld simulation Repeat PresentWireWorld(WW()) UpdateWireWorld(WW()) Delay(#Delay) ForEver
EndIf
DataSection
StartWW: Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 Data.i 0,0,0,3,3,3,3,2,1,3,3,0,0,0,0,0,0,0,0,0,0,0,0,0 Data.i 0,0,1,0,0,0,0,0,0,0,0,3,3,3,3,3,3,0,0,0,0,0,0,0 Data.i 0,0,0,2,3,3,3,3,3,3,3,0,0,0,0,0,0,3,0,0,0,0,0,0 Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,0,0,0,0 Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,0,0,3,3,3,3,3 Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,3,3,3,0,0,0,0 Data.i 0,0,0,3,3,3,3,3,3,3,3,0,0,0,0,0,0,3,0,0,0,0,0,0 Data.i 0,0,1,0,0,0,0,0,0,0,0,3,3,3,3,3,3,0,0,0,0,0,0,0 Data.i 0,0,0,2,3,3,3,3,1,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0 Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 Data.i 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
EndDataSection</lang>
Load from external source, graphical presentations
<lang PureBasic>CompilerIf #PB_Compiler_Unicode
CompilerError "The file handling in this small program is only in ASCII."
CompilerEndIf
Enumeration
#Empty #Electron_head #Electron_tail #Conductor #COL_Empty = $000000 #COL_Electron_head = $5100FE #COL_Electron_tail = $6A3595 #COL_Conductor = $62C4FF #WW_Window = 0 #WW_IGadget = 0 #WW_Timer = 0 #WW_Image = 0
EndEnumeration
- Delay=100
Global XSize, YSize
Procedure Limit(n, min, max)
If n<min: n=min ElseIf n>max: n=max EndIf ProcedureReturn n
EndProcedure
Procedure Moore_neighborhood(Array World(2),x,y)
Protected cnt=0, i, j For i=Limit(x-1, 0, XSize) To Limit(x+1, 0, XSize) For j=Limit(y-1, 0, YSize) To Limit(y+1, 0, YSize) If World(i,j)=#Electron_head cnt+1 EndIf Next Next ProcedureReturn cnt
EndProcedure
Procedure PresentWireWorld(Array World(2))
Protected x,y StartDrawing(ImageOutput(#WW_Image)) For y=0 To YSize-1 For x=0 To XSize-1 Select World(x,y) Case #Electron_head Plot(x,y,#COL_Electron_head) Case #Electron_tail Plot(x,y,#COL_Electron_tail) Case #Conductor Plot(x,y,#COL_Conductor) Default Plot(x,y,#COL_Empty) EndSelect Next Next StopDrawing() ImageGadget(#WW_IGadget,0,0,XSize,YSize,ImageID(#WW_Image))
EndProcedure
Procedure UpdateWireWorld(Array World(2))
Dim NewArray(XSize,YSize) Protected i, j For i=0 To XSize For j=0 To YSize Select World(i,j) Case #Electron_head NewArray(i,j)=#Electron_tail Case #Electron_tail NewArray(i,j)=#Conductor Case #Conductor Define m=Moore_neighborhood(World(),i,j) If m=1 Or m=2 NewArray(i,j)=#Electron_head Else NewArray(i,j)=#Conductor EndIf Default ; e.g. should be Empty NewArray(i,j)=#Empty EndSelect Next Next CopyArray(NewArray(),World())
EndProcedure
Procedure LoadDataFromFile(File$,Array A(2))
Define Line$, x, y, *c.Character If OpenFile(0,File$) ; ; Count non-commented lines & length of the first line, e.g. get Array(x,y) While Not Eof(0) Line$=Trim(ReadString(0)) *c=@Line$ If Not PeekC(*c)=';' y+1 If Not x While PeekC(*c)>='0' And PeekC(*c)<='3' x+1: *c+1 Wend EndIf EndIf Wend XSize=x: YSize=y Dim A(XSize,YSize) ; ; Read in the Wire-World y=0 FileSeek(0,0) While Not Eof(0) Line$=Trim(ReadString(0)) *c=@Line$ If Not PeekC(*c)=';' x=0 While x<XSize A(x,y)=PeekC(*c)-'0' x+1: *c+1 Wend y+1 EndIf Wend CloseFile(0) EndIf
EndProcedure
- Title="WireWorld, PureBasic"
If OpenWindow(#WW_Window,0,0,XSize,YSize,#Title,#PB_Window_SystemMenu)
Dim WW.i(0,0) Define Pattern$ = "Text (*.txt)|*.txt", Pattern = 0 Define DefFile$ = "WireWorld.txt", Event Define Title$ = "Please choose file To load" Define File$ = OpenFileRequester(Title$, DefFile$, Pattern$, Pattern) AddWindowTimer(#WW_Window,#WW_Timer,#Delay) LoadDataFromFile(File$,WW()) ResizeWindow(#WW_Window,0,0,XSize,YSize) CreateImage(#WW_Image,XSize,YSize) Repeat Event=WaitWindowEvent() If Event=#PB_Event_Timer PresentWireWorld(WW()) UpdateWireWorld (WW()) EndIf Until Event=#PB_Event_CloseWindow
EndIf</lang> Example of data file to load
; Save as "WireWorld.txt" ; ; ;=Comment ; 0=Empty Cell ; 1=Electron Head ; 2=Electron Tail ; 3=Conductor ; ; All lines nees to be of the same length, ; and containing only the defined values. ; ; ; Start of World ; 000000000000000000000000000000000000000000030030000000000000000000000000 000000000000000000000000000000000000000000300030000000000000000000000000 000333321330000000000000000000000033330003000030000000000000000000000000 001000000003333330000000000000000030030030000030000000000000000000000000 000233333330000003000000000000000030003300033330000000000000000000000000 000000000000000033330000333000000030000000030003330000000000000000000000 000000000000000030033333300333333333333333333333003333333333333333333333 000000000000000033330000333000000000000000000003330000030000000000000000 000333333330000003000000000000000000000000000000000000030000000000000000 001000000003333330000000033333330033333330000000000000030000000000000000 000233331230000000000000030000030030000030000000000033333333300000000000 000000000000000000000000030000030030000300000000000300000003000000000000 000000000000000000000000033333330033333000000000000003000033000000000000 000000000000000000000000030000000030000300000000000000333030000000000000 000000000000000000000000030000000030000030000000000000300033333333333330 000333321330000000000000030000000030000030003330000000333000000000000000 001000000003333330000000030000000003333300003330000000000000000000000000 000233333330000003000000300000000003000000003000000000000000000000000000 000000000000000033330003000033000030000000030000000000000000000000000000 000000000000000030033333333330333333333333333333333333333333333333333333 000000000000000033330000000033003000000000000000300000000000000000000000 000333333330000003000000000000003000000000000000300000000000000000000000 001000000003333330000000000000003000000000000000300000000000000000000000 000233331230000000000000000000003330000000000000300000000000000000000000 000000000000000000000000000000000030000000000000300000000000000000000000 000000000000000000000000000000000030000000000003333000000000000000000000 000000000000000000000000000000000030000000000003003333333333333333333333 000000000000000000000000000000000030000000000003333000000000000000000000 000333321330000000000000000000000003333000000000300000000000000000000000 001000000003333330000000000000000003003000000000300000000000000000000000 000233333330000003000000000000000003003333333333300000000000000000000000 000000000000000033330000330000000003000000000000000000000000000000000000 000000000000000030033333303333333333333333333333333333333333333333333333 000000000000000033330000330000000000000000000000000000000000000000000003 000333333330000003000000000000000000000000000000000000000000000000000003 001000000003333330000000003333333333333333333333333333333333333333333003 000233331230000000000000030000000000000000000000000000000000000000000003 000000000000000333333333333333333333333333333333333333333333333333333333 000000000000000300000000000000000000000000000000000000000000000000000000
Python
<lang python> Wireworld implementation.
from io import StringIO from collections import namedtuple from pprint import pprint as pp import copy
WW = namedtuple('WW', 'world, w, h') head, tail, conductor, empty = allstates = 'Ht. '
infile = StringIO(\
tH.........
. .
...
. . Ht.. ......\ )
def readfile(f):
file > initial world configuration world = [row.rstrip('\r\n') for row in f] height = len(world) width = max(len(row) for row in world) # fill right and frame in empty cells nonrow = [ " %*s " % (-width, "") ] world = nonrow + \ [ " %*s " % (-width, row) for row in world ] + \ nonrow world = [list(row) for row in world] return WW(world, width, height)
def newcell(currentworld, x, y):
istate = currentworld[y][x] assert istate in allstates, 'Wireworld cell set to unknown value "%s"' % istate if istate == head: ostate = tail elif istate == tail: ostate = conductor elif istate == empty: ostate = empty else: # istate == conductor n = sum( currentworld[y+dy][x+dx] == head for dx,dy in ( (-1,-1), (-1,+0), (-1,+1), (+0,-1), (+0,+1), (+1,-1), (+1,+0), (+1,+1) ) ) ostate = head if 1 <= n <= 2 else conductor return ostate
def nextgen(ww):
'compute next generation of wireworld' world, width, height = ww newworld = copy.deepcopy(world) for x in range(1, width+1): for y in range(1, height+1): newworld[y][x] = newcell(world, x, y) return WW(newworld, width, height)
def world2string(ww):
return '\n'.join( .join(row[1:-1]).rstrip() for row in ww.world[1:-1] )
ww = readfile(infile) infile.close()
for gen in range(10):
print ( ("\n%3i " % gen) + '=' * (ww.w-4) + '\n' ) print ( world2string(ww) ) ww = nextgen(ww)</lang>
Sample Output
0 ======= tH......... . . ... . . Ht.. ...... 1 ======= .tH........ H . ... H . t... ...... 2 ======= H.tH....... t . ... t . .H.. ...... 3 ======= tH.tH...... . H ... . . HtH. ...... 4 ======= .tH.tH..... H t HHH H . t.tH ...... 5 ======= H.tH.tH.... t . ttt t . .H.t ...... 6 ======= tH.tH.tH... . H ... . . HtH. ...... 7 ======= .tH.tH.tH.. H t HHH H . t.tH ...... 8 ======= H.tH.tH.tH. t . ttt t . .H.t ...... 9 ======= tH.tH.tH.tH . H ... . . HtH. ......
Ruby
See: Wireworld/Ruby
Tcl
See: Wireworld/Tcl
Ursala
The board is represented as a list of character strings, and the neighborhoods function uses the swin library function twice to construct a two dimensional 3 by 3 sliding window. The rule function maps a pair (cell,neighborhood) to a new cell. <lang Ursala>#import std
rule = case~&l\~&l {`H: `t!, `t: `.!,`.: @r ==`H*~; {'H','HH'}?</`H! `.!}
neighborhoods = ~&thth3hthhttPCPthPTPTX**K7S+ swin3**+ swin3@hNSPiCihNCT+ --<0>*+ 0-*
evolve "n" = @iNC ~&x+ rep"n" ^C\~& rule**+ neighborhoods@h</lang> test program: <lang Ursala>diode =
<
' .. ', 'tH....... .Ht', ' .. '>
- show+
example = mat0 evolve13 diode</lang> output:
.. tH....... .Ht .. .. .tH...... Ht. .. .H ..tH..... t.. .H Ht ...tH...H ... Ht t. ....tH..t ... t. .. .....tH.. ... .. .. ......tH. ... .. H. .......tH ... H. tH ........t ... tH .t ......... H.. .t .. ......... tH. .. .. ......... .tH .. .. ......... ..t .. .. ......... ... ..