Loss scatterplot timeseries ошибки

Question

Я пытаюсь создать кривую лёсса для подмножества временных рядов. Все подмножества, кажется, имеют похожие проблемы при применении лессов, поэтому проблема может быть в моем df но я не уверен, как решить эту проблему.

Данные доступны здесь: https://dl.dropbox.com/s/zy6b5mjcu7uteof/data_all_PAR_max.csv?dl=0

Эта функция является частью более крупной функции, поэтому некоторые значения передаются и определяются здесь, чтобы помочь воспроизвести ошибки:

sumfile <- read.csv('https://dl.dropbox.com/s/zy6b5mjcu7uteof/data_all_PAR_max.csv')
codename = "EXEM"
descriptor = "max"
radtype = "PAR"
totYrs = c(1997:2015)
ylbl = expression("PAR " ~ (mu ~ mol ~ photons ~ m^{-2} ~ s^{-1}))
clr = "blue"

group <- melt(sumfile,  id.vars = 'date', variable.name = 'series')
setnames(group, old = c('date','series','value'), new = c('Date','Year',radtype))
group$Date <- as.Date(group$Date)
# group <- na.omit(group) # uncommenting resolves error!
o <- order(group$Date)
lo <- loess(PAR ~ as.numeric(Date), span = 0.25, data=group)

plot(group$Date,group$PAR,pch=19,cex=0.1, col=clr,
     xlab ="Date",
     ylab = ylbl,
    main = paste('Loess curve for', descriptor, radtype, 'from', min(totYrs), 'to',
              max(totYrs), '\nmeasured at', codename, 'met',sep=' '))
lines(group$Date[o], lo$fitted[o], col='red', lwd=1)

Замена lines за points дает лучшую картину ошибки

points(group$Date[o], lo$fitted[o], col='red', lwd=1)

Сюжет должен выглядеть примерно так:

Фантомные точки кажутся артефактом NA в наборе данных.

Я создал цикл для проверки каждого отдельного года, который обнаружил больше ошибок.

for (i in totYrs) {
  tryCatch({         
    yval <- paste(radtype, i, descriptor,sep='_')

    sumfile$date <- as.Date(sumfile$date)
    lo_ <- eval(parse(text = paste("loess(", yval, "~ as.numeric(date),
                                 span = 0.25, data=sumfile)")))
    oo <- order(sumfile$date)
    plot(sumfile$date, eval(parse(text = paste("sumfile$",yval))),
         pch=19,cex=0.1, col=clr,
         xlab ="Date",
         ylab = ylbl,
         main = paste('Loess curve for', descriptor, radtype, 'measured at\n',
                      codename, 'met during', i, '/', i+1, 'field season',sep=' '))
    lines(sumfile$date[oo], lo_$fitted[oo], col='red', lwd=1)  
  }, error=function(e){print("One or more years was not plotted because there was no data")})
}

Цикл создает график для каждого года и иллюстрирует, как сглаживание кривой работает в течение одних лет, но не других.

настройка loess(y ~ x, na.action=na.exclude) не оказывает никакого влияния на конечные результаты. Добавление group <- na.omit(group) в расплавленном df до loess() устраняет ошибки для этого фрейма данных, но проблема, кажется, сохраняется при рассмотрении отдельных лет. Вот один пример:

sumfile$date <- as.Date(sumfile$date)
no_na <- na.omit(subset(sumfile, select=c(date,PAR_2013_max)))
lo13 <- loess(PAR_2013_max ~ as.numeric(date), span = 0.25, data=no_na)
oo <- order(sumfile$date)
plot(sumfile$date, sumfile$PAR_2013_max)
lines(sumfile$date[oo], lo13$fitted[oo], col='red', lwd=1)

Любая помощь в определении решения для построения годовых кривых очень ценится.

Answer 1

Я думаю, что вы правы относительно того, откуда эти "призрачные" точки. Вы должны иметь возможность пропустить любые значения NA, вот пример с использованием ggplot2:

plot <- ggplot( data = group, aes( x = Date, y = PAR ) ) +
    geom_point( na.rm = TRUE ) +
    geom_smooth( method = "loess", span = 0.2, na.rm = TRUE )
plot

Это дает мне хорошую кривую. Обратите внимание, что переменная "span" определяет уровень сглаживания с помощью функции loess, поэтому настройте его по вкусу или оставьте его, чтобы принять сглаживание по умолчанию.

Это также работает с каждым годом индивидуально:

plot <- ggplot( data = sumfile, aes( x = as.Date( date ), y = PAR_2013_max ) ) +
    geom_point( na.rm = TRUE ) +
    geom_smooth( method = "loess", span = 0.2, na.rm = TRUE )
plot