提取R？中的多项式模型对象的临界点

问题描述

我正在尝试求解已拟合到数据的三次多项式函数的拐点，即一阶导数为零的x值。

我还需要一种方法来找到x的临界点处的y值。

使用lm()拟合模型并使用summary()查看模型质量非常容易。通过添加预测并使用geom_line()，我可以轻松地绘制函数。

必须是专门用于解决此问题的软件包或基本R函数。有人可以建议一种方法吗？

下面是描述问题的代表。不用说，绘制箭头仅用于说明问题。他们没有映射到真实的拐点，否则我不会问这个问题...


library(tidyverse)
library(modelr)

set.seed(0)
#generate random data and plot the values
df <- tibble(x= sample(x= c(-100:200),size= 50),y= -0.5*(x^3) + 50*(x^2) + 7*(x)  + rnorm(n=50,mean=10000,sd=50000) )

df %>% ggplot(aes(x,y)) +
  geom_point()


# fit a model to the data
cubic_poly_model <- lm(data= df,formula = y~poly(x,3))

# plot the fitted model
df %>%
  add_predictions(model = cubic_poly_model) %>%
  ggplot(aes(x,y))+
  geom_point(alpha=1/3)+
  geom_line(aes(x,y=pred))+
  annotate('text',label= 'critical point A',x=-50,y=-250000)+
  geom_segment(x=-50,xend=-10,y=-200000,yend=-5000,arrow = arrow(length=unit(3,'mm'),type = 'closed'))+
  annotate('text',label= 'critical point B',x=140,y=400000)+
  geom_segment(x=110,xend=90,y=300000,yend=100000,type = 'closed'))


# But how can I get the critical values of x and the y values they produce?

^{由happens when the consumer is cancelled（v0.3.0）于2020-09-03创建}

解决方法

我使用mosaic包设计了一个解决方案。 makeFun()函数允许将模型对象转换为函数。然后，您可以使用基数R optimize()在指定的间隔（在本例中为x值的范围）内找到该函数的最大值或最小值。在optimize()中指定“最大”参数，以说明要局部最大值还是局部最小值。

请参见下面的代码：

library(magrittr) 
 set.seed(0)

    #generate random data and plot the values
  
  df <- tibble::tibble(x= sample(x= c(-100:200),size= 50),y= -0.5*(x^3) + 50*(x^2) + 7*(x)  + rnorm(n=50,mean=10000,sd=50000) )
  
  
  
  cubic_poly_model <- lm(data= df,formula = y~poly(x,3))
  
  crit_values <- cubic_poly_model %>% 
    mosaic::makeFun() %>% 
    optimize(interval = c(min(df$x),max(df$x)),maximum = TRUE) 
  
  funct_crit_x <- crit_values[['maximum']][[1]]
  funct_max <- crit_values[['objective']]
  
  funct_crit_x
  funct_max

model-fitting polynomials r r