geom_smooth interpolation with weights to force interpolation through the origin-CodePudding

I am trying to run a custom defined interpolation using the custom defined nls function. I used a linear interpolation so as to make it easier.

I need the line to be forced to pass through the origin (0;0), therefore I added the weights on the Origin point.

RawData <- data.frame("a" = c(0, 4, 8, 24, 28, 0, 4, 8, 24, 28, 32, 32, 48, 48), "b" = c(0, 6.67,4.44,32.22,42.67,0,0.78, 3.15, 27.56, 32.28, 46.67, 34.65, 66.67, 59.84), "Grade" = c("Product A", "Product A", "Product A", "Product A", "Product A", "Product B", "Product B", "Product B", "Product B", "Product B", "Product A", "Product B", "Product A", "Product B"))


library(ggplot2)
library(ggrepel)
View(RawData)
attach(RawData)



#I put weights so as to force lines to cross (0;0) point
RawData$weight  = ifelse(RawData$`a`==0, 100, 1)

Then I go ahead with the nls model for the interpolation:

nls_se <- function(formula, data, start, ...) {
  mod <- nls(formula, data, start)
  class(mod) <- "nls_se"
  mod
}

predict.nls_se <- function(model, newdata, level = 0.9, ...) {
  class(model) <- "nls"
  p <- investr::predFit(model, newdata = newdata, 
                        interval = "confidence", level = level)
  list(fit = p, se.fit = p[,3] - p[,1])
}

At this point, I need to make the graph. I defined a simple linear function, to make this easy:

Graph <- ggplot(data=RawData, aes(x=`a`, y=`b`, col=Grade))   
geom_point(aes(color = Grade), shape = 1, size = 2.5)  
geom_smooth(mapping = aes(weight=weight), level=0.8, method = nls_se, formula=y ~ (a * x)   b, method.args = list(start = list(a = 10, b = 5)))  
scale_color_manual(values=c('#f92410','#644196', '#33b90e'))

The result looks like it is ignoring the forcing on the origin point:

Note that I know that if I place "lm" as model it works properly but I would like to understand why with nls_se not.

Graph <- ggplot(data=RawData, aes(x=`a`, y=`b`, col=Grade))   
geom_point(aes(color = Grade), shape = 1, size = 2.5)  
geom_smooth(mapping = aes(weight=weight), level=0.8, method = lm)  
scale_color_manual(values=c('#f92410','#644196', '#33b90e'))

CodePudding user response：

while functions like geom_smooth can be convenient in simple cases, when you need relatively more exotic things, or extra control etc, I find its better to separate out calculations from pure graphical plotting; here is an example

library(tidyverse)
library(investr)

RawData <- data.frame("a" = c(0, 4, 8, 24, 28, 0, 4, 8, 24, 28, 32, 32, 48, 48),
                      "b" = c(0, 6.67,4.44,32.22,42.67,0,0.78, 3.15, 27.56, 32.28, 46.67, 34.65, 66.67, 59.84), "Grade" = c("Product A", "Product A", "Product A", "Product A", "Product A", "Product B", "Product B", "Product B", "Product B", "Product B", "Product A", "Product B", "Product A", "Product B"))


#I put weights so as to force lines to cross (0;0) point
RawData$weight  = ifelse(RawData$`a`==0, 10, 1)


(rawdgrps <- RawData |> group_by(Grade) |> group_split())

models <- map(rawdgrps,
              ~nls(formula=b ~ (a_ * a)   b_,
              start = list(a_ = 10, b_ = 5),
              weights = weight,
              data = .x)
              )

(predictions <- map2_dfr(models,rawdgrps,
  ~bind_cols(.y, investr::predFit(.x, newdata = .y, 
                  interval = "confidence", level = .8) 
)))


(Graph <- ggplot(data=predictions, aes(x=`a`, y=`b`, col=Grade,fill=Grade))   
  geom_point( shape = 1, size = 2.5)   
    geom_line(aes(y=fit))   
    geom_ribbon(aes(ymin=lwr,ymax=upr),alpha=.1,linetype="dotted") 
  scale_color_manual(values=c('#f92410','#644196')))