geom_smooth interpolation with weights to force interpolation through the origin

GiacomoDB 0
Viewed 36

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:

enter image description here

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'))

enter image description here

interpolation ggplot2 r
1 Answers

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')))
Nir Graham0
Related