Regressão segmentada

library(segmented)

Dados de oferta e demanda de produtos.

demand <- c(1155, 362, 357, 111, 703, 494, 410, 63, 616, 468, 973, 235,
            180, 69, 305, 106, 155, 422, 44, 1008, 225, 321, 1001, 531, 143,
            251, 216, 57, 146, 226, 169, 32, 75, 102, 4, 68, 102, 462, 295,
            196, 50, 739, 287, 226, 706, 127, 85, 234, 153, 4, 373, 54, 81,
            18)
offer <- c(39.3, 23.5, 22.4, 6.1, 35.9, 35.5, 23.2, 9.1, 27.5, 28.6, 41.3,
           16.9, 18.2, 9, 28.6, 12.7, 11.8, 27.9, 21.6, 45.9, 11.4, 16.6,
           40.7, 22.4, 17.4, 14.3, 14.6, 6.6, 10.6, 14.3, 3.4, 5.1, 4.1,
           4.1, 1.7, 7.5, 7.8, 22.6, 8.6, 7.7, 7.8, 34.7, 15.6, 18.5, 35,
           16.5, 11.3, 7.7, 14.8, 2, 12.4, 9.2, 11.8, 3.9)

dados = data.frame(Demanda = demand, Oferta = offer)
require(ggplot2)
qplot(Oferta,Demanda, group = offer > 22.4, geom = c('point', 'smooth'), method = 'lm', se = F, data = dados)

Aqui está um exemplo que faz uso do pacote R segmented para detectar automaticamente as quebras.

ajuste.lm <- lm(Demanda ~ Oferta, data = dados)
o <- segmented(ajuste.lm, seg.Z = ~ Oferta, psi = list(Oferta = c(20,40)),
  control = seg.control(display = FALSE)
)
summary(o)
## 
##  ***Regression Model with Segmented Relationship(s)***
## 
## Call: 
## segmented.lm(obj = ajuste.lm, seg.Z = ~Oferta, psi = list(Oferta = c(20, 
##     40)), control = seg.control(display = FALSE))
## 
## Estimated Break-Point(s):
##                Est. St.Err
## psi1.Oferta 33.970  1.848
## psi2.Oferta 39.239  3.933
## 
## Meaningful coefficients of the linear terms:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -12.582     30.459  -0.413    0.681    
## Oferta        15.873      1.979   8.019 2.06e-10 ***
## U1.Oferta     84.649    108.641   0.779       NA    
## U2.Oferta   -111.710    110.484  -1.011       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 100 on 48 degrees of freedom
## Multiple R-Squared: 0.8861,  Adjusted R-squared: 0.8742 
## 
## Convergence *not* attained in 38 iter. (rel. change -1.1929e-05)
dados1 = data.frame(Oferta = offer, Demanda = broken.line(o)$fit)
ggplot(dados, aes(x = Oferta, y = Demanda)) + geom_point() + geom_line(data = dados1, color = 'blue')

slope(o)
## $Oferta
##           Est.  St.Err.  t value CI(95%).l CI(95%).u
## slope1  15.873   1.9794  8.01940    11.894    19.853
## slope2 100.520 108.6200  0.92543  -117.880   318.920
## slope3 -11.187  20.1940 -0.55397   -51.791    29.416