Percolation/Site percolation/J

From Rosetta Code

<lang J>groups=:[: +/\ 2 </\ 0 , * ooze=: [ >. [ +&* [ * [: ; groups@[ <@(* * 2 < >./)/. + percolate=: ooze/\.@|.^:2^:_@(* (1 + # {. 1:))

trial=: percolate@([ >: ]?@$0:) simulate=: %@[ * [: +/ (2 e. {:)@trial&15 15"0@#</lang>

Explanation:

groups uses a sum fold on successive prefixes to identify regions of contiguous bits.

<lang j> 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0

  * 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0

1 0 1 0 1 0 1 0 0 1 1 1 1 1 0

  (0, *) 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0

0 1 0 1 0 1 0 1 0 0 1 1 1 1 1 0

  (2 </\ 0, *) 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0

1 0 1 0 1 0 1 0 0 1 0 0 0 0 0

  ([: +/\ 2 </\ 0, *) 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0

1 1 2 2 3 3 4 4 4 5 5 5 5 5 5</lang>

ooze propagates 2s from its right argument to adjacent groups of non-zero locations in its left argument.

<lang j> 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 + 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1 2 0 3 1 2 1 1 2 0 3 1 2 2 2 1

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 (groups@[ <@(* * 2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

┌───┬───┬───┬─────┬───────────┐ │0 0│1 1│0 0│0 0 0│1 1 1 1 1 1│ └───┴───┴───┴─────┴───────────┘

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 ([: ; groups@[ <@(* * 2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

0 0 1 1 0 0 0 0 0 1 1 1 1 1 1

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 ([ * [: ; groups@[ <@(* * 2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

0 0 2 0 0 0 0 0 0 1 1 1 1 1 0

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 ([ +&* [ * [: ; groups@[ <@(* * 2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

1 0 2 0 1 0 1 0 0 2 2 2 2 2 0

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 ([ >. [ +&* [ * [: ; groups@[ <@(* * 2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

2 0 2 0 1 0 1 0 0 2 2 2 2 2 0</lang>

Note that u/. uses the key in the left argument to gather corresponding values from the right argument (which are then processed by u).

<lang j> 2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 (groups@[ </. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1 ┌───┬───┬───┬─────┬───────────┐ │2 0│3 1│2 1│1 2 0│3 1 2 2 2 1│ └───┴───┴───┴─────┴───────────┘

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 (groups@[ <@(>./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

┌─┬─┬─┬─┬─┐ │2│3│2│2│3│ └─┴─┴─┴─┴─┘

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 (groups@[ <@(2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

┌─┬─┬─┬─┬─┐ │0│1│0│0│1│ └─┴─┴─┴─┴─┘

  2 0 2 0 1 0 1 0 0 1 1 1 1 1 0 (groups@[ <@(* * 2 < >./)/. +) 0 0 1 1 1 1 0 2 0 2 0 1 1 1 1

┌───┬───┬───┬─────┬───────────┐ │0 0│1 1│0 0│0 0 0│1 1 1 1 1 1│ └───┴───┴───┴─────┴───────────┘</lang>

We use +&* because 1 +&* 2 is 2, but also 2 +&* 2 is 2:

<lang j> +&* table 0 1 2 ┌───┬─────┐ │+&*│0 1 2│ ├───┼─────┤ │0 │0 1 1│ │1 │1 2 2│ │2 │1 2 2│ └───┴─────┘</lang>

percolate changes 1s in the first row to 2s, then flips over that result and performs an ooze right fold on suffixes, and then does that again (which restores the original orientation and propagates 2s in all directions). And it repeats this until all changes have been propagated.

<lang J> A 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1

  (1 + # {. 1:) A

2 1 1 1 1 1 1 1 1 1 1 1 1 1 1

  (* (1 + # {. 1:)) A

2 2 2 0 0 0 0 0 2 2 2 2 0 2 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 0 1 0 0 1 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 1 0 0 1 0 1 0 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 0 1 1 0 0 1 0 1 0 0 1 1

  |. (* (1 + # {. 1:)) A

1 1 1 0 1 1 0 0 1 0 1 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 0 1 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 1 0 1 0 1 1 0 0 0 0 1 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 1 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 0 2 2 2 0 0 0 0 0 2 2 2 2 0 2 0

  ooze/\. |. (* (1 + # {. 1:)) A

2 2 2 0 2 2 0 0 1 0 1 0 0 1 1 2 2 2 2 2 0 0 1 1 1 1 0 0 1 0 2 2 2 2 0 1 1 1 1 1 0 0 1 0 1 2 0 1 1 1 1 1 0 1 0 0 1 1 0 0 2 2 0 1 1 1 0 0 1 0 1 0 0 0 1 2 2 0 1 0 1 1 0 1 1 1 1 1 1 1 2 2 2 0 1 0 0 0 0 0 0 0 0 1 1 1 0 2 0 1 1 0 0 0 0 1 0 1 0 0 0 2 2 0 1 0 1 0 0 1 0 1 1 0 0 0 0 2 0 0 1 1 0 1 0 1 1 1 0 2 1 0 2 2 0 1 1 1 1 0 1 1 0 2 2 0 2 2 2 0 1 1 1 0 1 1 0 0 2 0 0 2 2 0 0 0 1 1 0 0 1 1 0 2 0 2 2 2 2 0 1 0 0 2 2 0 0 0 2 0 2 2 2 0 0 0 0 0 2 2 2 2 0 2 0

  ooze/\.@|.^:2 (* (1 + # {. 1:)) A

2 2 2 0 0 0 0 0 2 2 2 2 0 2 0 2 2 2 2 0 1 0 0 2 2 0 0 0 2 0 0 2 2 0 0 0 1 1 0 0 1 1 0 2 0 0 2 2 2 0 1 1 1 0 1 1 0 0 2 0 1 0 2 2 0 1 1 1 1 0 1 1 0 2 2 0 0 2 0 0 1 1 0 1 0 1 1 1 0 2 0 2 2 0 1 0 1 0 0 1 0 1 1 0 0 2 0 2 0 1 1 0 0 0 0 1 0 1 0 0 2 2 2 0 1 0 0 0 0 0 0 0 0 1 1 2 2 0 2 0 2 2 0 1 1 1 1 1 1 1 2 2 0 2 2 2 0 0 1 0 1 0 0 0 1 2 0 2 2 2 2 2 0 1 0 0 1 1 0 0 2 2 2 2 0 1 1 1 1 1 0 0 1 0 1 2 2 2 2 2 0 0 1 1 1 1 0 0 1 0 2 2 2 0 2 2 0 0 1 0 1 0 0 1 1

  ooze/\.@|.^:2^:2 (* (1 + # {. 1:)) A

2 2 2 0 0 0 0 0 2 2 2 2 0 2 0 2 2 2 2 0 1 0 0 2 2 0 0 0 2 0 0 2 2 0 0 0 1 1 0 0 1 1 0 2 0 0 2 2 2 0 1 1 1 0 1 1 0 0 2 0 1 0 2 2 0 1 1 1 1 0 1 1 0 2 2 0 0 2 0 0 1 1 0 1 0 1 1 1 0 2 0 2 2 0 1 0 1 0 0 1 0 1 1 0 0 2 0 2 0 1 1 0 0 0 0 1 0 1 0 0 2 2 2 0 1 0 0 0 0 0 0 0 0 2 2 2 2 0 2 0 2 2 0 2 2 2 2 2 2 2 2 2 0 2 2 2 0 0 2 0 1 0 0 0 1 2 0 2 2 2 2 2 0 2 0 0 1 1 0 0 2 2 2 2 0 2 2 2 2 2 0 0 1 0 1 2 2 2 2 2 0 0 2 2 2 2 0 0 1 0 2 2 2 0 2 2 0 0 2 0 2 0 0 1 1

  ooze/\.@|.^:2^:3 (* (1 + # {. 1:)) A

2 2 2 0 0 0 0 0 2 2 2 2 0 2 0 2 2 2 2 0 1 0 0 2 2 0 0 0 2 0 0 2 2 0 0 0 1 1 0 0 1 1 0 2 0 0 2 2 2 0 1 1 1 0 1 1 0 0 2 0 1 0 2 2 0 1 1 1 1 0 1 1 0 2 2 0 0 2 0 0 1 1 0 1 0 1 1 1 0 2 0 2 2 0 1 0 1 0 0 1 0 1 1 0 0 2 0 2 0 1 1 0 0 0 0 1 0 1 0 0 2 2 2 0 1 0 0 0 0 0 0 0 0 2 2 2 2 0 2 0 2 2 0 2 2 2 2 2 2 2 2 2 0 2 2 2 0 0 2 0 2 0 0 0 2 2 0 2 2 2 2 2 0 2 0 0 1 1 0 0 2 2 2 2 0 2 2 2 2 2 0 0 1 0 1 2 2 2 2 2 0 0 2 2 2 2 0 0 1 0 2 2 2 0 2 2 0 0 2 0 2 0 0 1 1

  ooze/\.@|.^:2^:_ (* (1 + # {. 1:)) A

2 2 2 0 0 0 0 0 2 2 2 2 0 2 0 2 2 2 2 0 1 0 0 2 2 0 0 0 2 0 0 2 2 0 0 0 1 1 0 0 1 1 0 2 0 0 2 2 2 0 1 1 1 0 1 1 0 0 2 0 1 0 2 2 0 1 1 1 1 0 1 1 0 2 2 0 0 2 0 0 1 1 0 1 0 1 1 1 0 2 0 2 2 0 1 0 1 0 0 1 0 1 1 0 0 2 0 2 0 1 1 0 0 0 0 1 0 1 0 0 2 2 2 0 1 0 0 0 0 0 0 0 0 2 2 2 2 0 2 0 2 2 0 2 2 2 2 2 2 2 2 2 0 2 2 2 0 0 2 0 2 0 0 0 2 2 0 2 2 2 2 2 0 2 0 0 1 1 0 0 2 2 2 2 0 2 2 2 2 2 0 0 1 0 1 2 2 2 2 2 0 0 2 2 2 2 0 0 1 0 2 2 2 0 2 2 0 0 2 0 2 0 0 1 1</lang>

(^:_ repeats an operation until it reaches a fixed point. In other words, it's basically a while loop.)

trial generates an arbitrary connection matrix and runs percolate on it. You'll typically get a different result from each trial.

<lang j> 0.6 0: 15 15 0

  0.6 (] ?@$ 0:) 15 15
 0.251168 0.233985   0.14541 0.219665  0.854985 0.0104645  0.449358 0.397573 0.0221767  0.701012      0.5692 0.320853    0.9029 0.0698325  0.439166
 0.919973  0.31569  0.733443 0.397144  0.314414 0.0626569  0.125752 0.222472  0.859704  0.517682    0.249954 0.420026  0.974397  0.353249  0.199624
0.0632196 0.729989 0.0384723 0.962052  0.583483  0.794639  0.101726 0.987826 0.0711966 0.0199436    0.692024 0.281396   0.23614  0.445332  0.669898
 0.817156 0.896721  0.128014 0.499834   0.86062  0.544871  0.296865 0.762644  0.583945  0.325163    0.701976 0.863764  0.631463  0.590224 0.0233733
 0.577801 0.607615  0.893612 0.372065  0.692356  0.385318  0.948463 0.179848  0.482163   0.40125    0.690535  0.48328  0.936104  0.813984  0.319394
 0.311636  0.27107  0.565229 0.152493  0.990904  0.856595 0.0755649 0.511731  0.636254 0.0199192   0.0299945 0.465337  0.472827  0.978434  0.207082
 0.343524 0.388673  0.169093 0.133254  0.520914  0.736237  0.663096 0.757243  0.901397  0.367862     0.94831  0.45684 0.0569871 0.0211516  0.833437
 0.745867  0.62734  0.790395 0.909088  0.359723  0.265804  0.176521  0.34355 0.0484308  0.775815    0.593603 0.023714  0.359704  0.621523  0.567126
 0.866712 0.572275  0.679043  0.27958  0.649579   0.91871  0.229361 0.495236  0.646061  0.980648    0.563149 0.461033  0.630641  0.115773  0.460841

0.00359967 0.198523 0.509623 0.995623 0.395574 0.130878 0.458647 0.304251 0.552992 0.491661 0.0503197 0.523992 0.554198 0.818936 0.392742

 0.696368   0.3988  0.931908 0.776482   0.23695  0.686757  0.799919 0.471909  0.441598  0.145376    0.470236 0.728451  0.567937   0.26908  0.564895
 0.826714 0.202945  0.673436 0.655122   0.61951 0.0459954  0.777457 0.968675  0.418669  0.862087    0.836782 0.274477  0.483467  0.345968  0.530893
 0.294519 0.286444  0.522912 0.455377 0.0480425  0.789532   0.22362 0.116726  0.563241  0.107526 0.000663275  0.36509  0.140703  0.694587  0.533685
 0.155445 0.320069  0.102258 0.844235  0.981544  0.306235  0.627662 0.638738  0.806254  0.753405    0.391762 0.201705   0.07424  0.707749  0.373488
  0.58236 0.384308  0.636697 0.577945  0.953101  0.527706  0.992441 0.242658  0.514722  0.269795    0.621798 0.528643 0.0910917  0.072488  0.746536
  0.6 ([ >: ] ?@$ 0:) 15 15

1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 0 1 0 0 1 1 1 0 1 1 1 1 1 0 1 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0 0 1 0 1 1 0 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 1 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0

  0.6 ([ >: ] ?@$ 0:) 15 15

0 1 0 1 0 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 0 1 0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 1 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 1 1 1 1 0 1 1 0 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 1 0 1 1 1 1 0 0 1 1 1 0

  0.6 percolate@([ >: ] ?@$ 0:) 15 15

0 0 0 0 2 2 2 2 2 0 2 0 0 0 2 0 1 0 2 0 2 2 0 2 0 2 2 0 0 0 1 0 2 2 2 2 2 2 2 0 0 2 0 0 1 0 2 2 0 2 0 2 0 2 0 2 2 2 0 1 2 2 2 2 0 2 2 2 2 0 2 2 0 0 1 2 2 2 0 1 0 2 2 0 0 2 2 2 2 0 0 0 2 2 0 0 2 2 2 0 2 2 0 2 2 0 2 2 0 0 2 2 2 2 2 0 2 2 0 2 0 2 0 0 0 2 0 0 0 0 0 2 2 0 0 0 2 0 2 2 2 2 0 2 2 2 2 0 0 0 0 2 2 2 2 2 0 0 2 2 2 0 1 0 2 2 0 2 0 0 0 2 2 0 0 0 0 0 0 2 2 2 2 2 2 2 2 2 2 2 2 2 0 2 2 0 0 2 2 2 2 0 2 2 0 0 2 2 2 0 0 1 0 0 2 0 2 2 0 0 1 0 2 0 1</lang>

simulate runs a sequence of 15 by 15 trials and averages them. Since each trial is different, each run of simulate is different.

<lang j> 40 (%@[ * [: +/ (2 e. {:)@trial&15 15"0@#) 0.5 0.1

  40 ((2 e. {:)@trial&15 15"0@#) 0.5

0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 0 0

  40 ((2 e. {:)@trial&15 15"0@#) 0.5

0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0

  40 ([: +/ (2 e. {:)@trial&15 15"0@#) 0.5

6

  40 ([: +/ (2 e. {:)@trial&15 15"0@#) 0.5

4

  40 (%@[ * [: +/ (2 e. {:)@trial&15 15"0@#) 0.5

0.1

  40 (%@[ * [: +/ (2 e. {:)@trial&15 15"0@#) 0.5

0.125</lang>

Note that the alternative implementation is different. (For example, there, percolate generates an arbitrary 15 by 15 connection matrix, and finds connections on that - rather like trial in this implementation.)