zzu数学 实验四数列之3n+1问题

zzu数学 实验四数列之3n+1问题

源代码示例

series[a_] :=
Module[{a1 = a, an = {a}},
Do[a1 = If[Mod[a1, 2] == 1, 3 a1 + 1, a1/2]; AppendTo[an, a1];
If[Length[an] >= 3 && an[[-1]] == 1 && an[[-2]] == 2,
Break[]], {10000}]; an]

Do[
m = 4 k + 1;
Print[series[m]], {k, 1, 10}]

TableForm[
Table[{n, Length[series
] - 1}, {n, 10, 50}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "F(n)"}}(*给出行列指标*)]

Gn[n_] :=
Position[series
,
Select[series
, # < series
[[1]] &, 1][[1]]][[1]][[1]] - 2;
ubc[n_] := N[Max[Table[Gn[k]/Log[k], {k, 2, n}]]];
TableForm[
Table[{n, Gn
, N[Log
], N[Gn
/Log
], ubc
}, {n, 3, 100,
2}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "G(n)", "Log
", "c", "c的上界"}}(*给出行列指标*)]

T[n_]:=Max[series
]
ubK[m_]:=N[Max[Table[T
/n^2,{n,1,m}]]]
TableForm[
Table[{n, T
, n^2,N[T
/n^2],ubK
}, {n, 2, 1000,
15}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "T(n)", "n^2", "K","K的上界"}}(*给出行列指标*)]

E1[n_] := Module[{en = 0}, s = series
;
For[i = 2, i <= Length[s], i++, If[s[[i]] < s[[i - 1]], en++]]; en]
O1[n_] := Length[series
] - E1
- 1
divUB[m_] := Max[Table[O1
/E1
, {n, 1, m}]]
TableForm[
Table[{n, O1
, E1
, O1
/E1
, divUB
}, {n, 1, 1000,
10}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "O(n)", "E(n)", "O(n)/E(n)",
"O(n)/E(n)的上界"}}(*给出行列指标*)]
point=Table[O1
/E1
,{n,1,1000,5}];
ListPlot[point]

斐波契那数列

n = 10;
f = {1, 1};
Do[AppendTo[f, f[[i - 2]] + f[[i - 1]]], {i, 3, n}]
f
(**)

a = TimeUsed[];
m = 20000;
fn = Table[Fibonacci
, {n, m}];
ListPlot[fn, Joined -> True]
lfn = Log[fn];
lfnfit = Fit[lfn, {1, n}, n];
co = CoefficientList[lfnfit, n];
fe = E^co[[1]]*(E^co[[2]])^n;
fitfn = Table[fe /. n -> n, {n, 1, m}];
error = Abs[fn - fitfn];
Sum[error[[i]]/fn[[i]], {i, 1, m}]
ListPlot[error]
nfe = (5^(-1/2))*((((1 + 5^(1/2))/2)^n - ((1 - 5^(1/2))/2)^n));
nfn = Table[nfe /. n -> n, {n, 1, m}];
error2 = Abs[N[fn - nfn]]
Sum[error2[[i]]/fn[[i]], {i, 1, m}]
timeused = TimeUsed[] - a
(*当m=200000时，耗时52 .407秒，计算出累积误差相对达到了1 .80243*10^-7，说明此公式并不是通项公式。*)

第一次数学实验报告

1、 问题描述

（ 1） 对于形如n = 4k + 1等类型的奇数， 观察数列中是否会出现小于 n 的项；

（ 2） 航班 n 的上界F（ n） 与 n 存在一个什么函数关系？ 当 n 适当大后，是否有F（ n）< n；

（ 3） 航班 n 的保持高度航程G（ n） 的上界是否是c ∗ log(n)?其中， c 为一常数；

（ 4） 航班 n 的最大飞行高度T（ n） 与 n 的关系如何？ 是否有T（ n） < kn2?K 为常数。

（ 5） O(n)/E(n)的上界是什么？ 当 n 趋于无穷时， O(n)/E(n)的极限是否存在？如存在，它是什么。

2、 解决方案

（ 1） 编写函数 series，产生无穷数列，显示到末尾为 4,2,1 一列数，对 n=1 和 2 时特殊处理；以n = 4k + 1为例， 产生若干个数列， 观察数列中是否有小于 n 的项。

（ 2） 当 n 适当大时，以表格形式列出 n 与F（ n） 的值，观察是否有界

F(n)<n

。

（ 3） 编写航班 n 的保持高度航程函数 G（ n） ,思想是使用 select 函数挑选出第一个比前一个数小的数，并且使用 position 函数定位。需要注意的是，此时 n 不能为 1。编写比值 c 的上界函数 ubc，表示前 n 个 c 的最大值。同样列出表格，观察 c 是否恒有上界。

（ 4） 方法与（ 3）类似。

（ 5） 编写 O（ n） 和 E（ n）以及它们比值上界的函数，根据比值上界的变化趋势，推测两者比值的极限。

3、 程序

共用函数：
series[a_] := Module[{a1 = a, an = {a}}, Do[a1 = If[Mod[a1, 2] == 1, 3 a1 + 1,
a1/2];AppendTo[an, a1];If[Length[an] >= 3 && an[[-1]] == 1 && an[[-2]] == 2, Break[]],
{10000}];an]
（ 1）
Do[
m = 4 k + 1;
Print[series[m]], {k, 1, 10}]
（ 2）
TableForm[
Table[{n, Length[series
] - 1}, {n, 10, 50}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "F(n)"}}(*给出行列指标*)]
（ 3）
Gn[n_] :=
Position[series
,
Select[series
, # < series
[[1]] &, 1][[1]]][[1]][[1]] - 2;
ubc[n_] := N[Max[Table[Gn[k]/Log[k], {k, 2, n}]]];
TableForm[
Table[{n, Gn
, N[Log
], N[Gn
/Log
], ubc
}, {n, 3, 100,
2}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "G(n)", "Log
", "c", "c 的上界"}}(*给出行列指标*)]
（ 4）
T[n_]:=Max[series
]
ubK[m_]:=N[Max[Table[T
/n^2,{n,1,m}]]]
TableForm[
Table[{n, T
, n^2,N[T
/n^2],ubK
}, {n, 2, 1000,
15}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "T(n)", "n^2", "K","K 的上界"}}(*给出行列指标*)]
（ 5） E1[n_] := Module[{en = 0}, s = series
;
For[i = 2, i <= Length[s], i++, If[s[[i]] < s[[i - 1]], en++]]; en]
O1[n_] := Length[series
] - E1
- 1
divUB[m_] := Max[Table[O1
/E1
, {n, 1, m}]]
TableForm[
Table[{n, O1
, E1
, N[O1
/E1
], divUB
}, {n, 1, 1000,
10}](*给出表格形式，大括号表示要列出的元素*),
TableHeadings -> {{}, {"n", "O(n)", "E(n)", "O(n)/E(n)",
"O(n)/E(n)的上界"}}(*给出行列指标*)]