Графік розрахункових схилів, як і в питанні, - це чудова річ. Замість того, щоб фільтрувати за значимістю, хоча - або спільно з нею - чому б не викласти якийсь показник того, наскільки кожна регресія відповідає даним? Для цього середня квадратична помилка регресії легко інтерпретується та має значення.
Як приклад, наведений Rнижче код генерує часовий ряд з 11 растрових, виконує регресії та відображає результати трьома способами: у нижньому ряду, як окремі сітки оцінених схилів та середніх помилок у квадраті; у верхньому ряду, як накладання цих сіток разом із справжніми основними схилами (яких на практиці у вас ніколи не буде, але це забезпечується комп’ютерним моделюванням для порівняння). Накладення, оскільки він використовує колір для однієї змінної (орієнтовний нахил) та легкість для іншої (MSE), непросто інтерпретувати в цьому конкретному прикладі, але разом з окремими картами в нижньому рядку може бути корисним та цікавим.
(Будь ласка, проігноруйте перекладені легенди про накладку. Також зауважте, що кольорова схема для карти "Справжні схили" не зовсім така, як для карт передбачуваних схилів: випадкова помилка призводить до того, що деякі з оцінених схилів охоплюють a більш екстремальний діапазон, ніж справжні схили. Це загальне явище, пов'язане з регресією до середнього .)
До речі, це не найефективніший спосіб зробити велику кількість регресій за один і той же набір разів: натомість матрицю проекції можна попередньо обчислити і застосувати до кожного "стека" пікселів швидше, ніж перекомпонувати її для кожної регресії. Але це не має значення для цієї невеликої ілюстрації.
# Specify the extent in space and time.
#
n.row <- 60; n.col <- 100; n.time <- 11
#
# Generate data.
#
set.seed(17)
sd.err <- outer(1:n.row, 1:n.col, function(x,y) 5 * ((1/2 - y/n.col)^2 + (1/2 - x/n.row)^2))
e <- array(rnorm(n.row * n.col * n.time, sd=sd.err), dim=c(n.row, n.col, n.time))
beta.1 <- outer(1:n.row, 1:n.col, function(x,y) sin((x/n.row)^2 - (y/n.col)^3)*5) / n.time
beta.0 <- outer(1:n.row, 1:n.col, function(x,y) atan2(y, n.col-x))
times <- 1:n.time
y <- array(outer(as.vector(beta.1), times) + as.vector(beta.0),
dim=c(n.row, n.col, n.time)) + e
#
# Perform the regressions.
#
regress <- function(y) {
fit <- lm(y ~ times)
return(c(fit$coeff[2], summary(fit)$sigma))
}
system.time(b <- apply(y, c(1,2), regress))
#
# Plot the results.
#
library(raster)
plot.raster <- function(x, ...) plot(raster(x, xmx=n.col, ymx=n.row), ...)
par(mfrow=c(2,2))
plot.raster(b[1,,], main="Slopes with errors")
plot.raster(b[2,,], add=TRUE, alpha=.5, col=gray(255:0/256))
plot.raster(beta.1, main="True slopes")
plot.raster(b[1,,], main="Estimated slopes")
plot.raster(b[2,,], main="Mean squared errors", col=gray(255:0/256))
