交互式计算电导滴定结果的一种mathematica代码
我还有一个主要从事的行当，是跟化学有关的，之前做的项目里，有一种需求，需要对产品表面的功能性化学基团的浓度进行定量评估。行业里比较流行的、也写进了ISO标准的方法，主要是“电导滴定”。
电导滴定跟其它很多一大类定量分析方法的特点，都是先获取一系列数据点，然后描点、拟合曲线，找不同特征的趋势段，然后找转折点。以前，这种都是要在“坐标纸”上完成的。
有了强大的Wolfram的Notebook式的工具之后，我就想着，如何尽量减少手工操作，也提高效率和准确度，降低人为的失误率。
首先，我是借助了chatgpt 3.5免费的功能，把从Excel里面描的点，转换称mathematica能够识别的脚本的格式。这个直接复制Excel里面规则的数据，然后，让chatgpt帮你对这些数据作图或干点别的，给出mathematica的脚本，就能得到了。
然后有了数据，就是试算、补充和更新、优化代码了。这个程序至少眼前只有我自己知道怎么用，想要让它完全傻瓜式输入数据就直接给出结果还不现实。但分享出来，万一以后自己想看看呢。
ClearAll["Global`*"]
data = {{0, 4.95}, {1, 4.84}, {2, 4.72}, {3, 4.60}, {4, 4.49}, {5,
4.37}, {6, 4.26}, {7, 4.15}, {8, 4.04}, {9, 3.94}, {10,
3.84}, {11, 3.74}, {12, 3.64}, {13, 3.54}, {14, 3.44}, {15,
3.34}, {16, 3.24}, {17, 3.14}, {18, 3.05}, {19, 2.96}, {20,
2.87}, {21, 2.78}, {22, 2.69}, {23, 2.60}, {24, 2.52}, {25,
2.44}, {26, 2.35}, {27, 2.28}, {28, 2.21}, {29, 2.16}, {30,
2.17}, {31, 2.20}, {32, 2.21}, {33, 2.35}, {34, 2.53}, {35,
2.72}, {36, 2.92}, {37, 3.11}, {38, 3.29}, {39, 3.48}, {40,
3.67}, {41, 3.86}, {42, 4.04}, {43, 4.22}, {44, 4.40}, {45,
4.58}, {46, 4.76}, {47, 4.94}};
nnlm = Fit[data, Table[x^n, {n, 0, 12}], x]
(*minMeanMax[min_,max_]:={{min,min},{(max-min)/2,(max+min)/50},{max,\
max}}*)
Show[Plot[nnlm, {x, 0, 50}, PlotStyle -> {Thin, Green},
AxesOrigin -> {0, 1.5}], ListPlot[data, AxesOrigin -> {0, 2}],
Frame -> True, FrameTicks -> Automatic,
Epilog -> {{Red, PointSize -> .015,
Point[Transpose@{(x /. NSolve[D[nnlm, {x, 3}] == 0, x] //
Flatten) //
Cases[#, _Real] &, (nnlm /. NSolve[D[nnlm, {x, 3}] == 0, x] //
Flatten // Cases[#, _Real] &)}]}}]
index[data_, lowB_, upperB_] :=
data[[Position[data, _?(# >= lowB && # <= upperB &)][[;; , 1]]]]
lm01 = LinearModelFit[index[data, 20, 26], x, x];
lm02 = LinearModelFit[index[data, 29, 32], x, x];
lm03 = LinearModelFit[index[data, 34, 38], x, x];
Show[Plot[nnlm, {x, 0, 50}, PlotStyle -> {Blue, Thin, Dashed},
AxesOrigin -> {0, 1.5}],
Plot[Normal@lm01, {x, 0, 45}, PlotStyle -> {Red, Thin}],
Plot[Normal@lm02, {x, 9, 60}, PlotStyle -> {Red, Thin}],
Plot[Normal@lm03, {x, 30, 56}, PlotStyle -> {Red, Thin}],
ListPlot[data], Frame -> True,
Epilog -> {{Red, PointSize -> .015,
Point[Transpose@{(x /. NSolve[D[nnlm, {x, 3}] == 0, x] //
Flatten) //
Cases[#, _Real] &, (nnlm /. NSolve[D[nnlm, {x, 3}] == 0, x] //
Flatten // Cases[#, _Real] &)}]}}]
(Quantity[#, "Milliliters"]*
Quantity[0.09625,
"Moles"/"Liters"]/(Quantity[10.3166, "Grams"]*
Quantity[30, "Milligrams"/"Grams"])) &@((x /.
Solve[Normal@lm01 == Normal@lm02, x]) - (x /.
Solve[Normal@lm02 == Normal@lm03, x]) // Flatten // Last //
Minus) // UnitConvert[#, "Millimoles"/"Grams"] &
(Quantity[#, "Milliliters"]*
Quantity[0.09625,
"Moles"/"Liters"]/(Quantity[10.3166, "Grams"]*
Quantity[16.478, "Milligrams"/"Grams"])) &@((x /.
Solve[Normal@lm01 == Normal@lm02, x]) - (x /.
Solve[Normal@lm02 == Normal@lm03, x]) // Flatten // Last //
Minus) // UnitConvert[#, "Millimoles"/"Grams"] &
(Quantity[#, "Milliliters"]*
Quantity[0.09625,
"Moles"/"Liters"]/(Quantity[7.1817, "Grams"]*
Quantity[139, "Milligrams"/"Grams"])) &@((x /.
Solve[Normal@lm01 == Normal@lm02, x]) - (x /.
Solve[Normal@lm02 == Normal@lm03, x]) // Flatten // Last //
Minus) // UnitConvert[#, "Millimoles"/"Grams"] &