roptimizationlmmosaic

Calculating a critical point of a variable from lm object


The below quadratic model example (including data) is from Steve's Data Tips and Tricks.

# Sample Data and Quadratic Model
study_hours <- c(6, 9, 12, 14, 30, 35, 40, 47, 51, 55, 60)
exam_scores <- c(14, 28, 50, 70, 89, 94, 90, 75, 59, 44, 27)
data <- data.frame(study_hours, exam_scores)
model <- lm(exam_scores ~ study_hours + I(study_hours^2),
  data = data)

I can calculate the value of study_hours where the exam_score is maximized (inflection point or critical value) using a solution in Extract critical points of a polynomial model object in R?.

model %>% 
  mosaic::makeFun() %>%     
  optimize(interval = c(min(df$study_hours), max(df$study_hours)), maximum = TRUE) 

Another dataset and model (with error)

Now, I have another dataset and model below. I would like to get the value of variable ceoten where the log(salary) is maximized. However, I get the error below.

I am not sure if I correctly understood how the optimize function works.

(1) Can anyone share some insights?

(2) Would there be any other way to achieve the task?

library(wooldridge)
data("ceosal2")
ceosalary <- ceosal2
model2 <- lm(log(salary) ~ log(sales) + comten + 
     ceoten + I(ceoten^2),
                 data=ceosalary) 
    
library(mosaic)
model2 %>% 
# This function is used to extract the formula of the model as a function
mosaic::makeFun() %>%     
  optimize(interval = c(min(ceosalary$ceoten),
   max(ceosalary$ceoten)), maximum = TRUE) 

Error in f(arg, ...) : argument "comten" is missing, with no default


Solution

  • Your recipe doesn't work when there are predictor variables in the model other than the focal (quadratic) predictor.

    The easiest way to do this is with some calculus. Suppose y = b0 + b1*x1 + b2*x2 + b3*x3 + b4*x3^2 and we want to find a critical point with respect to x3. Then:

    dy/dx3 = b3 + 2*b4*x3
    

    We set the LHS to zero and get 0 = b3 + 2*b4*x3 ⇒ x3 = -b3/(2*b4).

    b3 <- coef(model2)[["ceoten"]]
    b4 <- coef(model2)[["I(ceoten^2)"]]
    maxval <- -b3/(2*b4)  ## 21.416
    
    pframe <- with(ceosalary,
       data.frame(sales = mean(sales), comten = mean(comten),
                  ceoten = seq(min(ceoten), max(ceoten), length.out = 51)))
    plot(pframe$ceoten, predict(model2, newdata = pframe), type = "l")
    abline(v = maxval, lty = 2, col = 2)
    

    Alternatively, you can set up your function using predict:

    pfun <- function(x) {
       pframe <- with(ceosalary,
            data.frame(sales = mean(sales), comten = mean(comten),
                       ceoten = x))
       predict(model2, newdata = pframe)
    }
    optimize(pfun, interval = c(min(ceosalary$ceoten), max(ceosalary$ceoten)), maximum = TRUE)
    

    (this will work for cases where you can't/don't feel like doing the calculus)