rmodelcurvelattice

Plotting correctly the exponential, hyperbolic and inverted hyperbolic model curve in lattice

I am just trying to plot families of many models (whose names you can visualize as commented lines) on lattice graphs. However, I am not sure if the

  1. EXPONENTIAL
  2. INVERTED HYPERBOLIC
  3. HYPERBOLIC

models are represented fine:

  xyplot(
  Petal.Width  ~ Petal.Length | Species,
  data = iris,
  panel = function(x, y, groups, ...) {
    panel.xyplot(x, y, ...)
    mod1 <- lm(y~x)
    mod2 <- lm(y~poly(x, 2))
    mod3 <- lm(y~poly(x, 3))
    mod4 <- nls(y ~ a * exp(-b * x), start = list(a = 1, b = 0.1), data = data.frame(x = x, y = y))  #exponential 
    mod5 <- nls(y ~ a / x, start = list(a = 1), data = data.frame(x = x, y = y)) #inverted hyperbolic  
    mod6 <- nls(y ~ a * x, start = list(a = 1), data = data.frame(x = x, y = y)) 
    #hyperbolic
    
    panel.abline(mod1, col='#0080ff')
    panel.curve(predict(mod2, newdata=data.frame(x=x)), col='purple', lwd=2)  
    panel.curve(predict(mod3, newdata=data.frame(x=x)), col='#ff00ff', lwd=2)
    panel.curve(predict(mod4, newdata=data.frame(x=x)), from = min(x), to = max(x), col = "red",lwd = 2)  
    panel.curve(predict(mod5, newdata=data.frame(x=x)), from = min(x), to = max(x), col = "green",lwd = 2)
    panel.curve(predict(mod6, newdata=data.frame(x=x)), from = min(x), to = max(x), col = "orange",lwd = 2)
    })

Could you correct if I am not plotting correct stuff? I am asking because in the first panel, I cannot get the graph.

Thanks

Solution

  • Looks like it should be correct. The only thing I might suggest is you could have the nls() models fail a bit more gracefully by using try() and then only plotting the curves where nls() doesn't fail:

    library(lattice)
xyplot(
  Petal.Width  ~ Petal.Length | Species,
  data = iris,
  panel = function(x, y, groups, ...) {
    panel.xyplot(x, y, ...)
    mod1 <- lm(y~x)
    mod2 <- lm(y~poly(x, 2))
    mod3 <- lm(y~poly(x, 3))
    mod4 <- try(nls(y ~ a * exp(-b * x), start = list(a = 1, b = 0.1), data = data.frame(x = x, y = y)))  #exponential 
    mod5 <- try(nls(y ~ a / x, start = list(a = 1), data = data.frame(x = x, y = y))) #inverted hyperbolic  
    mod6 <- try(nls(y ~ a * x, start = list(a = 1), data = data.frame(x = x, y = y))) 
    #hyperbolic
    
    panel.abline(mod1, col='#0080ff')
    panel.curve(predict(mod2, newdata=data.frame(x=x)), col='purple', lwd=2)  
    panel.curve(predict(mod3, newdata=data.frame(x=x)), col='#ff00ff', lwd=2)
    if(!inherits(mod4, "try-error"))panel.curve(predict(mod4, newdata=data.frame(x=x)), from = min(x), to = max(x), col = "red",lwd = 2)  
    if(!inherits(mod5, "try-error"))panel.curve(predict(mod5, newdata=data.frame(x=x)), from = min(x), to = max(x), col = "green",lwd = 2)
    if(!inherits(mod6, "try-error"))panel.curve(predict(mod6, newdata=data.frame(x=x)), from = min(x), to = max(x), col = "orange",lwd = 2)
    })


    #> Error in nls(y ~ a * exp(-b * x), start = list(a = 1, b = 0.1), data = data.frame(x = x,  : 
#>   singular gradient

    Created on 2024-04-05 with reprex v2.0.2