我有两个数据集,我使用R的lm
命令进行绘制。
下面的第一个图不是以红线为中心。
但是右边的第二张图是以线为中心的。
我的问题是:
我用来绘制数据的代码很简单:
data <-read.table("myfile.txt")
dat1x <- data$x1
dat1y <- data$y1
# plot left figure
dat1_lm <- lm(dat1x ~ dat1y)
plot(dat1x ~ dat1y)
abline(coef(dat1_lm),col="red")
dat1_lm.r2 <- summary(dat1_lm)$adj.r.squared;
# repeat the the same for right figure
dat2x <- data$x2
dat2y <- data$y2
dat2_lm <- lm(dat2x ~ dat2y)
plot(dat2x ~ dat2y)
abline(coef(dat2_lm),col="red")
dat2_lm.r2 <- summary(dat2_lm)$adj.r.squared;
更新 情节与RMSE得分:
我正在寻找一个分数,根据预测线的数据居中,显示右图比左边好。
答案 0 :(得分:5)
R平方给出了线的拟合优度,即由线性模型解释的数据集中的变化百分比。解释R平方的另一种方法是模型比平均模型表现得更好。 p值给出拟合的显着性,即线性模型的系数与零显着不同。
要提取这些值:
dat = data.frame(a = runif(100), b = runif(100))
lm_obj = lm(a~b, dat)
rsq = summary(lm_obj)[["r.squared"]]
p_value = summary(lm_obj)[["coefficients"]]["b","Pr(>|t|)"]
或者,您可以计算观察值与线性模型结果之间的RMSE:
rmse = sqrt(mean((dat$a - predict(lm_obj))^2))
请注意,这是a
的RMSE和线性模型。如果您希望RMSE为a
和b
:
rmse = sqrt(mean((dat$a - dat$b)^2))
答案 1 :(得分:1)
您可能正在寻找的是MAPE(平均绝对百分比误差)。它优于其他精度测量(MSE,MPE,RMSE,MAE等)的优点是MAPE不依赖于水平,它测量绝对错误,它具有明确的含义。您可以使用包forecast
来获取其中一些措施:
library(forecast)
data <- data.frame(y = rnorm(100), x = rnorm(100))
model <- lm(y ~ x, data)
accuracy(model)
# ME RMSE MAE MPE MAPE
# 5.455773e-18 1.019446e+00 7.957585e-01 1.198441e+02 1.205495e+02
accuracy(model)["MAPE"]
# MAPE
# 120.5495
或
mape <- function(f, x) mean(abs(1 - f / x) * 100)
mape(fitted(model), data$y)
# [1] 120.5495
另一方面,可能看起来MPE(平均百分比误差)更好地显示数据在预测线周围的中心位置,例如,让预测为p <- rep(2, 20)
,数据为y <- rep(c(3,1), 10)
,然后为MPE = 0
,但为MAPE = 100%
。
所以你应该决定你真正想要展示什么,MAPE更好地衡量准确性,但对于你的第二个例子,MPE可能是更好的选择。
更新:如果它确实是您要检查的中心,您应该查看没有任何正方形,绝对值等的错误求和的度量。也就是说,您也可能想要看看ME(平均误差),它比MPE稍微简单,但有不同的解释。这是一个有点类似于你的第一个例子的例子:
mpe <- function(f, x) mean((1 - f / x) * 100)
mape <- function(f, x) mean(abs(1 - f / x) * 100)
me <- function(f, x) mean(x - f)
set.seed(20130130)
y1 <- rnorm(1000, mean = 10, sd = 1.5) * (1:1000) / 300
y2 <- rnorm(1000, mean = 10, sd = 1.7) * (1:1000) / 250
pr <- (1:1000) / 30
data <- data.frame(y = c(y1, y2),
x = 1:1000,
prediction = rep(pr, 2),
id = rep(1:2, each = 1000))
results <- data.frame(MAPE = c(mape(pr, y1), mape(pr, y2)),
MPE = c(mpe(pr, y1), mpe(pr, y2)),
ME = c(me(pr, y1), me(pr, y2)),
id = 1:2)
results <- round(results, 2)
ggplot(data, aes(x, y)) + geom_line() + theme_bw() +
facet_wrap(~ id) + geom_line(aes(y = prediction), colour = "red") +
theme(strip.background = element_blank()) + labs(y = NULL, x = NULL) +
geom_text(data = results, x = 150, y = 50, aes(label = paste("MAPE:", MAPE))) +
geom_text(data = results, x = 150, y = 45, aes(label = paste("MPE:", MPE))) +
geom_text(data = results, x = 150, y = 40, aes(label = paste("ME:", ME)))