NCF参数化建筑论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 158152|回复: 86
打印 上一主题 下一主题

[建模练习] 元胞自动机(GH文件已到位)

[复制链接]
跳转到指定楼层
1m
发表于 2009-9-13 11:18:27 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
元胞自动机这个词最近听的实在太多了,人人都在讲这个词,skywoolf也说怎么人人都在说元胞自动机呢,今天就发一个元胞自动机的起源,康威生命游戏。

评分

参与人数 3强度 +3 照度 +40 收起 理由
as5211407 + 5
yanhui314 + 5 感谢
skywoolf + 3 + 30

查看全部评分

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏3 分享分享
2m
发表于 2009-9-13 12:20:32 | 只看该作者
GH文件可以直接用附件上传啊,你那个不会有好几m吧?
3m
发表于 2009-9-13 12:47:10 | 只看该作者
呵呵,关键就是那两块VB呀{:3_64:} 太多法则不知道了,百度一下
4m
 楼主| 发表于 2009-9-13 13:25:15 | 只看该作者
靠,辛辛苦苦才整出来的,管理员也不说给加精,太抠了!! 那就不发GH文件了,发代码吧!
5m
 楼主| 发表于 2009-9-13 13:27:08 | 只看该作者
Call Main Sub Main() 'Base point of the grid will be world origin 'Define number of cells in each direction Dim intNumU: intNumu = Rhino.GetInteger ("Number of Cells in x direction",10,10, 100) Dim intNumV: intNumV = Rhino.GetInteger ("Number of Cells in y direction",10,10, 100) 'Define number of generatons Dim intGeneration: intGeneration = Rhino.GetInteger ("Number of generations",50,1, 100) 'Create 2D array of rectangles (of type string) for cells 'We will first generate all cells, then show and hide them depending on each cell state Dim arr2DCells() ReDim arr2DCells(intNumU-1, intNumV-1) 'Generate all cells Call GenerateCells(arr2DCells, intNumU, intNumV) 'Define 2D array of cells states (of type int that takes values 0 and 1) Dim arr2DStates() ReDim arr2DStates(intNumU-1, intNumV-1) 'Create the initial state by generating random distribution Call GenerateRandomState(arr2DStates,intNumU, intNumV) 'Run the Game of Life Dim i Dim arrLifeObjs() Dim arrDeadObjs() For i = 0 To intGeneration 'Print which generation we are in Rhino.Print "Generation: " & i 'CStr(i) 'Run the current generation Call NewGeneration( arr2DStates, intNumU, intNumV ) 'Generate single dimention array of alive and dead objects (to be hidden) Call ExtractLifeList( arr2DCells, arr2DStates, intNumU, intNumV, arrLifeObjs, arrDeadObjs ) 'Hide all objects Call Rhino.HideObjects( arrDeadObjs ) Call Rhino.ShowObjects( arrLifeObjs ) Call Rhino.Redraw() Call Rhino.Sleep( 500 ) Next End Sub '------------------------------------------------------------- 'Generate Calls 'Starting from world origin, create squares of 1 unit width Sub GenerateCells(arr2DCells, intNumX, intNumY) Dim i, j Dim arrV : arrV = Array(0,0,1) Dim arrCenter For i = 0 To intNumX-1 For j = 0 To intNumY-1 'Create a circle arrCenter = Array(2*i,2*j,0) 'Assign object string value To its proper location In the array of cells arr2DCells(i,j) = Rhino.AddSphere(arrCenter, 1 ) Next Next End Sub 'Generate states randomly 'States are either 0 or 1 Sub GenerateRandomState(arr2DStates, intNumX, intNumY) Dim i, j For i = 0 To intNumX-1 For j = 0 To intNumY-1 Randomize arr2DStates(i,j) =Int((1 - 0 + 1) * Rnd) + 0 Next Next End Sub 'Run a generaion in the game of life 'Edge condition periodic Sub NewGeneration( arrStates, intNumX, intNumY ) Dim i,j Dim intLCount Dim prev_i, next_i, prev_j, next_j For i = 0 To (intNumX - 1) 'First index If i = 0 Then 'Take last index prev_i = intNumX-1 Else prev_i = i-1 End If 'Last index If i = intNumX-1 Then 'Take first index next_i = 0 Else next_i = i+1 End If For j = 0 To (intNumY - 1) If j = 0 Then prev_j = intNumY - 1 Else prev_j = j - 1 End If 'Check next col If j = intNumY-1 Then next_j = 0 Else next_j = j+1 End If 'Zero the living cells count intLCount = 0 'Count number of live neighbors (8 of them) 'Check top cell intLCount = intLCount + arrStates( next_i, j ) 'Check bottom cell intLCount = intLCount + arrStates( prev_i, j ) 'Check right cell intLCount = intLCount + arrStates( i, next_j ) 'Check left cell intLCount = intLCount + arrStates( i, prev_j ) 'Check top right cell intLCount = intLCount + arrStates( next_i, next_j ) 'Check top left cell intLCount = intLCount + arrStates( next_i, prev_j ) 'Check bottom right cell intLCount = intLCount + arrStates( prev_i, next_j ) 'Check bottom left cell intLCount = intLCount + arrStates( prev_i, prev_j ) 'Check if a cell is live or dead and to ' change/maintain state based On count of live neighbors If arrStates(i,j) = 1 Then 'Live cell If intLCount < 2 Then arrStates(i,j) = 0 End If If intLCount > 3 Then arrStates(i,j) = 0 End If Else 'Dead Cell If intLCount = 3 Then arrStates(i,j) = 1 End If End If Next Next End Sub 'Extract one dimentional array of living and dead objects Sub ExtractLifeList( arr2DCells, arr2DStates, intNumX, intNumY, arrLifeObjs, arrDeadObjs ) Dim k : k=0 Dim d : d=0 Dim i, j For i = 0 To intNumX-1 For j = 0 To intNumY-1 'Check if cell is alife If arr2DStates(i,j) = 1 Then ReDim Preserve arrLifeObjs(k) arrLifeObjs( k ) = arr2DCells(i,j) k = k+1 Else ReDim Preserve arrDeadObjs(d) arrDeadObjs( d ) = arr2DCells(i,j) d = d+1 End If Next Next End Sub
6m
发表于 2009-9-13 21:16:21 | 只看该作者
你都这样了~你四级怎么还不过呢?
7m
 楼主| 发表于 2009-9-13 21:39:32 | 只看该作者
