一行代码的分形

继续搬运果壳网上的旧贴。部分代码有改动。

---

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]}]