过滤 -- 化工原理实验Mathmatica代码

已于 2024-06-08 19:06:39 修改
阅读量706 收藏 6
点赞数 16
分类专栏： 化工原理实验数据处理 Wolfram Mathmatica 文章标签： 学习 数学建模
于 2024-06-01 14:08:50 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/2302_76770547/article/details/139372869
版权

文章目录

实验代码针对天津大学、重庆理工大学化工原理实验教材设计，若有其他需求，请自行编辑

原始数据记录

序号滤液高/cmp=0.05MPa θ/sp=0.05MPa Δθ/sp=0.10MPa θ/sp=0.10MPa Δθ/sp=0.15MPa θ/sp=0.15MPa Δθ/s
05.00.000.000.000.000.000.00
16.017.6817.6814.6014.609.049.04
27.057.8840.2035.6121.0125.7016.66
38.0117.6459.7664.5328.9148.7423.04
49.0183.4165.7794.7130.1773.9525.21
510.0261.3677.95135.7141.00106.5532.60
611.0359.7098.34183.5847.87141.2834.73
712.0470.81111.11237.5853.99182.1140.83
813.0600.73129.92296.6559.06225.9543.84
914.0857.51256.78381.1284.47280.9555.00
1014.5(第一组为14.5，二三组为15)3521.722664.21813.05431.92401.56120.61

尝试：拿第一组实验数据建立基本流程

(*导入数据*)
importedData = Import[" D : \\ WolframMathmatica \\ 过滤实验数据 . xlsx "];

selectedData1 = importedData[[1, 3 ;; 13, {2, 3, 4}]];
selectedData2 = importedData[[1, 3 ;; 13, {2, 5, 6}]];
selectedData3 = importedData[[1, 3 ;; 13, {2, 7, 8}]]

(*选取数据*)
data = selectedData3;

(*计算 \[CapitalDelta]q*)
a = 0.0475;
deltaV = 9.446*10^-4;
deltaQ = deltaV/a;

(*计算 \[CapitalDelta]\[Theta] 和 \
\[CapitalDelta]\[Theta]/\[CapitalDelta]q*)
deltaThetaList = Differences[data[[All, 2]]];
deltaQList = Table[deltaQ, {Length[deltaThetaList]}];
deltaThetaOverDeltaQList = deltaThetaList/deltaQList;
qList = Prepend[Table[0.05 + i*deltaQ, {i, Length[deltaThetaList]}], 
   0.05];

(*取中点值拟合*)
qToFitList = MovingAverage[qList, 2];
deltaThetaOverDeltaQToFitList = deltaThetaOverDeltaQList;

(*数据配对*)
fitData = Transpose[{qToFitList, deltaThetaOverDeltaQToFitList}];

(*线性拟合*)
fit = LinearModelFit[fitData, x, x];

(*提取斜率和截距*)
kValue = fit["BestFitParameters"][[1]];
qEIntercept = fit["BestFitParameters"][[2]];

(*去掉最后一个数据点并重新进行拟合*)
fitDataWithoutLastPoint = Most[fitData]; 
fitWithoutLastPoint = LinearModelFit[fitDataWithoutLastPoint, x, x];

(*添加自身结尾点确保最右端辅助线边界存在*) 
AppendTo[deltaThetaOverDeltaQList, deltaThetaOverDeltaQList[[-1]]];

(*输出结果*)
Print[fit]
Print["拟合直线斜率：", kValue];
Print["拟合直线截距：", qEIntercept];

