Mathematica编程技巧与算法实践

table {
border-collapse: collapse;
width: 100%;
margin-bottom: 1rem;
}
th, td {
border: 1px solid #ddd;
padding: 8px;
text-align: left;
}
th {
background-color: #f2f2f2;
}
tr:nth-child(even) {
background-color: #f9f9f9;
}
pre {
background-color: #f8f8f8;
padding: 15px;
border-radius: 4px;
overflow-x: auto;
}

121、构建一个二维整数格点图形。首先创建一个坐标点对的列表，然后用线条连接合适的坐标对（使用Graphics[Line[…]]），再用Graphics[Point[…]]添加点。

以下是一个简单示例代码用于构建二维整数格点图形：

m = 5; (* 定义格点范围 *)
coords = Flatten[Table[{i, j}, {i, 0, m}, {j, 0, m}], 1]; (* 创建坐标点列表 *)
lines = {}; (* 创建连接线条 *)
For[i = 1, i <= m + 1, i++,
  For[j = 1, j <= m, j++,
    lines = Append[lines, Line[{(i - 1)*(m + 1) + j, (i - 1)*(m + 1) + j + 1}]];
    lines = Append[lines, Line[{(j - 1)*(m + 1) + i, j*(m + 1) + i}]]
  ]
];
points = Graphics[Point[coords]];
linesGraphics = Graphics[lines];
Show[points, linesGraphics]

上述代码创建了一个

m x m

的二维整数格点图形，你可以根据需要调整

m

的值来改变格点范围。

122、找出以下列表中数字 9 的位置，并使用 Position 函数进行验证。列表为 {{2, 1, 10}, {9, 5, 7}, {2, 10, 4}, {10, 1, 9}, {6, 1, 6}}

可以使用

Position

函数来找出列表中数字 9 的位置，代码为：

Position[{{2, 1, 10}, {9, 5, 7}, {2, 10, 4}, {10, 1, 9}, {6, 1, 6}}, 9]

其结果将显示数字 9 在列表中的位置。

123、确定区间 [4302407360, 4302407713] 中是否存在质数。若存在，返回该区间内明确的质数。

要解决此问题，可先使用

Range

函数生成该区间的整数列表，再用

PrimeQ

函数判断每个数是否为质数，结合

Position

函数找出质数的位置，最后用

Extract

函数提取出这些质数。示例代码如下：

ints = Range[4302407360, 4302407713];
pos = Position[PrimeQ[ints], True];
primes = Extract[ints, pos];

PrimeQ

函数用于判断一个数是否为质数

Position

函数用于查找列表中满足条件的元素位置

Extract

函数用于根据位置提取元素

124、使用Part函数提取列表中偶数索引位置的元素和奇数索引位置的元素。已知输入为 In[1]:= lis = RandomInteger[{1, 20}, {12}] ，输出为 Out[1]= {5, 3, 3, 8, 17, 3, 3, 4, 20, 2, 11, 13}，请完成元素提取操作。

要提取偶数索引元素可使用

Part[lis, {2, 4, 6, 8, 10, 12}]

；提取奇数索引元素可使用

Part[lis, {1, 3, 5, 7, 9, 11}]

。

125、使用Table创建一个 3×3 的单位矩阵。创建完成后，再次使用Table对对角线上及对角线以上的所有元素求和。

使用

Table

创建矩阵的示例代码如下（创建一个 3×3 的单位矩阵）：

mat = Table[If[i == j, 1, 0], {i, 3}, {j, 3}]

对对角线上及以上元素求和的示例代码如下：

sum = Sum[mat[[i, j]], {i, 1, 3}, {j, i, 3}]

126、重新排列1到10的数字列表，使得输出中任意相邻的数字（例如1和2、2和3等）都不相邻。

一个可能的排列是{1, 3, 5, 7, 9, 2, 4, 6, 8, 10} 。

127、制作前10000个斐波那契数中首位数字出现频率的直方图，并说明此现象与本福特定律的关联。本福特定律指出在多种数据中首位数字的出现频率有一定规律，如数字1大约出现30%的时间，数字2大约出现17.6%的时间等，该现象已被证明存在于著名的数值序列、人口统计、死亡率、斐波那契数等诸多数据中，甚至被用于检测企业和税务欺诈。

