Search code examples
rggplot2purrrderivative

Plot derivations of multiple logistical curves with ggplot and purrr


The rows of data frame "pars" hold the two parameters defining logistical curves:

library(ggplot2)
library(purrr)

pars <- data.frame(
  diff = c(-1.5, 2.5),
  disc = c(1.2, 2.5)
)

These two curves can be plotted with map() and ggplot() like this.

icc <- function(x) map(
  1:nrow(pars),
  ~ stat_function(fun = function(x)
    (exp(pars$disc[.x]*(x - pars$diff[.x])))/(1 + exp(pars$disc[.x]*(x - pars$diff[.x]))))
)
ggplot(data.frame(x = -5 : 5)) +
  aes(x) +
  icc()

enter image description here

The corresponding derivations can be plotted like this:

disc1 <- 1.2
disc2 <- 2.5
diff1 <- -1.5
diff2 <- 2.5

icc1 <- function(x) (exp(disc1*(x - diff1)))/(1 + exp(disc1*(x - diff1)))
icc2 <- function(x) (exp(disc2*(x - diff2)))/(1 + exp(disc2*(x - diff2)))

info1 <- Deriv(icc1, "x")
info2 <- Deriv(icc2, "x")

ggplot(data.frame(x = -5 : 5)) +
  aes(x) +
  stat_function(fun = info1) +
  stat_function(fun = info2)

enter image description here

However, I'd like to use a more generic approach with preferably purrr() for the derivations as well since I'll need a function for a varying number of curves. Maybe there's a solution with pmap() that could iterate through a data frame with parameters and apply function and derivation to each row. Unfortunately, I was unlucky so far. I am extremely grateful for any helpful answers.


Solution

  • One option may look like so:

    1. I have put the parameters for your curves in a data.frame
    2. Making use of a function factory and pmap to loop over the params df to create a list of your icc functions.

    The rest is pretty straighforward.

    1. Loop over the list of functions to get the derivatives.

    2. Use map to add the stat_function layers.

    library(ggplot2)
    library(Deriv)
    #> Warning: package 'Deriv' was built under R version 4.1.2
    library(purrr)
    
    df <- data.frame(
      disc = c(1.2, 2.5),
      diff = c(-1.5, 2.5)
    )
    
    icc <- function(disc, diff) {
      function(x) (exp(disc*(x - diff)))/(1 + exp(disc*(x - diff)))
    }
    
    icc_list <- pmap(df, function(disc, diff) icc(disc, diff))
    info_list <- map(icc_list, Deriv, "x")
    
    ggplot(data.frame(x = -5 : 5)) +
      aes(x) +
      map(info_list, ~ stat_function(fun = .x))
    

    EDIT Incorporating different colors or ... is not a big deal, e.g. you could use purrr::map2 to loop over both info_list and your vector of colors to assign a color to each of your functions or derivatives:

    colorVec <- c("red", "blue")
    
    ggplot(data.frame(x = -5 : 5)) +
      aes(x) +
      map2(info_list, colorVec, ~ stat_function(fun = .x, color = .y))
    

    EDIT 2 Finally, we could apply the same idea to get a legend like so, where instead of setting the color as an argument we map on the color aes and set the colors via scale_color_manual:

    colorVec <- c("red", "blue")
    labelsVec <- c("f1", "f2")
    names(colorVec) <- labelsVec
    
    ggplot(data.frame(x = -5 : 5)) +
      aes(x) +
      map2(info_list, labelsVec, ~ stat_function(fun = .x, aes(color = .y))) +
      scale_color_manual(values = colorVec)
    

    enter image description here