Wireworld

Wireworld
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

C

See: Wireworld/C

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

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 $ findIndex (==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> (3 3 nwS;. _3 board)^: (<10) circuit</lang> Example run:

   (3 3 nwS;. _3 board)^: (<10) 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. .....

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>

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  = f.readlines()
   world  = [row.rstrip('\r\n') for row in world]
   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',
  '        ..   '>

1. 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
        ..   

        ..   
......... ...
        ..