ChrisBatho/Totalistic Cellular Automation

caption='Totalistic Cellular Automation'for='totalistic.ijs'
NB. totalcellauto - totalistic cellular automation
NB. By Chris J. Batho and Oleg Kobchenko  v1.01
NB. http://www.jsoftware.com/jwiki/Scripts/Totalistic_Cellular_Automation

NB.====================================================

NB.*sel_line v select the first line
NB. line=. sel_line number (in 1..4)
sel_line=: 3 : 0
  ('SL',":y)~
)

NB.*calc v calculate one matrix
NB. matrix=. firstLine calc seqNumber
calc=: 4 : 0
  'z c'=. x tauto y
  Y=. x,z        NB. two lines of the output
  x=. z
  z=. 1{.c
  for. i. 321 do.
    'z c'=. x tauto y
    Y=. Y,z
    x=. z
    z=. 1{.c
  end.
  NB.  as required col = length  nom 162
  235 162 $ Y    NB. can make as many rows
)

NB.====================================================
NB. associated functions for the rule.

rule=: (7#3)&#:       NB. 1-D Boolean automata rule

rrule=: |.@rule       NB. reverse rule function

NB. get next line from z
NB. to sort out a line
NB. 'z c'=. x tauto y
tauto=: 4 : 0
  a=. rrule y
  b=. 3{.x            NB. grab first 3 num of n1
  avg=. +/ b          NB. calc avg.(sum 0-6) of 3 bits of n1
  c=. a lauto avg     NB. apply rule
  z=. c,c                 NB. put c in z to removes start glitch
  for_d. 1+i.160 do.  NB. put in loop
    b=. (3+d){.x      NB. grab next num of ni
    b=. d}.b
    avg=. +/ b
    c=. a lauto avg
    z=. z,c           NB. completes the new line
  end.
  z;c
)
NB. result is c, the data to insert in z
NB. for each line

lauto=: 4 : 0
  if. y = 0 do. 
    1 {. x            NB. get 1st digit if zero
  else.
    y }. (y + 1) {. x
  end.
)

NB.====================================================
NB. sample lines of data (n1)
vv =. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 0  0 0 0  0 0 0
vvc=. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 0  0 1 0  0 0 0
vvg=. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 0
SL1=: vv,vv,vv,vvc,vv,vv,vv,vvg

ww=. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 0  0 0 0  0 0 0
wwc=. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 1  2 3 2  1 0 0
wwg=. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 0
SL2=: ww,ww,ww,wwc,ww,ww,ww,wwg

xx =. 0 1 1  1 2 0  2 3 0  0 0 0  3 0 2  0 1 0  0 2 0
xxa=. 0 1 0  0 3 0  3 0 0  0 0 0  0 0 0  3 1 0  0 3 0
xxb=. 0 0 0  1 1 0  0 0 0  0 0 0  0 0 0  0 0 0  0 0 0
xxc=. 0 0 0  0 0 0  0 0 0  0 0 0  0 0 0  0 1 0  0 2 2
xxd=. 0 0 0  0 0 0  0 0 0  0 0 0  1 0 0  0 0 0  0 0 0
xxe=. 0 0 0  0 0 0  0 0 0  0 2 2  0 0 0  0 1 0  0 0 3
xxf=. 0 2 0  0 2 0  0 0 1  0 0 0  0 0 0  0 0 0  0 0 0
xxg=. 0 0 0  0 2 0  0 0 0  0 0 0  0 1 0
SL3=: xx,xxa,xxb,xxc,xxd,xxe,xxf,xxg

zz =. 3 3 3  3 2 1  2 3 3  1 1 1  3 3 3  3 1 2  1 2 3
zza=. 1 1 1  3 3 0  3 0 0  0 0 0  0 0 0  3 1 0  3 3 3
zzb=. 3 1 2  1 2 3  1 1 1  3 3 0  0 3 0  0 2 0  1 1 0
zzc=. 3 3 2  0 1 0  2 2 0  0 2 0  0 3 0  0 0 0  2 0 0
zzd=. 0 2 0  0 0 0  0 0 0  0 1 0  0 2 2  0 2 0  0 0 0
zze=. 0 0 1  0 3 0  1 0 0  0 2 0  0 0 0  0 2 1  2 2 2
zzf=. 0 1 0  0 2 2  0 2 0  0 1 0  0 3 3  0 2 2  0 2 0
zzg=. 0 1 1  3 3 3  0 1 0  0 1 0  0 2 0
SL4=: zz,zza,zzb,zzc,zzd,zze,zzf,zzg

NB.====================================================
Note 'Two examples'
110 ([ view (calc~ sel_line)) 1

63 ([ view (calc~ sel_line)) 4
)

NB. =========================================================
NB. Viewer: one or more matrices
require 'viewmat'

NB.* view v calculate cellular automata
view=: 3 : 0
  'RuleNo StartLine Rules'=. y
  for_rule. RuleNo + i.Rules do.
    m=. rule (calc~ sel_line) StartLine
    (16bffffff 16b808080 0) viewmat m;":rule,StartLine
    glwh 2*|.$m
  end.
)

NB. resize canvas precisely
glwh=: 3 : 'wd''pmovex '',(+0 0,y-glqwh_jgl2_@$@#)&.".wd''qformx'''

NB. =========================================================
NB. GUI: Input and Controler
require 'strings'

F=: 0 : 0
pc f;pn "Totalistic Cellular Automata";
xywh 4 5 76 11;cc s1 static ss_center;cn "Rule Number (6561 max)";
xywh 10 16 50 151;cc cbRuleNo combobox ws_vscroll cbs_autohscroll;
xywh 106 6 36 10;cc s2 static ss_center;cn "Start Line";
xywh 64 16 122 50;cc cbStartLine combobox ws_vscroll cbs_autohscroll;
xywh 64 70 122 51;cc stDesc static;
xywh 65 124 121 2;cc stBox1 staticbox ss_etchedhorz;
xywh 76 135 47 10;cc s3 static;cn "Rules to Draw";
xywh 127 134 28 11;cc edRules edit;
xywh 102 153 40 11;cc bnDraw button bs_defpushbutton;cn "Draw";
pas 6 6;pcenter;
rem form end;
)

NB.* run v run cellular automata input GUI
run=: 3 : 0
  wd F
  n=. 34 42 63 65 70 88 95 101 114 132 144 149 157
  n=. n,173 176 199 200 201 203 228 231 248 262 266
  n=. n,268 380 792 1502 1599 1635 1649 1664 2042
  n=. n,2043 2046 2049 2051
  wd 'set cbRuleNo ',":n
  wd 'setselect cbRuleNo 0'

  wd 'set cbStartLine *',Start
  wd 'setselect cbStartLine 0'

  wd 'set edRules 1'
  wd 'set stDesc *',Desc rplc LF;' '
  wd 'pshow;'
)

f_close=: 3 : 0
  wd 'pclose'
)

fire=: 3 : 0
  RuleNo=.    1>.{.0".cbRuleNo
  StartLine=. 1>.{.0".'.'taketo cbStartLine
  Rules=.     1>.{.0".edRules
  r=. 'Draw: RuleNo=',(":RuleNo),' StartLine=',(":StartLine)
  smoutput r,' Rules=',(":Rules)
  view RuleNo,StartLine,Rules
)
f_cbRuleNo_button=: f_cbStartLine_button=: fire
f_bnDraw_button=:   f_edRules_button=:     fire

Desc=: 0 : 0
A totalistic cellular automaton is a cellular automata
in which the rules depend only on the total
(or equivalently, the average) of the values of the
cells in a neighborhood.
)

Start=: 0 : 0
1. Centre 1
2. Centre 1 2 3 2 1
3. Random sparse
4. Random populated
)

NB. =========================================================
Note 'Test - Press Ctrl+R on each line'
  run ''                    NB. run GUI
  110 (calc~ sel_line) 1    NB. return matrix
  view 110 1 2              NB. view matrix(es)
)

NB. run''   NB. uncomment for debugging, use Ctrl+W
run''