Show[
 ListPlot[fitData, PlotStyle -> Red, PlotMarkers -> {Automatic, 5}, 
  AxesLabel -> {"q 值", "\[CapitalDelta]\[Theta]/\[CapitalDelta]q"}, 
  PlotRange -> {{0, 0.30}, All}, Frame -> True,
  PlotLegends -> Placed[{"  Fit Data"}, {Left, Top}]],
 Plot[fit[x], {x, Min[qToFitList], 0.26}, 
  PlotStyle -> {Blue, Thickness[0.003]},
  PlotLegends -> Placed[{"Fit Line"}, {Left, Top}]],
 Plot[fitWithoutLastPoint[x], {x, Min[qToFitList], 0.26}, 
  PlotStyle -> {Green, Thickness[0.003]},
  PlotLegends -> 
   Placed[{"Fit Line Without Last Point"}, {Left, Top}]], 
 Epilog -> {Flatten@
    Table[{{Black, Dashed, 
       Line[{{qList[[i]], 0}, {qList[[i]], 
          deltaThetaOverDeltaQList[[i]]}}]}, {Black, 
       Line[{{qList[[i]], 
          deltaThetaOverDeltaQList[[i]]}, {qList[[i + 1]], 
          deltaThetaOverDeltaQList[[i]]}}]}, {Black, Dashed, 
       Line[{{qList[[i + 1]], 0}, {qList[[i + 1]], 
          deltaThetaOverDeltaQList[[i + 1]]}}]}}, {i, 
      Length[qList] - 1}]}]

尝试：Mathmatica代码效果图

在这里插入图片描述

尝试：输出结果

参数值
拟合直线斜率-1245.22
拟合直线截距21846.1

在这里插入图片描述

函数化流程

(*函数：过滤实验拟合*)
FilterFitting[data_List] := 
 Module[{a, deltaV, deltaQ, deltaThetaList, deltaQList, 
   deltaThetaOverDeltaQList, qList, qToFitList, 
   deltaThetaOverDeltaQToFitList, fitData, fit, 
   fitDataWithoutLastPoint, fitWithoutLastPoint, kValue, qEIntercept},
   a = 0.0475;
  deltaV = 9.446*10^-4;
  deltaQ = deltaV/a;
  deltaThetaList = Differences[data[[All, 2]]];
  deltaQList = Table[deltaQ, {Length[deltaThetaList]}];
  deltaThetaOverDeltaQList = deltaThetaList/deltaQList;
  qList = 
   Prepend[Table[0.05 + i*deltaQ, {i, Length[deltaThetaList]}], 
    0.05];
  qToFitList = MovingAverage[qList, 2];
  deltaThetaOverDeltaQToFitList = deltaThetaOverDeltaQList;
  fitData = Transpose[{qToFitList, deltaThetaOverDeltaQToFitList}];
  fit = LinearModelFit[fitData, x, x];
  kValue = fit["BestFitParameters"][[1]];
  qEIntercept = fit["BestFitParameters"][[2]];
  fitDataWithoutLastPoint = Most[fitData];
  fitWithoutLastPoint = 
   LinearModelFit[fitDataWithoutLastPoint, x, x];
  AppendTo[deltaThetaOverDeltaQList, deltaThetaOverDeltaQList[[-1]]];
  {qToFitList, deltaThetaOverDeltaQToFitList, fitData, fit}]

