Rasterise images ggplot dans R pour tikzdevice

Question

J'utilise R pour analyser les données, ggplot pour créer des graphiques, tikzDevice pour les imprimer et enfin latex pour créer un rapport. Le problème est que les grandes parcelles avec beaucoup de points échouent en raison de la limite de mémoire du latex. J'ai trouvé ici https://github.com/yihui/tikzDevice/issues/103 une solution qui pixellise l'intrigue avant d'imprimer le fichier tikz, ce qui permet d'imprimer les points et le texte individuellement.

require(png) 
require(ggplot2) 
require(tikzDevice) 

## generate data 
n=1000000; x=rnorm(n); y=rnorm(n) 

## first try primitive 
tikz("test.tex",standAlone=TRUE) 
plot(x,y) 
dev.off() 
## fails due to memory 
system("pdflatex test.tex") 


## rasterise points first 
png("inner.png",width=8,height=6,units="in",res=300,bg="transparent") 
par(mar=c(0,0,0,0)) 
plot.new(); plot.window(range(x), range(y)) 
usr <- par("usr") 
points(x,y) 
dev.off() 
# create tikz file with rasterised points 
im <- readPNG("inner.png",native=TRUE) 
tikz("test.tex",7,6,standAlone=TRUE) 
plot.new() 
plot.window(usr[1:2],usr[3:4],xaxs="i",yaxs="i") 
rasterImage(im, usr[1],usr[3],usr[2],usr[4]) 
axis(1); axis(2); box(); title(xlab="x",ylab="y") 
dev.off() 
## this works 
system("pdflatex test.tex") 


## now with ggplot 
p <- ggplot(data.frame(x=x, y=y), aes(x=x, y=y)) + geom_point() 
## what here? 

Dans cet exemple, le premier pdflatex échoue. La seconde réussit grâce à la pixellisation.

Comment puis-je l'appliquer avec ggplot?

Answer 1

Voici une démonstration de principe pour illustrer les étapes à suivre. Comme indiqué dans les commentaires, ce n'est pas recommandé ou pratique, mais pourrait être la base d'une implémentation de niveau inférieur.

require(png) 
require(ggplot2) 
require(tikzDevice) 

n=100; 
d <- data.frame(x=rnorm(n), y=rnorm(n), z=rnorm(n)) 

p <- ggplot(d, aes(x=x, y=y, colour=z, size=z, alpha=x)) + geom_point() 

## draw the layer by itself on a png file 
library(grid) 
g <- ggplotGrob(p) 
# grid.newpage() 
gg <- g$grobs[[6]]$children[[3]] 
gg$vp <- viewport() # don't ask me 
tmp <- tempfile(fileext = "png") 
png(tmp, width=10, height=4, bg = "transparent", res = 30, units = "in") 
grid.draw(gg) 
dev.off() 
## import it as a raster layer 
rl <- readPNG(tmp, native = TRUE) 
unlink(tmp) 

## add it to a plot - note that the positions match, 
## but the size can be off unless one ensures that the panel has the same size and aspect ratio 
ggplot(d, aes(x=x, y=y)) + geom_point(shape="+", colour="red") + 
    annotation_custom(rasterGrob(rl, width = unit(1,"npc"), height=unit(1,"npc"))) + 
    geom_point(aes(size=z), shape=1, colour="red", show.legend = FALSE) 

## to illustrate the practical use, we use a blank layer to train the scales 
## and set the panel size to match the png file 
pf <- ggplot(d, aes(x=x, y=y)) + geom_blank() + 
    annotation_custom(rasterGrob(rl, width = unit(1,"npc"), height=unit(1,"npc"), interpolate = FALSE)) 

tikz("test.tex", standAlone=TRUE) 
grid.draw(egg::set_panel_size(pf, width=unit(10, "cm"), height=unit(4, "cm"))) 
dev.off() 

system("lualatex test.tex") 
system("open test.pdf") 

nous pouvons zoomer et vérifier que le texte est vectoriel alors que la couche est (ici basse résolution pour la démonstration) raster.

Answer 2

ok, je vais écrire ici parce qu'il était trop grand pour la boîte de commentaires. Au lieu d'ajouter les points tramés à un nouveau tracé avec de nouvelles échelles, vous pouvez remplacer le repère original par le repère pixellisé par g$grobs[[6]]$children[[3]] <- rasterGrob(rl). Le problème est qu'il ne s'agrandit pas, donc vous devez connaître la taille de l'image finale avant. Ensuite, vous pouvez poursuivre STH comme ceci:

rasterise <- function(ggp, 
         width = 6, 
         height = 3, 
         res.raster = 300, 
         raster.id= c(4,3), 
         file = ""){ 
    ## RASTERISE 
    require(grid) 
    require(png) 
    ## draw the layer by itself on a png file 
    gb <- ggplot_build(ggp) 
    gt <- ggplot_gtable(gb) 
    ## calculate widths 
    h <- as.numeric(convertUnit(sum(gt$heights), unitTo="in")) 
    w <- as.numeric(convertUnit(sum(gt$widths) , unitTo="in")) 
    w.raster <- width-w 
    h.raster <- height-h 
    ## print points as png 
    grid.newpage() 
    gg <- gt$grobs[[raster.id[1]]]$children[[raster.id[2]]] 
    gg$vp <- viewport() # don't ask me 
    tmp <- tempfile(fileext = "png") 
    png(tmp, width=w.raster, height=h.raster, bg = "transparent", res = res.raster, units = "in") 
    grid.draw(gg) 
    dev.off() 
    ## import it as a raster layer 
    points <- readPNG(tmp, native = TRUE) 
    points <- rasterGrob(points, width = w.raster, height = h.raster, default.units = "in") 
    unlink(tmp) 
    ## ADD TO PLOT 
    gt$grobs[[raster.id[1]]]$children[[raster.id[2]]] <- points 
    ## PLOT TMP 
    ### HERE YOU CAN ONLY PRINT IT IN THIS DIMENSIONS! 
    pdf(file, width = width, height = height) 
    grid.draw(gt) 
    dev.off() 
} 

Et puis utilisez avec

data <- data.frame(x = rnorm(1000), y = rnorm(1000)) 
plot <- ggplot(data, aes(x = x, y = y)) + 
    geom_point() + 
    annotate("text", x = 2, y = 2, label = "annotation") 

rasterise(ggp  = plot, 
      width  = 6, 
      height  = 3, 
      res.raster = 10, 
      raster.id = c(4,2), 
      file  = "~/test.pdf") 

Le problème reste l'ID du Grob que vous voulez rasterise. Je n'ai pas trouvé un bon moyen de trouver le bon automatiquement. Cela dépend des couches que vous ajoutez à l'intrigue.