R语言做的坐标轴归一化程序

实际的曲线采集仪器，往往采集的坐标轴数据不统一，因此比如吸收谱乘以光源光谱这样的操作都无法进行。我这里设计了一个基于LOESS拟合的小程序，可以重新定义坐标轴，这样就可以把不同设备采集的曲线数据用相同坐标轴展示，从而可以进行例如光透过物质后光谱的模拟计算。

两个曲线抓图生成数据网站：

WebPlotDigitizer

https://automeris.io/

其代码为：

rm(list = ls())#清空工作区，可在括号内加装变量等定向清除某个变量等
#install.packages("readxl")
library(readxl)
#install.packages("dplyr")
library(dplyr)
#install.packages("lattice")
library(lattice)
#install.packages("gridExtra")
library(gridExtra)
#install.packages("reshape2")
library(reshape2)
#install.packages("RColorBrewer")
library(RColorBrewer)
colormap<-colorRampPalette(rev(brewer.pal(11,'RdYlGn')))(100)
file_path<-file.choose()#在此标注加载文件目录，如E:\工作
#检测到的光谱数据所在目录，数据结构第一行是列名
par(mfrow = c(1,1))#画图设置
dir.create("D:/R_figure")#创建目录，如果已存在会警告，但不影响
setwd("D:/R_figure")#似乎现在工作目录修正不接受中文了
getwd()
mydata <- read_excel(file_path)
z1<-mydata
library(stats)
x<-z1$`波长（nm）`#光谱数据第一行在excel中定义
y<-z1$光谱光强
new_xmin<-round(min(x) * 10) / 10
new_xmax<-round(max(x) * 10)/  10
new_x <-seq(new_xmin,new_xmax,by=0.1)#小数点后保留一位
fit<-loess(y~x,span=0.01)#这里根据plot绘图结果进行微调
light <- predict(fit, newdata=data.frame(x=new_x))#采用loess拟合，并生成基于
#精度为0.1nm的新X轴的曲线拟合值
lightspectral<-cbind(new_x,light)
plot(x,y)
lines(new_x,light)#观察拟合效果，如果拟合效果不好，微调span值

startspectral1<-2511.8#
stopspectral1<-5400#设置需要保留的波长范围
lightstart<-round((startspectral1-new_xmin1)*10+1)
lightstop<-round((stopspectral1-new_xmin1)*10+1)
lightrange<-lightspectral[lightstart:lightstop,]

title<-paste("light range",".csv")
write.table(lightrange, file=title,row.names=FALSE,col.names=FALSE,sep=',')