(*函数：过滤实验作图*)
FilterPlot[data_List] := 
 Module[{a, deltaV, deltaQ, deltaThetaList, deltaQList, 
   deltaThetaOverDeltaQList, qList, qToFitList, 
   deltaThetaOverDeltaQToFitList, fitData, fit, 
   fitDataWithoutLastPoint, fitWithoutLastPoint, kValue, qEIntercept, 
   plot}, a = 0.0475;
  deltaV = 9.446*10^-4;
  deltaQ = deltaV/a;
  deltaThetaList = Differences[data[[All, 2]]];
  deltaQList = Table[deltaQ, {Length[deltaThetaList]}];
  deltaThetaOverDeltaQList = deltaThetaList/deltaQList;
  qList = 
   Prepend[Table[0.05 + i*deltaQ, {i, Length[deltaThetaList]}], 
    0.05];
  qToFitList = MovingAverage[qList, 2];
  deltaThetaOverDeltaQToFitList = deltaThetaOverDeltaQList;
  fitData = Transpose[{qToFitList, deltaThetaOverDeltaQToFitList}];
  fit = LinearModelFit[fitData, x, x];
  kValue = fit["BestFitParameters"][[1]];
  qEIntercept = fit["BestFitParameters"][[2]];
  fitDataWithoutLastPoint = Most[fitData];
  fitWithoutLastPoint = 
   LinearModelFit[fitDataWithoutLastPoint, x, x];
  Print[fit];
  Print["拟合直线斜率：", kValue];
  Print["拟合直线截距：", qEIntercept];
  AppendTo[deltaThetaOverDeltaQList, deltaThetaOverDeltaQList[[-1]]];
  plot := 
   Show[ListPlot[fitData, PlotStyle -> Red, 
     PlotMarkers -> {Automatic, 5}, 
     AxesLabel -> {"q 值", "\[CapitalDelta]\[Theta]/\[CapitalDelta]q"},
      PlotRange -> {{0, 0.30}, All}, Frame -> True, 
     PlotLegends -> Placed[{" Fit Data"}, {Left, Top}]], 
    Plot[fit[x], {x, Min[qToFitList], 0.26}, 
     PlotStyle -> {Blue, Thickness[0.003]}, 
     PlotLegends -> Placed[{"Fit Line"}, {Left, Top}]], 
    Plot[fitWithoutLastPoint[x], {x, Min[qToFitList], 0.26}, 
     PlotStyle -> {Green, Thickness[0.003]}, 
     PlotLegends -> 
      Placed[{"Fit Line Without Last Point"}, {Left, Top}]], 
    Epilog -> {Flatten@
       Table[{{Black, Dashed, 
          Line[{{qList[[i]], 0}, {qList[[i]], 
             deltaThetaOverDeltaQList[[i]]}}]}, {Black, 
          Line[{{qList[[i]], 
             deltaThetaOverDeltaQList[[i]]}, {qList[[i + 1]], 
             deltaThetaOverDeltaQList[[i]]}}]}, {Black, Dashed, 
          Line[{{qList[[i + 1]], 0}, {qList[[i + 1]], 
             deltaThetaOverDeltaQList[[i + 1]]}}]}}, {i, 
         Length[qList] - 1}]}];
  plot]

(*导入数据*)
importedData = Import["D:\\WolframMathmatica\\过滤实验数据.xlsx"];
selectedData1 = importedData[[1, 3 ;; 13, {2, 3, 4}]];
selectedData2 = importedData[[1, 3 ;; 13, {2, 5, 6}]];
selectedData3 = importedData[[1, 3 ;; 13, {2, 7, 8}]];
{qToFitList1, deltaThetaOverDeltaQToFitList1, fitData1, fit1} = 
  FilterFitting[selectedData1];
Print["拟合直线：", fit1];
plot1 = FilterPlot[selectedData1]

{qToFitList2, deltaThetaOverDeltaQToFitList2, fitData2, fit2} = 
  FilterFitting[selectedData2];
Print["拟合直线：", fit2];
plot2 = FilterPlot[selectedData2]

{qToFitList3, deltaThetaOverDeltaQToFitList3, fitData3, fit3} = 
  FilterFitting[selectedData3];
Print["拟合直线：", fit3];
plot3 = FilterPlot[selectedData3]

函数化流程：Mathmatica代码效果图

在这里插入图片描述

函数化流程：输出结果

拟合直线斜率拟合直线截距
-41471.396036.

在这里插入图片描述

拟合直线斜率拟合直线截距
-6054.8767879.6

在这里插入图片描述

拟合直线斜率拟合直线截距
-1245.2221846.1

在这里插入图片描述

函数功能去重

Clear["Global`*"]

