电脑
Mathematica
给出平面上的100个随机点，顺次连接线段，形成一个折线图形：pl = RandomPoint[Disk[], 100];Graphics[{Point[pl],Line[pl]}]
依次取各条线段的中点，再顺次连接这些中点，得到新的折线图形：pl1=Table[(RotateRight[pl,n][[1]]+RotateRight[pl,n][[2]])/2,{n,100}];{Graphics[{Point[pl],Line[pl],Point[pl1],Line[pl1]}], Graphics[{Point[pl1],Line[pl1]}]}
再执行一次上面的操作：pl2=Table[(RotateRight[pl1,n][[1]]+RotateRight[pl1,n][[2]])/2,{n,100}];{Graphics[{Point[pl1],Line[pl1],Point[pl2],Line[pl2]}], Graphics[{Point[pl2],Line[pl2]}]}
用Nest对上面的操作进行迭代：pl100=Nest[Table[(RotateRight[#,n][[1]]+RotateRight[#,n][[2]])/2, {n,100}]&,pl,100];{Graphics[{Point[pl99],Line[pl99],Point[pl100],Line[pl100]}], Graphics[{Point[pl100],Line[pl100]}]}下图就是第100操作之后得到的图形。
再看看迭代到1000次的效果图：pl1000=Nest[Table[(RotateRight[#,n][[1]]+RotateRight[#,n][[2]])/2, {n,100}]&,pl,1000];{Graphics[{Point[pl999],Line[pl999],Point[pl1000],Line[pl1000]}], Graphics[{Point[pl1000],Line[pl1000]}]}
用一个动画来演示这个过程的效果，迭代深度定为3000次。
Mathematica的Graphics，可以把图像放缩到合适的大小，且又不失比例，是演示这个现象的有效方法。
由于对应的动态图有3000多帧，所以没能够上传。