继续搬运果壳网上的旧帖。部分代码有改动。
Wolfram 公司在 Twitter 上开了个帐号,叫 Tweet-a-Program (@wolframtap)。你只要发一段 Mathematica 代码并@它,它就会自动把运行结果回复给你。由于 Twitter 的字数限制,这段 Mathematica 代码不能超过128字(现在 Twitter 的字数限制涨了,但 Tweet-a-Program 的字数限制还是不变)。
我一般用它来画分形。
Multicolumn[Table[Image3D@Array[Boole@SubsetQ[s,Plus@@Abs[IntegerDigits[{##},3,3]-1]]&,{3,3,3}^3,0],{s,Subsets@{0,1,2,3}}],4] |
JuliaSetPlot[z-(z^9-1)/(9z^2),z,ColorFunction->"RustTones"] |
Image@Array[BitAnd,{2,2}^9,0] |
Image[1-Last@SubstitutionSystem[{0->{{1,1,1},{1,1,1},{1,1,1}},1->{{0,1,0},{1,0,1},{0,1,0}}},{{1}},6]] |
Graphics[{RGBColor@##3,Point@{#,#2}}&@@(2y^Range[7].#)&/@Tuples[{{x=.886,y=.5,y,0,0},{-x,y,0,y,0},{0,-1,0,0,y}},7]] |
Image[Table[If[ColorQ@#,#,Black]&[Hue[(Arg@#+Pi)/(2Pi),1/Abs@#]&[MandelbrotSetBoettcher[x+I y]]],{y,-2,2,.01},{x,-2,2,.01}]] |
Graphics@Line[AnglePath@#,VertexColors->Hue/@Subdivide@Length@#]&@MapIndexed[#(-1)^Tr@#2&,Flatten@Nest[{#,#[[1]]}&,{Pi/2,0},17]] |
Multicolumn[Table[Image3D[Array[BitXor,{2,2,2}^5,0]/.{i->1,_Integer->0}],{i,0,31}],4] |
f={Tuples[Range[2^#]-1,#2],First@HilbertCurve@##}&;Grid@Table[Image@Partition[a[[Ordering@b]]/2^6,2^9],{a,f[6,3]},{b,f[9,2]}] |