现在，我在心里想一个不超过n的正整数t。你的任务是尽可能用奇数次猜测猜中这个数（你知道n是多少）。每次猜测后，我都会告诉你你所做的猜测是大了还是小了。你不能猜测已经被排除了的数（来消耗猜测次数），你的每次猜测都必须符合我原来给出的回答。你觉得，你获胜（奇数次猜中）的几率有多大？

 
    动态规划的几个类似的经典模型启发了我们：设a[m]表示采取最优策略后在m个数里猜奇数次猜中的概率，b[m]表示如果题目要求我们猜偶数次，那最优策略下有m个数时获胜的概率是多少。考虑现在我有m个数可以猜，我想在奇数次内猜中。现在我猜的是数字i。狗屎运最好时，我一次猜中直接就赢了，它的概率是1/m；有(i-1)/m的情况下我会得到“大了”的提示，这样的话我需要用偶数次猜测去猜前面那i-1个数；剩余的那(m-i)/m的情况中，我需要用偶数次猜测去猜m-i个数。因此，a[m] = Max {1/m + (i-1)/m * b[i-1] + (m-i)/m * b[m-i], 1≤i≤m} 。类似地，我们也可以得出b[m]的递推公式：b[m] = Max {(i-1)/m * a[i-1] + (m-i)/m * a[m-i], 1≤i≤m} 。
    学习使用Mathematica确实是一件好事，你可以用Mathematica非常方便地描述出我们上面的两个递推公式，不需要自己去写那些冗长的程序了。
a[m_] := Max[Table[1/m + (i-1)/m * b[i-1] + (m-i)/m * b[m-i], {i, m}]]; a[0] := 0;
b[m_] := Max[Table[(i-1)/m * a[i-1] + (m-i)/m * a[m-i], {i, m}]]; b[0] := 0;

查看更多 »

    在所有8-bit的整数中，含有k个数字“1”的二进制数一共有C(8,k)个。给出其中的一个二进制数，你如何利用位运算快速找到下一个恰有k个“1”的数？例如，如果给你二进制数01011100，那么下一个（含4个“1”的）数就是01100011。在继续阅读下去之前，建议你仔细思考一下。你或许会想看看我很早以前写的一篇介绍位运算的文章。这是一道很好的题目，很多位运算技巧在这里都有体现。

    在草稿纸上随便举几个例子，规律很容易看出来。由于“1”的个数是固定的，为了让这个二进制数更大，我们必须把第一个出现在“1”左边的“0”改成“1”；同时，为了让这个二进制数尽可能小，我们必须把它右边那些“1”重新排到最低位去。
    更具体地说，下一个二进制数可以通过以下步骤得到：找到右起第一个单个的或连续的数字“1”，把它们全改成“0”，同时把它们左边的那个“0”改为“1”。此时，“1”的个数可能减少了，我们只需把还差的“1”摆在最右边就行了。举个例子，01011100的右起第一个“1”在第三位，把它和左边紧挨着的“1”一并变为“0”，并把再左边那个“0”变为“1”，于是我们得到01100000。我们还差两个“1”，把这两个“1”补在最低位得到01100011即可。现在我们的任务是，想出一个用位运算来实现这些步骤的办法。
    我们已经熟知，用x & -x可以提取最右边的那个“1”。当意识到可以利用加法来消除连续的“1”时，我们很快得到了第一步操作的位运算实现：把x & -x加到x上，利用二进制加法的进位把“..01111..”变成“..10000..”。现在，我们需要计算出刚才的操作中一共“跳过”了多少个“1”，换句话说现在的x的右起第一个“1”和原来的x的右起第一个“1”差了多少位。关键就在这里！我们可以用除法来完成这一步，例如100000除以100就相当于把被除数右移2位，得到的结果即可以表示两个数中的“1”差了多少位。在最低位产生指定数量的“1”需要用到另一个技巧：减1操作可以把右边连续的“0”都变成“1”，即把...10000变成...01111。我们得到了该问题的第一个算法：

b = x & -x;
t = x + b;
c = t & -t;
m = (c/b >> 1) - 1;
r = t | m; //最终结果

    我们对上述算法做一个简单的说明：

操作              | 样例     |  说明
------------------+----------+----------------------------
x                 | 01011100 |  原数
b = x & -x        | 00000100 |  提取x的右起第一个“1”
t = x + b         | 01100000 |  把x的右起第一个位于某个“1”左边的“0”变成“1”，并把它右边的那些“1”都变为“0”
c = t & -t        | 00100000 |  提取t的右起第一个“1”
c / b             | 00001000 |  右移c中的那个“1”，其结果中最低位连续的“0”的个数正好是c和b中的“1”相差的距离
m = (c/b >> 1) - 1| 00000011 |  在最低位产生数字“1”，其个数比上述的“距离”少1
r = t | m         | 01100011 |  最终结果

    除去赋值，我们一共用了9个运算符。有可能用更少的运算么？

查看更多 »

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

查看更多 »

    Ubigraph是一个全新的图论动画生成软件，利用它你可以快速生成图论模型的图形和动画，直观地展示出各种图论模型的三维结构，演示各种图论算法的过程，非常适合用于研究和教学。之前本Blog曾经介绍过一个类似的软件graphviz，但这里提到的Ubigraph显然更强大一些。上面的动画就是由Ubigraph生成的二叉查找树演示动画（高清版here），看上去相当的酷。值得一提的是，Ubigraph也是相当易用的。graphviz有它自己的语法规则，而Ubigraph则直接支持Python, Ruby, PHP, Java, C, C++等几乎所有主流语言，因此不管你原先使用的是什么语言，你都可以很快地融入到Ubigraph来。例如，在C语言中包含一个头文件UbigraphAPI.h，你便可以像往常一样用循环语句“画”一个环。

#include <UbigraphAPI.h>
 
int main(int const argc, const char ** const argv)
{
int i;
for (i=0; i < 10; ++i)
ubigraph_new_vertex_w_id(i);
 
for (i=0; i < 10; ++i)
ubigraph_new_edge(i, (i+1)%10);
 
sleep(2);
 
ubigraph_clear();
}

    你可以在这里下载这个软件。目前该软件暂时没有Windows版。

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

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

查看更多 »