靠你,哥也是放假的时候才开始搞的,要是早搞早就过了!
8m
发表于 2009-9-19 20:58:30 | 只看该作者
啥玩意啊,完全不懂,今天看那帮规划优秀作品有一个也整“自动机”说实话,我看的时候一直试图吧那些包状物拼出个图案什么的,老大,开班开班~~
9m
 楼主| 发表于 2009-9-20 08:32:20 | 只看该作者
8# Dove 那不是包状物拼出来的图案,那是计算机根据设计者自己的规定的转换法则生成出来的,我一会儿发一个关于元胞自动机做规划的例子,你看看,或许可以明白一点。
10m
发表于 2009-9-20 16:39:21 | 只看该作者
感觉这个挺有意思的...楼主能不能附上ghx文件啊!谢谢啦
11m
发表于 2009-9-20 16:47:47 | 只看该作者
10# 射手明 f(x)系统有些问题,我代他传了一下。欢迎来到NCF!
12m
发表于 2009-9-22 15:19:48 | 只看该作者
f(x) 你脚步语言找什么教程学的啊?
13m
 楼主| 发表于 2009-9-22 16:06:32 | 只看该作者
我只学过101
头像被屏蔽
14m
发表于 2009-10-23 15:26:39 | 只看该作者
7# f(x) 大哥是说的计算机四级吗? 神人也.....
15m
发表于 2009-11-6 11:53:42 | 只看该作者
呵呵···催眠书
16m
发表于 2009-11-7 16:32:55 | 只看该作者
这贴需要更新。。。。
17m
发表于 2009-11-25 13:14:22 | 只看该作者
6# rwl1688 别这样。。。四级而已, 让老外来考中文四级, 有0.1%能过都算不错了
18m
发表于 2009-11-30 17:45:07 | 只看该作者
恩,,学习学习
19m
发表于 2009-12-4 08:20:29 | 只看该作者
相视一笑思学隐侠
20m
发表于 2009-12-4 14:19:44 | 只看该作者
得看看了~学习中~

小黑屋|手机版|NCF参数化建筑论坛 ( 浙ICP备2020044100号-2 )    辽公网安备21021102000973号

GMT+8, 2024-11-1 15:26 , Processed in 0.072881 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表