r - 纠正时间序列中的连续错误
问题描述
由于传感器故障或其他外部因素,我有非常大的连续数据集(> 1M 行)经常“中断”或“跳跃”。这些中断对应于添加或删除的恒定值,并且仅持续有限的时间。我正在尝试将这些序列与其余数据重新对齐。
par(mfrow=c(2,1))
#simulating perfect dataset
dfe<-data.frame(
date=seq(as.Date('2015-07-12'),as.Date('2015-07-12')+49, by = '1 day'),
valueideal=round(sin(seq(1,50,1))+20)
)
#introducing artifacts
dfe$valuer<-dfe$valueideal
dfe$valuer[10:20]<-dfe$valueideal[10:20]+10
dfe$valuer[30:35]<-dfe$valueideal[30:35]-10
#plotting ideal vs real data
plot(dfe$date, dfe$valuer, main="real data", ylim=c(8,32))
plot(dfe$date, dfe$valueideal, main="ideal data", ylim=c(8,32))
所以我的数据看起来像“真实数据”,我希望他们重新调整它们就像“理想数据”。
到目前为止,我已经制作了一个for
循环,除了每个工件的第一个数据点外,它大部分都有效,并且它对其余数据有轻微影响。我不确定为什么或如何解决它:
#trying to solve it with a loop
dfe$valuel<-dfe$valuer
for (i in seq(2,length(dfe$valuel)-1,1)){
future<-diff(c(dfe$valuel[i],dfe$valuel[i+1]))
past<-diff(c(dfe$valuel[i-1],dfe$valuel[i]))
if (abs(future)>2*abs(past)){
dfe$valuel[i:length(dfe$valuel)]<-dfe$valuel[i:length(dfe$valuel)]-future
}
}
plot(dfe$date, dfe$valuel, main="loop corrected data", ylim=c(8,32))
我也担心在我非常大的数据集上使用这种方法,我不确定这需要多长时间。所以我也尝试使用这个R 函数从向量方法中的后续值中减去向量中的连续值之间的差异,但这并不顺利,可能是因为很难选择一个delta_max
相关的值:
#trying to solve it with a vectorised function
remove_artifacts <- function(weights, delta_max) {
# calculate deltas, and set first delta to zero
dw <- c(0, diff(x))
# create vector of zeros and abs(observations) > delta_max
# dw * (logical vector) results in either:
# dw * 0 (if FALSE)
# dw * 1 (if TRUE)
dm <- dw * (abs(dw) > delta_max)
# subtract the cumulative sum of observations > delta_max
return(weights - cumsum(dm))
}
dfe$valuedm<-remove_artifacts(dfe$valuer, 10)
plot(dfe$date, dfe$valuedm, main="remove artifacts function", ylim=c(8,32))
所以我的问题是,我怎样才能有效地纠正这些连续的数据中断?
解决方案
这是一个不完美的解决方案。首先,我使用您的代码来设置问题。
#simulating perfect dataset
dfe<-data.frame(
date=seq(as.Date('2015-07-12'),as.Date('2015-07-12')+49, by = '1 day'),
valueideal=round(sin(seq(1,50,1))+20)
)
#introducing artifacts
dfe$valuer<-dfe$valueideal
dfe$valuer[10:20]<-dfe$valueideal[10:20]+10
dfe$valuer[30:35]<-dfe$valueideal[30:35]-10
接下来,我使用breakpoints
fromstrucchange
包来查找时间序列中的断点。
# Find breakpoints
bp <- strucchange::breakpoints(valuer ~ date, data = dfe)
# Get breakpoints plus start & end of time series
int <- c(1, bp$breakpoints + 1, nrow(dfe))
在这里,我根据断点为数据集添加标签。我已经绘制了包括颜色在内的图表,以查看我们做得如何。(一个落伍者,还不错。)
# Create labels
dfe$label <- cut(1:nrow(dfe),
breaks = int,
include.lowest = TRUE,
right = FALSE)
# Plot "real" data coloured by label
with(dfe, plot(date, valuer, col = label, main="real data", ylim=c(8,32)))
然后我切换到data.table,因为那是我的果酱。
# Load library
library(data.table)
# Convert to data.table
setDT(dfe)
我分组label
,然后使用每个间隔的平均值进行更正。
# Offset by mean
dfe[, corrected := valuer - mean(valuer), by = label]
# Plot again
with(dfe, plot(date, corrected, col = label, main = "Corrected data", ylim = c(-10, 10)))
由reprex 包(v0.2.1.9000)于 2019 年 12 月 2 日创建
掉队者稍微偏离了这个区间,但修正后的解决方案并不糟糕。
TL;博士
# Find breakpoints
bp <- strucchange::breakpoints(valuer ~ date, data = dfe)$breakpoints
# Add start & end points
int <- c(1, bp + 1, nrow(dfe))
# Tag intervals
dfe$label <- cut(1:nrow(dfe),
breaks = int,
include.lowest = TRUE,
right = FALSE)
# Correct by subtracting mean from each interval
data.table::setDT(dfe)[, corrected := valuer - mean(valuer), by = label]
推荐阅读
- crystal-reports - 上传到 .csv 时字段格式不成立
- android - Json 字符串 java bean 对象
- python - 在 TensorFlow 中实现简单的 PPO 代理
- twitter-bootstrap - 在导航项中单击时折叠引导导航栏。在移动视口中
- node.js - 如何使用打字稿扩展快递对象?
- javascript - 异步/等待。解析错误:await 是保留字。JS
- python-3.x - 从 Pandas Agg 绘制阴影误差条
- vba - VBA计数如果为空/空白并在顶行输出 - 循环列数组
- testing - 检查 Windows 身份验证的测试用例
- jquery - 在第一行之后插入