Daisuke Minematsu和他的同学们发现，Josephus问题中也隐藏着分形图形。Josephus问题是初学编程的人必然会接触到的一个问题——n个人围成一圈进行1到k报数，每次报到k的人退出游戏（离开这个圆圈），那么最后剩下的那个人是谁。在这里，我们考虑一个Josephus问题的变种：双向Josephus问题。双向Josephus问题中有两个交替进行的报数进程，其中一个按顺时针方向踢出每第k个人，另一个进程则逆时针踢出每第k个人。两个进程交替进行，直到最后只剩一人为止。假如n=10, k=3的话，第一个退出的人是#3，第二个退出的人是#8，第三个退出的人是#6，以后分别是4, 10, 9, 5, 1, 7，最后剩下的人是2。我们用S(n,k)来表示在相应的n值和k值的情况下最后剩下的那个人的编号，对于每个固定的k值，函数S的图象竟然都是一个分形图形。右图是S(n,4)所对应的图象，你可以非常清楚地看到这个图象的自相似性。你可以自己用Mathematica来验证一下。

查看更多 »

    我的左眼有相当严重的散光，因此无缘各种类型的3D立体图，包括看对眼、立体眼镜、左右两幅图（一只眼睛看一个）等等。后来，网上出现了一种只需要一只眼睛就能体验的3D图，原理非常简单，效果也比较震撼。只需要在两个眼睛的位置分别拍照，然后做成gif循环显示两个图片，大脑也可以从中迅速获取信息分辨出第三维来。闲逛ffffound时偶然发现这个图，突然想到：同样的方法为何不用于展示三维数据呢？于是试着用Mathematica做了一个。Mathematica输出gif动画相当简单，只需要一句Export["file.gif",{g1, g2, ...}]就行了。在这里，我们将用三维空间的点来展示组合数的各位数字之和的分布情况。可以看到，使用3D动画的效果非常明显。

img = ListPointPlot3D[
  Table[Total[IntegerDigits[Binomial[i, j]]], {i, 0, 50}, {j, 0, 50}],
   ViewVertical -> {0, 0, 1}, ImageSize -> 600];
Export["F:\\file.gif", {Show[img, ViewVector -> {-32, -20, 60}],
  Show[img, ViewVector -> {-31, -21, 60}]}];

    类似地，我们还可以做出环视一周的gif动画来，虽然这样将很难观察出细节，但对总体的把握效果将更好。

    只有想不到，没有做不到。还是在这里，我惊奇地发现Mathematica居然有DictionaryLookup和WordData这样的函数（我的6.0里就有，不知道5.x有没有）。于是，一连串牛B的Mathematica用法出现了：

 
包含ijk三个连续字母的单词：
In[1]:= DictionaryLookup["*" ~~ "ijk" ~~ "*"]
Out[1]= {"Dijkstra"}

 
连续三次出现重复字母的单词：
In[2]:= DictionaryLookup[RegularExpression[".*(.)\1(.)\2(.)\3.*"]]
Out[2]= {"bookkeeper", "bookkeepers", "bookkeeping"}

 
首尾三个（及以上）的字母完全相同的单词：
In[3]:= DictionaryLookup[RegularExpression["([a-z]{3,})[a-z]*\1"]]
Out[3]= {"abracadabra", "anticoagulant", "antidepressant", \
"antioxidant", "antiperspirant", "bedaubed", "beriberi", "bonbon", \
"cancan", "chichi", "couscous", "dumdum", "entailment", \
"entanglement", "entertainment", "enthrallment", "enthronement", \
"enticement", "entitlement", "entombment", "entrainment", \
"entrancement", "entrapment", "entrenchment", "froufrou", "hotshot", \
"hotshots", "ingesting", "ingoing", "ingraining", "ingratiating", \
"ingrowing", "ionization", "mesdames", "microcosmic", "murmur", \
"muumuu", "outshout", "outshouts", "physiography", "pompom", \
"redelivered", "rediscovered", "respires", "restores", \
"restructures", "tartar", "tessellates", "testates", "testes", \
"tormentor", "tsetse", "underfund", "underground"}

查看更多 »

jintianhu2000在这个帖子里说：

这是本人读高中时发现的一个数学猜想，一直不能证明或推翻
 
任何一个不能被3整除的偶数，如488，按下列步骤：
若该数为偶数，则把它各位数之和的平方作为新数；若该数为奇数，则把它各位数之和的立方作为新数。再把那个新数重复以上步骤（数就各位数之和平方，奇数就各位数之和立方），一步步计算下去，肯定能在9步内变为1。
如：
  488(偶)    4+8+8=20      20*20=400
  400(偶)    4+0+0=4       4*4=16
  16(偶)     1+6=7         7*7=49
  49(奇)     4+9=13        13*13*13=2197
  2197(奇)   2+1+9+7=19    19*19*19=6859
  6859(奇)   6+8+5+9=28    28*28*28=21952
  21952(偶)  2+1+9+5+2=19  19*19=361
  361(奇)    3+6+1=10      10*10*10=1000
  1000(偶)   1+0+0+0=1     1*1=1   （共9步）
 
