Option Explicit

Private Const PATHFILE As String = "C:\HOME\VBA\ROSETTA"

Sub Main()
Dim arr
Dim Dict As Object
Dim Book As String, temp As String
Dim T#
T = Timer
   Book = ExtractTxt(PATHFILE & "\les miserables.txt")
   temp = RemovePunctuation(Book)
   temp = UCase(temp)
   arr = Split(temp, " ")
   Set Dict = CreateObject("Scripting.Dictionary")
   FillDictionary Dict, arr
   Erase arr
   SortDictByFreq Dict, arr
   DisplayTheTopMostUsedWords arr, 10

Debug.Print "Words different in this book : " & Dict.Count
Debug.Print "-------------------------"
Debug.Print ""
Debug.Print "Optionally : "
Debug.Print "Frequency of the word MISERABLE : " & DisplayFrequencyOf("MISERABLE", Dict)
Debug.Print "Frequency of the word DISASTER : " & DisplayFrequencyOf("DISASTER", Dict)
Debug.Print "Frequency of the word ROSETTA_CODE : " & DisplayFrequencyOf("ROSETTA_CODE", Dict)
Debug.Print "-------------------------"
Debug.Print "Execution Time : " & Format(Timer - T, "0.000") & " sec."
End Sub

Private Function ExtractTxt(strFile As String) As String
'http://rosettacode.org/wiki/File_input/output#VBA
Dim i As Integer
   i = FreeFile
   Open strFile For Input As #i
       ExtractTxt = Input(LOF(1), #i)
   Close #i
End Function

Private Function RemovePunctuation(strBook As String) As String
Dim T, i As Integer, temp As String
Const PUNCT As String = """,;:!?."
   T = Split(StrConv(PUNCT, vbUnicode), Chr(0))
   temp = strBook
   For i = LBound(T) To UBound(T) - 1
      temp = Replace(temp, T(i), " ")
   Next
   temp = Replace(temp, "--", " ")
   temp = Replace(temp, "...", " ")
   temp = Replace(temp, vbCrLf, " ")
   RemovePunctuation = Replace(temp, "  ", " ")
End Function

Private Sub FillDictionary(d As Object, a As Variant)
Dim L As Long
   For L = LBound(a) To UBound(a)
      If a(L) <> "" Then _
         d(a(L)) = d(a(L)) + 1
   Next
End Sub

Private Sub SortDictByFreq(d As Object, myArr As Variant)
Dim K
Dim L As Long
   ReDim myArr(1 To d.Count, 1 To 2)
   For Each K In d.keys
      L = L + 1
      myArr(L, 1) = K
      myArr(L, 2) = CLng(d(K))
   Next
   SortArray myArr, LBound(myArr), UBound(myArr), 2
End Sub

Private Sub SortArray(a, Le As Long, Ri As Long, Col As Long)
Dim ref As Long, L As Long, r As Long, temp As Variant
   ref = a((Le + Ri) \ 2, Col)
   L = Le
   r = Ri
   Do
         Do While a(L, Col) < ref
            L = L + 1
         Loop
         Do While ref < a(r, Col)
            r = r - 1
         Loop
         If L <= r Then
            temp = a(L, 1)
            a(L, 1) = a(r, 1)
            a(r, 1) = temp
            temp = a(L, 2)
            a(L, 2) = a(r, 2)
            a(r, 2) = temp
            L = L + 1
            r = r - 1
         End If
   Loop While L <= r
   If L < Ri Then SortArray a, L, Ri, Col
   If Le < r Then SortArray a, Le, r, Col
End Sub

Private Sub DisplayTheTopMostUsedWords(arr As Variant, Nb As Long)
Dim L As Long, i As Integer
   i = 1
   Debug.Print "Rank Word    Frequency"
   Debug.Print "==== ======= ========="
   For L = UBound(arr) To UBound(arr) - Nb + 1 Step -1
      Debug.Print Left(CStr(i) & "    ", 5) & Left(arr(L, 1) & "       ", 8) & " " & Format(arr(L, 2), "0 000")
      i = i + 1
   Next
End Sub

Private Function DisplayFrequencyOf(Word As String, d As Object) As Long
   If d.Exists(Word) Then _
      DisplayFrequencyOf = d(Word)
End Function


isPrime :: Integer -> Bool
isPrime n
   |n == 2 = True
   |n == 1 = False
   |otherwise = null $ filter (\i -> mod n i == 0 ) [2 .. root]
   where
      root :: Integer
      root = toInteger $ floor $ sqrt $ fromIntegral n

isWieferichPrime :: Integer -> Bool
isWieferichPrime n =  isPrime n && mod ( 2 ^ ( n - 1 ) - 1 ) ( n ^ 2 ) == 0

solution :: [Integer]
solution = filter isWieferichPrime [2 .. 5000]

main :: IO ( )
main = do
   putStrLn "Wieferich primes less than 5000:"
   print solution


import java.util.*;

public class WieferichPrimes {
    public static void main(String[] args) {
        final int limit = 5000;
        System.out.printf("Wieferich primes less than %d:\n", limit);
        for (Integer p : wieferichPrimes(limit))
            System.out.println(p);
    }

    private static boolean[] primeSieve(int limit) {
        boolean[] sieve = new boolean[limit];
        Arrays.fill(sieve, true);
        if (limit > 0)
            sieve[0] = false;
        if (limit > 1)
            sieve[1] = false;
        for (int i = 4; i < limit; i += 2)
            sieve[i] = false;
        for (int p = 3; ; p += 2) {
            int q = p * p;
            if (q >= limit)
                break;
            if (sieve[p]) {
                int inc = 2 * p;
                for (; q < limit; q += inc)
                    sieve[q] = false;
            }
        }
        return sieve;
    }

    private static long modpow(long base, long exp, long mod) {
        if (mod == 1)
            return 0;
        long result = 1;
        base %= mod;
        for (; exp > 0; exp >>= 1) {
            if ((exp & 1) == 1)
                result = (result * base) % mod;
            base = (base * base) % mod;
        }
        return result;
    }

    private static List<Integer> wieferichPrimes(int limit) {
        boolean[] sieve = primeSieve(limit);
        List<Integer> result = new ArrayList<>();
        for (int p = 2; p < limit; ++p) {
            if (sieve[p] && modpow(2, p - 1, p * p) == 1)
                result.add(p);
        }
        return result;
    }
}


#SingleInstance, Force
#NoEnv
SetBatchLines, -1
File := "Wireworld.txt"
CellSize := 20
CellSize2 := CellSize - 2
C1 := 0xff000000
C2 := 0xff0066ff
C3 := 0xffd40055
C4 := 0xffffcc00

if (!FileExist(File)) {
	MsgBox, % "File(" File ") is not present."
	ExitApp
}

; Uncomment if Gdip.ahk is not in your standard library
; #Include, Gdip.ahk
If !pToken := Gdip_Startup(){
	MsgBox, 48, Gdiplus error!, Gdiplus failed to start. Please ensure you have Gdiplus on your system.
	ExitApp
}
OnExit, Exit

A := [], Width := 0
Loop, Read, % File
{
	Row := A_Index
	Loop, Parse, A_LoopReadLine
	{
		if (A_Index > Width)
			Width := A_Index
		if (A_LoopField = A_Space)
			continue
		A[Row, A_Index] := A_LoopField
	}
}

Width := Width * CellSize + 2 * CellSize
, Height := Row * CellSize + 2 * CellSize
, Row := ""
, TopLeftX := (A_ScreenWidth - Width) // 2
, TopLeftY := (A_ScreenHeight - Height) // 2

Gui, 1: -Caption +E0x80000 +LastFound +AlwaysOnTop +ToolWindow +OwnDialogs
Gui, 1: Show, NA

hwnd1 := WinExist()
, hbm := CreateDIBSection(Width, Height)
, hdc := CreateCompatibleDC()
, obm := SelectObject(hdc, hbm)
, G := Gdip_GraphicsFromHDC(hdc)
, Gdip_SetSmoothingMode(G, 4)

Loop {
	pBrush := Gdip_BrushCreateSolid(C1)
	, Gdip_FillRectangle(G, pBrush, 0, 0, Width, Height)
	, Gdip_DeleteBrush(pBrush)

	for RowNum, Row in A
		for CellNum, Cell in Row
			C := Cell = "H" ? C2 : Cell = "t" ? C3 : C4
			, pBrush := Gdip_BrushCreateSolid(C)
			, Gdip_FillRectangle(G, pBrush, CellNum * CellSize + 1, RowNum * CellSize - 2, CellSize2, CellSize2)
			, Gdip_DeleteBrush(pBrush)

	UpdateLayeredWindow(hwnd1, hdc, TopLeftX, TopLeftY, Width, Height)
	, Gdip_GraphicsClear(G)
	, A := NextState(A)
	Sleep, 600
}

NextState(A) {
	B := {}
	for RowNum, Row in A {
		for CellNum, Cell in Row {
			if (Cell = "H")
				B[RowNum, CellNum] := "t"
			else if (Cell = "t")
				B[RowNum, CellNum] := "."
			else if (Cell = ".") {
				H_Count := 0
				Loop 3 {
					Y := RowNum - 2 + A_Index
					Loop, 3 {
						X := CellNum - 2 + A_Index
						if (A[Y, X] = "H")
							H_Count++
					}
				}
				if (H_Count = 1 || H_Count = 2)
					B[RowNum, CellNum] := "H"
				else
					B[RowNum, CellNum] := "."
			}
		}
	}
	return B
}

p::Pause

Esc::
Exit:
Gdip_Shutdown(pToken)
ExitApp


import "io" for File
import "/str" for Str
import "/sort" for Sort
import "/fmt" for Fmt
import "/pattern" for Pattern

var fileName = "135-0.txt"
var text = File.read(fileName).trimEnd()
var groups = {}
// match runs of A-z, a-z, 0-9 and any non-ASCII letters with code-points < 256
var p = Pattern.new("+1&w")
var lines = text.split("\n")
for (line in lines) {
    var ms = p.findAll(line)
    for (m in ms) {
        var t = Str.lower(m.text)
        groups[t] = groups.containsKey(t) ? groups[t] + 1 : 1
    }
}
var keyVals = groups.toList
Sort.quick(keyVals, 0, keyVals.count - 1) { |i, j| (j.value - i.value).sign }
System.print("Rank  Word  Frequency")
System.print("====  ====  =========")
for (rank in 1..10) {
    var word = keyVals[rank-1].key
    var freq = keyVals[rank-1].value
    Fmt.print("$2d    $-4s    $5d", rank, word, freq)
}


def is_prime:
  . as $n
  | if ($n < 2)         then false
    elif ($n % 2 == 0)  then $n == 2
    elif ($n % 3 == 0)  then $n == 3
    elif ($n % 5 == 0)  then $n == 5
    elif ($n % 7 == 0)  then $n == 7
    elif ($n % 11 == 0) then $n == 11
    elif ($n % 13 == 0) then $n == 13
    elif ($n % 17 == 0) then $n == 17
    elif ($n % 19 == 0) then $n == 19
    else {i:23}
    | until( (.i * .i) > $n or ($n % .i == 0); .i += 2)
    | .i * .i > $n
    end;

# Emit an array of primes less than `.`
def primes:
  if . < 2 then []
  else
    [2] + [range(3; .; 2) | select(is_prime)]
  end;

# for the sake of infinite-precision integer arithmetic
def power($b): . as $a | reduce range(0; $b) as $i (1; .*$a);


ClearAll[WieferichPrimeQ]
WieferichPrimeQ[n_Integer] := PrimeQ[n] && Divisible[2^(n - 1) - 1, n^2]
Select[Range[5000], WieferichPrimeQ]


import math
import bignum

func isPrime(n: Positive): bool =
  if n mod 2 == 0: return n == 2
  if n mod 3 == 0: return n == 3
  var d = 5
  while d <= sqrt(n.toFloat).int:
    if n mod d == 0: return false
    inc d, 2
    if n mod d == 0: return false
    inc d, 4
  result = true

echo "Wieferich primes less than 5000:"
let two = newInt(2)
for p in 2u..<5000:
  if p.isPrime:
    if exp(two, p - 1, p * p) == 1:    # Modular exponentiation.
      echo p


$ww = ""
$ww &= "tH........." & @CR
$ww &= ".   .      " & @CR
$ww &= "   ...     " & @CR
$ww &= ".   .      " & @CR
$ww &= "Ht.. ......"
$rows = StringSplit($ww, @CR)
$cols = StringSplit($rows[1], "")
Global $Wireworldarray[$rows[0]][$cols[0]]
For $I = 1 To $rows[0]
	$cols = StringSplit($rows[$I], "")
	For $k = 1 To $cols[0]
		$Wireworldarray[$I - 1][$k - 1] = $cols[$k]
	Next
Next
Wireworld($Wireworldarray)
Func Wireworld($array)
	Local $labelarray = $array
	Local $Top = 0, $Left = 0
	$hFui = GUICreate("Wireworld", UBound($array, 2) * 25, UBound($array) * 25)
	For $I = 0 To UBound($array) - 1
		For $k = 0 To UBound($array, 2) - 1
			Switch $array[$I][$k]
				Case "t" ; Tail
					$labelarray[$I][$k] = GUICtrlCreateButton("", $Left, $Top, 25, 25)
					GUICtrlSetBkColor($labelarray[$I][$k], 0xFF0000)
				Case "h" ; Head
					$labelarray[$I][$k] = GUICtrlCreateButton("", $Left, $Top, 25, 25)
					GUICtrlSetBkColor($labelarray[$I][$k], 0x0000FF)
				Case "." ; Conductor
					$labelarray[$I][$k] = GUICtrlCreateButton("", $Left, $Top, 25, 25)
					GUICtrlSetBkColor($labelarray[$I][$k], 0xFFFF00)
				Case " " ; Empty
					$labelarray[$I][$k] = GUICtrlCreateButton("", $Left, $Top, 25, 25)
					GUICtrlSetBkColor($labelarray[$I][$k], 0x000000)
			EndSwitch
			$Left += 25
		Next
		$Left = 0
		$Top += 25
	Next
	GUISetState()
	Local $nextsteparray = $array
	While 1
		$msg = GUIGetMsg()
		$array = $nextsteparray
		Sleep(250)
		For $I = 0 To UBound($array) - 1
			For $k = 0 To UBound($array, 2) - 1
				If $array[$I][$k] = " " Then ContinueLoop
				If $array[$I][$k] = "h" Then $nextsteparray[$I][$k] = "t"
				If $array[$I][$k] = "t" Then $nextsteparray[$I][$k] = "."
				If $array[$I][$k] = "." Then
					$counter = 0
					If $I - 1 >= 0 Then ; Top
						If $array[$I - 1][$k] = "h" Then $counter += 1
					EndIf
					If $k - 1 >= 0 Then ; left
						If $array[$I][$k - 1] = "h" Then $counter += 1
					EndIf
					If $I + 1 <= UBound($array) - 1 Then ; Bottom
						If $array[$I + 1][$k] = "h" Then $counter += 1
					EndIf
					If $k + 1 <= UBound($array, 2) - 1 Then ;Right
						If $array[$I][$k + 1] = "h" Then $counter += 1
					EndIf
					If $I - 1 >= 0 And $k - 1 >= 0 Then ; left Top
						If $array[$I - 1][$k - 1] = "h" Then $counter += 1
					EndIf
					If $I + 1 <= UBound($array) - 1 And $k + 1 <= UBound($array, 2) - 1 Then ; Right Bottom
						If $array[$I + 1][$k + 1] = "h" Then $counter += 1
					EndIf
					If $I + 1 <= UBound($array) - 1 And $k - 1 >= 0 Then ;Left Bottom
						If $array[$I + 1][$k - 1] = "h" Then $counter += 1
					EndIf
					If $I - 1 >= 0 And $k + 1 <= UBound($array, 2) - 1 Then ; Top Right
						If $array[$I - 1][$k + 1] = "h" Then $counter += 1
					EndIf
					If $counter = 1 Or $counter = 2 Then $nextsteparray[$I][$k] = "h"
				EndIf
			Next
		Next
		For $I = 0 To UBound($nextsteparray) - 1
			For $k = 0 To UBound($nextsteparray, 2) - 1
				Switch $nextsteparray[$I][$k]
					Case "t" ; Tail
						GUICtrlSetBkColor($labelarray[$I][$k], 0xFF0000)
					Case "h" ; Head
						GUICtrlSetBkColor($labelarray[$I][$k], 0x0000FF)
					Case "." ; Conductor
						GUICtrlSetBkColor($labelarray[$I][$k], 0xFFFF00)
					Case " " ; Empty
						GUICtrlSetBkColor($labelarray[$I][$k], 0x000000)
				EndSwitch
				$Left += 25
			Next
			$Left = 0
			$Top += 25
		Next
		If $msg = -3 Then Exit
	WEnd
EndFunc   ;==>Wireworld


let $maxentries := 10,
    $uri := 'https://www.gutenberg.org/files/135/135-0.txt'
return
<words in="{$uri}" top="{$maxentries}"> {
(
  let $doc := unparsed-text($uri),
  $tokens := (
               tokenize($doc, '\W+')[normalize-space()]
                 ! lower-case(.)
                 ! normalize-unicode(., 'NFC')
             )
  return
    for $token in $tokens
    let $key := $token
    group by $key
    let $count := count($token)
    order by $count descending
    return <word key="{$key}" count="{$count}"/>
)[position()=(1 to $maxentries)]
}</words>


fname,count := vm.arglist;	// grab cammand line args

   // words may have leading or trailing "_", ie "the" and "_the"
File(fname).pump(Void,"toLower",  // read the file line by line and hash words
   RegExp("[a-z]+").pump.fp1(Dictionary().incV))  // line-->(word:count,..)
.toList().copy().sort(fcn(a,b){ b[1]<a[1] })[0,count.toInt()] // hash-->list
.pump(String,Void.Xplode,"%s,%s\n".fmt).println();


use feature 'say';
use ntheory qw(is_prime powmod);

say 'Wieferich primes less than 5000: ' . join ', ', grep { is_prime($_) and powmod(2, $_-1, $_*$_) == 1 } 1..5000;


with javascript_semantics
include mpfr.e
function weiferich(integer p)
    mpz p2pm1m1 = mpz_init()
    mpz_ui_pow_ui(p2pm1m1,2,p-1)
    mpz_sub_ui(p2pm1m1,p2pm1m1,1)
    return mpz_fdiv_q_ui(p2pm1m1,p2pm1m1,p*p)=0
end function
printf(1,"Weiferich primes less than 5000: %V\n",{filter(get_primes_le(5000),weiferich)})


#!/usr/bin/python

def isPrime(n):
    for i in range(2, int(n**0.5) + 1):
        if n % i == 0:
            return False
    return True

def isWeiferich(p):
    if not isPrime(p):
        return False
    q = 1
    p2 = p ** 2
    while p > 1:
        q = (2 * q) % p2
        p -= 1
    if q == 1:
        return True
    else:
        return False

if __name__ == '__main__':
    print("Wieferich primes less than 5000: ")
    for i in range(2, 5001):
        if isWeiferich(i):
            print(i)


  5000 eratosthenes

  [ dup isprime iff
      [ dup 1 - bit 1 -
        swap dup * mod
        0 = ]
    else [ drop false ] ] is wieferich ( n --> b )

  5000 times [ i^ wieferich if [ i^ echo cr ] ]


/* 2009-09-27 <[email protected]> */
#define ANIMATE_VT100_POSIX
#include <stdio.h>
#include <string.h>
#ifdef ANIMATE_VT100_POSIX
#include <time.h>
#endif

char world_7x14[2][512] = {
  {
    "+-----------+\n"
    "|tH.........|\n"
    "|.   .      |\n"
    "|   ...     |\n"
    "|.   .      |\n"
    "|Ht.. ......|\n"
    "+-----------+\n"
  }
};

void next_world(const char *in, char *out, int w, int h)
{
  int i;

  for (i = 0; i < w*h; i++) {
    switch (in[i]) {
    case ' ': out[i] = ' '; break;
    case 't': out[i] = '.'; break;
    case 'H': out[i] = 't'; break;
    case '.': {
      int hc = (in[i-w-1] == 'H') + (in[i-w] == 'H') + (in[i-w+1] == 'H') +
               (in[i-1]   == 'H')                    + (in[i+1]   == 'H') +
               (in[i+w-1] == 'H') + (in[i+w] == 'H') + (in[i+w+1] == 'H');
      out[i] = (hc == 1 || hc == 2) ? 'H' : '.';
      break;
    }
    default:
      out[i] = in[i];
    }
  }
  out[i] = in[i];
}

int main()
{
  int f;

  for (f = 0; ; f = 1 - f) {
    puts(world_7x14[f]);
    next_world(world_7x14[f], world_7x14[1-f], 14, 7);
#ifdef ANIMATE_VT100_POSIX
    printf("\x1b[%dA", 8);
    printf("\x1b[%dD", 14);
    {
      static const struct timespec ts = { 0, 100000000 };
      nanosleep(&ts, 0);
    }
#endif
  }

  return 0;
}


#lang typed/racket
(require math/number-theory)

(: wieferich-prime? (-> Positive-Integer Boolean))

(define (wieferich-prime? p)
  (and (prime? p)
       (divides? (* p p) (sub1 (expt 2 (sub1 p))))))

(module+ main
  (define wieferich-primes<5000
    (for/list : (Listof Integer) ((p (sequence-filter wieferich-prime?
                                                      (in-range 1 5000))))
      p))
  wieferich-primes<5000)


put "Wieferich primes less than 5000: ", join ', ', ^5000 .grep: { .is-prime and not ( exp($_-1, 2) - 1 ) % .² };


/*REXX program finds and displays  Wieferich primes  which are under a specified limit N*/
parse arg n .                                    /*obtain optional argument from the CL.*/
if n=='' | n==","  then n= 5000                  /*Not specified?  Then use the default.*/
numeric digits 3000                              /*bump # of dec. digs for calculation. */
numeric digits max(9, length(2**n) )             /*calculate # of decimal digits needed.*/
call genP                                        /*build array of semaphores for primes.*/
          title= ' Wieferich primes that are  < '   commas(n)    /*title for the output.*/
w= length(title) + 2                             /*width of field for the primes listed.*/
say ' index │'center(title, w)                   /*display the title for the output.    */
say '───────┼'center(""   , w, '─')              /*   "     a   sep   "   "     "       */
found= 0                                         /*initialize number of Wieferich primes*/
         do j=1  to #;    p= @.j                 /*search for Wieferich primes in range.*/
         if (2**(p-1)-1)//p**2\==0  then iterate /*P**2 not evenly divide  2**(P-1) - 1?*/       /* ◄■■■■■■■ the filter.*/
         found= found + 1                        /*bump the counter of Wieferich primes.*/
         say center(found, 7)'│'  center(commas(p), w)    /*display the Wieferich prime.*/
         end   /*j*/

say '───────┴'center(""   , w, '─');   say       /*display a  foot sep  for the output. */
say 'Found '       commas(found)       title     /*   "    "  summary    "   "     "    */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg ?;  do jc=length(?)-3  to 1  by -3; ?=insert(',', ?, jc); end;  return ?
/*──────────────────────────────────────────────────────────────────────────────────────*/
genP:        @.1=2; @.2=3; @.3=5; @.4=7; @.5=11  /*define some low primes  (index-1).   */
      !.=0;  !.2=1; !.3=1; !.5=1; !.7=1; !.11=1  /*   "     "   "    "     (semaphores).*/
                           #= 5;  sq.#= @.# ** 2 /*number of primes so far;     prime². */
        do [email protected].#+2  by 2  to n-1;  parse var j '' -1 _   /*get right decimal digit of J.*/
        if    _==5  then iterate                               /*J ÷ by 5?    Yes, skip.*/
        if j//3==0  then iterate;  if j//7==0  then iterate    /*" "  " 3?    J ÷ by 7? */
               do k=5  while sq.k<=j             /* [↓]  divide by the known odd primes.*/
               if j//@.k==0  then iterate j      /*Is J ÷ a P?   Then not prime.   ___  */
               end   /*k*/                       /* [↑]  only process numbers  ≤  √ J   */
        #= #+1;    @.#= j;   sq.#= j*j;   !.j= 1 /*bump # Ps; assign next P; P sqare; P.*/
        end          /*j*/;               return


#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;
}


require "prime"

puts Prime.each(5000).select{|p| 2.pow(p-1 ,p*p) == 1 }


// [dependencies]
// primal = "0.3"
// mod_exp = "1.0"

fn wieferich_primes(limit: usize) -> impl std::iter::Iterator<Item = usize> {
    primal::Primes::all()
        .take_while(move |x| *x < limit)
        .filter(|x| mod_exp::mod_exp(2, *x - 1, *x * *x) == 1)
}

fn main() {
    let limit = 5000;
    println!("Wieferich primes less than {}:", limit);
    for p in wieferich_primes(limit) {
        println!("{}", p);
    }
}


func is_wieferich_prime(p, base=2) {
    powmod(base, p-1, p**2) == 1
}

say ("Wieferich primes less than 5000: ", 5000.primes.grep(is_wieferich_prime))


func primeSieve(limit: Int) -> [Bool] {
    guard limit > 0 else {
        return []
    }
    var sieve = Array(repeating: true, count: limit)
    sieve[0] = false
    if limit > 1 {
        sieve[1] = false
    }
    if limit > 4 {
        for i in stride(from: 4, to: limit, by: 2) {
            sieve[i] = false
        }
    }
    var p = 3
    while true {
        var q = p * p
        if q >= limit {
            break
        }
        if sieve[p] {
            let inc = 2 * p
            while q < limit {
                sieve[q] = false
                q += inc
            }
        }
        p += 2
    }
    return sieve
}

func modpow(base: Int, exponent: Int, mod: Int) -> Int {
    if mod == 1 {
        return 0
    }
    var result = 1
    var exp = exponent
    var b = base
    b %= mod
    while exp > 0 {
        if (exp & 1) == 1 {
            result = (result * b) % mod
        }
        b = (b * b) % mod
        exp >>= 1
    }
    return result
}

func wieferichPrimes(limit: Int) -> [Int] {
    let sieve = primeSieve(limit: limit)
    var result: [Int] = []
    for p in 2..<limit {
        if sieve[p] && modpow(base: 2, exponent: p - 1, mod: p * p) == 1 {
            result.append(p)
        }
    }
    return result
}

let limit = 5000
print("Wieferich primes less than \(limit):")
for p in wieferichPrimes(limit: limit) {
    print(p)
}


import "/math" for Int
import "/big" for BigInt

var primes = Int.primeSieve(5000)
System.print("Wieferich primes < 5000:")
for (p in primes) {
    var num = (BigInt.one << (p - 1)) - 1
    var den = p * p
    if (num % den == 0) System.print(p)
}


abstract class Cell(shared Character char) of emptyCell | head | tail | conductor {

    shared Cell output({Cell*} neighbors) =>
            switch (this)
            case (emptyCell) emptyCell
            case (head) tail
            case (tail) conductor
            case (conductor) (neighbors.count(head.equals) in 1..2 then head else conductor);

    string => char.string;
}

object emptyCell extends Cell(' ') {}

object head extends Cell('H') {}

object tail extends Cell('t') {}

object conductor extends Cell('.') {}

Map<Character,Cell> cellsByChar = map { for (cell in `Cell`.caseValues) cell.char->cell };

class Wireworld(String data) {

    value lines = data.lines;

    value width = max(lines*.size);
    value height = lines.size;

    function toIndex(Integer x, Integer y) => x + y * width;

    variable value currentState = Array.ofSize(width * height, emptyCell);
    variable value nextState = Array.ofSize(width * height, emptyCell);

    for (j->line in lines.indexed) {
        for (i->char in line.indexed) {
            currentState[toIndex(i, j)] = cellsByChar[char] else emptyCell;
        }
    }

    value emptyGrid = Array.ofSize(width * height, emptyCell);
    void clear(Array<Cell> cells) => emptyGrid.copyTo(cells);

    shared void update() {
        clear(nextState);
        for(j in 0:height) {
            for(i in 0:width) {
                if(exists cell = currentState[toIndex(i, j)]) {
                    value nextCell = cell.output(neighborhood(currentState, i, j));
                    nextState[toIndex(i, j)] = nextCell;
                }
            }
        }
        value temp = currentState;
        currentState = nextState;
        nextState = temp;
    }

    shared void display() {
        for (row in currentState.partition(width)) {
            print("".join(row));
        }
    }

    shared {Cell*} neighborhood(Array<Cell> grid, Integer x, Integer y) => {
                for (j in y - 1..y + 1)
                for (i in x - 1..x + 1)
                if(i in 0:width && j in 0:height)
                grid[toIndex(i, j)]
            }.coalesced;

}

shared void run() {
    value data = "tH.........
                  .   .
                     ...
                  .   .
                  Ht.. ......";

    value world = Wireworld(data);

    variable value generation = 0;

    void display() {
        print("generation: ``generation``");
        world.display();
    }

    display();

    while (true) {
        if (exists input = process.readLine(), input.lowercased == "q") {
            return;
        }
        world.update();
        generation++;
        display();

    }
}


(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.. ......")))


import std.stdio, std.algorithm;

void wireworldStep(char[][] W1, char[][] W2) pure nothrow @safe @nogc {
    foreach (immutable r; 1 .. W1.length - 1)
        foreach (immutable c; 1 .. W1[0].length - 1)
            switch (W1[r][c]) {
                case 'H': W2[r][c] = 't'; break;
                case 't': W2[r][c] = '.'; break;
                case '.':
                    int nH = 0;
                    foreach (sr; -1 .. 2)
                        foreach (sc; -1 .. 2)
                            nH += W1[r + sr][c + sc] == 'H';
                    W2[r][c] = (nH == 1 || nH == 2) ? 'H' : '.';
                    break;
                default:
            }
}

void main() {
    auto world = ["         ".dup,
                  "  tH     ".dup,
                  " .  .... ".dup,
                  "  ..     ".dup,
                  "         ".dup];

    char[][] world2;
    foreach (row; world)
        world2 ~= row.dup;

    foreach (immutable step; 0 .. 7) {
        writefln("\nStep %d: ------------", step);
        foreach (row; world[1 .. $ - 1])
            row[1 .. $ - 1].writeln;
        wireworldStep(world, world2);
        swap(world, world2);
    }
}


program Wireworld;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.IOUtils;

var
  rows, cols: Integer;
  rx, cx: Integer;
  mn: TArray<Integer>;

procedure Print(grid: TArray<byte>);
begin
  writeln(string.Create('_', cols * 2), #10);

  for var r := 1 to rows do
  begin
    for var c := 1 to cols do
    begin
      if grid[r * cx + c] = 0 then
        write(' ')
      else
        write(' ', chr(grid[r * cx + c]));
    end;
    writeln;
  end;
end;

procedure Step(var dst: TArray<byte>; src: TArray<byte>);
begin
  for var r := 1 to rows do
  begin
    for var c := 1 to cols do
    begin
      var x := r * cx + c;
      dst[x] := src[x];

      case chr(dst[x]) of
        'H':
          dst[x] := ord('t');
        't':
          dst[x] := ord('.');
        '.':
          begin
            var nn := 0;
            for var n in mn do
              if src[x + n] = ord('H') then
                inc(nn);
            if (nn = 1) or (nn = 2) then
              dst[x] := ord('H');
          end;
      end;
    end;
  end;
end;

procedure Main();
const
  CONFIG_FILE = 'ww.config';
begin

  if not FileExists(CONFIG_FILE) then
  begin
    Writeln(CONFIG_FILE, ' not exist');
    exit;
  end;

  var srcRows := TFile.ReadAllLines(CONFIG_FILE);

  rows := length(srcRows);

  cols := 0;
  for var r in srcRows do
  begin
    if Length(r) > cols then
      cols := length(r);
  end;

  rx := rows + 2;
  cx := cols + 2;

  mn := [-cx - 1, -cx, -cx + 1, -1, 1, cx - 1, cx, cx + 1];

  var _odd: TArray<byte>;
  var _even: TArray<byte>;

  SetLength(_odd, rx * cx);
  SetLength(_even, rx * cx);

  FillChar(_odd[0], rx * cx, 0);
  FillChar(_even[0], rx * cx, 0);

  for var i := 0 to High(srcRows) do
  begin
    var r := srcRows[i];

    var offset := (i + 1) * cx + 1;
    for var j := 1 to length(r) do
      _odd[offset + j - 1] := ord(r[j]);
  end;

  while True do
  begin
    print(_odd);
    step(_even, _odd);
    Readln;

    print(_even);
    step(_odd, _even);
    Readln;
  end;
end;

begin
  Main;

  {$IFNDEF UNIX} readln; {$ENDIF}
end.


import system'routines;
import extensions;
import cellular;

const string sample =
" tH......
.        ......
 ...Ht...      .
              ....
              .  .....
              ....
 ......tH      .
.        ......
 ...Ht...";

const string conductorLabel = ".";
const string headLabel = "H";
const string tailLabel = "t";
const string emptyLabel = " ";

const int empty = 0;
const int conductor = 1;
const int electronHead = 2;
const int electronTail = 3;

wireWorldRuleSet = new RuleSet
{
    proceed(Space s, int x, int y, ref int retVal)
    {
        int cell := s.at(x, y);

        cell =>
            conductor
            {
                int number := s.LiveCell(x, y, electronHead);
                if (number == 1 || number == 2)
                {
                    retVal := electronHead
                }
                else
                {
                    retVal := conductor
                }
            }
            electronHead
            {
                retVal := electronTail
            }
            electronTail
            {
                retVal := conductor
            }
            :{
                retVal := cell
            }
    }
};

sealed class Model
{
    Space   theSpace;

    constructor load(string stateString, int maxX, int maxY)
    {
        var strings := stateString.splitBy(newLine).selectBy:(s => s.toArray()).toArray();

        theSpace := IntMatrixSpace.allocate(maxX, maxY, RuleSet
        {
            proceed(Space s, int x, int y, ref int retVal)
            {
                if (x < strings.Length)
                {
                    var l := strings[x];
                    if (y < l.Length)
                    {
                        (l[y]) =>
                            conductorLabel { retVal := conductor }
                            headLabel      { retVal := electronHead }
                            tailLabel      { retVal := electronTail }
                            emptyLabel     { retVal := empty }
                    }
                    else
                    {
                        retVal := empty
                    }
                }
                else
                {
                    retVal := empty
                }

            }
        })
    }

    run()
    {
        theSpace.update(wireWorldRuleSet)
    }

    print()
    {
        int columns := theSpace.Columns;
        int rows := theSpace.Rows;

        int i := 0;
        int j := 0;
        while (i < rows)
        {
            j := 0;

            while (j < columns)
            {
                var label := emptyLabel;
                int cell := theSpace.at(i, j);

                cell =>
                    conductor    { label := conductorLabel }
                    electronHead { label := headLabel }
                    electronTail { label := tailLabel };

                console.write(label);

                j := j + 1
            };

            i := i + 1;
            console.writeLine()
        }
    }
}

public program()
{
    Model model := Model.load(sample,10,30);
    for(int i := 0, i < 10, i += 1)
    {
        console.printLineFormatted("Iteration {0}",i);
        model.print().run()
    }
}


defmodule Wireworld do
  @empty      " "
  @head       "H"
  @tail       "t"
  @conductor  "."
  @neighbours (for x<- -1..1, y <- -1..1, do: {x,y}) -- [{0,0}]

  def set_up(string) do
    lines = String.split(string, "\n", trim: true)
    grid = Enum.with_index(lines)
           |> Enum.flat_map(fn {line,i} ->
                String.codepoints(line)
                |> Enum.with_index
                |> Enum.map(fn {char,j} -> {{i, j}, char} end)
              end)
           |> Enum.into(Map.new)
    width = Enum.map(lines, fn line -> String.length(line) end) |> Enum.max
    height = length(lines)
    {grid, width, height}
  end

  # to string
  defp to_s(grid, width, height) do
    Enum.map_join(0..height-1, fn i ->
      Enum.map_join(0..width-1, fn j -> Map.get(grid, {i,j}, @empty) end) <> "\n"
    end)
  end

  # transition all cells simultaneously
  defp transition(grid) do
    Enum.into(grid, Map.new, fn {{x, y}, state} ->
      {{x, y}, transition_cell(grid, state, x, y)}
    end)
  end

  # how to transition a single cell
  defp transition_cell(grid, current, x, y) do
    case current do
      @empty -> @empty
      @head  -> @tail
      @tail  -> @conductor
      _      -> if neighbours_with_state(grid, x, y) in 1..2, do: @head, else: @conductor
    end
  end

  # given a position in the grid, find the neighbour cells with a particular state
  def neighbours_with_state(grid, x, y) do
    Enum.count(@neighbours, fn {dx,dy} -> Map.get(grid, {x+dx, y+dy}) == @head end)
  end

  # run a simulation up to a limit of transitions, or until a recurring
  # pattern is found
  # This will print text to the console
  def run(string, iterations\\25) do
    {grid, width, height} = set_up(string)
    Enum.reduce(0..iterations, {grid, %{}}, fn count,{grd, seen} ->
      IO.puts "Generation : #{count}"
      IO.puts to_s(grd, width, height)

      if seen[grd] do
        IO.puts "I've seen this grid before... after #{count} iterations"
        exit(:normal)
      else
        {transition(grd), Map.put(seen, grd, count)}
      end
    end)
    IO.puts "ran through #{iterations} iterations"
  end
end

# this is the "2 Clock generators and an XOR gate" example from the wikipedia page
text = """
 ......tH
.        ......
 ...Ht...      .
              ....
              .  .....
              ....
 tH......      .
.        ......
 ...Ht...
"""

Wireworld.run(text)


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 [email protected] cstate + [email protected] emit loop ;
: show  ['] showrow foreachrow  ;

: line ( row addr len -- )
  bounds do
    i [email protected]
    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 + [email protected] 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 + [email protected]
  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 ;


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


#define MAXX 319
#define MAXY 199

enum state
   E=0, C=8, H=9, T=4   'doubles as colours: black, grey, bright blue, red
end enum

dim as uinteger world(0 to 1, 0 to MAXX, 0 to MAXY), active = 0, buffer = 1
dim as double rate = 1./3.   'seconds per frame
dim as double tick
dim as uinteger x, y

function turn_on( world() as unsigned integer, x as uinteger, y as uinteger, a as uinteger ) as boolean
    dim as ubyte n = 0
    dim as integer qx, qy
    for qx = -1 to 1
        for qy = -1 to 1
            if qx=0 andalso qy=0 then continue for
            if world(a,(x+qx+MAXX+1) mod (MAXX+1), (y+qy+MAXY+1) mod (MAXY+1))=H then n=n+1  'handles wrap-around
        next qy
    next qx
    if n=1 then return true
    if n=2 then return true
    return false
end function

'generate sample map

for x=20 to 30
    world(active, x, 20) = C
    world(active, x, 24) = C
next x
world(active, 24, 24 ) = E
world(active, 20, 21 ) = C
world(active, 20, 23 ) = C
world(active, 24, 21 ) = C
world(active, 23, 22 ) = C
world(active, 24, 22 ) = C
world(active, 25, 22 ) = C
world(active, 24, 23 ) = C
world(active, 20, 20 ) = T
world(active, 21, 20 ) = H
world(active, 21, 24 ) = T
world(active, 20, 24 ) = H

screen 12

do
    tick = timer
    for x = 0 to 319
        for y = 0 to 199
            pset (x,y), world(active, x, y)
            if world(active,x,y) = E then world(buffer,x,y) = E   'empty cells stay empty
            if world(active,x,y) = H then world(buffer,x,y) = T   'electron heads turn into electron tails
            if world(active,x,y) = T then world(buffer,x,y) = C   'electron tails revert to conductors
            if world(active,x,y) = C then
                if turn_on(world(),x,y,active) then
                    world(buffer,x,y) = H                         'maybe electron heads spread
                else
                    world(buffer,x,y) = C                         'otherwise condutor remains conductor
                end if
            end if
        next y
    next x
    while tick + rate > timer
    wend
    cls
    buffer = 1 - buffer
    active = 1 - buffer
loop


//Create event
/*
Wireworld first declares constants and then reads a wireworld from a textfile.
In order to implement wireworld in GML a single array is used.
To make it behave properly, there need to be states that are 'in-between' two states:
0 = empty
1 = conductor from previous state
2 = electronhead from previous state
5 = electronhead that was a conductor in the previous state
3 = electrontail from previous state
4 = electrontail that was a head in the previous state
*/
empty = 0;
conduc = 1;
eHead = 2;
eTail = 3;
eHead_to_eTail = 4;
coduc_to_eHead = 5;
working = true;//not currently used, but setting it to false stops wireworld. (can be used to pause)
toroidalMode = false;
factor = 3;//this is used for the display. 3 means a single pixel is multiplied by three in size.

var tempx,tempy ,fileid, tempstring, gridid, listid, maxwidth, stringlength;
tempx = 0;
tempy = 0;
tempstring = "";
maxwidth = 0;

//the next piece of code loads the textfile containing a wireworld.
//the program will not work correctly if there is no textfile.
if file_exists("WW.txt")
{
fileid = file_text_open_read("WW.txt");
gridid = ds_grid_create(0,0);
listid = ds_list_create();
    while !file_text_eof(fileid)
    {
    tempstring = file_text_read_string(fileid);
    stringlength = string_length(tempstring);
    ds_list_add(listid,stringlength);
        if maxwidth < stringlength
        {
        ds_grid_resize(gridid,stringlength,ds_grid_height(gridid) + 1)
        maxwidth = stringlength
        }
        else
        {
        ds_grid_resize(gridid,maxwidth,ds_grid_height(gridid) + 1)
        }

        for (i = 1; i <= stringlength; i +=1)
        {
            switch (string_char_at(tempstring,i))
            {
            case ' ': ds_grid_set(gridid,tempx,tempy,empty); break;
            case '.': ds_grid_set(gridid,tempx,tempy,conduc); break;
            case 'H': ds_grid_set(gridid,tempx,tempy,eHead); break;
            case 't': ds_grid_set(gridid,tempx,tempy,eTail); break;
            default: break;
            }
        tempx += 1;
        }
    file_text_readln(fileid);
    tempy += 1;
    tempx = 0;
    }
file_text_close(fileid);
//fill the 'open' parts of the grid
tempy = 0;
    repeat(ds_list_size(listid))
    {
    tempx = ds_list_find_value(listid,tempy);
        repeat(maxwidth - tempx)
        {
        ds_grid_set(gridid,tempx,tempy,empty);
        tempx += 1;
        }
    tempy += 1;
    }
boardwidth = ds_grid_width(gridid);
boardheight = ds_grid_height(gridid);
//the contents of the grid are put in a array, because arrays are faster.
//the grid was needed because arrays cannot be resized properly.
tempx = 0;
tempy = 0;
    repeat(boardheight)
    {
        repeat(boardwidth)
        {
        board[tempx,tempy] = ds_grid_get(gridid,tempx,tempy);
        tempx += 1;
        }
    tempy += 1;
    tempx = 0;
    }
//the following code clears memory
ds_grid_destroy(gridid);
ds_list_destroy(listid);
}


package main

import (
    "bytes"
    "fmt"
    "io/ioutil"
    "strings"
)

var rows, cols int // extent of input configuration
var rx, cx int     // grid extent (includes border)
var mn []int       // offsets of moore neighborhood

func main() {
    // read input configuration from file
    src, err := ioutil.ReadFile("ww.config")
    if err != nil {
        fmt.Println(err)
        return
    }
    srcRows := bytes.Split(src, []byte{'\n'})

    // compute package variables
    rows = len(srcRows)
    for _, r := range srcRows {
        if len(r) > cols {
            cols = len(r)
        }
    }
    rx, cx = rows+2, cols+2
    mn = []int{-cx-1, -cx, -cx+1, -1, 1, cx-1, cx, cx+1}

    // allocate two grids and copy input into first grid
    odd := make([]byte, rx*cx)
    even := make([]byte, rx*cx)
    for ri, r := range srcRows {
        copy(odd[(ri+1)*cx+1:], r)
    }

    // run
    for {
        print(odd)
        step(even, odd)
        fmt.Scanln()

        print(even)
        step(odd, even)
        fmt.Scanln()
    }
}

func print(grid []byte) {
    fmt.Println(strings.Repeat("__", cols))
    fmt.Println()
    for r := 1; r <= rows; r++ {
        for c := 1; c <= cols; c++ {
            if grid[r*cx+c] == 0 {
                fmt.Print("  ")
            } else {
                fmt.Printf(" %c", grid[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 'H':
                dst[x] = 't'
            case 't':
                dst[x] = '.'
            case '.':
                var nn int
                for _, n := range mn {
                    if src[x+n] == 'H' {
                        nn++
                    }
                }
                if nn == 1 || nn == 2 {
                    dst[x] = 'H'
                }
            }
        }
    }
}


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)


link graphics

$define EDGE  -1
$define EMPTY 0
$define HEAD 1
$define TAIL 2
$define COND 3

global Colours,Width,Height,World,oldWorld

procedure main()             # wire world modified from forestfire

    Height := 400            # Window height
    Width  := 400            # Window width
    Rounds := 500            # max Rounds
    Delay  := 5              # Runout Delay

    setup_world(read_world())
    every round := 1 to Rounds do {
       show_world()
       if \runout then
          delay(Delay)
       else
          case Event() of {
             "q" : break                            # q = quit
             "r" : runout := 1                      # r = run w/o stepping
             "s" : WriteImage("Wireworld-"||round)  # save
              }
       evolve_world()
       }
    WDone()
end

procedure read_world()  #: for demo in place of reading
   return [ "tH.........",
            ".   .",
            "   ...",
            ".   .",
            "Ht.. ......"]
end

procedure setup_world(L)     #: setup the world

    Colours := table()       # define colours
    Colours[EDGE]  := "grey"
    Colours[EMPTY] := "black"
    Colours[HEAD]  := "blue"
    Colours[TAIL]  := "red"
    Colours[COND]  := "yellow"

    States := table()
    States["t"] := TAIL
    States["H"] := HEAD
    States[" "] := EMPTY
    States["."] := COND

    WOpen("label=Wireworld", "bg=black",
          "size=" || Width+2 || "," || Height+2) | # add for border
             stop("Unable to open Window")
    every !(World := list(Height)) := list(Width,EMPTY)  # default
    every ( World[1,1 to Width]  | World[Height,1 to Width] |
            World[1 to Height,1] | World[1 to Height,Width] ) := EDGE

    every r := 1 to *L & c := 1 to *L[r] do {      # setup read in program
       World[r+1, c+1] :=  States[L[r,c]]
       }
end

procedure show_world()      #: show World - drawn changes only
   every r := 2 to *World-1 & c := 2 to *World[r]-1 do
      if /oldWorld | oldWorld[r,c] ~= World[r,c] then {
         WAttrib("fg=" || Colours[tr := World[r,c]])
         DrawPoint(r,c)
      }
end

procedure evolve_world()    #: evolve world
    old := oldWorld := list(*World)     # freeze copy
    every old[i := 1 to *World] := copy(World[i])  # deep copy

    every r := 2 to *World-1 & c := 2 to *World[r]-1 do
       World[r,c] := case old[r,c] of {   # apply rules
        # EMPTY : EMPTY
          HEAD  : TAIL
          TAIL  : COND
          COND  : {
              i := 0
              every HEAD = ( old[r-1,c-1 to c+1] | old[r,c-1|c+1] | old[r+1,c-1 to c+1] ) do i +:= 1
              if i := 1 | 2 then HEAD
          }
       }
end


<!DOCTYPE html><meta charset="UTF-8">
<title>Wireworld</title>

<input type='file' accept='text/plain' onchange='openFile( event )' />


def lines: split("\n")|length;

def cols: split("\n")[0]|length + 1;  # allow for the newline

# Is there an "H" at [x,y] relative to position i, assuming the width is w?
# Input is an array; 72 is "H"
def isH(x; y; i; w): if .[i+ w*y + x] == 72 then 1 else 0 end;

def neighborhood(i;w):
  isH(-1; -1; i; w) + isH(0; -1; i; w) + isH(1; -1; i; w) +
  isH(-1;  0; i; w)                    + isH(1;  0; i; w) +
  isH(-1;  1; i; w) + isH(0;  1; i; w) + isH(1;  1; i; w) ;

# The basic rules:
# Input: a world
# Output: the next state of .[i]
def evolve(i; width) :
  # "Ht. " | explode => [ 72,  116,  46,  32 ]
  .[i] as $c
  | if   $c ==  32 then $c           # " " => " "
    elif $c == 116 then 46           # "t" => "."
    elif $c ==  72 then 116          # "H" => "t"
    elif $c ==  46 then              # "."
      # updates are "simultaneous" i.e. relative to $world
      neighborhood(i; width) as $sum
      | (if [1,2]|index($sum) then 72 else . end)  # "H"
    else $c
    end ;

# [world, lines, cols] | next(w) => [world, lines, cols]
def next:
  .[0] as $world | .[1] as $lines | .[2] as $w
  | reduce range(0; $world|length) as $i
    ($world;
      $world | evolve($i; $w) as $next
      | if  .[$i] == $next then . else .[$i] = $next end )
  | [., $lines, $w] ; #


function surround2D(b, i, j)
    h, w = size(b)
    [b[x,y] for x in i-1:i+1, y in j-1:j+1 if (0 < x <= h && 0 < y <= w)]
end

surroundhas1or2(b, i, j) = 0 < sum(map(x->Char(x)=='H', surround2D(b, i, j))) <= 2 ? 'H' : '.'

function boardstep!(currentboard, nextboard)
    x, y = size(currentboard)
    for j in 1:y, i in 1:x
        ch = Char(currentboard[i, j])
        if ch == ' '
            continue
        else
            nextboard[i, j] = (ch == 'H') ? 't' : (ch == 't' ? '.' :
                   surroundhas1or2(currentboard, i, j))
        end
    end
end

const b1 = "         " *
           "  tH     " *
           " .  .... " *
           "  ..     " *
           "         "
const mat = reshape(map(x->UInt8(x[1]), split(b1, "")), (9, 5))'
const mat2 = copy(mat)

function printboard(mat)
    for i in 1:size(mat)[1]
        println("\t", join([Char(c) for c in mat[i,:]], ""))
    end
end

println("Starting Wireworld board:")
printboard(mat)
for step in 1:8
    boardstep!(mat, mat2)
    println(" Step $step:")
    printboard(mat2)
    mat .= mat2
end


WindowWidth  = 840
WindowHeight = 600

dim p$( 40, 25), q$( 40, 25)

empty$     = " "    '   white
tail$      = "t"    '   yellow
head$      = "H"    '   black
conductor$ = "."    '   red

jScr       = 0

nomainwin

menu #m, "File", "Load", [load], "Quit", [quit]

open "wire world" for graphics_nf_nsb as #m
  #m "trapclose [quit]"
  'timer 1000, [tmr]
  wait

end

[quit]
  close #m
  end

[load]
  'timer 0
  filedialog "Open WireWorld File", "*.ww", file$
  open file$ for input as #in
    y =0
    while not( eof( #in))
      line input #in, lijn$
      ' print "|"; lijn$; "|"
      for x =0 to len( lijn$) -1
        p$( x, y) =mid$( lijn$, x +1, 1)

        select case p$( x, y)
            case " "
                clr$ ="white"
            case "t"
                clr$ ="yellow"
            case "H"
                clr$ ="black"
            case "."
                clr$ ="red"
        end select

        #m "goto " ; 4 +x *20; " "; 4 +y *20
        #m "backcolor "; clr$
        #m "down"
        #m "boxfilled "; 4 +x *20 +19; " "; 4 +y *20 +19
        #m "up ; flush"
      next x
      y =y +1
    wend
  close #in
  'notice "Ready to run."
  timer 1000, [tmr]
  wait

[tmr]
  timer 0
  scan

  for x =0 to 40                                '   copy temp array /current array
    for y =0 to 25
      q$( x, y) =p$( x, y)
    next y
  next x

  for y =0 to 25
    for x =0 to 40
      select case q$( x, y)
        case head$                              '   heads ( black) become tails ( yellow)
          p$( x, y ) =tail$
          clr$ ="yellow"

        case tail$                              '   tails ( yellow) become conductors ( red)
          p$( x, y ) =conductor$
          clr$ ="red"

        case conductor$                         '
          hCnt =0

          xL =x -1: if xL < 0 then xL =40       '   wrap-round edges at all four sides
          xR =x +1: if xR >40 then xR = 0
          yA =y -1: if yA < 0 then yA =25
          yB =y +1: if yB >40 then yB = 0

          if q$( xL, y ) =head$ then hCnt =hCnt +1  '   Moore environment- 6 neighbours
          if q$( xL, yA) =head$ then hCnt =hCnt +1  '   count all neighbours currently heads
          if q$( xL, yB) =head$ then hCnt =hCnt +1

          if q$( xR, y ) =head$ then hCnt =hCnt +1
          if q$( xR, yA) =head$ then hCnt =hCnt +1
          if q$( xR, yB) =head$ then hCnt =hCnt +1

          if q$( x,  yA) =head$ then hCnt =hCnt +1
          if q$( x,  yB) =head$ then hCnt =hCnt +1

          if ( hCnt =1) or ( hCnt =2) then       '      conductor ( red) becomes head ( yellow) in this case only
            p$( x, y ) =head$                    '          otherwise stays conductor ( red).
            clr$ ="black"
          else
            p$( x, y ) =conductor$
            clr$ ="red"
          end if

        case else
          clr$ ="white"
      end select

      #m "goto " ; 4 +x *20; " "; 4 +y *20
      #m "backcolor "; clr$
      #m "down"
      #m "boxfilled "; 4 +x *20 +19; " "; 4 +y *20 +19
      #m "up"
    next x
  next y
  #m "flush"
  #m "getbmp scr 0 0 400 300"

  'bmpsave "scr", "R:\scrJHF" +right$( "000" +str$( jScr), 3) +".bmp"
  jScr =jScr+1
  if jScr >20 then wait
  timer 1000, [tmr]
wait


to wireworld :filename :speed ;speed in n times per second, approximated
Make "speed 60/:speed
wireworldread :filename
Make "bufferfield (mdarray (list :height :width) 0)
for [i 0 :height-1] [for [j 0 :width-1] [mdsetitem (list :i :j) :bufferfield mditem (list :i :j) :field]]
pu ht
Make "gen 0
while ["true] [ ;The user will have to halt it :P
    ;clean
    seth 90
    setxy 0 20
    ;label :gen
    sety 0
    for [i 0 :height-1] [for [j 0 :width-1] [mdsetitem (list :i :j) :field mditem (list :i :j) :bufferfield]]
    for [i 0 :height-1] [
        for [j 0 :width-1] [
            if (mditem (list :i :j) :field)=[] [setpixel [255 255 255]] ;blank
            if (mditem (list :i :j) :field)=1 [setpixel [0 0 0] if wn :j :i 2 [mdsetitem (list :i :j) :bufferfield 2]] ;wire
            if (mditem (list :i :j) :field)=2 [setpixel [0 0 255] mdsetitem (list :i :j) :bufferfield 3] ;head
            if (mditem (list :i :j) :field)=3 [setpixel [255 0 0] mdsetitem (list :i :j) :bufferfield 1] ;tail
            setx xcor+1
        ]
        setxy 0 ycor-1
    ]
    Make "gen :gen+1
    wait :speed
]
end

to wireworldread :filename
local [line]
openread :filename
setread :filename
Make "width 0
Make "height 0
; first pass, take dimensions
while [not eofp] [
    Make "line readword
    if (count :line)>:width [Make "width count :line]
    Make "height :height+1
]
; second pass, load data
setreadpos 0
Make "field (mdarray (list :height :width) 0)
for [i 0 :height-1] [
    Make "line readword
    foreach :line [
        if ?=char 32 [mdsetitem (list :i #-1) :field []]
        if ?=".      [mdsetitem (list :i #-1) :field 1]
        if ?="H      [mdsetitem (list :i #-1) :field 2]
        if ?="t      [mdsetitem (list :i #-1) :field 3]
    ]
]
setread []
close :filename
end

to wn :x :y :thing ;WireNeighbourhood
Make "neighbours 0
if (mditem (list :y-1 :x) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y-1 :x+1) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y :x+1) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y+1 :x+1) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y+1 :x) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y+1 :x-1) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y :x-1) :field)=:thing [Make "neighbours :neighbours+1]
if (mditem (list :y-1 :x-1) :field)=:thing [Make "neighbours :neighbours+1]
ifelse OR :neighbours=1 :neighbours=2 [op "true] [op "false]
end


local map = {{'t', 'H', '.', '.', '.', '.', '.', '.', '.', '.', '.'},
             {'.', ' ', ' ', ' ', '.'},
             {' ', ' ', ' ', '.', '.', '.'},
             {'.', ' ', ' ', ' ', '.'},
             {'H', 't', '.', '.', ' ', '.', '.', '.', '.', '.', '.'}}

function step(map)
    local next = {}
    for i = 1, #map do
        next[i] = {}
        for j = 1, #map[i] do
            next[i][j] = map[i][j]
            if map[i][j] == "H" then
                next[i][j] = "t"
            elseif map[i][j] == "t" then
                next[i][j] = "."
            elseif map[i][j] == "." then
                local count = 	((map[i-1] or {})[j-1] == "H" and 1 or 0) +
                                ((map[i-1] or {})[j] == "H" and 1 or 0) +
                                ((map[i-1] or {})[j+1] == "H" and 1 or 0) +
                                ((map[i] or {})[j-1] == "H" and 1 or 0) +
                                ((map[i] or {})[j+1] == "H" and 1 or 0) +
                                ((map[i+1] or {})[j-1] == "H" and 1 or 0) +
                                ((map[i+1] or {})[j] == "H" and 1 or 0) +
                                ((map[i+1] or {})[j+1] == "H" and 1 or 0)
                if count == 1 or count == 2 then
                    next[i][j] = "H"
                else
                    next[i][j] = "."
                end
            end
        end
    end
    return next
end

if not not love then
    local time, frameTime, size = 0, 0.25, 20
    local colors = {["."] = {255, 200, 0},
                    ["t"] = {255, 0, 0},
                    ["H"] = {0, 0, 255}}
    function love.update(dt)
        time = time + dt
        if time > frameTime then
            time = time - frameTime
            map = step(map)
        end
    end

    function love.draw()
        for i = 1, #map do
            for j = 1, #map[i] do
                love.graphics.setColor(colors[map[i][j]] or {0, 0, 0})
                love.graphics.rectangle("fill", j*size, i*size, size, size)
            end
        end
    end
else
    for iter = 1, 10 do
        print("\nstep "..iter.."\n")
        for i = 1, #map do
            for j = 1, #map[i] do
                io.write(map[i][j])
            end
            io.write("\n")
        end
        map = step(map)
    end
end


import strutils, os

var world, world2 = """
+-----------+
|tH.........|
|.   .      |
|   ...     |
|.   .      |
|Ht.. ......|
+-----------+"""

let h = world.splitLines.len
let w = world.splitLines[0].len

template isH(x, y): int = int(s[i + w * y + x] == 'H')

proc next(o: var string, s: string, w: int) =
  for i, c in s:
    o[i] = case c
      of ' ': ' '
      of 't': '.'
      of 'H': 't'
      of '.':
        if (isH(-1, -1) + isH(0, -1) + isH(1, -1) +
            isH(-1,  0)              + isH(1,  0) +
            isH(-1,  1) + isH(0,  1) + isH(1,  1)
           ) in 1..2: 'H' else: '.'
      else: c

while true:
  echo world
  stdout.write "\x1b[",h,"A"
  stdout.write "\x1b[",w,"D"
  sleep 100

  world2.next(world, w)
  swap world, world2


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


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


\\ 0 = conductor, 1 = tail, 2 = head, 3 = empty
wireworldStep(M)={
	my(sz=matsize(M),t);
	matrix(sz[1],sz[2],x,y,
		t=M[x,y];
		if(t,
			[0,1,3][t]
		,
			t=sum(i=max(x-1,1),min(x+1,sz[1]),
				sum(j=max(y-1,1),min(y+1,sz[2]),
					M[i,j]==2
				)
			);
			if(t==1|t==2,2,3)
		)
	)
};
animate(M)={
	while(1,display(M=wireworldStep(M)))
};
display(M)={
	my(sz=matsize(M),t);
	for(i=1,sz[1],
		for(j=1,sz[2],
			t=M[i,j];
			print1([".","t","H"," "][t+1])
		);
		print
	)
};
animate(read("wireworld.gp"))


--
-- demo\rosetta\Wireworld.exw
-- ==========================
--
--  Invoke with file to read, or let it read the one below (if compiled assumes source is in the same directory)
--
--  Note that tabs in description files are not supported - where necessary spaces can be replaced with _ chars.
--  (tab chars in text files should technically always represent (to-next) 8 spaces, but not many editors respect
--   that, and instead assume the file will only ever be read by the same program/with matching settings. </rant>)
--  (see also demo\edix\src\tabs.e\ExpandTabs() for what you'd need if you knew what the tab chars really meant.)
--
with javascript_semantics
constant default_description = """
tH.........
.___.
___...
.___.
Ht.. ......
"""
sequence lines, counts
integer longest

function valid_line(string line, integer l=0)
    if length(line)=0 then return 0 end if
    for i=1 to length(line) do
        integer ch = line[i]
        if not find(ch," _.tH") then
            if l and ch='\t' then
                -- as above
                printf(1,"error: tab char on line %d\n",{l})
                {} = wait_key()
                abort(0)
            end if
            return 0
        end if
    end for
    return 1
end function

procedure load_desc()
    sequence text
    if platform()=JS then
        text = split(default_description,"\n")
    else
        string filename = substitute(command_line()[$],".exe",".exw")
        integer fn = open(filename,"r")
        if fn=-1 then
            printf(1,"error opening %s\n",{filename})
            {} = wait_key()
            abort(0)
        end if
        text = get_text(fn,GT_LF_STRIPPED)
        close(fn)
    end if
    lines = {}
    for i=1 to length(text) do
        string line = text[i]
        if valid_line(line) then
            lines = {line}
            longest = length(line)
            for j=i+1 to length(text) do
                line = text[j]
                if not valid_line(line,j) then exit end if
                lines = append(lines,line)
                if longest<length(line) then
                    longest = length(line)
                end if
            end for
            exit
        end if
    end for
    counts = deep_copy(lines)
end procedure

constant dxy = {{-1,-1}, {-1,+0}, {-1,+1},
                {+0,-1},          {+0,+1},
                {+1,-1}, {+1,+0}, {+1,+1}}

procedure set_counts()
    for y=1 to length(lines) do
        for x=1 to length(lines[y]) do
            if lines[y][x]='.' then
                integer count = 0
                for k=1 to length(dxy) do
                    integer {cx,cy} = sq_add({x,y},dxy[k])
                    if cy>=1 and cy<=length(lines)
                    and cx>=1 and cx<=length(lines[cy])
                    and lines[cy][cx]='H' then
                        count += 1
                    end if
                end for
                counts[y][x] = (count=1 or count=2)
            end if
        end for
    end for
end procedure

include pGUI.e

constant title = "Wireworld"
Ihandle dlg, canvas, timer
cdCanvas cddbuffer, cdcanvas

function redraw_cb(Ihandle /*ih*/)
    integer {w, h} = IupGetIntInt(canvas, "DRAWSIZE")
    integer dx = floor(w/(longest+2))
    integer dy = floor(h/(length(lines)+2))
    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer)
    set_counts()
    for y=1 to length(lines) do
        for x=1 to length(lines[y]) do
            integer c = lines[y][x], colour
            if find(c," _") then
                colour = CD_BLACK
            elsif c='.' then
                colour = CD_YELLOW
                if counts[y][x] then
                    lines[y][x] = 'H'
                end if
            elsif c='H' then
                colour = CD_BLUE
                lines[y][x] = 't'
            elsif c='t' then
                colour = CD_RED
                lines[y][x] = '.'
            end if
            cdCanvasSetForeground(cddbuffer, colour)
            cdCanvasBox(cddbuffer,x*dx,x*dx+dx,h-y*dy,h-(y*dy+dy))
        end for
    end for
    cdCanvasFlush(cddbuffer)
    return IUP_DEFAULT
end function

function timer_cb(Ihandle /*ih*/)
    IupUpdate(canvas)
    return IUP_IGNORE
end function

function map_cb(Ihandle ih)
    cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    cdCanvasSetBackground(cddbuffer, CD_BLACK)
    return IUP_DEFAULT
end function

procedure main()
    load_desc()
    IupOpen()

    canvas = IupCanvas("RASTERSIZE=300x180")
    IupSetCallbacks(canvas, {"MAP_CB", Icallback("map_cb"),
                             "ACTION", Icallback("redraw_cb")})

    timer = IupTimer(Icallback("timer_cb"), 500)

    dlg = IupDialog(canvas,`TITLE="%s"`, {title})

    IupShow(dlg)
    IupSetAttribute(canvas, "RASTERSIZE", NULL)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure

main()


$desc = 'tH.........
.   .
  ........
.   .
Ht.. ......

      ..
tH.... .......
      ..

      ..
tH..... ......
      ..';

$steps = 30;

//fill in the world with the cells
$world = array(array());
$row = 0;
$col = 0;
foreach(str_split($desc) as $i){
    switch($i){
        case "\n":
            $row++;
            //if($col > $width) $width = $col;
            $col = 0;
            $world[] = array();
            break;
        case '.':
            $world[$row][$col] = 1;//conductor
            $col++;
            break;
        case 'H':
            $world[$row][$col] = 2;//head
            $col++;
            break;
        case 't':
            $world[$row][$col] = 3;//tail
            $col++;
            break;
        default:
            $world[$row][$col] = 0;//insulator/air
            $col++;
            break;
    };
};
function draw_world($world){
    foreach($world as $rowc){
        foreach($rowc as $cell){
            switch($cell){
                case 0:
                    echo ' ';
                    break;
                case 1:
                    echo '.';
                    break;
                case 2:
                    echo 'H';
                    break;
                case 3:
                    echo 't';
            };
        };
        echo "\n";
    };
    //var_export($world);
};
echo "Original world:\n";
draw_world($world);
for($i = 0; $i < $steps; $i++){
    $old_world = $world; //backup to look up where was an electron head
    foreach($world as $row => &$rowc){
        foreach($rowc as $col => &$cell){
            switch($cell){
                case 2:
                    $cell = 3;
                    break;
                case 3:
                    $cell = 1;
                    break;
                case 1:
                    $neigh_heads = (int) @$old_world[$row - 1][$col - 1] == 2;
                    $neigh_heads += (int) @$old_world[$row - 1][$col] == 2;
                    $neigh_heads += (int) @$old_world[$row - 1][$col + 1] == 2;
                    $neigh_heads += (int) @$old_world[$row][$col - 1] == 2;
                    $neigh_heads += (int) @$old_world[$row][$col + 1] == 2;
                    $neigh_heads += (int) @$old_world[$row + 1][$col - 1] == 2;
                    $neigh_heads += (int) @$old_world[$row + 1][$col] == 2;
                    if($neigh_heads == 1 || $neigh_heads == 2){
                        $cell = 2;
                    };
            };
        };
        unset($cell); //just to be safe
    };
    unset($rowc); //just to be safe
    echo "\nStep " . ($i + 1) . ":\n";
    draw_world($world);
};


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


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


'''
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 racket
(require 2htdp/universe)
(require 2htdp/image)
(require racket/fixnum)

; see the forest fire task, from which this is derived...
(define-struct wire-world (width height cells) #:prefab)

(define state:_ 0)
(define state:. 1)
(define state:H 2)
(define state:t 3)

(define (char->state c)
  (case c
    ((#\_ #\space) state:_)
    ((#\.) state:.)
    ((#\H) state:H)
    ((#\t) state:t)))

(define (initial-world l)
  (let ((h (length l))
        (w (string-length (first l))))
    (make-wire-world w h
                     (for*/fxvector
                      #:length (* h w)
                      ((row (in-list l))
                       (cell (in-string row)))
                      (char->state cell)))))

(define initial-list
  '("tH........."
    ".   .      "
    "   ...     "
    ".   .      "
    "Ht.. ......"))

(define-syntax-rule (count-neighbours-in-state ww wh wc r# c# state-to-match)
  (for/sum
      ((r (in-range (- r# 1) (+ r# 2)))
       #:when (< -1 r wh)
       (c (in-range (- c# 1) (+ c# 2)))
       #:when (< -1 c ww)
       ;; note, this will check cell at (r#, c#), too but it's not
       ;; worth checking that r=r# and c=c# each time in
       ;; this case, we know that (r#, c#) is a conductor:
       ; #:unless (and (= r# r) (= c# c))
       (i (in-value (+ (* r ww) c)))
       #:when (= state-to-match (fxvector-ref wc i)))
    1))

(define (cell-new-state ww wh wc row col)
  (let ((cell (fxvector-ref wc (+ col (* row ww)))))
    (cond
      ((= cell state:_) cell) ; empty -> empty
      ((= cell state:t) state:.) ; tail -> empty
      ((= cell state:H) state:t) ; head -> tail
      ((<= 1 (count-neighbours-in-state ww wh wc row col state:H) 2) state:H)
      (else cell))))

(define (wire-world-tick world)
  (define ww (wire-world-width world))
  (define wh (wire-world-height world))
  (define wc (wire-world-cells world))

  (define (/w x) (quotient x ww))
  (define (%w x) (remainder x ww))

  (make-wire-world
   ww wh
  (for/fxvector
   #:length (* ww wh)
   ((cell (in-fxvector wc))
    (r# (sequence-map /w (in-naturals)))
    (c# (sequence-map %w (in-naturals))))
   (cell-new-state ww wh wc r# c#))))

(define colour:_ (make-color   0   0   0))  ; black
(define colour:. (make-color  128 128 128)) ; grey
(define colour:H (make-color  128 255 255)) ; bright cyan
(define colour:t (make-color    0 128 128)) ; dark cyan

(define colour-vector (vector colour:_ colour:. colour:H colour:t))
(define (cell-state->colour state) (vector-ref colour-vector state))

(define render-scaling 20)
(define (render-world W)
  (define ww (wire-world-width W))
  (define wh (wire-world-height W))
  (define wc (wire-world-cells W))
   (let* ((flat-state
           (for/list ((cell (in-fxvector wc)))
             (cell-state->colour cell))))
     (place-image (scale render-scaling (color-list->bitmap flat-state ww wh))
                  (* ww (/ render-scaling 2))
                  (* wh (/ render-scaling 2))
                  (empty-scene (* render-scaling ww) (* render-scaling wh)))))

(define (run-wire-world #:initial-state W)
  (big-bang
   (initial-world W) ;; initial state
   [on-tick wire-world-tick
            1/8 ; tick time (seconds)
            ]
   [to-draw render-world]))

(run-wire-world #:initial-state initial-list)


class Wireworld {
    has @.line;
    method height () { @!line.elems }
    has int $.width;

    multi method new(@line) { samewith :@line, :width(max @line».chars) }
    multi method new($str ) { samewith $str.lines }

    method gist { join "\n", @.line }

    method !neighbors($i where ^$.height, $j where ^$.width)
    {
        my @i = grep ^$.height, $i «+« (-1, 0, 1);
        my @j = grep ^$.width,  $j «+« (-1, 0, 1);
        gather for @i X @j -> (\i, \j) {
            next if [ i, j ] ~~ [ $i, $j ];
            take @!line[i].comb[j];
        }
    }
    method succ {
        my @succ;
        for ^$.height X ^$.width -> ($i, $j) {
            @succ[$i] ~=
            do given @!line[$i].comb[$j] {
                when 'H' { 't' }
                when 't' { '.' }
                when '.' {
                    grep('H', self!neighbors($i, $j)) == 1|2 ?? 'H' !! '.'
                }
                default { ' ' }
            }
        }
        return self.new: @succ;
    }
}

my %*SUB-MAIN-OPTS;
%*SUB-MAIN-OPTS<named-anywhere> = True;

multi sub MAIN (
    IO()      $filename,
    Numeric:D :$interval = 1/4,
    Bool      :$stop-on-repeat,
) {
    run-loop :$interval, :$stop-on-repeat, Wireworld.new: $filename.slurp;
}

#| run a built-in example
multi sub MAIN (
    Numeric:D :$interval = 1/4,
    Bool      :$stop-on-repeat,
) {
    run-loop :$interval, :$stop-on-repeat, Wireworld.new: Q:to/END/
    tH.........
    .   .
       ...
    .   .
    Ht.. ......
    END
}

sub run-loop (
    Wireworld:D     $initial,
    Real:D(Numeric) :$interval = 1/4,
    Bool            :$stop-on-repeat
){
    my %seen is SetHash;

    for $initial ...^ * eqv * { # generate a sequence (uses .succ)
        print "\e[2J";
        say '#' x $initial.width;
        .say;
        say '#' x $initial.width;

        if $stop-on-repeat {
            last if %seen{ .gist }++;
        }

        sleep $interval;
    }
}


/*REXX program  displays a   wire world   Cartesian grid   of  four─state  cells.       */
parse arg  iFID .  '('  generations  rows  cols  bare  head  tail  wire  clearScreen  reps
if iFID==''  then iFID= "WIREWORLD.TXT"          /*should default input file  be used?  */
        bla = 'BLANK'                            /*the "name" for a blank.              */
generations = p(generations     100   )          /*number generations that are allowed. */
       rows = p(rows            3     )          /*the number of cell  rows.            */
       cols = p(cols            3     )          /* "     "    "   "   columns.         */
       bare = pickChar(bare     bla   )          /*character used to show an empty cell.*/
clearScreen = p(clearScreen     0     )          /*1    means to clear the screen.      */
       head = pickChar(head     'H'   )          /*pick the character for the  head.    */
       tail = pickChar(tail     't'   )          /*  "   "      "      "   "   tail.    */
       wire = pickChar(wire     .     )          /*  "   "      "      "   "   wire.    */
       reps = p(reps            2     )          /*stop program  if there are 2 repeats.*/
fents= max(cols, linesize() - 1)                 /*the fence width used after displaying*/
#reps= 0;     $.= bare;   gens= abs(generations) /*at start, universe is new and barren.*/
                                                 /* [↓]     read the input file.        */
       do r=1  while lines(iFID)\==0             /*keep reading until the  End─Of─File. */
       q= strip( linein(iFID), 'T')              /*get a line from input file.          */
       L= length(q);      cols= max(cols, L)     /*calculate maximum number of columns. */
          do c=1  for L;  $.r.c= substr(q, c, 1) /*assign the cells for the   R   row.  */
          end   /*c*/
       end      /*r*/
!.= 0;                      signal on halt       /*initial state of cells;  handle halt.*/
rows= r - 1;   life= 0;     call showCells       /*display initial state of the cells.  */
                                                 /*watch cells evolve, 4 possible states*/
  do   life=1  for gens;    @.= bare             /*perform for the number of generations*/
     do   r=1  for rows                          /*process each of the rows.            */
       do c=1  for cols;    ?= $.r.c;    ??= ?   /*   "      "   "  "  columns.         */
                 select                          /*determine the type of cell.          */
                 when ?==head  then ??= tail
                 when ?==tail  then ??= wire
                 when ?==wire  then do;  #= hood();   if #==1 | #==2  then ??= head;   end
                 otherwise     nop
                 end   /*select*/
       @.r.c= ??                                 /*possible assign a  cell  a new state.*/
       end             /*c*/
     end               /*r*/

  call assign$                                   /*assign alternate cells ──► real world*/
  if generations>0 | life==gens  then call showCells
  end   /*life*/
                                                 /*stop watching the universe (or life).*/
halt: if life-1\==gens  then say 'The  ───Wireworld───  program was interrupted by user.'
done: exit 0                                     /*stick a fork in it,  we are all done.*/
/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
$:         parse arg _row,_col;                  return  $._row._col==head
assign$:   do r=1  for rows;   do c=1  for cols;   $.r.c= @.r.c;   end;   end;      return
hood:      return  $(r-1,c-1)  + $(r-1,c)  + $(r-1,c+1)  + $(r,c-1)  + $(r,c+1)  + $(r+1,c-1)  + $(r+1,c)  + $(r+1,c+1)
p:         return word(arg(1), 1)                           /*pick the 1st word in list.*/
pickChar:  parse arg _ .;arg U .;L=length(_);if U==bla then _=' '; if L==3 then _=d2c(_);if L==2 then _=x2c(_);return _
showRows:  _=;  do r=1  for rows; z=;  do c=1 for cols; z= z||$.r.c; end;  z= strip(z,'T'); say z; _= _||z; end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
showCells: if clearScreen  then 'CLS'                       /*◄──change CLS for the host*/
           call showRows                                    /*show rows in proper order.*/
           say right( copies('═', fents)life, fents)        /*display a title for cells.*/
           if _==''                   then signal done      /*No life?   Then stop run. */
           if !._                     then #reps= #reps + 1 /*detected repeated pattern.*/
           !._= 1                                           /*it is now an extant state.*/
           if reps\==0 & #reps<=reps  then return           /*so far, so good,  no reps.*/
           say '"Wireworld" repeated itself'    reps    "times,  the program is stopping."
           signal done                                      /*jump to this pgm's "exit".*/


use std::str::FromStr;

#[derive(Debug, Copy, Clone, PartialEq)]
pub enum State {
    Empty,
    Conductor,
    ElectronTail,
    ElectronHead,
}

impl State {
    fn next(&self, e_nearby: usize) -> State {
        match self {
            State::Empty => State::Empty,
            State::Conductor => {
                if e_nearby == 1 || e_nearby == 2 {
                    State::ElectronHead
                } else {
                    State::Conductor
                }
            }
            State::ElectronTail => State::Conductor,
            State::ElectronHead => State::ElectronTail,
        }
    }
}

#[derive(Debug, Clone, PartialEq)]
pub struct WireWorld {
    pub width: usize,
    pub height: usize,
    pub data: Vec<State>,
}

impl WireWorld {
    pub fn new(width: usize, height: usize) -> Self {
        WireWorld {
            width,
            height,
            data: vec![State::Empty; width * height],
        }
    }

    pub fn get(&self, x: usize, y: usize) -> Option<State> {
        if x >= self.width || y >= self.height {
            None
        } else {
            self.data.get(y * self.width + x).copied()
        }
    }

    pub fn set(&mut self, x: usize, y: usize, state: State) {
        self.data[y * self.width + x] = state;
    }

    fn neighbors<F>(&self, x: usize, y: usize, mut f: F) -> usize
        where F: FnMut(State) -> bool
    {
        let (x, y) = (x as i32, y as i32);
        let neighbors = [(x-1,y-1),(x-1,y),(x-1,y+1),(x,y-1),(x,y+1),(x+1,y-1),(x+1,y),(x+1,y+1)];

        neighbors.iter().filter_map(|&(x, y)| self.get(x as usize, y as usize)).filter(|&s| f(s)).count()
    }

    pub fn next(&mut self) {
        let mut next_state = vec![];
        for y in 0..self.height {
            for x in 0..self.width {
                let e_count = self.neighbors(x, y, |e| e == State::ElectronHead);
                next_state.push(self.get(x, y).unwrap().next(e_count));
            }
        }
        self.data = next_state;
    }
}

impl FromStr for WireWorld {
    type Err = ();
    fn from_str(s: &str) -> Result<WireWorld, ()> {
        let s = s.trim();
        let height = s.lines().count();
        let width = s.lines().map(|l| l.trim_end().len()).max().unwrap_or(0);
        let mut world = WireWorld::new(width, height);

        for (y, line) in s.lines().enumerate() {
            for (x, ch) in line.trim_end().chars().enumerate() {
                let state = match ch {
                    '.' => State::Conductor,
                    't' => State::ElectronTail,
                    'H' => State::ElectronHead,
                    _ => State::Empty,
                };
                world.set(x, y, state);
            }
        }
        Ok(world)
    }
}


(* Maximilian Wuttke 12.04.2016 *)

type world = char vector vector

fun getstate (w:world, (x, y)) = (Vector.sub (Vector.sub (w, y), x)) handle Subscript => #" "

fun conductor (w:world, (x, y)) =
	let
	  val s = [getstate (w, (x-1, y-1)) = #"H", getstate (w, (x-1, y)) = #"H", getstate (w, (x-1, y+1)) = #"H",
	           getstate (w, (x,   y-1)) = #"H",                                getstate (w, (x,   y+1)) = #"H",
	           getstate (w, (x+1, y-1)) = #"H", getstate (w, (x+1, y)) = #"H", getstate (w, (x+1, y+1)) = #"H"]
	  (* Count `true` in s *)
	  val count = List.length (List.filter (fn x => x=true) s)
	in
	  if count = 1 orelse count = 2 then #"H" else #"."
	end

fun translate (w:world, (x, y)) =
	case getstate (w, (x, y)) of
	   #" " => #" "
	 | #"H" => #"t"
	 | #"t" => #"."
	 | #"." => conductor (w, (x, y))
	 | s    => s

fun next_world (w : world) = Vector.mapi (fn (y, row) => Vector.mapi (fn (x, _) => translate (w, (x, y))) row) w

(* Test *)

(* makes a list of strings into a world *)
fun make_world (rows : string list) : world =
	Vector.fromList (map (fn (row : string) => Vector.fromList (explode row)) rows)

(* word_str reverses make_world *)
fun vec_str (r:char vector) = implode (List.tabulate (Vector.length r, fn x => Vector.sub (r, x)))
fun world_str (w:world)     = List.tabulate (Vector.length w, fn y => vec_str (Vector.sub (w, y)))
fun print_world (w:world)   = (map (fn row_str => print (row_str ^ "\n")) (world_str w); ())

val test = make_world [
	"tH.........",
	".   .      ",
	"   ...     ",
	".   .      ",
	"Ht.. ......"]


#import std

rule          = case~&l\~&l {`H: `t!, `t: `.!,`.: @r ==`H*~; {'H','HH'}?</`H! `.!}

neighborhoods = ~&thth3hthhttPCPthPTPTX**K7S+ swin3**+ [email protected]+ --<0>*+ 0-*

evolve "n"    = @iNC ~&x+ rep"n" ^C\~& rule**+ [email protected]