使用 Mathematica 制作真值表

使用 Mathematica 内置的 BooleanTable 函数制作逻辑表达式的真值表。

核心是使用 BooleanTable 函数。以下是代码,使用时修改前两行即可。

expression := {(P && Q && R), (P || Q || R), Xor[P, Q, R]};
variables := {P, Q, R};
table = Reverse@Boole@BooleanTable[expression, variables];
Flatten[{
  {Flatten@{variables, expression}},
  Table[
    Flatten[{
      Characters@IntegerString[i - 1, 2, Length@variables], 
      table[[i]]}],
    {i, 1, Length@table}]
}, 1] // TableForm // TraditionalForm

在 Wolfram Mathematica 10.0 将产生以下的输出。

以上代码的输出

如何玩坏静点电荷电场

用 Mathematica 绘制电场线、等势面。

这一组大约是去年4月份的作品。截图均来自 Mathematica 8.0。图片曾经上传到人人网。

我们先来定义,静点电荷电场中电势函数。其实是文档里给的示例,稍加修改。前两个参数用各个点电荷的位置和电荷量描述了电场,第三个参数是位置坐标,返回的是电势,以无穷远处为势能零点。

ElectroStaticPotential[q_, p_, r_] :=
   Sum[q[[i]]/Norm[r - p[[i]]], {i, Length[q]}]

然后我们来画最经典的,等量异种电荷。

ContourPlot[ElectroStaticPotential[{1, -1}, {{-1, 0}, {1, 0}}, {x, y}],
   {x, -4, 4}, {y, -4, 4}, PlotRange -> 1,  ClippingStyle -> Automatic, ContourLabels -> True]

以上代码的输出

果然是我们熟悉的图形。ContourPlot 函数给出的是二维函数的等高线图。下面我们把这个图画成三维的,不再用颜色深浅,而是用海拔高度,来表示数值的高低。用到 Plot3D 函数。

Plot3D[
   ElectroStaticPotential[{1, -1}, {{-1, 0}, {1, 0}}, {x, y}],
   {x, -4, 4}, {y, -4, 4}, PlotRange -> 6, 
   Mesh -> None, Axes -> False]

平面上等量异种电荷电场的电势分布

我们亦可以只画电荷连线上的电荷分布,就是一维函数的图象。我们需要用 Plot 函数。

Plot[
   ElectroStaticPotential[{1, -1}, {{-1}, {1}}, {x}], 
   {x, -4, 4}, PlotRange -> 20, Mesh -> None, Axes -> {True, False}]

等量异种电荷,连线上的电势分布

这一点可以看出 Mathematica 在符号计算方面的优势。我们前面定义的 ElectroStaticPotential 里调用的是内置的向量运算,多少维都可以。下面我们就来画个三维的。

ContourPlot3D[
 ElectroStaticPotential[{1, -1}, {{-1, 0, 0}, {1, 0, 0}}, {x, y, z}], 
 {x, -4, 4}, {y, -4, 4}, {z, -4, 4}, PlotRange -> 1, 
 Contours -> {-0.8, -0.6, -0.4, -0.2, 0, 0.2, 0.4, 0.6, 0.8}, 
 RegionFunction -> Function[{x, y, z}, y > 0], 
 ContourStyle -> 
  Join[Table[Lighter[Green, i/4], {i, 0, 4}], 
   Table[Lighter[Orange, i/4], {i, 4, 0, -1}]], Mesh -> None, 
 Axes -> False]

代码看起来很长,这是因为我们比较详细地自定义了图象的样式。效果应该不错。

以上代码的输出

以上是玩维数。下面我们来修改一下电荷的数量和电量。

比如现在是三个电荷,居于等边三角形三个顶点上。

ContourPlot[
   ElectroStaticPotential[
      {1, -1, -1}, 
      {{-1, 0}, {1, 0}, {0, Sqrt[3]}}, 
      {x, y}],
   {x, -4, 4}, {y, -4, 4}, PlotRange -> 1, 
   ClippingStyle -> Automatic, 
   ContourLabels -> True]

三个等量电荷(+1, -1, -1)形成电场的等势面

几乎整个平面都被负电荷占领了,正电势只有一个小圈的范围。因为我们的 ElectroStaticPotential 函数非常厉害,所以我们可以随意地修改电荷的数量,指定每一个的位置,或者挪动它们的位置。于是有以下的漫画。

漫画:电荷的战争

下面是电场线。因为知识、能力有限……我并不能推导出电场线的解析式。但是我可以写出每一点的电场方向。我打算使用 Mathematica 的 StreamPlot 函数,它能给出向量场的直观图形——流线图。

首先写一个电场函数,它将返回一个向量,表示了该点处电场的方向。

EE[q_, p_, r_] := 
   Sum[q[[i]]/Norm[r - p[[i]]]^2*{{r - p[[i]]}/Norm[r - p[[i]]]}, 
      {i, Length[q]}]

然后我们期待熟悉的图形吧——等量异种电荷:

StreamPlot[
   EE[{+1, -1}, {{-1, 0}, {1, 0}}, {x, y}],
   {x, -4, 4}, {y, -4, 4}, 
   StreamPoints -> Fine, StreamScale -> None]

