R：在geom_smooth中使用自定義函數時沒有選擇其他參數

Question

這是一個涉及我早期問題geom_smooth with facet_grid and different fitting functions的問題。在那個問題中，我試圖在geom_smooth中爲ggplot2的facet網格中的每個方面使用不同的擬合函數。 Marco Sandri懇切地提供了一個答案，我正試圖使用​​用戶定義的公式而不是現有公式（例如，lm,loess）。這是我的代碼。

# Load library 
library(ggplot2) 

# Load data 
data(mtcars) 

# Smoothing function with different behaviour depending on the panel 
custom.smooth <- function(formula, data,...){ 
    smooth.call <- match.call() 

    if(as.numeric(unique(data$PANEL)) == 6) { 
    # Nonlinear regression 
    method.name <- eval(parse(text="nls")) 
    # Specify formula 
    formula <- as.formula("y ~ a * x^b") 
    # Add initial parameters 
    smooth.call[["start"]] <- c(a = 10, b = -0.5) 
    }else{ 
    # Linear regression 
    method.name <- eval(parse(text="lm")) 
    } 

    # Add function name 
    smooth.call[[1]] <- method.name 
    # Perform fit 
    eval.parent(smooth.call) 
} 

# Plot data with custom fitting function 
p <- ggplot(mtcars,aes(x = disp, y = mpg)) + geom_point() + facet_grid(gear ~ am) 
p <- p + geom_smooth(method = "custom.smooth") 
print(p) 

在這段代碼中，我定義了一個函數custom.smooth來選擇適合的模型。在這個例子中，所有的模型都是線性迴歸，除了面板6，這是一個用戶定義的函數y ~ a*x^b。運行此代碼給出了錯誤：

Warning message: Computation failed in stat_smooth() : singular gradient matrix at initial parameter estimates

然而，當我在面板6與這些初始參數上運行數據nls我得到沒有這樣的錯誤（即，nls(mpg ~ a * disp^b, mtcars %>% filter(gear == 5, am == 1), start = c(a = 10, b = -0.5))）。這讓我認爲nls沒有看到我指定的起始值。我自己也嘗試在這樣的geom_smooth函數指定這些參數：

p <- p + geom_smooth(method = "custom.smooth", method.args = list(start = c(a = 10, b = -0.5))) 

，但我遇到同樣的問題。任何想法如何讓我的起始值爲nls？或者是代碼不起作用的另一個原因？

Answer 1

這裏的解決方案，從this post大大受益。我不知道爲什麼以前的版本沒有工作，但這似乎工作正常。

# Load library 
library(ggplot2) 

# Load data 
data(mtcars) 

# Smoothing function with different behaviour depending on the panel 
custom.smooth <- function(formula, data,...){ 
    smooth.call <- match.call() 

    if(as.numeric(unique(data$PANEL)) == 6) { 
    # Nonlinear regression 
    smooth.call[[1]] <- quote(nls) 
    # Specify formula 
    smooth.call$formula <- as.formula("y ~ a * x^b") 
    # Add initial parameters 
    smooth.call$start <- c(a = 300, b = -0.5) 
    }else{ 
    # Linear regression 
    smooth.call[[1]] <- quote(lm) 
    } 

    # Perform fit 
    eval.parent(smooth.call) 
} 

# Plot data with custom fitting function 
p <- ggplot(mtcars,aes(x = disp, y = mpg)) + geom_point() + facet_grid(gear ~ am) 
p <- p + geom_smooth(method = "custom.smooth", se = FALSE) 
print(p)