哪位高手能证明或推翻它？？

查看更多 »

    Wolfram的Blog上更新了一段非常牛的Mathematica代码，真的让我大开眼界。只需要三行代码，你就可以自己做一个马赛克拼图。
imagePool = Map[With[{i = Import[#]}, {i, Mean[Flatten[N[i[[1, 1]]], 1]]}] &, FileNames["Pool/*.jpg"]];
closeMatch[c_] := RandomChoice[Take[SortBy[imagePool, Norm[c - #[[2]]] &], 20]][[1]];
Grid[Reverse[Map[closeMatch, Import["MasterImage.tif"][[1, 1]], {2}]], Spacings -> {0, 0}]

    其中，"Pool/*.jpg"是你的图库，我估计最少也得有几百张吧。我用Photoshop把我的collection全部处理成了35x35的小图；为了让最终效果更佳，我特地把它们全部处理成单色的，并且减小了对比度。"MasterImage.tif"是你的目标图片，Mathematica会把这个图片中的每一个像素用图库中一个合适的图来代替。我把我的照片剪裁了一下，然后压成19x22的大小。Mathematica首先把所有照片以及每个照片的RGB值的中位数存成一个list，函数closeMatch将图片按照RGB值的均方根排序，然后随机从头20个中选出一个。第三行用Grid函数输出我们所要的马赛克拼图。最后我们就得到了——由众MM图所组成的Matrix67的肖像画！！如果你还看不出来的话，站远点儿眯着眼睛就能看出来了。

查看更多 »

    Stetson大学的一个非常可爱的MM（以后本Blog将简称她为Stetson MM）和我分享了一个很神奇的东西。她们正在做一个线性代数的课题研究，题目的大致意思是“用矩阵来构造分形图形”。Stetson MM叫我试着做下面这个实验：对于一个坐标点(x,y)，定义下面4个矩阵变换：
    
    然后，初始时令(x,y)等于(0,0)，按照 T1 - 85%, T2 - 6%, T3 - 8%, T4 - 1% 的概率，随机选择一个变换对该点进行操作，生成的点就是新的(x,y)；把它画在图上后，再重复刚才的操作，并一直这样做下去。我心里觉得奇怪，这为什么会得到分形图形呢？于是我写了一个简单的Mathematica程序：
list = {{0, 0}};
last = {{0}, {0}};
For[i = 0, i < 50000, i++, r = Random[];
   If[r < 0.85, last = {{0.83, 0.03}, {-0.03, 0.86}}.last + {{0}, {1.5}},
     If[r < 0.91, last = {{0.2, -0.25}, {0.21, 0.23}}.last + {{0}, {1.5}},
       If[r < 0.99, last = {{-0.15, 0.27}, {0.25, 0.26}}.last + {{0}, {0.45}},
         last = {{0, 0}, {0, 0.17}}.last + {{0}, {0}}
       ]
     ]
   ];
   list = Append[list, First[Transpose[last]]];
]
ListPlot[list, PlotStyle -> PointSize[0.002]]

    程序运行的结果真的是令我大吃一惊：竟然真的是一个分形图形！！我不禁再次对数学产生了一种崇敬和畏惧感！！

查看更多 »

又一个有创意的想法！下面这个函数在自然数点上的取值正好构成了Hello world!的ASCII码，是当之无愧的Hello world函数：

round( 96.75 - 21.98*cos(x*1.118) + 13.29*sin(x*1.118) - 8.387*cos(2*x*1.118)
    + 17.94*sin(2*x*1.118) + 1.265*cos(3*x*1.118) + 16.58*sin(3*x*1.118)
    + 3.988*cos(4*x*1.118) + 8.463*sin(4*x*1.118) + 0.3583*cos(5*x*1.118)
    + 5.878*sin(5*x*1.118)  )

这是这个函数的图像：

来源：http://www.poromenos.org/node/89

查看更多 »

    不知是哪个牛人发现了这样一个有趣的函数f(x,y)=e^(-x^2-y^2/2) * cos(4x) + e^(-3((x+0.5)^2+y^2/2))，它可以说是“函数界”里的Hello World，因为当z充分小的时候（比如取0<z<0.001），函数图象是两个大大的字母，向电脑前的你表示最真挚的问候。看来，以后打招呼又有新的方式了。

    

    另外一些有趣的问题是，有没有牛人能找到一个并不太复杂的，可以显示“Hello World”的初等函数呢？或者更实用一些的，想要创作一个“XXX我爱你函数”需要花多长时间，函数本身会有多复杂？
    消息来源：http://www.walkingrandomly.com/?p=19

    你认为，是这个“HI函数”牛B，还是爱的方程式牛B？或者爱的方程式3D版更牛一些？或者数学公式生成的色情图片更牛？个人觉得，还是Tupper自我指涉公式最牛。