Eu tenho uma linha de melhor ajuste. Preciso de pontos de dados que não alterem minha linha de melhor ajuste

Estou fazendo uma apresentação sobre linhas de montagem. Eu tenho uma função linear simples, . Estou tentando obter pontos de dados dispersos que posso colocar em um gráfico de dispersão que manterá minha linha de melhor ajuste na mesma equação.$y=1x+b$

Eu adoraria aprender essa técnica no R ou no Excel - o que for mais fácil.

Escolha qualquer $(x_i)$ desde que pelo menos dois deles sejam diferentes. Defina uma interceptação $\beta_0$ e a inclinação $\beta_1$ e defina

Este ajuste é perfeito. Sem alterar o ajuste, você pode modificar $y_0$ para $y = y_0 + \varepsilon$ adicionando qualquer vetor de erro $\varepsilon=(\varepsilon_i)$ a ele, desde que ortogonal ao vetor $x = (x_i)$ e ao vetor constante $(1,1,\ldots, 1)$ . Uma maneira fácil de obter esse erro é escolher qualquer vetor $e$ e ser $\varepsilon$ os resíduos após a regressão de $e$contra $x$ . No código abaixo, $e$ é gerado como um conjunto de valores normais aleatórios independentes com média $0$ e desvio padrão comum.

Além disso, você pode até mesmo pré-selecionar a quantidade de dispersão, talvez, estipulando que $R^2$ deve ser. Deixando $\tau^2 = \text{var}(y_i) = \beta_1^2 \text{var}(x_i)$ , redimensione novamente os resíduos para ter uma variação de

Este método é totalmente geral: todos os exemplos possíveis (para um determinado conjunto de $x_i$ ) podem ser criados dessa maneira.

Exemplos

Quarteto de Anscombe

Podemos facilmente reproduzir o Quarteto de Anscombe de quatro conjuntos de dados bivariados qualitativamente distintos com as mesmas estatísticas descritivas (até segunda ordem).

O código é notavelmente simples e flexível.

set.seed(17)
rho <- 0.816                                             # Common correlation coefficient
x.0 <- 4:14
peak <- 10
n <- length(x.0)

# -- Describe a collection of datasets.
x <- list(x.0, x.0, x.0, c(rep(8, n-1), 19))             # x-values
e <- list(rnorm(n), -(x.0-peak)^2, 1:n==peak, rnorm(n))  # residual patterns
f <- function(x) 3 + x/2                                 # Common regression line

par(mfrow=c(2,2))
xlim <- range(as.vector(x))
ylim <- f(xlim + c(-2,2))
s <- sapply(1:4, function(i) {
  # -- Create data.
  y <- f(x[[i]])                                         # Model values
  sigma <- sqrt(var(y) * (1 / rho^2 - 1))                # Conditional S.D.
  y <- y + sigma * scale(residuals(lm(e[[i]] ~ x[[i]]))) # Observed values

  # -- Plot them and their OLS fit.
  plot(x[[i]], y, xlim=xlim, ylim=ylim, pch=16, col="Orange", xlab="x")
  abline(lm(y ~ x[[i]]), col="Blue")

  # -- Return some regression statistics.
  c(mean(x[[i]]), var(x[[i]]), mean(y), var(y), cor(x[[i]], y), coef(lm(y ~ x[[i]])))
})
# -- Tabulate the regression statistics from all the datasets.
rownames(s) <- c("Mean x", "Var x", "Mean y", "Var y", "Cor(x,y)", "Intercept", "Slope")
t(s)

A saída fornece estatísticas descritivas de segunda ordem para os dados $(x,y)$ de cada conjunto de dados. Todas as quatro linhas são idênticas. Você pode criar facilmente mais exemplos alterando x(as coordenadas x) e e(os padrões de erro) desde o início.

Simulações

R$y$$\beta=(\beta_0,\beta_1)$$R^2$$0 \le R^2 \le 1$$x$

simulate <- function(x, beta, r.2) {
  sigma <- sqrt(var(x) * beta[2]^2 * (1/r.2 - 1))
  e <- residuals(lm(rnorm(length(x)) ~ x))
  return (y.0 <- beta[1] + beta[2]*x + sigma * scale(e))
}

(Não seria difícil portar isso para o Excel - mas é um pouco doloroso.)

$(x,y)$$60$ $x$$\beta=(1,-1/2)$$1$$-1/2$$R^2 = 0.5$

n <- 60
beta <- c(1,-1/2)
r.2 <- 0.5   # Between 0 and 1

set.seed(17)
x <- rnorm(n)

par(mfrow=c(1,4))
invisible(replicate(4, {
  y <- simulate(x, beta, r.2)
  fit <- lm(y ~ x)
  plot(x, y)
  abline(fit, lwd=2, col="Red")
}))

summary(fit)$R^2$$x_i$