等量异种电荷形成电场的电场线

好极了,和教科书上的没什么两样。下面开始变换花样,我们改变两个电荷的电量之比。可以想象电场线会向电荷量大的电荷那边偏。以前在练习册上看到过一些图形,但是都很粗略,今天来看看精确的。

我们用到 Table 函数,可以生成一个列表。等于是批量画图啦。

Table[
   StreamPlot[
     EE[{+1, -p}, {{-1, 0}, {1, 0}}, {x, y}], {x, -4, 4}, {y, -4, 4}, 
        StreamPoints -> Fine, StreamScale -> None, 
        PlotLabel -> StringJoin["1 :", ToString[p]]], 
  {p, {1, 1.05, 1.2, 1.5, 2, 4}}]

不等量异种电荷形成电场的电场线

最后是脑洞之作,假如库仑定律下面不是 2 次方……电场线会变成什么样?为了达到这个目的,我们需要重新写一下前面的电场函数 EE,使之多接受一个参数。

EEE[q_, p_, r_, k_] := 
   Sum[q[[i]]/Norm[r - p[[i]]]^k*{{r - p[[i]]}/Norm[r - p[[i]]]},
	  {i, Length[q]}];
Table[
   StreamPlot[
      EEE[{+1, -1}, {{-1, 0}, {1, 0}}, {x, y}, k],
      {x, -4, 4}, {y, -4, 4},
      StreamPoints -> Fine, StreamScale -> None, 
      PlotLabel -> StringJoin[ToString[k]]], 
   {k, {-4, -2, -1, -0.5, 0.5, 1, 2, 4}}]

假如库仑定律下面不是 2 次方……?

(完)

无敌拟合,有限数列的克星

地球人都知道,对于有限数列,找到一个通项公式是简单的。事实上,对于项数为 n 的数列,我们只需不超过 (n-1) 次的多项式。本文用 Wolfram 语言的代码求这个多项式。……恩,还有点拓展的玩法。

地球人都知道,对于有限数列,找到一个通项公式是简单的。事实上,对于项数为 n 的数列,我们只需不超过 (n-1) 次的多项式。

以下是 Wolfram 语言的代码。

num = 2048;
list = First[RealDigits[num, 10]];
len = Length[list];
fit = Fit[list, Table[y^k, {k, 0, len - 1}], y];
Print[list]; Print@TraditionalForm@fit /. y -> x;
Print@Show[Plot[fit /. y -> x, {x, 0, len + 1}], ListPlot[list]]

这段代码在 Wolfram Mathematica 10.0 将产生以下输出。

无敌拟合代码产生的输出

如果你想玩其他数列,你只需要修改代码第一行中的数字。如果你的数列以 0 开头或者出现了超出 0~9 范围的数,将前两行改为如下所示的一行即可。

list = {1, 9, 4, 9, 1, 0, 0, 1};

你同样能得到一条优美的曲线,精确地穿过你给定的每一个点。这自然得益于 Mathematica 不逊于人的数值功能,同时亦是因为我们有以下结论作为保证。文首曾经提及。

对任意项数为 n 的有限数列,可以找到一个不超过 (n-1) 次的多项式,作为它的通项公式。

……我承认表述得很蹩脚。下面我试着证明它。

设数列为 {a1,a2,a3,…,an},待定多项式 f(x)=b0 + b1x + b2x2 + … + bnxn。对于任意 i = 1,2,3,…,n ,应有 f(i)=ai,由此得方程组

$$\begin{cases}b_{0} + b_{1} + b_{2} + \cdots + b_{n}= a_{1} \\ b_{0} + 2b_{1} + 4b_{2} + \cdots + 2^{n}b_{n}= a_{2} \\ \vdots \quad \quad \quad \vdots \\ b_{0} + nb_{1} + n^{2}b_{2} + \cdots + n^{n}b_{n}= a_{n} \end{cases}$$

好了。数一数,我们有 n 个方程,b0,b1,b2,…,bn 一共 (n+1) 个未知数。当 bi 全为零(i = 0,1,2,…,n),自然万事大吉。否则是非齐次线性方程组,系数矩阵的行向量组线性无关,秩为 n,每个向量增加一个分量后仍线性无关,故增广矩阵秩也为 n,根据线性方程组和矩阵的相关理论,得知这个方程组一定有解。所以符合要求的 f 存在。证毕。

好极了!好开心,这是我首次把线性代数课程学的东西用起来………反正这个证明看起来没什么问题……

回顾一下证明过程,我们注意到, f 不一定要是一个 (n-1) 次多项式。只要它是 (n-1) 个线性无关的函数的线性组合,证明就成立。所以有以下的玩法。

Mathematica 提供的 Fit 函数是很强大滴,它可以接受各种各样的函数,用这些函数的线性组合给出最小二乘拟合。下面的例子,数列是 {1,9,9,6,1,0,0,1},第一组是六个三角函数加上指数、对数、线性函数,第二组是从 0 到 7 次的正弦函数,第三组是个 7 次多项式。效果就比较壮观了。

混入三角、指数对数之后的拟合结果更加壮观。

(完)