FilterfitLineting[selectedData_List] :=
 Module[
  {a, deltaV, deltaQ, deltaThetaList, deltaQList, 
   deltaThetaOverDeltaQList, qList, qMeanTofitLineList, 
   deltaThetaOverDeltaqMeanTofitLineList, fitCoordinates, fitLine, 
   fitCoordinatesWithoutLastPoint, fitLineWithoutLastPoint, kValue, 
   qEIntercept}, a = 0.0475;
  deltaV = 9.446*10^-4;
  deltaQ = deltaV/a;
  deltaThetaList = Differences[selectedData[[All, 2]]];
  deltaQList = Table[deltaQ, {Length[deltaThetaList]}];
  deltaThetaOverDeltaQList = deltaThetaList/deltaQList;
  qList = 
   Prepend[Table[0.05 + i*deltaQ, {i, Length[deltaThetaList]}], 
    0.05];
  qMeanTofitLineList = MovingAverage[qList, 2];
  deltaThetaOverDeltaqMeanTofitLineList = deltaThetaOverDeltaQList;
  fitCoordinates = 
   Transpose[{qMeanTofitLineList, 
     deltaThetaOverDeltaqMeanTofitLineList}];
  fitLine = LinearModelFit[fitCoordinates, x, x];
  kValue = fitLine["BestFitParameters"][[1]];
  qEIntercept = fitLine["BestFitParameters"][[2]];
  fitCoordinatesWithoutLastPoint = Most[fitCoordinates];
  fitLineWithoutLastPoint = 
   LinearModelFit[fitCoordinatesWithoutLastPoint, x, x];
  AppendTo[deltaThetaOverDeltaQList, deltaThetaOverDeltaQList[[-1]]];
  {a, deltaV, deltaQ, deltaThetaList, deltaQList, 
   deltaThetaOverDeltaQList, qList, qMeanTofitLineList, 
   deltaThetaOverDeltaqMeanTofitLineList, fitCoordinates, fitLine, 
   fitCoordinatesWithoutLastPoint, fitLineWithoutLastPoint, kValue, 
   qEIntercept}]
FilterPlot[selectedData_List, fitCoordinates_, fitLine_, 
  fitLineWithoutLastPoint_, qMeanTofitLineList_] :=
 Module[
  {plot},
  plot = 
   Show[ListPlot[fitCoordinates, PlotStyle -> Red, 
     PlotMarkers -> {Automatic, 5}, 
     AxesLabel -> {"q 值", "\[CapitalDelta]\[Theta]/\[CapitalDelta]q"},
      PlotRange -> {{0, 0.30}, All}, Frame -> True, 
     PlotLegends -> Placed[{" fitLine selectedData"}, {Left, Top}]], 
    Plot[fitLine[x], {x, Min[qMeanTofitLineList], 0.26}, 
     PlotStyle -> {Blue, Thickness[0.003]}, 
     PlotLegends -> Placed[{"fitLine Line"}, {Left, Top}]], 
    Plot[fitLineWithoutLastPoint[x], {x, Min[qMeanTofitLineList], 
      0.26}, PlotStyle -> {Green, Thickness[0.003]}, 
     PlotLegends -> 
      Placed[{"fitLine Line Without Last Point"}, {Left, Top}]], 
    Epilog -> {Flatten@
       Table[{{Black, Dashed, 
          Line[{{qList[[i]], 0}, {qList[[i]], 
             deltaThetaOverDeltaQList[[i]]}}]}, {Black, 
          Line[{{qList[[i]], 
             deltaThetaOverDeltaQList[[i]]}, {qList[[i + 1]], 
             deltaThetaOverDeltaQList[[i]]}}]}, {Black, Dashed, 
          Line[{{qList[[i + 1]], 0}, {qList[[i + 1]], 
             deltaThetaOverDeltaQList[[i + 1]]}}]}}, {i, 
         Length[qList] - 1}]}];
  Print[fitLine];
  Print["拟合直线斜率：", fitLine["BestFitParameters"][[1]]];
  Print["拟合直线截距：", fitLine["BestFitParameters"][[2]]];
  {plot}]

importedData = Import["D:\\WolframMathmatica\\过滤实验数据.xlsx"];
plots = {};
Do[
 selectedData = importedData[[1, 3 ;; 13, {2, 3 + 2 i, 4 + 2 i}]];
 {a, deltaV, deltaQ, deltaThetaList, deltaQList, 
   deltaThetaOverDeltaQList, qList, qMeanTofitLineList, 
   deltaThetaOverDeltaqMeanTofitLineList, fitCoordinates, fitLine, 
   fitCoordinatesWithoutLastPoint, fitLineWithoutLastPoint, kValue, 
   qEIntercept} = FilterfitLineting[selectedData];
 plot = FilterPlot[selectedData, fitCoordinates, fitLine, 
   fitLineWithoutLastPoint, qMeanTofitLineList];
 AppendTo[plots, plot];, {i, 0, 2}
 ]
