r - 以编程方式向 stat_function() 添加颜色和图例

Question

我正在尝试编写一个函数，该函数使用不同的步长值绘制 ODE 解的相同图形近似值。我的 ODE 近似是正确的，我只是不知道如何添加识别每个函数的颜色和图例。

我试图关注this answer ，但我无法很好地将其转换为函数数量不恒定的上下文。

这是我的代码及其生成的输出。

library(purrr)
library(ggplot2)
library(glue)

eulerMethod = function(f, t0, y0, h, memo = 1000) {
  vec = double(memo + 1)

  vec[1] = y0
  for (i in 1:memo) {
    vec[i+1] = vec[i] + h*f(t0 + i*h, vec[i])
  }

  solution = function(t) {
    if (t < t0) return(NaN)
    n = (t-t0)/h

    intN = floor(n)
    if (n == intN)
      return(vec[n+1])
    else # linear interpolation
      return(vec[intN + 1] + (n - intN) * (vec[intN + 2] - vec[intN + 1]))
  }
}

compare = function(f, t0, y0, interval, hs = c(1, 0.5, 0.2, 0.1, 0.05)) {
  fs = map(hs, ~ eulerMethod(f, t0, y0, .)) %>% 
    map(Vectorize)

  # generates "h = 1" "h = 0.5" ... strings
  legends = map_chr(hs, ~ glue("h = {hs[[.]]}"))
  map(1:length(hs), ~ stat_function(fun = fs[[.]],
                                    geom = "line",
                                    aes_(colour = legends[.]))) %>%
    reduce(`+`, .init = ggplot(data.frame(x = interval), aes(x)))
}

# y' = y => solution = exp(x)
compare(function(t, y) y, 0, 1, c(0, 5))

Answer 1

我以前没有使用过glue，但它的工作方式并不像我想象的那样。它只是返回 h = 1 的五个副本。我已修改您的代码，仅使用 paste0 创建图例值:

compare = function(f, t0, y0, interval, hs = c(1, 0.5, 0.2, 0.1, 0.05)) {
  fs = map(hs, ~ eulerMethod(f, t0, y0, .)) %>% 
    map(Vectorize)

  # generates "h = 1" "h = 0.5" ... strings
  legends = paste0("h = ", hs)

  map(1:length(hs), ~ stat_function(fun = fs[[.]],
                                    geom = "line",
                                    aes_(colour = legends[.]))) %>%
    reduce(`+`, .init = ggplot(data.frame(x = interval), aes(x, colour=.)))
}

compare(function(t, y) y, 0, 1, c(0, 5))

另外，在我看来，代码可以变得更简单一些。例如:

compare = function(f, t0, y0, interval, hs = c(1, 0.5, 0.2, 0.1, 0.05)) {

  fs = map(hs, ~ eulerMethod(f, t0, y0, .)) %>% 
    map(Vectorize)

  ggplot(data.frame(x = interval), aes(x)) +
    map(1:length(fs), function(nn) {
      stat_function(fun = fs[[nn]], geom = "line", aes_(colour = factor(hs[nn])))
    }) +
    labs(colour="h")
}

compare(function(t, y) y, 0, 1, c(0, 5))