# [WSS22] Cellular automaton on Topological surfaces

Posted 8 months ago
2529 Views
|
5 Replies
|
15 Total Likes
|
5 Replies
Sort By:
Posted 1 month ago
 Excellent work, @Shuheng Li diagonalGridGraph[n_Integer, m_Integer] := With[ { g = NearestNeighborGraph[GraphEmbedding@GridGraph[{n, m}], DistanceFunction -> (ChessboardDistance)] }, VertexReplace[g, # -> -VertexIndex[g, #] & /@ VertexList[g]] ] torusGrid[n_Integer, m_Integer] := EdgeAdd[diagonalGridGraph[n, m], Union[ { Range[1, n][[#]] -> Range[n*m - m + 1, n*m][[#]], Range[1, n][[#]] -> Range[n*m - n + 1, n*m][[Mod[# + 1, n, 1]]], Range[1, n][[#]] -> Range[n*m - n + 1, n*m][[Mod[# - 1, m, 1]]] } & /@ Range[1, m] // Flatten, {Array[m*# - m + 1 &, m][[#]] <-> Array[n*# &, m][[#]], Array[n*# - n + 1 &, m][[#]] <-> Array[n*# &, m][[Mod[# + 1, m, 1]]], Array[n*# - n + 1 &, n][[#]] <-> Array[n*# &, n*m][[Mod[# - 1, m, 1]]]} & /@ Range[1, m] // Flatten] ] // SimpleGraph gliderLD[n_Integer, m_Integer, coordinate_List] := ReplacePart[ Array[0 &, n*m], {(coordinate[[2]] - 1)*n*m + coordinate[[1]] -> 1, (coordinate[[2]] - 1)*n + coordinate[[1]] + n + 1 -> 1, (coordinate[[1]] - 1)*n + coordinate[[2]] + 2 n - 1 -> 1, (coordinate[[1]] - 1)*n + coordinate[[2]] + 2 n -> 1, (coordinate[[1]] - 1)*n + coordinate[[2]] + 2 n + 1 -> 1}] listToGraph[g_Graph, state_List] := Graph[g, VertexStyle -> (If[ state[[#]] == 1, # -> Black, # -> ColorData["CherryTones"] /@ {RandomReal[]}] & /@ VertexList[g]), VertexSize -> 1] neighborPopulation[g_Graph, init_List] := Total[init[[#]] & /@ AdjacencyList[g, #]] & /@ VertexList[g] GSRule[g_Graph, init_List, survival_List, growth_List] := With[{N = neighborPopulation[g, init]}, If[init[[#]] == 0, If[MemberQ[growth, N[[#]]] == False, 1, 0], If[MemberQ[survival, N[[#]]] == True, 1, 0]] & /@ VertexList[g]] GSIterate[g_Graph, init_List, survival_List, growth_List, t_Integer] := NestList[GSRule[g, #, survival, growth] &, init, t] animate3D[g_Graph, init_List, survival_List, growth_List, t_Integer, speed_Integer : 1] := With[{A = Graph[listToGraph[g, #], VertexCoordinates -> Automatic] & /@ GSIterate[g, init, survival, growth, t]}, Animate[A[[u]], {u, 1, t + 1, speed}]] animate3D[torusGrid[15, 15], gliderLD[15, 15, {10, 10}], {2, 3, 4}, {3, 4}, 129, 1] On these topological surfaces, it's easy to get clogged full of random colors.
Posted 8 months ago
 Great work! I wonder if it will finally be possible to explore the behavior of general nearest-neighbor rules on such surfaces. Definition of such rules would require enumeration schemes for the grid. And maybe also the rules will become more complicated, for example, if the number of adjacent cells varies.You may also have a look at this post: https://community.wolfram.com/groups/-/m/t/2027803 It explores the behavior of totalistic cellular automata on 3D Lattices.
Posted 8 months ago
 Congrats, Shuheng, and thanks for putting in the work this month. How about making a semi-final revision of the underlying topological graphs and submitting them to WFR?
Posted 8 months ago
 Good idea, will definitely do that!
Posted 8 months ago
 -- you have earned Featured Contributor Badge Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!