Une fonction par facette

Question

Je peux tracer une fonction dans ggplot2, comme ceci :

library(ggplot2)
ggplot(data.frame(x=0), aes(x)) + geom_function(fun = sin) + xlim(c(-5,5))

Puis-je utiliser les facettes de ggplot2 pour tracer le graphique de plusieurs fonctions, une dans chaque facette (par exemple sin et cos) ?

Answer 1

Il semble que vous puissiez en fait faire des facettes par la fonction si vous fournissez à chaque couche ses propres données avec la variable de facette spécifiée :

library(ggplot2) # using ggplot2 3.3.5
ggplot(data.frame(x=0), aes(x)) + 
  geom_function(fun = sin, data = data.frame(x = -5:5, fun_name = "sin")) +
  geom_function(fun = cos, data = data.frame(x = -5:5, fun_name = "cos")) +
  facet_wrap(~fun_name)

Answer 2

... le plaisir n'est pas une esthétique ... vous pouvez en faire un :)

C'est un peu exagéré, mais c'est juste une démonstration rapide de ce qui est possible en modifiant les Geoms et les Stats. Ce qui suit est un hack rapide et je l'ai référencé avec pas mal de choses moches. ::: ce que vous ne feriez pas si vous emballiez correctement ce produit. En outre, il est clair que ce n'est pas correctement testé sur de nombreux cas d'utilisation. Quelques commentaires supplémentaires dans le code.

C'était assez ... amusant :)

df <- data.frame(x = 0, fun = c("sin", "cos", "tan", "mean"))

ggplot(df, aes(x)) +
  stat_function2(aes(fun = fun)) +
  xlim(c(-5,5)) +
  facet_wrap(~fun, scales = "free_y")

Modifier Geom et Stat - StatFunction2

StatFunction2 <- ggplot2:::StatFunction
## removing fun from the arguments
StatFunction2$compute_group <- function (data, scales, xlim = NULL, n = 101, args = list()) 
{
  if (is.null(scales$x)) {
    ## need to change that here a bit
    range <- rlang::`%||%`(xlim, c(0, 1))
    xseq <- seq(range[1], range[2], length.out = n)
    x_trans <- xseq
  }
  else {
    ## same same
    range <- rlang::`%||%`(xlim, scales$x$dimension())
    xseq <- seq(range[1], range[2], length.out = n)
    if (scales$x$is_discrete()) {
      x_trans <- xseq
    }
    else {
      x_trans <- scales$x$trans$inverse(xseq)
    }
  }
  ## get the function, this is the trick :)
  fun <- unique(data$fun)
  if (plyr::is.formula(fun)) 
    fun <- as_function(fun)
  y_out <- do.call(fun, c(list(quote(x_trans)), args))
  if (!is.null(scales$y) && !scales$y$is_discrete()) {
    y_out <- scales$y$trans$transform(y_out)
  }
  ggplot2:::new_data_frame(list(x = xseq, y = y_out))
}
## update stat_function - remove fun argument and reference new geom_function2
stat_function2 <- function (mapping = NULL, data = NULL, geom = "function2", position = "identity", 
                            ..., fun, xlim = NULL, n = 101, args = list(), na.rm = FALSE, 
                            show.legend = NA, inherit.aes = TRUE) 
{
  if (is.null(data)) {
    ### those ::: are just for to make it work here
    data <- ggplot2:::ensure_nonempty_data
  }
  layer(data = data, mapping = mapping, stat = StatFunction2, 
        geom = geom, position = position, show.legend = show.legend, 
        ## fun needs to be removed here too.
        inherit.aes = inherit.aes, params = list(n = n, 
                                                 args = args, na.rm = na.rm, xlim = xlim, ...))
}
## This is the correct way to create copies (children) of ggproto objects
## see https://stackoverflow.com/a/70637511/7941188
GeomFunction2 <- ggproto(NULL, GeomFunction)
## change the required aesthetics - this removes the warning that aesthetics are not known
GeomFunction2$required_aes <- c("x", "y", "fun")
## update the corresponding geom (two locations in this function definition)
geom_function2 <- function (mapping = NULL, data = NULL, stat = "function2", position = "identity", 
                            ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) 
{
  if (is.null(data)) {
    data <- ensure_nonempty_data
  }
  layer(data = data, mapping = mapping, stat = stat, geom = GeomFunction2, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(na.rm = na.rm, ...))
}

Answer 3

Parce que fun= n'est pas une esthétique, je pense que vous ne pouvez pas la facetter. Cependant, vous pouvez effectuer un faux facettage en utilisant la fonction patchwork paquet.

library(ggplot2)
gsin <- ggplot(data.frame(x=0), aes(x)) +
  geom_function(fun = sin) +
  xlim(c(-5,5)) +
  labs(title = "sin()")
gtan <- ggplot(data.frame(x=0), aes(x)) +
  geom_function(fun = tan) +
  xlim(c(-5,5)) +
  labs(title = "tan()")
gsin + gtan

Si vous préférez le "look" de ggplot2 Vous pouvez choisir cette méthode à la place :

gsin <- ggplot(data.frame(x=0, fun="sin"), aes(x)) +
  facet_wrap(~fun) +
  geom_function(fun = sin) +
  xlim(c(-5,5))
gtan <- ggplot(data.frame(x=0, fun="tan"), aes(x)) +
  facet_wrap(~fun) +
  geom_function(fun = tan) +
  xlim(c(-5,5))
gsin + gtan

Tout cela a jusqu'à présent effet de facet_*(scales="free_y") (parce que nous avons fixé xlim(.) ). Si vous voulez imiter plus fidèlement le facettage, vous devez contrôler les limites de toutes les facettes :

ylims <- c(-1, 1)
gsin <- ggplot(data.frame(x=0, fun="sin"), aes(x)) +
  facet_wrap(~fun) +
  geom_function(fun = sin) +
  xlim(c(-5,5)) +
  scale_y_continuous(limits = ylims)
gtan <- ggplot(data.frame(x=0, fun="tan"), aes(x)) +
  facet_wrap(~fun) +
  geom_function(fun = tan) +
  xlim(c(-5,5)) +
  scale_y_continuous(name = NULL, guide = NULL, limits = ylims)
gsin + gtan
# Warning: Removed 22 row(s) containing missing values (geom_path).

Techniquement, vous n'êtes pas requis ici pour fixer les limites y de tous, mais ... à moins que vous ne sachiez avec certitude que les limites sur les axes y non contraints seront celles dont vous avez besoin, il est possible qu'elles soient légèrement décalées. Par exemple, si vous changez la fonction initiale (dans un hack rapide) pour être 2*sin(x) mais oubliez de mettre à jour les limites en y des facettes restantes, alors vos tracés seront faux. Il est préférable de définir les limites à un seul endroit ( ylims <- ... ) et la référence dans tous parcelles.