24小时热门版块排行榜

返回列表

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

loujing

铁杆木虫 (正式写手)

应助: 19 (小学生)
金币: 5835.5
散金: 2028
红花: 8
帖子: 322
在线: 110.2小时
虫号: 58180
注册: 2005-02-20
性别: GG
专业: 计算机应用技术

[求助] 关于用Maple或Mathematica实现符号多项式拟合已有1人参与

最近在看李航老师的统计学习方法，想用Maple或Mathematica验证一下第一章中的多项式拟合。

看起来结果都不太对。
这是我异想天开了（这问题用Maple和Mathematica是无法解决的），还是哪里写错了，万望大家指教，十分感谢。

Mathematica：

CODE:

f[Subscript[w, j]] = 1/2 \!\(\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(n\)]\*SuperscriptBox[\((\*UnderoverscriptBox[\(\[Sum]\), \(j = 0\), \(m\)]\*SubscriptBox[\(w\), \(j\)] \*SubsuperscriptBox[\(x\), \(i\), \(j\)] - \*SubscriptBox[\(y\), \(i\)])\), \(2\)]\)

Maple:

CODE:

L := proc (w__j) options operator, arrow; (1/2)*(sum((sum(w__j*x__i^j, j = 0 .. m)-y__i)^2, i = 1 .. n)) end proc

回复此楼

» 猜你喜欢

博士读完未来一定会好吗已经有10人回复
小论文投稿已经有3人回复
Bioresource Technology期刊，第一次返修的时候被退回好几次了已经有9人回复
心脉受损已经有3人回复
到新单位后，换了新的研究方向，没有团队，持续积累2区以上论文，能申请到面上吗已经有8人回复
申请2026年博士已经有6人回复
请问哪里可以有青B申请的本子可以借鉴一下。已经有5人回复

1楼2016-01-08 11:33:37

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

xzczd

木虫 (小有名气)

应助: 72 (初中生)
金币: 1941.4
红花: 11
帖子: 290
在线: 144.2小时
虫号: 3305534
注册: 2014-07-03

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★
loujing: 金币+20, ★★★★★最佳答案 2016-01-11 09:34:03

引用回帖:

20楼: Originally posted by loujing at 2016-01-08 18:15:38
追问一下，在得到这里的联立方程组后，符号推导的工作是不是就可以算结束了？

如果接下来，我给出具体的一组(x_i,y_i)，如何再利用这里的推导，计算出具体的w_j？...

说结束也算结束了，说没结束也没结束，4楼的推导在这之后又多了一步，是把之前的结果写成了矩阵乘法的形式，这个其实是矩阵点乘规则的直接应用，，但是如果你想把这步也交给软件推导的话，我可以告诉你这个规则又是没在Mathematica里内置的。用上面提及的模式匹配当然可以进一步变形……不过，硬变过去真没啥意思（两者在编程实现上的区别也不算很大，而且如果对线代熟悉的话这步变形实际上靠目视即可确认）所以这里就不弄了。

其实，如果一开始的目标就是数值解，或者点数和多项式阶数都是具体的数的解析解的话，整个问题的求解会简单很多……不过既然你非要利用这里的推导的话：

CODE:

(*之前的代码我就不复制了*)

n = 3; m = 2;

points = RandomReal[1, {n, 2}]; 

{x[i_], y[i_]} := {points[[i, 1]], points[[i, 2]]};

var = w /@ Range[0, m];

Solve[Table[eqn, {j, 0, m}], var][[1]]

(var /. %).x^Range[0, m]

Show[Plot[%, {x, Min[points[[All, 1]]], Max[points[[All, 1]]]}], ListPlot[points], 

 PlotRange -> All]

Clear[x, y]

如果要用矩阵形式的那个公式的话：

CODE:

{xlist, ylist} = points\[Transpose];

With[{xm = #^Range[0, m] & /@ xlist}, Solve[ylist.xm == var.xm\[Transpose].xm, var]]

最后，如果一开始就定了阶数的话：

CODE:

f[i_, m_, x_] := Sum[w@j*x[[i]]^j, {j, 0, m}]

l[m_, n_, x_, y_] := 1/2 Sum[(f[i, m, x] - y[[i]])^2, {i, n}];

n = 4; m = 2;

var = w /@ Range[0, m];

{xlist, ylist} = Transpose@RandomReal[1, {n, 2}];

NSolve[D[l[m, n, xlist, ylist], {var}], var]

Show[ListPlot[Transpose[{xlist, ylist}]], 

 Plot[Evaluate[var.x^Range[0, m] /. %], {x, 0, 1}], PlotRange -> All]

最后的最后，虽然知道你是在学习这种方法所以大概对此不太关心，但是，线性拟合在Mathematica里是内置的，你可以看看Fit和LinearModelFit的帮助。