可按以下步骤实现：

生成前10000个斐波那契数；

提取每个斐波那契数的首位数字；

统计每个首位数字出现的频率；

用绘图工具（如Mathematica、Python的Matplotlib库等）制作直方图。

以Mathematica为例代码如下：

F[1] = 1;
F[2] = 1;
F[n_] := F[n - 2] + F[n - 1];
fibNums = Table[F[i], {i, 1, 10000}];
leadingDigits = IntegerDigits[#][[1]] & /@ fibNums;
hist = Histogram[leadingDigits, {Range[1, 9]}, "Probability"]

制作出的前10000个斐波那契数中首位数字出现频率的直方图所呈现的分布是本福特定律的一个实例，符合本福特定律所描述的首位数字出现频率规律。

128、给定一个矩阵，使用列表元素赋值来交换任意两行。

在 Mathematica 中，可通过类似

mat[[{i, j}]] = mat[[{j, i}]]

（其中

mat

是矩阵，

i

和

j

是要交换的行索引）的方式来交换矩阵的任意两行。

129、创建一个函数 AddColumn [mat, col, pos]，该函数将列向量 col 插入到矩阵 mat 中由 pos 指定的列位置。例如，若有矩阵 mat = RandomInteger[9, {4, 4}]，调用 AddColumn[mat, {a, b, c, d}, 3] 可将列向量 {a, b, c, d} 插入到矩阵 mat 的第 3 列位置。

在 Mathematica 中可以这样实现：

AddColumn[mat_, col_, pos_] := Module[{left, right}, 
  left = Take[mat, All, ;; pos - 1]; 
  right = Take[mat, All, pos ;;]; 
  Transpose[Join[Transpose[left], {col}, Transpose[right]]]
]

此代码先将矩阵按插入位置分成左右两部分，再将列向量插入中间，最后进行转置得到结果。

130、从列表{1, 2, 3, 4}和{a, b, c, d}开始，创建列表{2, 4, b, d}，然后创建列表{1, a, 2, b, 3, c, 4, d}。

在 Mathematica 中可使用以下代码解决：

创建列表

{2, 4, b, d}

：

Join[Take[{1, 2, 3, 4}, {2, 4, 2}], Take[{a, b, c, d}, {2, 4, 2}]]

创建列表

{1, a, 2, b, 3, c, 4, d}

：

Flatten[Transpose[{{1, 2, 3, 4}, {a, b, c, d}}]]

131、编写你自己的函数 randomChoice [lis, n]，该函数进行有放回的随机抽样，其中 n 是从列表 lis 中选取的元素数量。例如，输入 randomChoice[{a, b, c, d, e, f, g, h}, 12] ，可能的输出为 {e, c, h, b, g, c, d, c, b, c, b, f}。

randomChoice[lis_, n_] := Table[RandomChoice[lis], {n}]

132、导入一个包含一些文本的文件，并找出出现频率最高的二十个单词组合。像这样分组的单词对被称为二元组，即 n = 2 时的 n – 元组。使用 TextWords（Mathematica 10.1 新增）将长字符串拆分为单词列表，然后可以使用列表操作函数对其进行操作。

实现步骤如下：

导入文件获取文本；

使用

TextWords

拆分文本为单词列表；

生成二元组；

统计各二元组出现频率；

找出频率最高的二十个二元组。

在 Mathematica 中示例代码如下：

text = Import["文件路径"];
wordList = TextWords[text];
bigrams = Partition[wordList, 2, 1];
bigramCounts = Tally[bigrams];
sortedBigrams = SortBy[bigramCounts, Last, Greater];
top20Bigrams = Take[sortedBigrams, 20];
top20Bigrams[[All, 1]]

需将“文件路径”替换为实际文件路径。

133、使用 Characters 和 StringJoin 函数编写你自己的用户自定义函数，以实现与 StringInsert 和 StringDrop 相同的操作。

以下是示例代码：

对于实现

StringInsert

功能的函数，假设插入字符串到指定位置：

MyStringInsert[str_, insStr_, pos_] := StringJoin[
  Take[Characters[str], pos - 1], 
  Characters[insStr], 
  Drop[Characters[str], pos - 1]
]

对于实现

StringDrop

功能的函数，假设删除指定位置开始的若干字符：

MyStringDrop[str_, start_, length_] := StringJoin[
  Take[Characters[str], start - 1], 
  Drop[Characters[str], start + length - 1]
]

134、修改 MakeRef 函数，使其在作者信息行的末尾显示出版年份。调整样式，使年份以粗体字体显示。

大致思路是在

MakeRef

函数里获取出版年份，添加到作者信息行末尾，并使用

Style

函数将年份设置为粗体。假设关联中存在

Year

键来存储出版年份，修改后的代码可能如下：

MakeRef[ref_] := CellPrint[
  TextCell[
    Row[{
      makeAuthor[ref] <> " (" <> Style[ref["Year"], Bold] <> ")",
      makeTitle[ref],
      makeLink[ref]
    }, " "] , 
    "Text", 
    ShowStringCharacters -> False
  ]
]

135、确定可用于匹配符号表达式x/y的正确模式。

可使用Pattern[x_ / y_] 来匹配。

136、编写一个名为 Collatz 的函数，该函数接受一个整数 n 作为参数。如果 n 是奇数，则返回 3n + 1；如果 n 是偶数，则返回 n/2。

可编写如下函数：

Collatz[n_Integer] := If[OddQ[n], 3 n + 1, n / 2]

此函数使用

If

条件判断，若

n

为奇数（通过

OddQ[n]

判断），返回

3 n + 1

；若

n

为偶数，返回

n / 2

。

137、使用其他方式编写一个函数 abs[x]，当 x 是整数或有理数时，如果 x ≥ 0 则返回 x，如果 x < 0 则返回 -x。当 x 是复数时，abs[x] 应返回复数的模（即实部与虚部的平方和的平方根），请编写该函数。

可通过以下几种方式定义

x

为整数或有理数时的

abs[x]

：

方式一：使用条件运算符

/;


Clear[abs];
abs[x_] := x /; x ≥ 0;
abs[x_] := -x /; x < 0

方式二：将条件写在左边

Clear[abs];
abs[x_ /; x ≥ 0] := x;
abs[x_ /; x < 0] := -x

当处理复数时，可在上述基础上添加对复数的处理，例如：

Clear[abs];
abs[x_?NumberQ] := If[Im[x] == 0, If[x >= 0, x, -x], Sqrt[Re[x]^2 + Im[x]^2]]

这里使用了

Mathematica

语言：

?NumberQ

用于判断

x

是否为数字

Im[x]

用于获取复数的虚部

Re[x]

用于获取复数的实部

Sqrt

用于计算平方根

138、给定一组由代码 In[12]:= rawData = RandomVariate[NormalDistribution[0, 2], {200}]; 生成的数据，移除所有异常值，这里异常值的定义是与数据均值的偏差大于两个标准差。

可使用以下代码实现：

mean = Mean[rawData];
std = StandardDeviation[rawData];
filteredData = Select[rawData, Abs[# - mean] <= 2 * std &];

此代码先计算数据的均值和标准差，然后使用

Select

函数筛选出与均值偏差不超过两个标准差的数据点，得到移除异常值后的数据集。

139、使用模式匹配和重复替换定义一个函数来对列表中的元素求和。

可以定义函数

sumList[{x__}] := Total[{x}]

实现此功能。

140、编写一个函数来计算任何多项式表达式中的乘法总数。例如，对于一个幂，函数应返回指数减 1 的结果。如输入

MultiplyCount[t^5]

应输出 4，输入

MultiplyCount[a * x * y * t]

应输出 3，输入

MultiplyCount[a * x * y * t^4 + w * t]

应输出 7。

该函数

MultiplyCount

需具备识别多项式中乘法运算数量的功能，对于幂运算，返回

指数减 1

的值；对于多个变量相乘，返回

变量数量减 1

的值；对于多项式相加的情况，需分别计算各部分乘法数量后求和。

141、创建六个图形对象，每个对象代表一个标准六面骰子的一个面。Dice[n] 应该显示相应骰子的面。然后使用 Dice 函数创建一个 RollDice[] 函数，该函数“掷”两个骰子并将它们并排显示。创建一个额外的规则 RollDice[n]，该规则掷一对骰子 n 次，并将结果以列表或行的形式显示。一种解决此问题的方法是将骰子的面看作一个由九个元素组成的网格，其中一些元素处于开启状态（白色），一些处于关闭状态（蓝色）。然后为每个骰子面创建一组规则。一旦定义了规则，就可以使用类似下面的图形代码来创建图像：Dice[n_] := GraphicsGrid[Map[Graphics, Partition[Range[9], 3] /. rules[[n]], {2}]

思路是将骰子面看作九元素网格，为每个面定义规则，可借助如  
`Dice[n_] := GraphicsGrid[Map[Graphics, Partition[Range[9], 3] /. rules[[n]], {2}]]`  
这样的代码创建图形对象。  

要实现 `RollDice[]` 函数，可随机生成两个 1 到 6 之间的整数，然后用 `Dice` 函数显示这两个骰子面；  
`RollDice[n]` 函数则循环 n 次进行同样操作并显示结果。  

具体代码实现需进一步补充规则和完善函数。

142、创建一个谓词函数compositeQ，用于测试一个正整数是否为合数。将其与内置的CompositeQ函数进行验证。

compositeQ[n_Integer?Positive] := !PrimeQ[n]

可以使用一些正整数作为参数，分别调用

compositeQ

和内置的

CompositeQ

函数，比较它们的结果是否一致来进行验证。例如：

{compositeQ[4], CompositeQ[4]}


{compositeQ[7], CompositeQ[7]}


143、给定一个两列的数据数组，创建一个由三列组成的新数组，其中前两列与原数组相同，但第三列由前两列对应位置两个数字的平均值组成。

可使用编程语言如Python实现，示例代码如下：

import numpy as np

# 示例两列数组
original_array = np.array([[1, 2], [3, 4], [5, 6]])

# 计算第三列（前两列对应位置的平均值）
third_column = (original_array[:, 0] + original_array[:, 1]) / 2

# 将第三列添加到原数组中
new_array = np.column_stack((original_array, third_column))

print(new_array)

144、给定一个由Plot生成的图形，使用变换规则将构建该图形的每个点的y坐标减半，然后显示结果。

可使用以下代码实现：

假设图形为

plot

，首先提取点，然后将 y 坐标减半，最后重新构建图形并显示。代码示例如下：

pts = First@Cases[plot, Line[coords_List] -> coords, Infinity];
newPts = Map[{#[[1]], #[[2]]/2} &, pts];
newPlot = Graphics[Line[newPts]];
Show[newPlot]

这里假设图形中只有

Line

类型的对象，若有其他类型，可能需要调整代码。

145、扩展数硬币的示例，使函数接受硬币图像作为参数。

可按以下思路解决：

首先需确定不同硬币图像的特征

然后建立图像特征与硬币价值的规则映射

接着在函数中使用模式匹配将图像替换为对应价值

最后计算总价值

例如，可利用图像处理技术识别图像特征，再用类似的规则进行处理：

{图像特征1 → 价值1, 图像特征2 → 价值2, ...}

通过上述规则进行替换和计算。

146、编写另一个

FindSubsequence

定义，使其接受两个整数作为参数，实现功能为在第一个整数

digits

中查找第二个整数

subseq

作为子序列出现的起始和结束位置，并返回包含这些位置的列表。

可以通过将整数转换为数字列表，再使用查找子序列的逻辑来实现该函数。例如

FindSubsequence[n, 965]

应返回

{{181, 183}, {197, 199}}

。

147、利用历史全球地表温度数据，绘制一个图表，展示每年与1950 – 1980年平均温度的摄氏度差值。数据可从众多来源获取，包括美国国家航空航天局戈达德太空研究所（NASA 2015）。导入数据后，需要去除页眉和页脚信息，然后将{年份, 年平均温度}对输入到时间序列（TimeSeries）中。使用日期列表绘图（DateListPlot）来绘制图表，并在原始数据图的基础上添加一个平滑的五年移动平均线。

一般步骤如下：

从NASA戈达德太空研究所导入历史全球地表温度数据；

去除数据中的页眉和页脚信息；

提取{年份, 年平均温度}数据对；

计算每年与1950 – 1980年平均温度的差值；

将处理后的数据倒入TimeSeries；

使用DateListPlot绘制原始数据图；

计算五年移动平均线并添加到图表中。

148、使用Partition和Mean创建两项移动平均值，然后再创建三项移动平均值，并将结果与内置的MovingAverage函数进行核对。

可以按以下思路操作：

对于两项移动平均值：

使用

Partition

将列表按两项一组分割

再用

Mean

计算每组平均值

对于三项移动平均值：

同样使用

Partition

按三项一组分割

再用

Mean

计算每组平均值

最后与内置的

MovingAverage

函数计算结果核对

示例代码：

In[1]:= MovingAverage[{a, b, c, d, e}, 2]

149、找出所有恰好包含1到9这九个数字各一次的平方数。

可通过编写代码，遍历可能的数字范围，使用

SquareNumberQ

函数判断是否为平方数，并检查其是否恰好包含 1 到 9 这九个数字各一次来求解。

150、定义一个谓词函数PerfectQ[n]，如果n是一个完全数（即n等于其所有真因数之和），则该函数返回True。创建一个函数PerfectSearch[n]，用于找出小于n的所有完全数。然后找出小于106的所有完全数。

可通过遍历小于

n

的数，使用

PerfectQ

函数判断是否为完全数，若是则添加到结果列表中。在程序中实现此功能后，运行程序即可得到小于 106 的所有完全数。

示例代码（以 Mathematica 为例）：

PerfectSearch[n_] := Select[Range[1, n - 1], PerfectQ];
PerfectSearch[106]

151、编写一个可复用的函数PrimesLessThan[n]，该函数返回所有小于n的质数。

PrimesLessThan[n]函数可以这样实现：

Clear[n, p, lis]
PrimesLessThan[n_Integer?Positive] := Module[{lis = Range[n], p},
  For[p = 2, p ≤ Floor[Sqrt[n]], p++,
   Do[lis[[i]] = 1, {i, 2 p, n, p}]];
  DeleteCases[lis, 1]
]
PrimesLessThan::badarg = "PrimesLessThan was called with noninteger argument `1`.";
PrimesLessThan[n__] := Message[PrimesLessThan::badarg, n]

152、创建一个函数 LeadingDigit[n]，该函数接受一个整数 n 作为参数，并返回 n 的首位数字。设置你的函数，使其能够返回一组数字（如前 10000 个斐波那契数）的首位数字。

可使用以下代码实现：

LeadingDigit[n_] := First[IntegerDigits[n]];
leadingDigits = LeadingDigit /@ Table[Fibonacci[i], {i, 1, 10000}];

153、给定平面上的一组点，找出能完全包围这些点的边界矩形。对于三维空间中的点集，找出边界平行六面体。

可通过找出点集在各坐标轴上的最大和最小值来确定边界矩形或平行六面体。具体如下：

对于平面点集

：

找出 x 坐标的最大值和最小值

找出 y 坐标的最大值和最小值

从而确定矩形边界

对于三维点集

：

找出 x 坐标的最大值和最小值

找出 y 坐标的最大值和最小值

找出 z 坐标的最大值和最小值

从而确定平行六面体边界

154、创建一个函数 ToEdges[lis]，该函数接受一个元素对列表，并将其转换为适合图的有向边列表。确保该函数在其参数是单个元素对列表的情况下也能正常工作。

以下是一个可能的 Mathematica 实现：

ToEdges[lis_] := 
  If[Length[lis] == 1 && Head[lis[[1]]] === List, 
   {DirectedEdge @@ lis[[1]]}, 
   Map[DirectedEdge @@ # &, lis]
  ]

此代码定义了

ToEdges

函数，它会先检查输入是否为单个元素对列表，若是则直接创建有向边，若不是则对列表中的每个元素对应用有向边操作。