plots

函数功能去重：Mathmatica代码效果图

在这里插入图片描述

函数功能去重：输出结果

拟合直线斜率拟合直线截距
-41471.396036.

在这里插入图片描述

拟合直线斜率拟合直线截距
-6054.8767879.6

在这里插入图片描述

拟合直线斜率拟合直线截距
-1245.2221846.1

在这里插入图片描述
需要注意的是,若尝试在同一坐标轴下展示所有图形，可能报错

向阳a非࿐
关注
  • 16
    点赞
  • 踩
  • 6
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
专栏目录
tsil-mma:用于TSIL的Mathematica接口
04-05
TSIL-Mma TSIL-MMA提供了双回路自能积分库中...Mma 要构建TSIL-Mma，首先创建一个构建子目录，然后输入该目录： mkdir buildcd build 然后，调用cmake搜索Mathematica安装以及TSIL库和头文件： cmake -DTSIL_DIR=/path
vim-mathematica：Vim的Mathematica语法突出显示（以及更多）
02-01
安装 `vim-mathematica` 通常涉及克隆或下载 `vim-mathematica-master` 压缩包，然后将其解压到 Vim 的插件目录。对于现代 Vim，通常使用包管理器如 Vundle 或 NeoBundle 来简化安装过程。配置文件 `.vimrc` 需要...
【LaTeX】 案例分析 (8) - 高等数学分析 Mathematica 实验报告
Teddy van Jerry的博客
01-06 1967
这是 SEU 工科数学分析的 Mathematica 实验报告。 代码 效果 ALL RIGHTS RESERVED © 2021 Teddy van Jerry 欢迎转载，转载请注明出处。 See also Teddy van Jerry 的导航页
工具-2：数据拟合Mathematica
SemiconductorPhysics
04-19 354
工具-2：数据拟合Mathematica
matlab寻峰代码,寻峰的函数！！ - 程序语言 - MATLAB/Mathematica - 小木虫论坛-学术科研互动平台...
weixin_34673225的博客
03-18 617
我这里的数据是pgm的，我将其处理成多个高斯拟合的形式，现阶段只能将其最大的那个拟合出来，其他的高斯拟合我需要找到其峰值的位置！我把前边的语句先列举上：function [ OutArr ] = Graph( NameFile, PlotOut, Angl)InputVar = nargin;DAT=importdata(NameFile);if (InputVar>2)Angle = An...
八行代码实现图像分类-神一样的Mathematica
weixin_45600501的博客
01-18 2323
八行代码实现图像分类-神一般的mathematica工具
Mathematica仿真竞争性Lotka-Volterra方程(3种群)
weixin_44873868的博客
10-12 2018
根据演化生物学家恩斯特.麦尔的定义，物种是：能够相互配育的自然种群的类群，且这些类群与其它的类群在生殖上相互隔离。考虑3个具有Logistic动力学的3个种群和，在Lotka-Volterra公式的基础上添加额外的项来解释物种的相互作用。这个演示，除去必要的核心功能要点外，可以选择坐标轴是否显示数值，选择静态/动态设置显示出的坐标轴的最大值，还可以标定最后物种的数目比例。直观的理解（可能不严谨），种群是物种的子集，值的是某物种在一定范围内的个体集合。方程中并不显含时间，我们称这样的ODE是自治的。
matlab代码sqrt-mathematica-symbolic-toolbox:Matlab中的mathematica
05-23
Matlab代码sqrt Mathematica符号工具箱（版本3.0，2018年5月19日）（请勿与符号数学工具箱混淆） 此回购的内容包含一个MATLAB可执行文件的源math.c，该文件可通过其MathLink技术（更确切地说是Wolfram符号传输协议...
mathematica-comsol:从Wolfram Mathematica到COMSOL Multiphysics之间的链接
05-14
从Wolfram Mathematica到COMSOL Multiphysics之间的链接。 目前，它从COMSOL导出或参数文件导入表数据。 用法 安装软件包的。 Import[file_ , \"COMSOL\"]从comsol expor txt文件导入数据。 Import[file, {\...
PKUTreehole-Mathematica:PKU树洞的Mathematica软件包和GUI
05-12
北大树Kong数学用于PKU的Treehole和漂亮的GUI的完整API。 我讨厌编写README文件，仅此而已，请自己尝试！
quantum-utils-mathematica:用于Mathematica的QuantumUtils是面向量子信息科学家的软件库
05-16
Mathematica的QuantumUtils 用于Mathematica的QuantumUtils是面向量子信息科学家的软件库。 功能包括： 多部分张量操纵量子系统建模，包括量子点，电路，自旋和腔自旋和腔系统的符号李代数简化多种表示形式的量子...
mathematica-keygen_mathematica_keygen_
10-03
Widely admired for both its technical prowess and elegant ease of use
matlab终止以下代码-Tableau-Mathematica-integration:将Mathematica的计算能力和数据集与Tabl
05-21
matlab终止以下代码Mathematica和Tableau集成 Tableau 10.3引入了一项功能，可通过名为tabpy的库将python与tableau集成。 从2021.1版开始，tableau可与R，Python和Matlab等外部服务一起使用。 现在，您可以在Tableau...
matlab中算法实现代码实现原理-wolfram-papers:使用Mathematica和/或Wolfram技术的科学论文
05-20
matlab中算法实现代码实现原理RationalizeRoots：平方根合理化的软件包 出版物：计算机物理通信 作者：Besier，MarcoWasser，PascalWeinzierl，Stefan Bibcode： Feynman积分的计算通常涉及平方根。 获得多个对数的...
matlab求导代码-mmapkg:Mathematica软件包
05-24
本文将深入探讨MATLAB如何进行求导，并介绍与"mmapkg"相关的Mathematica软件包。 首先，MATLAB的`diff`函数适用于数值数组，可以计算一维数组的差分，从而间接求导。例如，如果你有一个函数的离散样本点，你可以...
matlab非参数代码-Mathematica-MATLAB:用于将Mathematica语法转换为MATLAB代码的实用程序包
06-08
Mathematica-MATLAB 用于将 Mathematica 语法转换为 MATLAB 代码的 Wolfram 语言包。 它最初由 Harri Ojanen 创建，但为了功能和清晰度已经更新和修改。 安装 将ToMatlab.wl下载到您机器上的某个永久位置。 您可以...
seats-problem.rar_Mathematica程序
07-14
一个用mathematica程序编写的关于座位问题的程序，有实用性。
matlab微分方程代码-Mathematica-Code-Collection:一些写过的mathematica代码
05-23
Mathematica-Code-Collection 一些写过的mathematica代码 mathematica是大二的时候上《数值计算方法》的时候现学现用的。这门课用到mathematica的地方主要是数值积分、矩阵运算、微分方程、迭代解方程/方程组等。 ...
jburkardt-math:John Burkardt 的 Mathematica 软件大集合的官方 Git 镜像
06-02
MATHEMATICA 笔记本和包 这是与一起使用的笔记本文件和包的集合。 ，其接受任意的（但非负）的权重函数在时间间隔的公式，并确定各点和对应的高斯求积规则的权重，由福田，胜也，Alt键和Matveenko的程序。 ，一个...
hands-on start to wolfram mathematica
最新发布
08-29
书中首先介绍 Mathematica 的基本概念和界面，包括如何创建和编辑代码、调用内置函数等。 接下来，书中通过一系列具体问题的解决方案来展示 Mathematica 的实际应用。例如，如何使用 Mathematica 进行数值计算、...

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

向阳a非࿐

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付：¥1
获取中
扫码支付

您的余额不足，请更换扫码支付或充值

打赏作者

实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值