Question

我正在分析从放置在候鸟上的地理定位器收集的一些数据。简而言之，我的数据是日出和日落时间，然后用于确定地球上的位置。

我使用GeoLight包（http://cran.r-project.org/web/packages/GeoLight/GeoLight.pdf）来识别外围数据 - 具体来说，我使用的是LoessFilter函数，该函数应用多项式回归并识别大于3个等间距范围的残差（由k中的k指定）应用函数时的代码）

我的问题是：该函数返回图表，其中异常数据点以红色标识。代码本身似乎存在关于返回TRUE或FALSE语句的问题，说明哪些点是异常值 - 所有都被声明为TRUE，即使识别出异常值。

因此我修改了功能代码以说明哪些残差是异常值。

然而，当我从原始数据集中删除这些行并重新运行该函数时，这些点尚未被删除。因此，残差与原始数据中的值有关之间存在一些差异：即，如果输出表明残差78是一个边缘点，则从原始数据中删除行78不会删除外围数据点。

我非常感谢帮助删除使用该功能识别的异常数据点。这似乎是一个非常简单的修复，但我似乎无法弄明白。

以下全部功能和数据的代码

由于艾玛

log2$tFirst<-as.POSIXlt(log2$tFirst)
log2$tSecond<-as.POSIXlt(log2$tSecond)

要获得剩余的代码

i.get.outliers<-function(residuals, k=3) {
  x <- residuals

#x是残差的向量 #k是衡量在指出该点是异常值之前要采用的四分位数范围的度量＃看起来3是k的好预设

QR<-quantile(x, probs = c(0.25, 0.75))
IQR<-QR[2]-QR[1]
Lower.band<-QR[1]-(k*IQR)
Upper.Band<-QR[2]+(k*IQR)
delete<-which(x<Lower.band |  x>Upper.Band)
return(as.vector(delete))
}

黄土滤波器功能代码

loessFilter <- function(tFirst, tSecond, type, k=3, plot=TRUE){
tw <- data.frame(datetime=as.POSIXct(c(tFirst,tSecond),"UTC"),type=c(type,ifelse(type==1,2,1)))
tw <- tw[!duplicated(tw$datetime),]
tw <- tw[order(tw[,1]),]

hours <- as.numeric(format(tw[,1],"%H"))+as.numeric(format(tw[,1],"%M"))/60

for(t in 1:2){
cor <- rep(NA, 24)
for(i in 0:23){
  cor[i+1] <- max(abs((c(hours[tw$type==t][1],hours[tw$type==t])+i)%%24 -
                        (c(hours[tw$type==t],hours[tw$type==t][length(hours)])+i)%%24),na.rm=T)
}
hours[tw$type==t] <- (hours[tw$type==t] + (which.min(round(cor,2)))-1)%%24
}

dawn <- data.frame(id=1:sum(tw$type==1),
                 datetime=tw$datetime[tw$type==1],
                 type=tw$type[tw$type==1],
                 hours = hours[tw$type==1], filter=FALSE)

dusk <- data.frame(id=1:sum(tw$type==2),
                 datetime=tw$datetime[tw$type==2],
                 type=tw$type[tw$type==2],
                 hours = hours[tw$type==2], filter=FALSE)


for(d in seq(30,k,length=5)){

predict.dawn <- predict(loess(dawn$hours[!dawn$filter]~as.numeric(dawn$datetime[!dawn$filter]),span=0.1))
predict.dusk <- predict(loess(dusk$hours[!dusk$filter]~as.numeric(dusk$datetime[!dusk$filter]),span=0.1))

del.dawn <- i.get.outliers(as.vector(residuals(loess(dawn$hours[!dawn$filter]~
                                                       as.numeric(dawn$datetime[!dawn$filter]),span=0.1))),k=d)
del.dusk <- i.get.outliers(as.vector(residuals(loess(dusk$hours[!dusk$filter]~
                                                       as.numeric(dusk$datetime[!dusk$filter]),span=0.1))),k=d)

if(length(del.dawn)>0) dawn$filter[!dawn$filter][del.dawn] <- TRUE
if(length(del.dusk)>0) dusk$filter[!dusk$filter][del.dusk] <- TRUE
}

if(plot){
par(mfrow=c(2,1),mar=c(3,3,0.5,3),oma=c(2,2,0,0))
plot(dawn$datetime[dawn$type==1],dawn$hours[dawn$type==1],pch="+",cex=0.6,xlab="",ylab="",yaxt="n")
lines(dawn$datetime[!dawn$filter], predict(loess(dawn$hours[!dawn$filter]~as.numeric(dawn$datetime[!dawn$filter]),span=0.1)) , type="l")
points(dawn$datetime[dawn$filter],dawn$hours[dawn$filter],col="red",pch="+",cex=1)
axis(2,labels=F)
mtext("Sunrise",4,line=1.2)

plot(dusk$datetime[dusk$type==2],dusk$hours[dusk$type==2],pch="+",cex=0.6,xlab="",ylab="",yaxt="n")
lines(dusk$datetime[!dusk$filter], predict(loess(dusk$hours[!dusk$filter]~as.numeric(dusk$datetime[!dusk$filter]),span=0.1)), type="l")
points(dusk$datetime[dusk$filter],dusk$hours[dusk$filter],col="red",pch="+",cex=1)
axis(2,labels=F)
legend("bottomleft",c("Outside filter","Inside filter"),pch=c("+","+"),col=c("black","red"),
       bty="n",cex=0.8)
mtext("Sunset",4,line=1.2)
mtext("Time",1,outer=T)
mtext("Sunrise/Sunset hours (rescaled)",2,outer=T)
}
all <- rbind(subset(dusk,filter),subset(dawn,filter))

filter <- rep(FALSE,length(tFirst))
filter[tFirst%in%all$datetime | tSecond%in%all$datetime] <- TRUE

＃original code： #return（！滤波器）

＃changed code to return outliersreturn（del.dusk）＃替换下面的代码打印外围点

return(c("delete dawn",del.dawn,"delete dusk",del.dusk))

}

申请功能 loessFilter（log2 $ tFirst，log2 $ tSecond，type = 1，k = 4，plot = TRUE）

删除值 - 需要删除日出和日落曲线

log2b<-log2[-c(77,78,124,125),]
length(log2$tFirst)
length(log2b$tFirst)

重复功能以查看值是否已经消失

loessFilter(log2b$tFirst, log2b$tSecond, type=1, k=4, plot=TRUE)

异常值仍在那里!!

这里是数据： http://www.4shared.com/file/jxVuTsVHce/002_geolight.html

在此处发布完整数据有点太长了，示例不能使用虚拟数据集：）

识别残差中的边远数据点（GeoLight包）

0 个答案: