new-state size:
	0 ]
	repeat size:
		random-range 0 2
	[ 0

update s1 s2:
	for i range 1 - len s1 2:
		s1! -- i
		s1!    i
		s1! ++ i
		+ +
		set-to s2 i = 2
	s2 s1

print-state s:
	for i range 1 - len s 2:
		!print\ s! i
	!print ""

same-state s1 s2:
	for i range 1 - len s1 2:
		if /= s1! i s2! i:
			return false
	true

run size:
	new-state size
	new-state size
	while true:
		update
		print-state over
		if same-state over over:
			return print-state drop

run 60


def step(state, rule) {
    var result := state(0, 1) # fixed left cell
    for i in 1..(state.size() - 2) {
        # Rule function receives the substring which is the neighborhood
        result += E.toString(rule(state(i-1, i+2)))
    }
    result += state(state.size() - 1) # fixed right cell
    return result
}

def play(var state, rule, count, out) {
    out.print(`0 | $state$\n`)
    for i in 1..count {
        state := step(state, rosettaRule)
        out.print(`$i | $state$\n`)
    }
    return state
}


class
	APPLICATION

create
	make

feature

	make
			-- First 10 states of the cellular automata.
		local
			r: RANDOM
			automata: STRING
		do
			create r.make
			create automata.make_empty
			across
				1 |..| 10 as c
			loop
				if r.double_item < 0.5 then
					automata.append ("0")
				else
					automata.append ("1")
				end
				r.forth
			end
			across
				1 |..| 10 as c
			loop
				io.put_string (automata + "%N")
				automata := update (automata)
			end
		end

	update (s: STRING): STRING
			-- Next state of the cellular automata 's'.
		require
			enough_states: s.count > 1
		local
			i: INTEGER
		do
			create Result.make_empty
				-- Dealing with the left border.
			if s [1] = '1' and s [2] = '1' then
				Result.append ("1")
			else
				Result.append ("0")
			end
				-- Dealing with the middle cells.
			from
				i := 2
			until
				i = s.count
			loop
				if (s [i] = '0' and (s [i - 1] = '0' or (s [i - 1] = '1' and s [i + 1] = '0'))) or ((s [i] = '1') and ((s [i - 1] = '1' and s [i + 1] = '1') or (s [i - 1] = '0' and s [i + 1] = '0'))) then
					Result.append ("0")
				else
					Result.append ("1")
				end
				i := i + 1
			end
				-- Dealing with the right border.
			if s [s.count] = '1' and s [s.count - 1] = '1' then
				Result.append ("1")
			else
				Result.append ("0")
			end
		ensure
			has_same_length: s.count = Result.count
		end

end


defmodule RC do
  def run(list, gen \\ 0) do
    print(list, gen)
    next = evolve(list)
    if next == list, do: print(next, gen+1), else: run(next, gen+1)
  end

  defp evolve(list), do: evolve(Enum.concat([[0], list, [0]]), [])

  defp evolve([a,b,c],      next), do: Enum.reverse([life(a,b,c) | next])
  defp evolve([a,b,c|rest], next), do: evolve([b,c|rest], [life(a,b,c) | next])

  defp life(a,b,c), do: (if a+b+c == 2, do: 1, else: 0)

  defp print(list, gen) do
    str = "Generation #{gen}: "
    IO.puts Enum.reduce(list, str, fn x,s -> s <> if x==0, do: ".", else: "#" end)
  end
end

RC.run([0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0])


import Maybe exposing (withDefault)
import List exposing (length, tail, reverse, concat, head, append, map3)
import Html exposing (Html, div, h1, text)
import String exposing (join)
import Svg exposing (svg)
import Svg.Attributes exposing (version, width, height, viewBox,cx,cy, fill, r)
import Html.App exposing (program)
import Random exposing (step, initialSeed, bool, list)
import Matrix exposing (fromList, mapWithLocation, flatten)  -- chendrix/elm-matrix
import Time exposing (Time, second, every)

type alias Model = { history : List (List Bool)
                   , cols : Int
                   , rows : Int
                   }

view : Model -> Html Msg
view model =
  let
    circleInBox (row,col) value =
      if value
      then [ Svg.circle [ r "0.3"
                        , fill ("purple")
                        , cx (toString (toFloat col + 0.5))
                        , cy (toString (toFloat row + 0.5))
                        ]
                        []
           ]
      else []

    showHistory model =
      model.history
        |> reverse
        |> fromList
        |> mapWithLocation circleInBox
        |> flatten
        |> concat
  in
    div []
        [ h1 [] [text "One Dimensional Cellular Automata"]
        , svg [ version "1.1"
              , width "700"
              , height "700"
              , viewBox (join " "
                           [ 0 |> toString
                           , 0 |> toString
                           , model.cols |> toString
                           , model.rows |> toString
                           ]
                        )
              ]
              (showHistory model)
        ]

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  if length model.history == model.rows
  then (model, Cmd.none)
  else
    let s1 = model.history |> head |> withDefault []
        s0 = False :: s1
        s2 = append (tail s1 |> withDefault []) [False]

        gen d0 d1 d2 =
          case (d0,d1,d2) of
            (False,  True,  True) -> True
            ( True, False,  True) -> True
            ( True,  True, False) -> True
            _                     -> False

        updatedHistory = map3 gen s0 s1 s2 :: model.history
        updatedModel = {model | history = updatedHistory}
    in (updatedModel, Cmd.none)

init : Int -> (Model, Cmd Msg)
init n =
  let gen1 = fst (step (list n bool) (initialSeed 34))
  in ({ history = [gen1], rows = n, cols= n }, Cmd.none)

type Msg = Tick Time

subscriptions model = every (0.2 * second) Tick

main = program
         {  init = init 40
         ,  view = view
         ,  update = update
         ,  subscriptions = subscriptions
         }


PROGRAM ONEDIM_AUTOMATA

! for rosettacode.org
!

!VAR I,J,N,W,K

!$DYNAMIC
DIM X[0],X2[0]

BEGIN

   DATA(20,0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0)

   PRINT(CHR$(12);)
   N=20      ! number of generation required
   READ(W)
   !$DIM X[W+1],X2[W+1]
   FOR I=1 TO W DO
      READ(X[I])
   END FOR
   FOR K=1 TO N DO
      PRINT("Generation";K;TAB(16);)
      FOR J=1 TO W DO
         IF X[J]=1 THEN PRINT("#";)  ELSE PRINT("_";) END IF
         IF X[J-1]+X[J]+X[J+1]=2 THEN X2[J]=1 ELSE X2[J]=0 END IF
      END FOR
      PRINT
      FOR J=1 TO W DO
         X[J]=X2[J]
      END FOR
   END FOR
END PROGRAM


include machine.e

function rules(integer tri)
    return tri = 3 or tri = 5 or tri = 6
end function

function next_gen(atom gen)
    atom new, bit
    new = rules(and_bits(gen,3)*2) -- work with the first bit separately
    bit = 2
    while gen > 0 do
        new += bit*rules(and_bits(gen,7))
        gen = floor(gen/2) -- shift right
        bit *= 2 -- shift left
    end while
    return new
end function

constant char_clear = '_', char_filled = '#'

procedure print_gen(atom gen)
    puts(1, int_to_bits(gen,32) * (char_filled - char_clear) + char_clear)
    puts(1,'\n')
end procedure

function s_to_gen(sequence s)
    s -= char_clear
    return bits_to_int(s)
end function

atom gen, prev
integer n

n = 0
prev = 0
gen = bits_to_int(rand(repeat(2,32))-1)
while gen != prev do
    printf(1,"Generation %d: ",n)
    print_gen(gen)
    prev = gen
    gen = next_gen(gen)
    n += 1
end while

printf(1,"Generation %d: ",n)
print_gen(gen)


USING: bit-arrays io kernel locals math sequences ;
IN: cellular

: bool-sum ( bool1 bool2 -- sum )
    [ [ 2 ] [ 1 ] if ]
    [ [ 1 ] [ 0 ] if ] if ;
:: neighbours ( index world -- # )
    index [ 1 - ] [ 1 + ] bi [ world ?nth ] [email protected] bool-sum ;
: count-neighbours ( world -- neighbours )
    [ length iota ] keep [ neighbours ] curry map ;

: life-law ( alive? neighbours -- alive? )
    swap [ 1 = ] [ 2 = ] if ;
: step ( world -- world' )
    dup count-neighbours [ life-law ] ?{ } 2map-as ;
: print-cellular ( world -- )
    [ CHAR: # CHAR: _ ? ] "" map-as print ;
: main-cellular ( -- )
    ?{ f t t t f t t f t f t f t f t f f t f f }
    10 [ dup print-cellular step ] times print-cellular ;
MAIN: main-cellular


class Automaton
{
  static Int[] evolve (Int[] array)
  {
    return array.map |Int x, Int i -> Int|
    {
      if (i == 0)
        return ( (x + array[1] == 2) ? 1 : 0)
      else if (i == array.size-1)
        return ( (x + array[-2] == 2) ? 1 : 0)
      else if (x + array[i-1] + array[i+1] == 2)
        return 1
      else
        return 0
    }
  }

  public static Void main ()
  {
    Int[] array := [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0]
    echo (array.join(""))
    Int[] newArray := evolve(array)
    while (newArray != array)
    {
      echo (newArray.join(""))
      array = newArray
      newArray = evolve(array)
    }
  }
}


: init ( bits count -- )
  0 do dup 1 and c, 2/ loop drop ;

20 constant size
create state $2556e size init 0 c,

: .state
  cr size 0 do
    state i + [email protected] if ." #" else space then
  loop ;

: ctable create does> + [email protected] ;
ctable rules $68 8 init

: gen
  state [email protected] ( window )
  size 0 do
    2*  state i + 1+ [email protected] or  7 and
    dup rules state i + c!
  loop drop ;

: life1d ( n -- )
  .state 1 do gen .state loop ;

10 life1d


PROGRAM LIFE_1D

  IMPLICIT NONE

  LOGICAL :: cells(20) = (/ .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .FALSE., .TRUE., .FALSE., &
                            .TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE. /)
  INTEGER :: i

  DO i = 0, 9
     WRITE(*, "(A,I0,A)", ADVANCE = "NO") "Generation ", i, ": "
     CALL Drawgen(cells)
     CALL Nextgen(cells)
  END DO

CONTAINS

  SUBROUTINE Nextgen(cells)
    LOGICAL, INTENT (IN OUT) :: cells(:)
    LOGICAL :: left, centre, right
    INTEGER :: i

    left = .FALSE.
    DO i = 1, SIZE(cells)-1
       centre = cells(i)
       right = cells(i+1)
       IF (left .AND. right) THEN
          cells(i) = .NOT. cells(i)
       ELSE IF (.NOT. left .AND. .NOT. right) THEN
          cells(i) = .FALSE.
       END IF
       left = centre
    END DO
    cells(SIZE(cells)) = left .AND. right
  END SUBROUTINE Nextgen

  SUBROUTINE Drawgen(cells)
    LOGICAL, INTENT (IN OUT) :: cells(:)
    INTEGER :: i

    DO i = 1, SIZE(cells)
       IF (cells(i)) THEN
          WRITE(*, "(A)", ADVANCE = "NO") "#"
       ELSE
          WRITE(*, "(A)", ADVANCE = "NO") "_"
       END IF
    END DO
    WRITE(*,*)
  END SUBROUTINE Drawgen

END PROGRAM LIFE_1D


'
' One Dimensional Cellular Automaton
'
start$="01110110101010100100"
max_cycles%=20 ! give a maximum depth
'
' Global variables hold the world, with two rows
' world! is set up with 2 extra cells width, so there is a FALSE on either side
' cur% gives the row for current world,
' new% gives the row for the next world.
'
size%=LEN(start$)
DIM world!(size%+2,2)
cur%=0
new%=1
clock%=0
'
@setup_world(start$)
OPENW 1
CLEARW 1
DO
  @display_world
  @update_world
  EXIT IF @same_state
  clock%=clock%+1
  EXIT IF clock%>max_cycles% ! safety net
LOOP
~INP(2)
CLOSEW 1
'
' parse given string to set up initial states in world
' -- assumes world! is of correct size
'
PROCEDURE setup_world(defn$)
  LOCAL i%
  ' clear out the array
  ARRAYFILL world!(),FALSE
  ' for each 1 in string, set cell to true
  FOR i%=1 TO LEN(defn$)
    IF MID$(defn$,i%,1)="1"
      world!(i%,0)=TRUE
    ENDIF
  NEXT i%
  ' set references to cur and new
  cur%=0
  new%=1
RETURN
'
' Display the world
'
PROCEDURE display_world
  LOCAL i%
  FOR i%=1 TO size%
    IF world!(i%,cur%)
      PRINT "#";
    ELSE
      PRINT ".";
    ENDIF
  NEXT i%
  PRINT ""
RETURN
'
' Create new version of world
'
PROCEDURE update_world
  LOCAL i%
  FOR i%=1 TO size%
    world!(i%,new%)[email protected]_state(@get_value(i%))
  NEXT i%
  ' reverse cur/new
  cur%=1-cur%
  new%=1-new%
RETURN
'
' Test if cur/new states are the same
'
FUNCTION same_state
  LOCAL i%
  FOR i%=1 TO size%
    IF world!(i%,cur%)<>world!(i%,new%)
      RETURN FALSE
    ENDIF
  NEXT i%
  RETURN TRUE
ENDFUNC
'
' Return new state of cell given value
'
FUNCTION new_state(value%)
  SELECT value%
  CASE 0,1,2,4,7
    RETURN FALSE
  CASE 3,5,6
    RETURN TRUE
  ENDSELECT
ENDFUNC
'
' Compute value for cell + neighbours
'
FUNCTION get_value(cell%)
  LOCAL result%
  result%=0
  IF world!(cell%-1,cur%)
    result%=result%+4
  ENDIF
  IF world!(cell%,cur%)
    result%=result%+2
  ENDIF
  IF world!(cell%+1,cur%)
    result%=result%+1
  ENDIF
  RETURN result%
ENDFUNC


package main

import "fmt"

const (
    start    = "_###_##_#_#_#_#__#__"
    offLeft  = '_'
    offRight = '_'
    dead     = '_'
)

func main() {
    fmt.Println(start)
    g := newGenerator(start, offLeft, offRight, dead)
    for i := 0; i < 10; i++ {
        fmt.Println(g())
    }
}

func newGenerator(start string, offLeft, offRight, dead byte) func() string {
    g0 := string(offLeft) + start + string(offRight)
    g1 := []byte(g0)
    last := len(g0) - 1
    return func() string {
        for i := 1; i < last; i++ {
            switch l := g0[i-1]; {
            case l != g0[i+1]:
                g1[i] = g0[i]
            case g0[i] == dead:
                g1[i] = l
            default:
                g1[i] = dead
            }
        }
        g0 = string(g1)
        return g0[1:last]
    }
}


def life1D = { self ->
    def right = self[1..-1] + [false]
    def left = [false] + self[0..-2]
    [left, self, right].transpose().collect { hood -> hood.count { it } == 2 }
}


import Data.List (unfoldr)
import System.Random (newStdGen, randomRs)

bnd :: String -> Char
bnd "_##" = '#'
bnd "#_#" = '#'
bnd "##_" = '#'
bnd _ = '_'

nxt :: String -> String
nxt = unfoldr go . ('_' :) . (<> "_")
  where
    go [_, _] = Nothing
    go xs = Just (bnd $ take 3 xs, drop 1 xs)

lahmahgaan :: String -> [String]
lahmahgaan xs =
  init
    . until
      ((==) . last <*> last . init)
      ((<>) <*> pure . nxt . last)
    $ [xs, nxt xs]

main :: IO ()
main =
  newStdGen
    >>= ( mapM_ putStrLn . lahmahgaan
            . map ("_#" !!)
            . take 36
            . randomRs (0, 1)
        )


# One dimensional Cellular automaton
record Automaton(size, cells)

procedure make_automaton (size, items)
  automaton := Automaton (size, items)
  while (*items < size) do push (automaton.cells, 0)
  return automaton
end

procedure automaton_display (automaton)
  every (write ! automaton.cells)
end

procedure automaton_evolve (automaton)
  revised := make_automaton (automaton.size, [])
  # do the left-most cell
  if ((automaton.cells[1] + automaton.cells[2]) = 2) then
    revised.cells[1] := 1
  # do the right-most cell
  if ((automaton.cells[automaton.size] + automaton.cells[automaton.size-1]) = 2) then
    revised.cells[revised.size] := 1
  # do the intermediate cells
  every (i := 2 to (automaton.size-1)) do {
    if ((automaton.cells[i-1] + automaton.cells[i] + automaton.cells[i+1]) = 2) then
      revised.cells[i] := 1
  }
  return revised
end

procedure main ()
  automaton := make_automaton (20, [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0])
  every (1 to 10) do { # generations
    automaton_display (automaton)
    automaton := automaton_evolve (automaton)
  }
end


public class Life{
	public static void main(String[] args) throws Exception{
		String start= "_###_##_#_#_#_#__#__";
		int numGens = 10;
		for(int i= 0; i < numGens; i++){
			System.out.println("Generation " + i + ": " + start);
			start= life(start);
		}
	}

	public static String life(String lastGen){
		String newGen= "";
		for(int i= 0; i < lastGen.length(); i++){
			int neighbors= 0;
			if (i == 0){//left edge
				neighbors= lastGen.charAt(1) == '#' ? 1 : 0;
			} else if (i == lastGen.length() - 1){//right edge
				neighbors= lastGen.charAt(i - 1) == '#' ? 1 : 0;
			} else{//middle
				neighbors= getNeighbors(lastGen.substring(i - 1, i + 2));
			}

			if (neighbors == 0){//dies or stays dead with no neighbors
				newGen+= "_";
			}
			if (neighbors == 1){//stays with one neighbor
				newGen+= lastGen.charAt(i);
			}
			if (neighbors == 2){//flips with two neighbors
				newGen+= lastGen.charAt(i) == '#' ? "_" : "#";
			}
		}
		return newGen;
	}

	public static int getNeighbors(String group){
		int ans= 0;
		if (group.charAt(0) == '#') ans++;
		if (group.charAt(2) == '#') ans++;
		return ans;
	}
}


function caStep(old) {
  var old = [0].concat(old, [0]); // Surround with dead cells.
  var state = []; // The new state.

  for (var i=1; i<old.length-1; i++) {
    switch (old[i-1] + old[i+1]) {
      case 0: state[i-1] = 0; break;
      case 1: state[i-1] = (old[i] == 1) ? 1 : 0; break;
      case 2: state[i-1] = (old[i] == 1) ? 0 : 1; break;
    }
  }
  return state;
}


# The 1-d cellular automaton:
def next:
   # Conveniently, jq treats null as 0 when it comes to addition
   # so there is no need to fiddle with the boundaries
  . as $old
  | reduce range(0; length) as $i
    ([];
     ($old[$i-1] + $old[$i+1]) as $s
     | if   $s == 0 then .[$i] = 0
       elif $s == 1 then .[$i] = (if $old[$i] == 1 then 1 else 0 end)
       else              .[$i] = (if $old[$i] == 1 then 0 else 1 end)
       end);

# pretty-print an array:
def pp: reduce .[] as $i (""; . + (if $i == 0 then " " else "*" end));

# continue until quiescence:
def go: recurse(. as $prev | next | if . == $prev then empty else . end) | pp;

# Example:
[0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0] | go


function next_gen(a::BitArray{1}, isperiodic=false)
    b = copy(a)
    if isperiodic
        ncnt = prepend!(a[1:end-1], [a[end]]) + append!(a[2:end], [a[1]])
    else
        ncnt = prepend!(a[1:end-1], [false]) + append!(a[2:end], [false])
    end
    b[ncnt .== 0] = false
    b[ncnt .== 2] = ~b[ncnt .== 2]
    return b
end

function show_gen(a::BitArray{1})
    s = join([i ? "\u2588" : " " for i in a], "")
    s = "\u25ba"*s*"\u25c4"
end

hi = 70
a = bitrand(hi)
b = falses(hi)
println("A 1D Cellular Atomaton with ", hi, " cells and empty bounds.")
while any(a) && any(a .!= b)
    println("    ", show_gen(a))
    b = copy(a)
    a = next_gen(a)
end
a = bitrand(hi)
b = falses(hi)
println()
println("A 1D Cellular Atomaton with ", hi, " cells and periodic bounds.")
while any(a) && any(a .!= b)
    println("    ", show_gen(a))
    b = copy(a)
    a = next_gen(a, true)
end


// version 1.1.4-3

val trans = "___#_##_"

fun v(cell: StringBuilder, i: Int) = if (cell[i] != '_') 1 else 0

fun evolve(cell: StringBuilder, backup: StringBuilder): Boolean {
    val len = cell.length - 2
    var diff = 0
    for (i in 1 until len) {
        /* use left, self, right as binary number bits for table index */
        backup[i] = trans[v(cell, i - 1) * 4 + v(cell, i) * 2 + v(cell, i + 1)]
        diff += if (backup[i] != cell[i]) 1 else 0
    }
    cell.setLength(0)
    cell.append(backup)
    return diff != 0
}

fun main(args: Array<String>) {
    val c = StringBuilder("_###_##_#_#_#_#__#__")
    val b = StringBuilder("____________________")
    do {
       println(c.substring(1))
    }
    while (evolve(c,b))
}


'   [RC] 'One-dimensional cellular automata'

'    does not wrap so fails for some rules
rule$ ="00010110"   '   Rule 22 decimal

state$ ="0011101101010101001000"

for j =1 to 20
    print state$
    oldState$ =state$
    state$ ="0"
    for k =2 to len( oldState$) -1
        NHood$ =mid$( oldState$, k -1, 3)  '   pick 3 char neighbourhood and turn binary string to decimal
        vNHood =0
        for kk =3 to 1 step -1
            vNHood =vNHood +val( mid$( NHood$, kk, 1)) *2^( 3 -kk)
        next kk
                                        '  .... & use it to index into rule$ to find appropriate new value
        state$ =state$ +mid$( rule$, vNHood +1, 1)
    next k
    state$ =state$ +"0"

next j

end


make "cell_list [0 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0]
make "generations 9

to evolve :n
ifelse :n=1 [make "nminus1 item :cell_count :cell_list][make "nminus1 item :n-1 :cell_list]
ifelse :n=:cell_count[make "nplus1 item 1 :cell_list][make "nplus1 item :n+1 :cell_list]
ifelse ((item :n :cell_list)=0) [
	ifelse (and (:nminus1=1) (:nplus1=1)) [output 1][output (item :n :cell_list)]
][
	ifelse (and (:nminus1=1) (:nplus1=1)) [output 0][
	   ifelse and (:nminus1=0) (:nplus1=0) [output 0][output (item :n :cell_list)]]
]
end

to CA_1D :cell_list :generations
make "cell_count count :cell_list
(print ")
make "printout "
repeat :cell_count [
make "printout word :printout ifelse (item repcount :cell_list)=1 ["#]["_]
]
(print "Generation "0: :printout)

repeat :generations [
       (make "cell_list_temp [])
       repeat :cell_count[
             (make "cell_list_temp (lput (evolve repcount) :cell_list_temp))
       ]
       make "cell_list :cell_list_temp
       make "printout "
       repeat :cell_count [
       	      make "printout word :printout ifelse (item repcount :cell_list)=1 ["#]["_]
       ]
       (print "Generation  word repcount ": :printout)
]
end

CA_1D :cell_list :generations


num_iterations = 9
f = { 0, 1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0 }

function Output( f, l )
    io.write( l, ":  " )
    for i = 1, #f do
        local c
        if f[i] == 1 then c = '#' else c = '_' end
        io.write( c )
    end
    print ""
end

Output( f, 0 )

for l = 1, num_iterations do
    local g = {}
    for i = 2, #f-1 do
        if f[i-1] + f[i+1] == 1 then
            g[i] = f[i]
        elseif f[i] == 0 and f[i-1] + f[i+1] == 2 then
            g[i] = 1
        else
            g[i] = 0
        end
    end
    if f[1]  == 1 and f[2]    == 1 then g[1]  = 1 else g[1]  = 0 end
    if f[#f] == 1 and f[#f-1] == 1 then g[#f] = 1 else g[#f] = 0 end
    f, g = g, f

    Output( f, l )
end


function one_dim_cell_automata(v,n)
   V='_#';
   while n>=0;
	disp(V(v+1));
	n = n-1;
	v = filter([1,1,1],1,[0,v,0]);
	v = v(3:end)==2;
   end;
end


MODULE Cell EXPORTS Main;

IMPORT IO, Fmt, Word;

VAR culture := ARRAY [0..19] OF INTEGER {0, 1, 1, 1,
                                         0, 1, 1, 0,
                                         1, 0, 1, 0,
                                         1, 0, 1, 0,
                                         0, 1, 0, 0};

PROCEDURE Step(VAR culture: ARRAY OF INTEGER) =
  VAR left: INTEGER := 0;
      this, right: INTEGER;
  BEGIN
    FOR i := FIRST(culture) TO LAST(culture) - 1 DO
      right := culture[i + 1];
      this := culture[i];
      culture[i] :=
          Word.Or(Word.And(this, Word.Xor(left, right)), Word.And(Word.Not(this), Word.And(left, right)));
      left := this;
    END;
    culture[LAST(culture)] := Word.And(culture[LAST(culture)], Word.Not(left));
  END Step;

PROCEDURE Put(VAR culture: ARRAY OF INTEGER) =
  BEGIN
    FOR i := FIRST(culture) TO LAST(culture) DO
      IF culture[i] = 1 THEN
        IO.PutChar('#');
      ELSE
        IO.PutChar('_');
      END;
    END;
  END Put;

BEGIN
  FOR i := 0 TO 9 DO
    IO.Put("Generation " & Fmt.Int(i) & " ");
    Put(culture);
    IO.Put("\n");
    Step(culture);
  END;
END Cell.


30 VAR length .
35 VAR height .
FOR length 0 ENDFOR 1 0 ARR VAR list .
length 1 - VAR topLen .
FOR topLen 0 ENDFOR 1 ARR VAR topLst .

DEF getNeighbors
    1 - VAR tempIndex .
    GET tempIndex SWAP
    tempIndex 1 + VAR tempIndex .
    GET tempIndex SWAP
    tempIndex 1 + VAR tempIndex .
    GET tempIndex SWAP .
    FOR 3 TOSTR ROT ENDFOR
    FOR 2 SWAP + ENDFOR
ENDDEF

DEF printArr
    LEN 1 - VAR stLen .
    0 VAR j .
    FOR stLen
        GET j
        TOSTR OUT .
        j 1 + VAR j .
    ENDFOR
    || PRINT .
ENDDEF

FOR height
    FOR length 0 ENDFOR ARR VAR next .
    1 VAR i .
    FOR length
        list i getNeighbors VAR last .
        i 1 - VAR ind .
        last |111| ==
        IF : .
            next 0 INSERT ind
        ENDIF

        last |110| ==
        IF : .
            next 1 INSERT ind
        ENDIF

        last |101| ==
        IF : .
            next 1 INSERT ind
        ENDIF

        last |100| ==
        IF : .
            next 0 INSERT ind
        ENDIF

        last |011| ==
        IF : .
            next 1 INSERT ind
        ENDIF

        last |010| ==
        IF : .
            next 1 INSERT ind
        ENDIF

        last |001| ==
        IF : .
            next 1 INSERT ind
        ENDIF

        last |000| ==
        IF : .
            next 0 INSERT ind
        ENDIF
        clear
        i 1 + VAR i .
    ENDFOR
    next printArr .
    next 0 ADD APPEND . VAR list .
ENDFOR


% we need a way to write a values and pass the same back
wi is rest link [write, pass]
% calculate the neighbors by rotating the array left and right and joining them
neighbors is pack [pass, sum [-1 rotate,  1 rotate]]
% calculate the individual birth and death of a single array element
igen is fork [ = [ + [first, second], 3 first], 0 first, = [ + [first, second], 2 first], 1 first, 0 first ]
% apply that to the array
nextgen is each igen neighbors
% 42
life is fork [ > [sum pass, 0 first], life nextgen wi, pass ]


import random

type
  BoolArray  = array[30, bool]
  Symbols    = array[bool, char]

proc neighbours(map: BoolArray, i: int): int =
  if i > 0:             inc(result, int(map[i - 1]))
  if i + 1 < len(map):  inc(result, int(map[i + 1]))

proc print(map: BoolArray, symbols: Symbols) =
  for i in map: write(stdout, symbols[i])
  write(stdout, "\l")

proc randomMap: BoolArray =
  randomize()
  for i in mitems(result): i = sample([true, false])

const
  num_turns = 20
  symbols   = ['_', '#']

  T = true
  F = false

var map =
  [F, T, T, T, F, T, T, F, T, F, T, F, T, F, T,
    F, F, T, F, F, F, F, F, F, F, F, F, F, F, F]

# map = randomMap()  # uncomment for random start

print(map, symbols)

for _ in 0 ..< num_turns:
  var map2 = map

  for i, v in pairs(map):
    map2[i] =
      if v: neighbours(map, i) == 1
      else: neighbours(map, i) == 2

  print(map2, symbols)

  if map2 == map: break
  map = map2


let get g i =
  try g.(i)
  with _ -> 0

let next_cell g i =
  match get g (i-1), get g (i), get g (i+1) with
  | 0, 0, 0 -> 0
  | 0, 0, 1 -> 0
  | 0, 1, 0 -> 0
  | 0, 1, 1 -> 1
  | 1, 0, 0 -> 0
  | 1, 0, 1 -> 1
  | 1, 1, 0 -> 1
  | 1, 1, 1 -> 0
  | _ -> assert(false)

let next g =
  let old_g = Array.copy g in
  for i = 0 to pred(Array.length g) do
    g.(i) <- (next_cell old_g i)
  done

let print_g g =
  for i = 0 to pred(Array.length g) do
    if g.(i) = 0
    then print_char '_'
    else print_char '#'
  done;
  print_newline()


: nextGen( l )
| i s |
   l byteSize dup ->s String newSize
   s loop: i [
      i 1 if=: [ 0 ] else: [ i 1- l byteAt '#' = ]
      i l byteAt '#' = +
      i s if=: [ 0 ] else: [ i 1+ l byteAt '#' = ] +
      2 if=: [ '#' ] else: [ '_' ] over add
      ]
;

: gen( l n -- )
    l dup .cr #[ nextGen dup .cr ] times( n ) drop ;


declare
  A0 = {List.toTuple unit "_###_##_#_#_#_#__#__"}

  MaxGenerations = 9

  Rules = unit('___':&_
               '__#':&_
               '_#_':&_
               '_##':&#
               '#__':&_
               '#_#':&#
               '##_':&#
               '###':&_)

  fun {Evolve A}
     {Record.mapInd A
      fun {$ I V}
         Left = {CondSelect A I-1 &_}
         Right = {CondSelect A I+1 &_}
         Env = {String.toAtom [Left V Right]}
      in
         Rules.Env
      end
     }
  end

  fun lazy {Iterate X F}
     X|{Iterate {F X} F}
  end
in
  for
     I in 0..MaxGenerations
     A in {Iterate A0 Evolve}
  do
     {System.showInfo "Gen. "#I#": "#{Record.toList A}}
  end


program Test;
{$IFDEF FPC}{$MODE DELPHI}{$ELSE}{$APPTYPE}{$ENDIF}
uses
  sysutils;
const
  cCHAR: array[0..1] of char = ('_','#');
type
  TRow =  array of byte;

function ConvertToRow(const s:string):tRow;
var
  i : NativeInt;
Begin
  i := length(s);
  setlength(Result,length(s));
  For i := i downto 0 do
    result[i-1]:= ORD(s[i]=cChar[1]);
end;

function OutRow(const row:tRow):string;
//create output string
var
  i: NativeInt;
Begin
  i := length(row);
  setlength(result,i);
  For i := i downto 1 do
    result[i]:= cChar[row[i-1]];
end;

procedure NextRow(row:pByteArray;MaxIdx:NativeInt);
//compute next row in place by the using a small storage for the
//2 values, that would otherwise be overridden
var
  leftValue,Value: NativeInt;
  i,trpCnt: NativeInt;
Begin
  leftValue := 0;
  trpCnt := row[0]+row[1];

  i := 0;
  while i < MaxIdx do
  Begin
    Value := row[i];
    //the rule for survive : PopCnt == 2
    row[i] := ORD(trpCnt= 2);
    //reduce popcnt of element before
    dec(trpCnt,leftValue);
    //goto next element
    inc(i);
    leftValue := Value;
    //increment popcnt by right element
    inc(trpCnt,row[i+1]);
    //move to next position in ring buffer
  end;
  row[MaxIdx] := ORD(trpCnt= 2);
end;

const
  TestString: string='  ### ## # # # #  #  ';
var
  s: string;
  row:tRow;
  i: NativeInt;
begin
  s := Teststring;
  row:= ConvertToRow(s);
  For i := 0 to 9 do
  Begin
    writeln(OutRow(row));
    NextRow(@row[0],High(row));
  end;
end.


string s = "_###_##_#_#_#_#__#__"
integer prev='_', curr, toggled = 1

while 1 do
    ?s
    for i=2 to length(s)-1 do
        curr = s[i]
        if prev=s[i+1]
        and (curr='#' or prev='#') then
            s[i] = 130-curr
            toggled = 1
        end if
        prev = curr
    end for
    if not toggled then ?s exit end if
    toggled = 0
end while


0 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 stklen var w
w tolist 0 0 put
0 w 1 + repeat var x2

10 for
	drop
	w for
		var j
		j get 1 == if "#" else "_" endif print
		j 1 - get var p1 j get swap j 1 + get rot p1 + + 2 ==
		x2 swap j set var x2
	endfor
	nl
	drop x2
endfor


go =>
   %    _ # # # _ # # _ # _ # _ # _ # _ _ # _ _
   S = [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0],
   println(init=S),
   run_ca(S),
   nl,

   println("Some random inits:"),
   _ = random2(),
   foreach(N in [5,10,20,50])
     S2 = [random() mod 2 : _I in 1..N],
     run_ca(S2),
     nl
    end.

%
% Run a CA and show the result.
%

% rule/1 is the default
run_ca(S) =>
  run_ca(S,rule).
run_ca(S,Rules) =>
  Len = S.length,
  All := [S],
  Seen = new_map(), % detect fixpoint and cycle
  while (not Seen.has_key(S))
    Seen.put(S,1),
    T = [S[1]] ++ [apply(Rules, slice(S,I-1,I+1)) : I in 2..Len-1] ++ [S[Len]],
    All := All ++ [T],
    S := T
  end,
  foreach(A in All) println(A.convert()) end,
  writeln(len=All.length).

% Convert:
%  0->"_"
%  1->"#"
convert(L) = Res =>
    B = "_#",
    Res = [B[L[I]+1] : I in 1..L.length].

% the rules
rule([0,0,0]) = 0. %
rule([0,0,1]) = 0. %
rule([0,1,0]) = 0. % Dies without enough neighbours
rule([0,1,1]) = 1. % Needs one neighbour to survive
rule([1,0,0]) = 0. %
rule([1,0,1]) = 1. % Two neighbours giving birth
rule([1,1,0]) = 1. % Needs one neighbour to survive
rule([1,1,1]) = 0. % Starved to death.


one_dimensional_cellular_automata(L) :-
	maplist(my_write, L), nl,
	length(L, N),
	length(LN, N),
	% there is a 0 before the beginning
	compute_next([0 |L], LN),
	(   L \= LN -> one_dimensional_cellular_automata(LN); true).

% All the possibilites
compute_next([0, 0, 0 | R], [0 | R1]) :-
	compute_next([0, 0 | R], R1).

compute_next([0, 0, 1 | R], [0 | R1]) :-
	compute_next([0, 1 | R], R1).

compute_next([0, 1, 0 | R], [0 | R1]) :-
	compute_next([1, 0 | R], R1).

compute_next([0, 1, 1 | R], [1 | R1]) :-
	compute_next([1, 1 | R], R1).

compute_next([1, 0, 0 | R], [0 | R1]) :-
	compute_next([0, 0 | R], R1).

compute_next([1, 0, 1 | R], [1 | R1]) :-
	compute_next([0, 1 | R], R1).

compute_next([1, 1, 0 | R], [1 | R1]) :-
	compute_next([1, 0 | R], R1).

compute_next([1, 1, 1 | R], [0 | R1]) :-
	compute_next([1, 1 | R], R1).

% the last four possibilies =>
% we consider that there is à 0  after the end
complang jq># The 1-d cellular automaton:
def next:
   # Conveniently, jq treats null as 0 when it comes to addition
   # so there is no need to fiddle with the boundaries
  . as $old
  | reduce range(0; length) as $i
    ([];
     ($old[$i-1] + $old[$i+1]) as $s
     | if   $s == 0 then .[$i] = 0
       elif $s == 1 then .[$i] = (if $old[$i] == 1 then 1 else 0 end)
       else              .[$i] = (if $old[$i] == 1 then 0 else 1 end)
       end);

# pretty-print an array:
def pp: reduce .[] as $i (""; . + (if $i == 0 then " " else "*" end));

# continue until quiescence:
def go: recurse(. as $prev | next | if . == $prev then empty else . end) | pp;

# Example:
[0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0] | goute_next([0, 0], [0]).

compute_next([1, 0], [0]).

compute_next([0, 1], [0]).

compute_next([1, 1], [1]).

my_write(0) :-
	write(.).

my_write(1) :-
	write(#).

one_dimensional_cellular_automata :-
	L = [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0],
	one_dimensional_cellular_automata(L).


EnableExplicit
Dim cG.i(21)
Dim nG.i(21)
Define.i n, Gen

DataSection
  Data.i 0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0
EndDataSection
For n=1 To 20
  Read.i cG(n)
Next

OpenConsole()
Repeat
  Print("Generation "+Str(Gen)+": ")
  For n=1 To 20
    Print(Chr(95-cG(n)*60))
  Next
  Gen +1
  PrintN("")
  For n=1 To 20
    If (cG(n) And (cG(n-1) XOr cg(n+1))) Or (Not cG(n) And (cG(n-1) And cg(n+1)))
     nG(n)=1
   Else
     nG(n)=0
   EndIf
  Next
  CopyArray(nG(), cG())
Until Gen > 9

PrintN("Press any key to exit"): Repeat: Until Inkey() <> ""


import random

printdead, printlive = '_#'
maxgenerations = 10
cellcount = 20
offendvalue = '0'

universe = ''.join(random.choice('01') for i in range(cellcount))

neighbours2newstate = {
 '000': '0',
 '001': '0',
 '010': '0',
 '011': '1',
 '100': '0',
 '101': '1',
 '110': '1',
 '111': '0',
 }

for i in range(maxgenerations):
    print "Generation %3i:  %s" % ( i,
          universe.replace('0', printdead).replace('1', printlive) )
    universe = offendvalue + universe + offendvalue
    universe = ''.join(neighbours2newstate[universe[i:i+3]] for i in range(cellcount))


 [ stack 0 ]                     is cells    (   --> s )

 [ dup size cells replace
   0 swap witheach
     [ char # =
       | 1 << ] ]                is setup    ( $ --> n )

 [ 0 swap
   cells share times
     [ dup i >> 7 &
       [ table 0 0 0 1 0 1 1 0 ]
       rot 1 << | swap ]
   drop 1 << ]                   is nextline ( n --> n )

  [ cells share times
      [ dup i 1+ bit &
        iff [ char # ]
        else [ char _ ]
        emit ]
    cr drop ]                    is echoline ( n -->   )

  [ setup
    [ dup echoline
      dup nextline
      tuck = until ]
    echoline ]                   is automate ( $ -->   )

  $ "_###_##_#_#_#_#__#__" automate


set.seed(15797, kind="Mersenne-Twister")

maxgenerations = 10
cellcount = 20
offendvalue = FALSE

## Cells are alive if TRUE, dead if FALSE
universe <- c(offendvalue,
              sample( c(TRUE, FALSE), cellcount, replace=TRUE),
              offendvalue)

## List of patterns in which the cell stays alive
stayingAlive <- lapply(list(c(1,1,0),
                            c(1,0,1),
                            c(0,1,0)), as.logical)

## x : length 3 logical vector
## map: list of length 3 logical vectors that map to patterns
##      in which x stays alive
deadOrAlive <- function(x, map) list(x) %in% map

cellularAutomata <- function(x, map) {
    c(x[1], apply(embed(x, 3), 1, deadOrAlive, map=map), x[length(x)])
}

deadOrAlive2string <- function(x) {
    paste(ifelse(x, '#', '_'), collapse="")
}

for (i in 1:maxgenerations) {
    universe <- cellularAutomata(universe, stayingAlive)
    cat(format(i, width=3), deadOrAlive2string(universe), "\n")
}


class Automaton {
    has $.rule;
    has @.cells;
    has @.code = $!rule.fmt('%08b').flip.comb».Int;

    method gist { "|{ @!cells.map({+$_ ?? '#' !! ' '}).join }|" }

    method succ {
        self.new: :$!rule, :@!code, :cells(
            @!code[
                    4 «*« @!cells.rotate(-1)
                »+« 2 «*« @!cells
                »+«       @!cells.rotate(1)
            ]
        )
    }
}

#  The rule proposed for this task is rule 0b01101000 = 104

my @padding = 0 xx 5;
my Automaton $a .= new:
    rule  => 104,
    cells => flat @padding, '111011010101'.comb, @padding
;
say $a++ for ^10;

# Rule 104 is not particularly interesting so here is [[wp:Rule 90|Rule 90]],
# which shows a [[wp:Sierpinski Triangle|Sierpinski Triangle]].

say '';
@padding = 0 xx 25;
$a = Automaton.new: :rule(90), :cells(flat @padding, 1, @padding);

say $a++ for ^20;


Red [
    Purpose: "One-dimensional cellular automata"
    Author: "Joe Smith"
]

vals: [0 1 0]
kill: [[0 0] [#[none] 0] [0 #[none]]]
evo: function [petri] [
	new-petri: copy petri
	while [petri/1] [
		if all [petri/-1 = 1 petri/2 = 1] [new-petri/1: select vals petri/1]
		if find/only kill reduce [petri/-1 petri/2] [new-petri/1: 0]
		petri: next petri new-petri: next new-petri
	]
	petri: head petri new-petri: head new-petri
	clear insert petri new-petri
]

display: function [petri] [
	print replace/all (replace/all to-string petri "0" "_") "1" "#"
	petri
]

loop 10 [
	evo display [1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0]
]


# 1D Cellular Automota

Assume an array of cells with an initial distribution of live and
dead cells, and imaginary cells off the end of the array having
fixed values.

Cells in the next generation of the array are calculated based on
the value of the cell and its left and right nearest neighbors in
the current generation.

If, in the following table, a live cell is represented by 1 and a
dead cell by 0 then to generate the value of the cell at a particular
index in the array of cellular values you use the following table:

000 -> 0  #
001 -> 0  #
010 -> 0  # Dies without enough neighbours
011 -> 1  # Needs one neighbour to survive
100 -> 0  #
101 -> 1  # Two neighbours giving birth
110 -> 1  # Needs one neighbour to survive
111 -> 0  # Starved to death.

I had originally written an implementation of this in RETRO 11.
For RETRO 12 I took advantage of new language features and some
further considerations into the rules for this task.

The first word, `string,` inlines a string to `here`. I'll use
this to setup the initial input.

~~~
:string, (s-) [ , ] s:for-each #0 , ;
~~~

The next two lines setup an initial generation and a buffer for
the evolved generation. In this case, `This` is the current
generation and `Next` reflects the next step in the evolution.

~~~
'This d:create
  '.###.##.#.#.#.#..#.. string,

'Next d:create
  '.................... string,
~~~

I use `display` to show the current generation.

~~~
:display (-)
  &This s:put nl ;
~~~

As might be expected, `update` copies the `Next` generation to
the `This` generation, setting things up for the next cycle.

~~~
:update (-)
  &Next &This dup s:length copy ;
~~~

The word `group` extracts a group of three cells. This data will
be passed to `evolve` for processing.

~~~
:group (a-nnn)
  [ fetch ]
  [ n:inc fetch ]
  [ n:inc n:inc fetch ] tri ;
~~~

I use `evolve` to decide how a cell should change, based on its
initial state with relation to its neighbors.

In the prior implementation this part was much more complex as I
tallied things up and had separate conditions for each combination.
This time I take advantage of the fact that only cells with two
neighbors will be alive in the next generation. So the process is:

- take the data from `group`
- compare to `$#` (for living cells)
- add the flags
- if the result is `#-2`, the cell should live
- otherwise it'll be dead

~~~
:evolve (nnn-c)
  [ $# eq? ] [email protected] + +
  #-2 eq? [ $# ] [ $. ] choose ;
~~~

For readability I separated out the next few things. `at` takes an
index and returns the address in `This` starting with the index.

~~~
:at (n-na)
  &This over + ;
~~~

The `record` word adds the evolved value to a buffer. In this case
my `generation` code will set the buffer to `Next`.

~~~
:record (c-)
  buffer:add n:inc ;
~~~

And now to tie it all together. Meet `generation`, the longest bit
of code in this sample. It has several bits:

- setup a new buffer pointing to `Next`

  - this also preserves the old buffer

- setup a loop for each cell in `This`

  - initial loop index at -1, to ensure proper dummy state for first cell
  - get length of `This` generation

- perform a loop for each item in the generation, updating `Next` as it goes

- copy `Next` to `This` using `update`.

~~~
:generation (-)
  [ &Next buffer:set
    #-1 &This s:length
    [ at group evolve record ] times drop
    update
  ] buffer:preserve ;
~~~

The last bit is a helper. It takes a number of generations and displays
the state, then runs a `generation`.

~~~
:generations (n-)
  [ display generation ] times ;
~~~

And a text. The output should be:

    .###.##.#.#.#.#..#..
    .#.#####.#.#.#......
    ..##...##.#.#.......
    ..##...###.#........
    ..##...#.##.........
    ..##....###.........
    ..##....#.#.........
    ..##.....#..........
    ..##................
    ..##................

~~~
#10 generations
~~~


/*REXX program generates & displays N generations of one─dimensional cellular automata. */
parse arg $ gens .                               /*obtain optional arguments from the CL*/
if    $=='' |    $==","  then $=001110110101010  /*Not specified?  Then use the default.*/
if gens=='' | gens==","  then gens=40            /* "      "         "   "   "     "    */

   do #=0  for gens                              /* process the  one-dimensional  cells.*/
   say  " generation"    right(#,length(gens))       ' '       translate($, "#·", 10)
   @=0                                                                /* [↓] generation.*/
          do j=2  for length($) - 1;          x=substr($, j-1, 3)     /*obtain the cell.*/
          if x==011 | x==101 | x==110  then @=overlay(1, @, j)        /*the cell lives. */
                                       else @=overlay(0, @, j)        /* "   "    dies. */
          end   /*j*/

   if [email protected]  then do;  say right('repeats', 40);  leave;  end          /*does it repeat? */
   [email protected]                                           /*now use the next generation of cells.*/
   end       /*#*/                               /*stick a fork in it,  we're all done. */


# Project : One-dimensional cellular automata

rule = ["0", "0", "0", "1", "0", "1", "1", "0"]
now = "01110110101010100100"

for generation = 0 to 9
    see "generation " + generation + ": " + now + nl
    nxt = ""
    for cell = 1 to len(now)
        str = "bintodec(" + '"' +substr("0"+now+"0", cell, 3) + '"' + ")"
        eval("p=" + str)
        nxt = nxt + rule[p+1]
    next
    temp = nxt
    nxt = now
    now = temp
next

func bintodec(bin)
     binsum = 0
     for n=1  to len(bin)
         binsum = binsum + number(bin[n]) *pow(2, len(bin)-n)
     next
     return binsum


def evolve(ary)
  ([0]+ary+[0]).each_cons(3).map{|a,b,c| a+b+c == 2 ? 1 : 0}
end

def printit(ary)
  puts ary.join.tr("01",".#")
end

ary = [0,1,1,1,0,1,1,0,1,0,1,0,1,0,1,0,0,1,0,0]
printit ary
until ary == (new = evolve(ary))
  printit ary = new
end


fn get_new_state(windowed: &[bool]) -> bool {
    match windowed {
        [false, true, true] | [true, true, false] => true,
        _ => false
    }
}

fn next_gen(cell: &mut [bool]) {
    let mut v = Vec::with_capacity(cell.len());
    v.push(cell[0]);
    for i in cell.windows(3) {
        v.push(get_new_state(i));
    }
    v.push(cell[cell.len() - 1]);
    cell.copy_from_slice(&v);
}

fn print_cell(cell: &[bool]) {
    for v in cell {
        print!("{} ", if *v {'#'} else {' '});
    }
    println!();
}

fn main() {

    const MAX_GENERATION: usize = 10;
    const CELLS_LENGTH: usize = 30;

    let mut cell: [bool; CELLS_LENGTH] = rand::random();

    for i in 1..=MAX_GENERATION {
        print!("Gen {:2}: ", i);
        print_cell(&cell);
        next_gen(&mut cell);
    }
}


def cellularAutomata(s: String) = {
  def it = Iterator.iterate(s) ( generation =>
    ("_%s_" format generation).iterator
    sliding 3
    map (_ count (_ == '#'))
    map Map(2 -> "#").withDefaultValue("_")
    mkString
  )

  (it drop 1) zip it takeWhile Function.tupled(_ != _) map (_._2) foreach println
}


(define (next-generation left petri-dish right)
  (if (null? petri-dish)
      (list)
      (cons (if (= (+ left
                      (car petri-dish)
                      (if (null? (cdr petri-dish))
                          right
                          (cadr petri-dish)))
                   2)
                1
                0)
            (next-generation (car petri-dish) (cdr petri-dish) right))))

(define (display-evolution petri-dish generations)
  (if (not (zero? generations))
      (begin (display petri-dish)
             (newline)
             (display-evolution (next-generation 0 petri-dish 0)
                                (- generations 1)))))

(display-evolution (list 1 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 0) 10)


$ include "seed7_05.s7i";

const string: start is "_###_##_#_#_#_#__#__";

const proc: main is func
  local
    var string: g0 is start;
    var string: g1 is start;
    var integer: generation is 0;
    var integer: i is 0;
  begin
    writeln(g0);
    for generation range 0 to 9 do
      for i range 2 to pred(length(g0)) do
        if g0[i-1] <> g0[i+1] then
          g1 @:= [i] g0[i];
        elsif g0[i] = '_' then
          g1 @:= [i] g0[i-1];
        else
          g1 @:= [i] '_'
        end if;
      end for;
      writeln(g1);
      g0 := g1;
    end for;
  end func;


import <Utilities/Conversion.sl>;

main(args(2)) :=
    run(args[1], stringToInt(args[2])) when size(args) = 2
else
    "Usage error: exec <initialCells> <generations>";

stringToCells(string(1))[i] := 0 when string[i] = '_' else 1;
cellsToString(cells(1))[i] := '#' when cells[i] = 1 else '_';

run(cellsString(1), generations) :=
        runHelper(stringToCells(cellsString), generations, cellsString);

runHelper(cells(1), generations, result(1)) :=
    let
        nextCells := step(cells);
    in
        result when generations = 0
    else
        runHelper(nextCells, generations - 1,
                  result ++ "\n" ++ cellsToString(nextCells));

step(cells(1))[i] :=
    let
        left := cells[i-1] when i > 1 else 0;
        right := cells[i + 1] when i < size(cells) else 0;
    in
        1 when (left + cells[i] + right) = 2
    else
        0;


proc evolve {a} {
    set new [list]
    for {set i 0} {$i < [llength $a]} {incr i} {
        lappend new [fate $a $i]
    }
    return $new
}

proc fate {a i} {
    return [expr {[sum $a $i] == 2}]
}

proc sum {a i} {
    set sum 0
    set start [expr {$i - 1 < 0 ? 0 : $i - 1}]
    set end [expr {$i + 1 >= [llength $a] ? $i : $i + 1}]
    for {set j $start} {$j <= $end} {incr j} {
        incr sum [lindex $a $j]
    }
    return $sum
}

proc print {a} {
    puts [string map {0 _ 1 #} [join $a ""]]
}

proc parse {s} {
    return [split [string map {_ 0 # 1} $s] ""]
}

set array [parse "_###_##_#_#_#_#__#__"]
print $array
while {[set new [evolve $array]] ne $array} {
    set array $new
    print $array
}


Imports System.Text

Module CellularAutomata

    Private Enum PetriStatus
        Active
        Stable
        Dead
    End Enum

    Function Main(ByVal cmdArgs() As String) As Integer
        If cmdArgs.Length = 0 Or cmdArgs.Length > 1 Then
            Console.WriteLine("Command requires string of either 1s and 0s or #s and _s.")
            Return 1
        End If

        Dim petriDish As BitArray

        Try
            petriDish = InitialisePetriDish(cmdArgs(0))
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return 1
        End Try

        Dim generation As Integer = 0
        Dim ps As PetriStatus = PetriStatus.Active

        Do While True
            If ps = PetriStatus.Stable Then
                Console.WriteLine("Sample stable after {0} generations.", generation - 1)
                Exit Do
            Else
                Console.WriteLine("{0}: {1}", generation.ToString("D3"), BuildDishString(petriDish))
                If ps = PetriStatus.Dead Then
                    Console.WriteLine("Sample dead after {0} generations.", generation)
                    Exit Do
                End If
            End If

            ps = GetNextGeneration(petriDish)
            generation += 1
        Loop

        Return 0
    End Function

    Private Function InitialisePetriDish(ByVal Sample As String) As BitArray
        Dim PetriDish As New BitArray(Sample.Length)
        Dim dead As Boolean = True

        For i As Integer = 0 To Sample.Length - 1
            Select Case Sample.Substring(i, 1)
                Case "1", "#"
                    PetriDish(i) = True
                    dead = False
                Case "0", "_"
                    PetriDish(i) = False
                Case Else
                    Throw New Exception("Illegal value in string position " & i)
                    Return Nothing
            End Select
        Next

        If dead Then
            Throw New Exception("Entered sample is dead.")
            Return Nothing
        End If

        Return PetriDish
    End Function

    Private Function GetNextGeneration(ByRef PetriDish As BitArray) As PetriStatus
        Dim petriCache = New BitArray(PetriDish.Length)
        Dim neighbours As Integer
        Dim stable As Boolean = True
        Dim dead As Boolean = True

        For i As Integer = 0 To PetriDish.Length - 1
            neighbours = 0
            If i > 0 AndAlso PetriDish(i - 1) Then neighbours += 1
            If i < PetriDish.Length - 1 AndAlso PetriDish(i + 1) Then neighbours += 1

            petriCache(i) = (PetriDish(i) And neighbours = 1) OrElse (Not PetriDish(i) And neighbours = 2)
            If PetriDish(i) <> petriCache(i) Then stable = False
            If petriCache(i) Then dead = False
        Next

        PetriDish = petriCache

        If dead Then Return PetriStatus.Dead
        If stable Then Return PetriStatus.Stable
        Return PetriStatus.Active

    End Function

    Private Function BuildDishString(ByVal PetriDish As BitArray) As String
        Dim sw As New StringBuilder()
        For Each b As Boolean In PetriDish
            sw.Append(IIf(b, "#", "_"))
        Next

        Return sw.ToString()
    End Function
End Module


def (gens n l)
  prn l
  repeat n
    zap! gen l
    prn l

def (gen l)
  with (a nil  b nil  c l.0)
    collect nil  # won't insert paren without second token
      each x cdr.l
        shift! a b c x
        yield (next a b c)
      yield (next b c nil)

def (next a b c)  # next state of b given neighbors a and c
  if (and a c)  not.b
     (or a c)  b


var trans = "___#_##_"

var v = Fn.new { |cell, i| (cell[i] != "_") ? 1 : 0 }

var evolve = Fn.new { |cell, backup|
    var len = cell.count - 2
    var diff = 0
    for (i in 1...len) {
        /* use left, self, right as binary number bits for table index */
        backup[i] = trans[v.call(cell, i - 1) * 4 + v.call(cell, i) * 2 + v.call(cell, i + 1)]
        diff = diff + ((backup[i] != cell[i]) ? 1 : 0)
    }
    cell.clear()
    cell.addAll(backup)
    return diff != 0
}

var c = "_###_##_#_#_#_#__#__".toList
var b = "____________________".toList
while(true) {
    System.print(c[1..-1].join())
    if (!evolve.call(c,b)) break
}


code ChOut=8, CrLf=9;
int  Gen, Now, New, I;
[Now:= $076A_A400;
for Gen:= 1 to 10 do
    [for I:= 31 downto 0 do ChOut(0, if Now & 1<<I then ^# else ^_);
    CrLf(0);
    New:= 0;
    for I:= 30 downto 1 do
        case Now>>(I-1) & 7 of %011, %101, %110: New:= New ! 1<<I other;
    Now:= New;
    ];
]


fcn life1D(line){
   right:=line[1,*] + False;           // shift left, False fill
   left :=T(False).extend(line[0,-1]); // shift right
   left.zip(line,right).apply(fcn(hood){ hood.sum(0)==2 });
}


using System;
using System.Collections.Generic;
using System.Linq;

class Program {

  // recursively permutates the list of squares to seek a matching sum
  static bool soms(int n, IEnumerable<int> f) {
    if (n <= 0) return false;
    if (f.Contains(n)) return true;
    switch(n.CompareTo(f.Sum())) {
      case 1: return false;
      case 0: return true;
      case -1:
        var rf = f.Reverse().Skip(1).ToList();
        return soms(n - f.Last(), rf) || soms(n, rf);
    }
    return false;
  }

  static void Main() {
    var sw = System.Diagnostics.Stopwatch.StartNew();
    int c = 0, r, i, g; var s = new List<int>(); var a = new List<int>();
    var sf = "stopped checking after finding {0} sequential non-gaps after the final gap of {1}";
    for (i = 1, g = 1; g >= (i >> 1); i++) {
      if ((r = (int)Math.Sqrt(i)) * r == i) s.Add(i);
      if (!soms(i, s)) a.Add(g = i);
    }
    sw.Stop();
    Console.WriteLine("Numbers which are not the sum of distinct squares:");
    Console.WriteLine(string.Join(", ", a));
    Console.WriteLine(sf, i - g, g);
    Console.Write("found {0} total in {1} ms",
      a.Count, sw.Elapsed.TotalMilliseconds);
  }
}


package main

import (
    "fmt"
    "math"
    "rcu"
)

func contains(a []int, n int) bool {
    for _, e := range a {
        if e == n {
            return true
        }
    }
    return false
}

// recursively permutates the list of squares to seek a matching sum
func soms(n int, f []int) bool {
    if n <= 0 {
        return false
    }
    if contains(f, n) {
        return true
    }
    sum := rcu.SumInts(f)
    if n > sum {
        return false
    }
    if n == sum {
        return true
    }
    rf := make([]int, len(f))
    copy(rf, f)
    for i, j := 0, len(rf)-1; i < j; i, j = i+1, j-1 {
        rf[i], rf[j] = rf[j], rf[i]
    }
    rf = rf[1:]
    return soms(n-f[len(f)-1], rf) || soms(n, rf)
}

func main() {
    var s, a []int
    sf := "\nStopped checking after finding %d sequential non-gaps after the final gap of %d\n"
    i, g := 1, 1
    for g >= (i >> 1) {
        r := int(math.Sqrt(float64(i)))
        if r*r == i {
            s = append(s, i)
        }
        if !soms(i, s) {
            g = i
            a = append(a, g)
        }
        i++
    }
    fmt.Println("Numbers which are not the sum of distinct squares:")
    fmt.Println(a)
    fmt.Printf(sf, i-g, g)
    fmt.Printf("Found %d in total\n", len(a))
}

var r int


#def squares: range(1; infinite) | . * .;

# sums of distinct squares (sods)
# Output: a stream of [$n, $sums] where $sums is the array of sods based on $n
def sods:
  # input: [$n, $sums]
  def next:
    . as [$n, $sums]
    | (($n+1)*($n+1)) as $next
    | reduce $sums[] as $s ($sums + [$next];
        if index($s + $next) then . else . + [$s + $next] end)
    | [$n + 1, unique];

  [1, [1]]
  | recurse(next);

# Input: an array
# Output: the length of the run beginning at $n
def length_of_run($n):
  label $out
  | (range($n+1; length),null) as $i
  | if $i == null then (length-$n)
    elif .[$i] == .[$i-1] + 1 then empty
    else $i-$n, break $out
    end;

# Input: an array
def length_of_longest_run:
  . as $in
  | first(
      foreach (range(0; length),null) as $i (0;
        if $i == null then .
        else ($in|length_of_run($i)) as $n
        | if $n > . then $n else . end
        end;
        if $i == null or (($in|length) - $i) < . then . else empty end) );

def sq: .*.;

# Output: [$ix, $length]
def relevant_sods:
  first(
    sods
    | . as [$n, $s]
    | ($s|length_of_longest_run) as $length
    | if $length > ($n+1|sq) then . else empty end );

def not_sum_of_distinct_squares:
  relevant_sods
  | . as [$ix, $sods]
  | [range(2; $ix+2|sq)] - $sods;

not_sum_of_distinct_squares


#=
Here we show all the 128 < numbers < 400 can be expressed as a sum of distinct squares. Now
11 * 11 < 128 < 12 * 12. It is also true that we need no square less than 144 (12 * 12) to
reduce via subtraction of squares all the numbers above 400 to a number > 128 and < 400 by
subtracting discrete squares of numbers over 12, since the interval between such squares can
be well below 128: for example, |14^2 - 15^2| is 29. So, we can always find a serial subtraction
of discrete integer squares from any number > 400 that targets the interval between 129 and
400. Once we get to that interval, we already have shown in the program below that we can
use the remaining squares under 400 to complete the remaining sum.
=#

using Combinatorics

squares = [n * n for n in 1:20]

possibles = [n for n in 1:500 if all(combo -> sum(combo) != n, combinations(squares))]

println(possibles)


ClearAll[SumOfSquareable]
SumOfSquareable[n_Integer] := MemberQ[Total /@ Subsets[Range[1, Floor[Sqrt[n]]]^2, {1, \[Infinity]}], n]
notsummable = {};
i = 1;
Do[
 If[SumOfSquareable[i],
  If[i > 1,
   If[i - Max[notsummable] > Max[notsummable],
    Break[]
    ]
   ]
  ,
  AppendTo[notsummable, i]
  ];
 i++
 ,
 {\[Infinity]}
 ]
notsummable


program practicalnumbers;
{$IFDEF Windows}  {$APPTYPE CONSOLE} {$ENDIF}
var
  HasSum: array of byte;
function FindLongestContiniuosBlock(startIdx,MaxIdx:NativeInt):NativeInt;
var
  hs0 : pByte;
  l : NativeInt;
begin
  l := 0;
  hs0 := @HasSum[0];
  for startIdx := startIdx to MaxIdx do
  Begin
    IF hs0[startIdx]=0 then
      BREAK;
    inc(l);
  end;
  FindLongestContiniuosBlock := l;
end;

function SumAllSquares(Limit: Uint32):NativeInt;
//mark sum and than shift by next summand == add
var
  hs0, hs1: pByte;
  idx, j, maxlimit, delta,MaxContiniuos,MaxConOffset: NativeInt;
begin
  MaxContiniuos := 0;
  MaxConOffset := 0;
  maxlimit := 0;
  hs0 := @HasSum[0];
  hs0[0] := 1; //has sum of 0*0
  idx := 1;

  writeln('number offset  longest  sum of');
  writeln('                block  squares');
  while idx <= Limit do
  begin
    delta := idx*idx;
    //delta is within the continiuos range than break
    If (MaxContiniuos-MaxConOffset) > delta then
      BREAK;

    //mark oldsum+ delta with  oldsum
    hs1 := @hs0[delta];
    for j := maxlimit downto 0 do
      hs1[j] := hs1[j] or hs0[j];

    maxlimit := maxlimit + delta;

    j := MaxConOffset;
    repeat
      delta := FindLongestContiniuosBlock(j,maxlimit);
      IF delta>MaxContiniuos then
      begin
        MaxContiniuos:= delta;
        MaxConOffset := j;
      end;
      inc(j,delta+1);
    until j > (maxlimit-delta);
    writeln(idx:4,MaxConOffset:7,MaxContiniuos:8,maxlimit:8);
    inc(idx);
  end;
  SumAllSquares:= idx;
end;

var
  limit,
  sumsquare,
  n: NativeInt;
begin
  Limit := 25;
  sumsquare := 0;
  for n := 1 to Limit do
    sumsquare := sumsquare+n*n;
  writeln('sum of square [1..',limit,'] = ',sumsquare) ;
  writeln;

  setlength(HasSum,sumsquare+1);
  n := SumAllSquares(Limit);
  writeln(n);
  for Limit := 1 to n*n do
    if HasSum[Limit]=0 then
      write(Limit,',');
  setlength(HasSum,0);
 {$IFNDEF UNIX}  readln; {$ENDIF}
end.


with javascript_semantics
sequence summable = {true} -- (1 can be expressed as 1*1)
integer n = 2
while true do
    integer sq = n*n
    summable &= repeat(false,sq)
    -- (process backwards to avoid adding sq more than once)
    for i=length(summable)-sq to 1 by -1 do
        if summable[i] then
            summable[i+sq] = true
        end if
    end for
    summable[sq] = true
    integer r = match(repeat(true,(n+1)*(n+1)),summable)
    if r then
        summable = summable[1..r-1]
        exit
    end if
    n += 1
end while
constant nwansods = "numbers which are not the sum of distinct squares"
printf(1,"%s\n",{join(shorten(apply(find_all(false,summable),sprint),nwansods,5))})


my @squares = ^∞ .map: *²; # Infinite series of squares

for 1..∞ -> $sq {          # for every combination of all squares
    my @sums = @squares[^$sq].combinations».sum.unique.sort;
    my @run;
    for @sums {
        @run.push($_) and next unless @run.elems;
        if $_ == @run.tail + 1 { @run.push: $_ } else { last if @run.elems > @squares[$sq]; @run = () }
    }
    put grep * ∉ @sums, 1..@run.tail and last if @run.elems > @squares[$sq];
}


var squares = (1..18).map { |i| i * i }.toList
var combs = []
var results = []

// generate combinations of the numbers 0 to n-1 taken m at a time
var combGen = Fn.new { |n, m|
    var s = List.filled(m, 0)
    var last = m - 1
    var rc // recursive closure
    rc = Fn.new { |i, next|
        var j = next
        while (j < n) {
            s[i] = j
            if (i == last) {
                combs.add(s.toList)
            } else {
                rc.call(i+1, j+1)
            }
            j = j + 1
        }
    }
    rc.call(0, 0)
}

for (n in 1..324) {
    var all = true
    for (m in 1..18) {
        combGen.call(18, m)
        for (comb in combs) {
            var tot = (0...m).reduce(0) { |acc, i| acc + squares[comb[i]] }
            if (tot == n) {
                all = false
                break
            }
        }
        if (!all) break
        combs.clear()
    }
    if (all) results.add(n)
}

System.print("Numbers which are not the sum of distinct squares:")
System.print(results)


F riseEqFall(=num)
   ‘Check whether a number belongs to sequence A296712.’
   V height = 0
   V d1 = num % 10
   num I/= 10
   L num != 0
      V d2 = num % 10
      height += (d1 < d2) - (d1 > d2)
      d1 = d2
      num I/= 10
   R height == 0

V num = 0
F nextNum()
   L
      :num++
      I riseEqFall(:num)
         L.break
   R :num

print(‘The first 200 numbers are:’)
L 200
   print(nextNum(), end' ‘ ’)
print()

L 0 .< 10'000'000 - 200 - 1
   nextNum()
print(‘The 10,000,000th number is: ’nextNum())


puts:	equ	9	; CP/M calls
putch:	equ	2
	org	100h
	;;;	Print first 200 numbers
	lxi	d,first
	mvi	c,puts
	call	5
	mvi	b,200	; 200 numbers
f200:	push	b
	call	next	; Get next number
	call	pnum	; Print the number
	pop	b	; Restore counter
	dcr	b	; Are we there yet?
	jnz	f200	; If not, next number
	;;;	Find 10,000,000th number
	lxi	d,tenmil
	mvi	c,puts
	call	5
f1e7:	call	next	; Keep generating numbers until ten million reached
	jnz	f1e7	; Then print the number
	;;;	Print the current number
pnum:	lxi	d,num
pscan:	dcx	d	; Scan for zero
	ldax	d
	ana	a
	jnz	pscan
	mvi	c,puts	; Once found, print string
	jmp	5
	;;;	Increment number until rises and falls are equal
next:	lxi	h,num
incdgt:	mov	a,m	; Get digit
	ana	a	; If 0, then initialize
	jz	grow
	inr	a	; Otherwise, increment
	mov	m,a	; Store back
	cpi	'9'+1	; Rollover?
	jnz	idone	; If not, we're done
	mvi	m,'0'	; If so, set digit to 0
	dcx	h	; And increment previous digit
	jmp	incdgt
grow:	mvi	m,'1'
idone:	lxi	h,num	; Find rises and falls
	mvi	b,0	; B = rises - falls
	mov	c,m	; C = right digit in comparison
pair:	dcx	h
	mov	a,m	; A = left digit in comparison
	ana	a	; When zero, done
	jz	check
	cmp	c	; Compare left digit to right digit
	jc	fall	; A<C = fall
	jnz	rise	; A>C = rise
nxdgt:	mov	c,a	; C is now left digit
	jmp	pair	; Check next pair
fall:	dcr	b	; Fall: decrement B
	jmp	nxdgt
rise:	inr	b	; Rise: increment B
	jmp	nxdgt
check:	mov	a,b	; If B=0 then rises and falls are equal
	ana	a
	jnz	next	; Otherwise, increment number and try again
	lxi	h,ctr	; But if so, decrement the counter to 10 million
	mov	a,m	; First byte
	sui	1
	mov	m,a
	inx	h	; Second byte
	mov	a,m
	sbb	b	; B=0 here
	mov	m,a
	inx	h	; Third byte
	mov	a,m
	sbb	b
	mov	m,a
	dcx	h	; OR them together to see if the number is zero
	ora	m
	dcx	h
	ora	m
	ret
	;;;	Strings
first:	db	'The first 200 numbers are:',13,10,'$'
tenmil:	db	13,10,10,'The 10,000,000th number is: $'
	;;;	Current number (stored as ASCII)
	db	0,0,0,0,0,0,0,0
num:	db	'0 $'
	;;;	24-bit counter to keep track of ten million
ctr:	db	80h,96h,98h	; 1e7 = 989680h


puts:	equ	9		; MS-DOS print string
	cpu	8086
	bits	16
	org	100h
section	.text
	mov	bp,98h		; BP:DI = 989680h = ten million
	mov	di,9680h
	;;;	Print first 200 numbers
	mov	dx,first	; Print message
	mov	ah,puts
	int	21h
n200:	call	next		; Get next number
	call	pnum		; Print the number
	cmp	di,95B8h	; Have we had 200 yet?
	ja	n200		; If not, print next number
	;;;	Print the 10 millionth number
	mov	dx,tenmil	; Print message
	mov	ah,puts
	int	21h
n1e7:	call	next		; Get next number
	jnz	n1e7		; Until we have the 10 millionth
	;;;	Print the current number
pnum:	std			; Read backwards
	xchg	si,di		; Keep DI safe
	mov	di,num
	mov	cx,9
	xor	al,al		; Find the first zero
	repnz	scasb
	inc	di		; Go to first digit
	inc	di
	xchg	si,di		; Put DI back
	mov	dx,si		; Call DOS to print the number
	mov	ah,puts
	int	21h
	ret
	;;;	Increment number until rises and falls are equal
next:	std			; Read number backwards
.inc:	mov	bx,num
.iloop:	mov	al,[bx]		; Get digit
	test	al,al		; If uninitialized, write a 1
	jz	.grow
	inc	ax		; Otherwise, increment
	mov	[bx],al		; Write it back
	cmp	al,'9'+1	; Rollover?
	jnz	.idone		; If not, the increment is done
	mov	[bx],byte '0'	; But if so, this digit should be 0,
	dec	bx		; and the next digit incremented.
	jmp	.iloop
.grow:	mov	[bx],byte '1'	; The number gains an extra digit
.idone:	xor	bl,bl		; BL = rise and fall counter
	mov	si,num
	lodsb			; Read first digit to compare to
.pair:	xchg	ah,al		; Previous digit to compare
	lodsb			; Read next digit
	test	al,al		; Done yet?
	jz	.done
	cmp	al,ah		; If not, compare the digits
	ja	.fall		; If they are different,
	jb	.rise		; there is a fall or a rise
	jmp	.pair		; Otherwise, try next pair
.fall:	dec	bl		; Fall: decrement BL
	jmp	.pair
.rise:	inc	bl		; Rise: increment BL
	jmp	.pair
.done:	test	bl,bl		; At the end, check if BL is zero
	jnz	.inc		; If not, try next number
	sub	di,1		; Decrement the million counter in BP:DI
	sbb	bp,0
	mov	ax,di		; Test if BP:DI is zero
	or	ax,bp
	ret
section	.data
	;;;	Strings
first:	db	'The first 200 numbers are:',13,10,'$'
tenmil:	db	13,10,10,'The 10,000,000th number is: $'
	;;;	Current number, stored as ASCII
	db	0,0,0,0,0,0,0,0
num:	db	'0 $'


with Ada.Text_Io;
with Ada.Integer_Text_Io;

procedure Equal_Rise_Fall is
   use Ada.Text_Io;

   function Has_Equal_Rise_Fall (Value : Natural) return Boolean is
      Rises : Natural := 0;
      Falls : Natural := 0;
      Image : constant String := Natural'Image (Value);
      Last  : Character := Image (Image'First + 1);
   begin
      for Pos in Image'First + 2 .. Image'Last loop
         if Image (Pos) > Last then
            Rises := Rises + 1;
         elsif Image (Pos) < Last then
            Falls := Falls + 1;
         end if;
         Last := Image (Pos);
      end loop;
      return Rises = Falls;
   end Has_Equal_Rise_Fall;

   Value : Natural := 1;
   Count : Natural := 0;
begin
   loop
      if Has_Equal_Rise_Fall (Value) then
         Count := Count + 1;
         if Count <= 200 then
            Ada.Integer_Text_Io.Put (Value, Width => 5);
            if Count mod 20 = 0 then
               New_Line;
            end if;
         end if;
         if Count = 10_000_000 then
            New_Line;
            Put_Line ("The 10_000_000th: " & Natural'Image (Value));
            exit;
         end if;
      end if;
      Value := Value + 1;
   end loop;
end Equal_Rise_Fall;


BEGIN
    # returns TRUE if the number of digits in n followed by a higher digit (rises)  #
    #              equals the number of digits followed by a lower digit (falls)    #
    #        FALSE otherwise                                                        #
    PROC rises equals falls = ( INT n )BOOL:
         BEGIN
            INT rf   := 0;
            INT prev := n MOD 10;
            INT v    := n OVER 10;
            WHILE v > 0 DO
                INT d = v MOD 10;
                IF d < prev THEN
                    rf +:= 1    # rise                                              #
                ELIF d > prev THEN
                    rf -:= 1    # fall                                              #
                FI;
                prev := d;
                v OVERAB 10
            OD;
            rf = 0
        END; # rises equals falls #
    # task tests                                                                    #
    print( ( "The first 200 numbers in the sequence are:", newline ) );
    INT count    := 0;
    INT max count = 10 000 000;
    FOR n WHILE count < max count DO
        IF rises equals falls( n ) THEN
            count +:= 1;
            IF count <= 200 THEN
                print( ( whole( n, -4 ) ) );
                IF count MOD 20 = 0 THEN print( ( newline ) ) FI
            ELIF count = max count THEN
                print( ( newline, "The 10 millionth number in the sequence is ", whole( n, -8 ), ".", newline ) )
            FI
        FI
    OD
END


risefall←{
    ⍝ Determine if a number is in the sequence
    inSeq←0=(+/2(<->)/10(⊥⍣¯1)⊢)

    ⍝ First 200 numbers
    ⎕←'The first 200 numbers are:'
    ⎕←(⊢(/⍨)inSeq¨)⍳404

    ⍝ 10,000,000th number
    ⍝ You can't just make a list that big and filter
    ⍝ it, because that will just get you a WS FULL.
    ⍝ Instead it's necessary to loop over them the old-
    ⍝ fashioned way
    ⍞←'The 10,000,000th number is: '
    ⎕←1e7{⍺=0:⍵-1 ⋄ (⍺-inSeq ⍵)∇ ⍵+1}1
}


limit1 := 200, limit2 := 10000000
count := 0, result1 := result1 := ""
loop{
    num := A_Index
    if !Rise_Fall(num)
        continue
    count++
    if (count <= limit1)
        result1 .= num . (Mod(count, 20) ? "`t" : "`n")
    if (count = limit2){
        result2 := num
        break
    }
    if !mod(count, 10000)
        ToolTip % count
}
ToolTip
MsgBox % "The first " limit1 " numbers in the sequence:`n" result1 "`nThe " limit2 " number in the sequence is: " result2
return

Rise_Fall(num){
    rise := fall := 0
    for i, n in StrSplit(num){
        if (i=1)
            prev := n
        else if (n > prev)
            rise++
        else if (n < prev)
            fall++
        if (rise > (StrLen(num)-1) /2) || (fall > (StrLen(num)-1) /2)
            return 0
        prev := n
    }
    if (fall = rise)
        return 1
}


# syntax: GAWK -f NUMBERS_WITH_EQUAL_RISES_AND_FALLS.AWK
# converted from Go
BEGIN {
    print("1-200:")
    while (1) {
      if (rises_equals_falls(++n)) {
        if (++count <= 200) {
          printf("%4d",n)
          if (count % 20 == 0) {
            printf("\n")
          }
        }
        if (count == 1E7) {
          printf("\n%d: %d",count,n)
          break
        }
      }
    }
    exit(0)
}
function rises_equals_falls(n,  d,falls,prev,rises) {
    if (n < 10) {
      return(1)
    }
    prev = -1
    while (n > 0) {
      d = n % 10
      if (prev >= 0) {
        if (d < prev) {
          rises++
        }
        else if (d > prev) {
          falls++
        }
      }
      prev = d
      n = int(n / 10)
    }
    return(rises == falls)
}


#include <stdio.h>

/* Check whether a number has an equal amount of rises
 * and falls
 */
int riseEqFall(int num) {
    int rdigit = num % 10;
    int netHeight = 0;
    while (num /= 10) {
        netHeight += ((num % 10) > rdigit) - ((num % 10) < rdigit);
        rdigit = num % 10;
    }
    return netHeight == 0;
}

/* Get the next member of the sequence, in order,
 * starting at 1
 */
int nextNum() {
    static int num = 0;
    do {num++;} while (!riseEqFall(num));
    return num;
}

int main(void) {
    int total, num;

    /* Generate first 200 numbers */
    printf("The first 200 numbers are: \n");
    for (total = 0; total < 200; total++)
        printf("%d ", nextNum());

    /* Generate 10,000,000th number */
    printf("\n\nThe 10,000,000th number is: ");
    for (; total < 10000000; total++) num = nextNum();
    printf("%d\n", num);

    return 0;
}


#include <iomanip>
#include <iostream>

bool equal_rises_and_falls(int n) {
    int total = 0;
    for (int previous_digit = -1; n > 0; n /= 10) {
        int digit = n % 10;
        if (previous_digit > digit)
            ++total;
        else if (previous_digit >= 0 && previous_digit < digit)
            --total;
        previous_digit = digit;
    }
    return total == 0;
}

int main() {
    const int limit1 = 200;
    const int limit2 = 10000000;
    int n = 0;
    std::cout << "The first " << limit1 << " numbers in the sequence are:\n";
    for (int count = 0; count < limit2; ) {
        if (equal_rises_and_falls(++n)) {
            ++count;
            if (count <= limit1)
                std::cout << std::setw(3) << n << (count % 20 == 0 ? '\n' : ' ');
        }
    }
    std::cout << "\nThe " << limit2 << "th number in the sequence is " << n << ".\n";
}


% Find how many rises and falls a number has
rises_falls = proc (n: int) returns (int,int)
    rises: int := 0
    falls: int := 0

    while n >= 10 do
        dl: int := n//10
        n := n / 10
        dh: int := n//10
        if dh < dl then rises := rises + 1
        elseif dl < dh then falls := falls + 1
        end
    end
    return (rises, falls)
end rises_falls

% Generate all numbers with equal rises and falls
equal_rises_falls = iter () yields (int)
    n: int := 1
    rises, falls: int
    while true do
        rises, falls := rises_falls(n)
        if rises = falls then yield (n) end
        n := n + 1
    end
end equal_rises_falls

% Show the first 200 and the 10,000,000th
start_up = proc ()
    po: stream := stream$primary_output()
    count: int := 0

    for n: int in equal_rises_falls() do
        count := count + 1
        if count <= 200 then
            stream$putright(po, int$unparse(n), 5)
            if count//10 = 0 then stream$putc(po, '\n') end
        elseif count = 10000000 then
            stream$putl(po, "\nThe 10,000,000th number is: "
                         || int$unparse(n))
            break
        end
    end
end start_up


include "cowgol.coh";

# return the change in height of a number
sub height(n: uint32): (h: int8) is
    h := 0;
    var dgt := (n % 10) as uint8;
    var prev: uint8;
    n := n / 10;

    while n > 0 loop
        prev := dgt;
        dgt := (n % 10) as uint8;
        n := n / 10;
        if prev < dgt then
            h := h + 1;
        elseif prev > dgt then
            h := h - 1;
        end if;
    end loop;
end sub;

var number: uint32 := 0;
var seen: uint32 := 0;
var col: uint8 := 10;

print("The first 200 numbers are:");
print_nl();
while seen < 10000000 loop
    loop
        number := number + 1;
        if height(number) == 0 then break; end if;
    end loop;
    seen := seen + 1;
    if seen <= 200 then
        print_i32(number);
        col := col - 1;
        if col != 0 then
            print_char('\t');
        else
            print_char('\n');
            col := 10;
        end if;
    end if;
end loop;

print_nl();
print("The 10,000,000th number is: ");
print_i32(number);
print_nl();


// A296712. Nigel Galloway: October 9th., 2020
let fN g=let rec fN Ψ n g=match n,Ψ with (0,0)->true |(0,_)->false |_->let i=n%10 in fN (Ψ + (compare i g)) (n/10) i in fN 0 g (g%10)
let A296712=seq{1..2147483647}|>Seq.filter fN
A296712|>Seq.take 200|>Seq.iter(printf "%d "); printfn"\n"
[999999;9999999;99999999]|>List.iter(fun n->printfn "The %dth element is %d" (n+1) (Seq.item n A296712))


USING: grouping io kernel lists lists.lazy math math.extras
prettyprint tools.memory.private ;

: rises-and-falls-equal? ( n -- ? )
    0 swap 10 /mod swap
    [ 10 /mod rot over - sgn rotd + spin ] until-zero drop 0 = ;

: OEIS:A296712 ( -- list )
    1 lfrom [ rises-and-falls-equal? ] lfilter ;

! Task
"The first 200 numbers in OEIS:A296712 are:" print
200 OEIS:A296712 ltake list>array 20 group simple-table. nl

"The 10 millionth number in OEIS:A296712 is " write
9,999,999 OEIS:A296712 lnth commas print


: in-seq? ( n -- is N in the sequence? )
  0 swap            \ height
  10 /mod           \  digit and rest of number
  begin dup while   \ as long as the number isn't zero...
    10 /mod         \ get next digit and quotient
    -rot swap       \ retrieve previous digit
    over - sgn      \ see if higher, lower or equal (-1, 0, 1)
    >r rot r> +     \ add to height
    -rot swap       \ quotient on top of stack
  repeat
  drop drop         \ drop number and last digit
  0=                \ is height equal to zero?
;

: next-val ( n -- n: retrieve first element of sequence higher than N )
  begin 1+ dup in-seq? until
;

: two-hundred
  begin over 200 < while
    next-val dup .
    swap 1+ swap
  repeat
;

: ten-million
  begin over 10000000 < while
    next-val
    swap 1+ swap
  repeat
;

0 0 \ top of stack: current index and number
." The first 200 numbers are: " two-hundred cr cr
." The 10,000,000th number is: " ten-million . cr
bye


      PROGRAM A296712
          INTEGER IDX, NUM, I
*         Index and number start out at zero
          IDX = 0
          NUM = 0
*         Find and write the first 200 numbers
          WRITE (*,'(A)') 'The first 200 numbers are: '
          DO 100 I = 1, 200
              CALL NEXT NUM(IDX, NUM)
              WRITE (*,'(I4)',ADVANCE='NO') NUM
              IF (MOD(I,20).EQ.0) WRITE (*,*)
  100     CONTINUE
*         Find the 10,000,000th number
          WRITE (*,*)
          WRITE (*,'(A)',ADVANCE='NO') 'The 10,000,000th number is: '
  200     CALL NEXT NUM(IDX, NUM)
          IF (IDX.NE.10000000) GOTO 200
          WRITE (*,'(I8)') NUM
          STOP
      END

*     Given index and current number, retrieve the next number
*     in the sequence.
      SUBROUTINE NEXT NUM(IDX, NUM)
          INTEGER IDX, NUM
          LOGICAL IN SEQ
  100     NUM = NUM + 1
          IF (.NOT. IN SEQ(NUM)) GOTO 100
          IDX = IDX + 1
      END

*     See whether N is in the sequence
      LOGICAL FUNCTION IN SEQ(N)
          INTEGER N, DL, DR, VAL, HEIGHT
*         Get first digit and divide value by 10
          DL = MOD(N, 10)
          VAL = N / 10
          HEIGHT = 0
  100     IF (VAL.NE.0) THEN
*             Retrieve digits by modulo and division
              DR = DL
              DL = MOD(VAL, 10)
              VAL = VAL / 10
*             Record rise or fall
              IF (DL.LT.DR) HEIGHT = HEIGHT + 1
              IF (DL.GT.DR) HEIGHT = HEIGHT - 1
              GOTO 100
          END IF
*         N is in the sequence if the final height is 0
          IN SEQ = HEIGHT.EQ.0
          RETURN
      END


function eqrf( n as uinteger ) as boolean
    dim as string sn = str(n)
    dim as integer q = 0
    for i as uinteger = 2 to len(sn)
        if asc(mid(sn,i,1)) > asc(mid(sn,i-1,1)) then
            q += 1
        elseif asc(mid(sn,i,1)) < asc(mid(sn,i-1,1)) then
            q -= 1
        end if
    next i
    if q = 0 then return true else return false
end function

dim as uinteger c = 0, i = 1
while c < 10000001
    if eqrf(i) then
        c += 1
        if c <= 200 then print i;" ";
        if c = 10000000 then print : print i
    end if
    i += 1
wend


package main

import "fmt"

func risesEqualsFalls(n int) bool {
    if n < 10 {
        return true
    }
    rises := 0
    falls := 0
    prev := -1
    for n > 0 {
        d := n % 10
        if prev >= 0 {
            if d < prev {
                rises = rises + 1
            } else if d > prev {
                falls = falls + 1
            }
        }
        prev = d
        n /= 10
    }
    return rises == falls
}

func main() {
    fmt.Println("The first 200 numbers in the sequence are:")
    count := 0
    n := 1
    for {
        if risesEqualsFalls(n) {
            count++
            if count <= 200 {
                fmt.Printf("%3d ", n)
                if count%20 == 0 {
                    fmt.Println()
                }
            }
            if count == 1e7 {
                fmt.Println("\nThe 10 millionth number in the sequence is ", n)
                break
            }
        }
        n++
    }
}


import Data.Char

pairs :: [a] -> [(a,a)]
pairs (a:b:as) = (a,b):pairs (b:as)
pairs _        = []

riseEqFall :: Int -> Bool
riseEqFall n = rel (>) digitPairs == rel (<) digitPairs
    where rel r = sum . map (fromEnum . uncurry r)
          digitPairs = pairs $ map digitToInt $ show n

a296712 :: [Int]
a296712 = [n | n <- [1..], riseEqFall n]

main :: IO ()
main = do
	putStrLn "The first 200 numbers are: "
	putStrLn $ unwords $ map show $ take 200 a296712
	putStrLn ""
	putStr "The 10,000,000th number is: "
	putStrLn $ show $ a296712 !! 9999999


public class EqualRisesFalls {
    public static void main(String[] args) {
        final int limit1 = 200;
        final int limit2 = 10000000;
        System.out.printf("The first %d numbers in the sequence are:\n", limit1);
        int n = 0;
        for (int count = 0; count < limit2; ) {
            if (equalRisesAndFalls(++n)) {
                ++count;
                if (count <= limit1)
                    System.out.printf("%3d%c", n, count % 20 == 0 ? '\n' : ' ');
            }
        }
        System.out.printf("\nThe %dth number in the sequence is %d.\n", limit2, n);
    }

    private static boolean equalRisesAndFalls(int n) {
        int total = 0;
        for (int previousDigit = -1; n > 0; n /= 10) {
            int digit = n % 10;
            if (previousDigit > digit)
                ++total;
            else if (previousDigit >= 0 && previousDigit < digit)
                --total;
            previousDigit = digit;
        }
        return total == 0;
    }
}


def risesEqualsFalls:
  . as $n
  | if . < 10 then true
    else {rises: 0, falls: 0, prev: -1, n: $n}
    | until (.n <= 0;
        (.n % 10 ) as $d
        | if .prev >= 0
          then if $d < .prev then .rises += 1
               elif $d > .prev then .falls += 1
               else .
	       end
	  else .
	  end
        | .prev = $d
        | .n = ((.n/10)|floor) )
    | .rises == .falls
    end ;

def A296712: range(1; infinite) | select(risesEqualsFalls);

# Override jq's incorrect definition of nth/2
# Emit the $n-th value of the stream, counting from 0; or emit nothing
def nth($n; s):
 if $n < 0 then error("nth/2 doesn't support negative indices")
 else label $out
 | foreach s as $x (-1; .+1; select(. >= $n) | $x, break $out)
 end;

# The tasks
"First 200:",
 [limit(200; A296712)],

 "\nThe 10 millionth number in the sequence is \(
    nth(1e7 - 1; A296712))"


using Lazy

function rises_and_falls(n)
    if n < 10
        return 0, 0
    end
    lastr, rises, falls = n % 10, 0, 0
    while n != 0
        n, r = divrem(n, 10)
        if r > lastr
            falls += 1
        elseif r < lastr
            rises += 1
        end
        lastr = r
    end
    return rises, falls
end

isA296712(x) = ((a, b) = rises_and_falls(x); return a == b)

function genA296712(N, M)
    A296712 = filter(isA296712, Lazy.range(1));
    j = 0
    for i in take(200, A296712)
        j += 1
        print(lpad(i, 4), j % 20 == 0 ? "\n" : "")
    end
    for i in take(M, A296712)
        j = i
    end
    println("\nThe $M-th number in sequence A296712 is $j.")
end

genA296712(200, 10_000_000)


            NORMAL MODE IS INTEGER
            VECTOR VALUES FMT = $I8,1H:,I9*$

            INTERNAL FUNCTION(NUM)
            ENTRY TO RISFAL.
            N=NUM
            DEPTH = 0
            DIGA = N-(N/10)*10
            N = N/10
LOOP        WHENEVER N.E.0, FUNCTION RETURN DEPTH.E.0
            DIGB = DIGA
            DIGA = N-(N/10)*10
            N = N/10
            WHENEVER DIGA.L.DIGB, DEPTH=DEPTH-1
            WHENEVER DIGA.G.DIGB, DEPTH=DEPTH+1
            TRANSFER TO LOOP
            END OF FUNCTION

            I=0
            J=0
LOOP        J=J+1
            WHENEVER .NOT.RISFAL.(J), TRANSFER TO LOOP
            I=I+1
            WHENEVER I.LE.200, PRINT FORMAT FMT, I, J
            WHENEVER I.L.10000000, TRANSFER TO LOOP
            PRINT FORMAT FMT, I, J

            END OF PROGRAM


ClearAll[EqualRisesAndFallsQ]
EqualRisesAndFallsQ[n_Integer] := Total[Sign[Differences[IntegerDigits[n]]]] == 0
Take[Select[Range[1000], EqualRisesAndFallsQ], 200]
valid = 0;
Dynamic[{i, valid}]
Do[
 If[EqualRisesAndFallsQ[i],
  valid += 1;
  If[valid == 10^7, Print[i]; Break[]]
  ]
 ,
 {i, 50 10^6}
 ]


import strutils

func insequence(n: Positive): bool =
  ## Return true if "n" is in the sequence.
  if n < 10: return true
  var diff = 0
  var prev = n mod 10
  var n = n div 10
  while n != 0:
    let digit = n mod 10
    if digit < prev: inc diff
    elif digit > prev: dec diff
    prev = digit
    n = n div 10
  result = diff == 0

iterator a297712(): (int, int) =
  ## Yield the positions and the numbers of the sequence.
  var n = 1
  var pos = 0
  while true:
    if n.insequence:
      inc pos
      yield (pos, n)
    inc n

echo "First 200 numbers in the sequence:"
for (pos, n) in a297712():
  if pos <= 200:
    stdout.write ($n).align(3), if pos mod 20 == 0: '\n' else: ' '
  elif pos == 10_000_000:
    echo "\nTen millionth number in the sequence: ", n
    break


#!/usr/bin/perl

use strict;
use warnings;

sub rf
  {
  local $_ = shift;
  my $sum = 0;
  $sum += $1 <=> $2 while /(.)(?=(.))/g;
  $sum
  }

my $count = 0;
my $n = 0;
my @numbers;
while( $count < 200 )
  {
  rf(++$n) or $count++, push @numbers, $n;
  }
print "first 200: @numbers\n" =~ s/.{1,70}\K\s/\n/gr;

$count = 0;
$n = 0;
while( $count < 10e6 )
  {
  rf(++$n) or $count++;
  }
print "\n10,000,000th number: $n\n";


with javascript_semantics
atom t1 = time()+1
integer count = 0, n = 0
printf(1,"The first 200 numbers are:\n")
while true do
    n += 1
    integer rmf = 0,
            l = remainder(n,10),
            r = floor(n/10)
    while r do
        integer p = remainder(r,10)
        rmf += compare(l,p)
        l = p
        r = floor(r/10)
    end while
    if rmf=0 then
        count += 1
        if count<=200 then
            printf(1,"%3d ",n)
            if remainder(count,20)=0 then
                printf(1,"\n")
            end if
        end if
        if count == 1e7 then
            if platform()!=JS then progress("") end if
            printf(1,"\nThe %,dth number is %,d\n",{count,n})
            exit
        end if
        if time()>t1 and platform()!=JS then
            progress("%,d:%,d\r",{count,n})
            t1 = time()+1
        end if
    end if
end while


import itertools

def riseEqFall(num):
    """Check whether a number belongs to sequence A296712."""
    height = 0
    d1 = num % 10
    num //= 10
    while num:
        d2 = num % 10
        height += (d1<d2) - (d1>d2)
        d1 = d2
        num //= 10
    return height == 0

def sequence(start, fn):
    """Generate a sequence defined by a function"""
    num=start-1
    while True:
        num += 1
        while not fn(num): num += 1
        yield num

a296712 = sequence(1, riseEqFall)

# Generate the first 200 numbers
print("The first 200 numbers are:")
print(*itertools.islice(a296712, 200))

# Generate the 10,000,000th number
print("The 10,000,000th number is:")
print(*itertools.islice(a296712, 10000000-200-1, 10000000-200))
# It is necessary to subtract 200 from the index, because 200 numbers
# have already been consumed.


/*REXX pgm  finds and displays  N  numbers that have an equal number of rises and falls,*/
parse arg n .                                    /*obtain optional argument from the CL.*/
if n=='' | n==","  then n= 200                   /*Not specified?  Then use the default.*/
append= n>0                                      /*a flag that is used to append numbers*/
n= abs(n)                                        /*use the absolute value of  N.        */
call init                                        /*initialize the  rise/fall  database. */
          do j=1  until #==n                     /*test integers until we have N of them*/
          s= 0                                   /*initialize the sum of  rises/falls.  */
                        do k=1  for length(j)-1  /*obtain a set of two digs from number.*/
                        t= substr(j, k, 2)       /*obtain a set of two digs from number.*/
                        s= s + @.t               /*sum the rises and falls in the number*/
                        end   /*k*/
          if s\==0  then iterate                 /*Equal # of rises & falls? Then add it*/
          #= # + 1                               /*bump the count of numbers found.     */
          if append  then $= $ j                 /*append to the list of numbers found. */
          end   /*j*/

if append  then call show                        /*display a list of  N  numbers──►term.*/
           else say  'the '  commas(n)th(n)  " number is: "   commas(j)    /*show Nth #.*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas:  parse arg _;  do c=length(_)-3  to 1  by -3; _=insert(',', _, c); end;   return _
th:      parse arg th;  return word('th st nd rd',1+(th//10)*(th//100%10\==1)*(th//10<4))
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: @.= 0;   do i=1  for 9;    _= i' ';     @._= 1;    _= '0'i;   @._= +1;   end  /*i*/
               do i=10  to 99;   parse var i  a 2 b;     if a>b  then              @.i= -1
                                                                 else if a<b  then @.i= +1
               end   /*i*/;      #= 0;        $=;        return
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: say 'the first '   commas(#)   " numbers are:";   say;       w= length( word($, #) )
      _=;    do o=1  for n;     _= _ right( word($, o), w);    if o//20\==0  then iterate
             say substr(_, 2);  _=               /*display a line;  nullify a new line. */
             end   /*o*/                         /* [↑]  display  20  numbers to a line.*/

      if _\==''  then say substr(_, 2);   return /*handle any residual numbers in list. */


func isok(arr) {
    var diffs = arr.map_cons(2, {|a,b| a - b })
    diffs.count { .is_pos } == diffs.count { .is_neg }
}

var base = 10

with (200) {|n|
    say "First #{n} terms (base #{base}):"
    n.by { isok(.digits(base)) && .is_pos }.each_slice(20, {|*a|
        say a.map { '%3s' % _ }.join(' ')
    })
}

with (1e7) {|n|     # takes a very long time
    say "\nThe #{n.commify}-th term (base #{base}): #{
            n.th { isok(.digits(base)) && .is_pos }.commify}"
}


import Foundation

func equalRisesAndFalls(_ n: Int) -> Bool {
    var total = 0
    var previousDigit = -1
    var m = n
    while m > 0 {
        let digit = m % 10
        m /= 10
        if previousDigit > digit {
            total += 1
        } else if previousDigit >= 0 && previousDigit < digit {
            total -= 1
        }
        previousDigit = digit
    }
    return total == 0
}

var count = 0
var n = 0
let limit1 = 200
let limit2 = 10000000
print("The first \(limit1) numbers in the sequence are:")
while count < limit2 {
    n += 1
    if equalRisesAndFalls(n) {
        count += 1
        if count <= limit1 {
            print(String(format: "%3d", n), terminator: count % 20 == 0 ? "\n" : " ")
        }
    }
}
print("\nThe \(limit2)th number in the sequence is \(n).")


import "/fmt" for Fmt

var risesEqualsFalls = Fn.new { |n|
    if (n < 10) return true
    var rises = 0
    var falls = 0
    var prev = -1
    while (n > 0) {
        var d = n%10
        if (prev >= 0) {
            if (d < prev) {
                rises = rises + 1
            } else if (d > prev) {
                falls = falls + 1
            }
        }
        prev = d
        n = (n/10).floor
    }
    return rises == falls
}

System.print("The first 200 numbers in the sequence are:")
var count = 0
var n = 1
while (true) {
    if (risesEqualsFalls.call(n)) {
        count = count + 1
        if (count <= 200) {
            Fmt.write("$3d ", n)
            if (count % 20 == 0) System.print()
        }
        if (count == 1e7) {
            Fmt.print("\nThe 10 millionth number in the sequence is $,d.", n)
            break
        }
    }
    n = n + 1
}


func RiseFall(N);       \Return 'true' if N has equal rises and falls
int  N, R, F, D, D0;
[R:= 0;  F:= 0;
N:= N/10;
D0:= rem(0);
while N do
    [N:= N/10;
    D:= rem(0);
    if D > D0 then R:= R+1;
    if D < D0 then F:= F+1;
    D0:= D;
    ];
return R = F;
];

int N, Cnt;
[N:= 1;
Cnt:= 0;
loop    [if RiseFall(N) then
            [Cnt:= Cnt+1;
            if Cnt <= 200 then
                [IntOut(0, N);
                if rem (Cnt/10) = 0 then CrLf(0)
                                    else ChOut(0, 9\tab\);
                ];
            if Cnt = 10_000_000 then
                [Text(0, "10 millionth number is ");
                IntOut(0, N);  CrLf(0);
                quit;
                ];
            ];
        N:= N+1;
        ];
]


F left_rect((Float -> Float) f, Float x, Float h) -> Float
   R f(x)

F mid_rect((Float -> Float) f, Float x, Float h) -> Float
   R f(x + h / 2)

F right_rect((Float -> Float) f, Float x, Float h) -> Float
   R f(x + h)

F trapezium((Float -> Float) f, Float x, Float h) -> Float
   R (f(x) + f(x + h)) / 2.0

F simpson((Float -> Float) f, Float x, Float h) -> Float
   R (f(x) + 4 * f(x + h / 2) + f(x + h)) / 6.0

F cube(Float x) -> Float
   R x * x * x

F reciprocal(Float x) -> Float
   R 1 / x

F identity(Float x) -> Float
   R x

F integrate(f, a, b, steps, meth)
   V h = (b - a) / steps
   V ival = h * sum((0 .< steps).map(i -> @meth(@f, @a + i * @h, @h)))
   R ival

L(a, b, steps, func, func_name) [(0.0, 1.0, 100, cube, ‘cube’),
                                 (1.0, 100.0, 1000, reciprocal, ‘reciprocal’),
                                 (0.0, 5000.0, 5'000'000, identity, ‘identity’),
                                 (0.0, 6000.0, 6'000'000, identity, ‘identity’)]
   L(rule, rule_name) [(left_rect,  ‘left_rect’),
                        (mid_rect,   ‘mid_rect’),
                      (right_rect, ‘right_rect’),
                       (trapezium,  ‘trapezium’),
                         (simpson,    ‘simpson’)]
      print("#. integrated using #.\n  from #. to #. (#. steps) = #.".format(
            func_name, rule_name, a, b, steps, integrate(func, a, b, steps, rule)))


function leftRect(f:Function, a:Number, b:Number, n:uint):Number
{
	var sum:Number = 0;
	var dx:Number = (b-a)/n;
	for (var x:Number = a; n > 0; n--, x += dx)
		sum += f(x);
	return sum * dx;
}

function rightRect(f:Function, a:Number, b:Number, n:uint):Number
{
	var sum:Number = 0;
	var dx:Number = (b-a)/n;
	for (var x:Number = a + dx; n > 0; n--, x += dx)
		sum += f(x);
	return sum * dx;
}

function midRect(f:Function, a:Number, b:Number, n:uint):Number
{
	var sum:Number = 0;
	var dx:Number = (b-a)/n;
	for (var x:Number = a + (dx / 2); n > 0; n--, x += dx)
		sum += f(x);
	return sum * dx;
}
function trapezium(f:Function, a:Number, b:Number, n:uint):Number
{
	var dx:Number = (b-a)/n;
	var x:Number = a;
	var sum:Number = f(a);
	for(var i:uint = 1; i < n; i++)
	{
		a += dx;
		sum += f(a)*2;
	}
	sum += f(b);
	return 0.5 * dx * sum;
}
function simpson(f:Function, a:Number, b:Number, n:uint):Number
{
	var dx:Number = (b-a)/n;
	var sum1:Number = f(a + dx/2);
	var sum2:Number = 0;
	for(var i:uint = 1; i < n; i++)
	{
		sum1 += f(a + dx*i + dx/2);
		sum2 += f(a + dx*i);
	}
	return (dx/6) * (f(a) + f(b) + 4*sum1 + 2*sum2);
}


generic
   type Scalar is digits <>;
   with function F (X : Scalar) return Scalar;
package Integrate is
   function Left_Rectangular     (A, B : Scalar; N : Positive) return Scalar;
   function Right_Rectangular    (A, B : Scalar; N : Positive) return Scalar;
   function Midpoint_Rectangular (A, B : Scalar; N : Positive) return Scalar;
   function Trapezium            (A, B : Scalar; N : Positive) return Scalar;
   function Simpsons             (A, B : Scalar; N : Positive) return Scalar;
end Integrate;


MODE F = PROC(LONG REAL)LONG REAL;

###############
## left rect ##
###############

PROC left rect = (F f, LONG REAL a, b, INT n) LONG REAL:
BEGIN
   LONG REAL h= (b - a) / n;
   LONG REAL sum:= 0;
   LONG REAL x:= a;
   WHILE x <= b - h DO
      sum := sum + (h * f(x));
      x +:= h
   OD;
   sum
END # left rect #;

#################
## right rect  ##
#################

PROC right rect = (F f, LONG REAL a, b, INT n) LONG REAL:
BEGIN
   LONG REAL h= (b - a) / n;
   LONG REAL sum:= 0;
   LONG REAL x:= a + h;
   WHILE x <= b DO
      sum := sum + (h * f(x));
      x +:= h
   OD;
   sum
END # right rect #;

###############
## mid rect  ##
###############

PROC mid rect = (F f, LONG REAL a, b, INT n) LONG REAL:
BEGIN
   LONG REAL h= (b - a) / n;
   LONG REAL sum:= 0;
   LONG REAL x:= a;
   WHILE x <= b - h DO
      sum := sum + h * f(x + h / 2);
      x +:= h
   OD;
   sum
END # mid rect #;

###############
## trapezium ##
###############

PROC trapezium = (F f, LONG REAL a, b, INT n) LONG REAL:
BEGIN
   LONG REAL h= (b - a) / n;
   LONG REAL sum:= f(a) + f(b);
   LONG REAL x:= 1;
   WHILE x <= n - 1 DO
      sum := sum + 2 * f(a + x * h );
      x +:= 1
   OD;
   (b - a) / (2 * n) * sum
END # trapezium #;

#############
## simpson ##
#############

PROC simpson = (F f, LONG REAL a, b, INT n) LONG REAL:
BEGIN
   LONG REAL h= (b - a) / n;
   LONG REAL sum1:= 0;
   LONG REAL sum2:= 0;
   INT limit:= n - 1;
   FOR i FROM 0 TO limit DO
      sum1 := sum1 + f(a + h * LONG REAL(i) + h / 2)
   OD;
   FOR i FROM 1 TO limit DO
      sum2 +:= f(a + h * LONG REAL(i))
   OD;
   h / 6 * (f(a) + f(b) + 4 * sum1 + 2 * sum2)
END # simpson #;

# test the above procedures #
PROC test integrators = ( STRING     legend
                        , F          function
                        , LONG REAL  lower limit
                        , LONG REAL  upper limit
                        , INT        iterations
                        ) VOID:
BEGIN
    print( ( legend
           , fixed(  left rect( function, lower limit, upper limit, iterations ), -20, 6 )
           , fixed( right rect( function, lower limit, upper limit, iterations ), -20, 6 )
           , fixed(   mid rect( function, lower limit, upper limit, iterations ), -20, 6 )
           , fixed(  trapezium( function, lower limit, upper limit, iterations ), -20, 6 )
           , fixed(    simpson( function, lower limit, upper limit, iterations ), -20, 6 )
           , newline
           )
         )
END; # test integrators #
print( ( "   "
       , "           left rect"
       , "          right rect"
       , "            mid rect"
       , "           trapezium"
       , "             simpson"
       , newline
       )
     );
test integrators( "x^3", ( LONG REAL x )LONG REAL: x * x * x, 0,     1,       100 );
test integrators( "1/x", ( LONG REAL x )LONG REAL: 1 / x,     1,   100,     1 000 );
test integrators( "x  ", ( LONG REAL x )LONG REAL: x,         0, 5 000, 5 000 000 );
test integrators( "x  ", ( LONG REAL x )LONG REAL: x,         0, 6 000, 6 000 000 );

SKIP