Geom_text en caja con ggplot2

Question

Estoy desarrollando un gráfico con ggplot2 en el que necesito superponer texto sobre otros elementos gráficos. Dependiendo del color de los elementos subyacentes al texto, puede ser difícil leer el texto. ¿Hay alguna forma de dibujar geom_text en un cuadro delimitador con un fondo semitransparente?

puedo hacer esto con plotrix:

library(plotrix) 
Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas") 
SampleFrame <- data.frame(X = 1:10, Y = 1:10) 
TextFrame <- data.frame(X = 4:7, Y = 4:7, LAB = Labels) 
### plotrix ### 
plot(SampleFrame, pch = 20, cex = 20) 
boxed.labels(TextFrame$X, TextFrame$Y, TextFrame$LAB, 
bg = "#ffffff99", border = FALSE, 
xpad = 3/2, ypad = 3/2) 

Pero no sé de una manera de lograr resultados similares con ggplot2:

### ggplot2 ### 
library(ggplot2) 
Plot <- ggplot(data = SampleFrame, 
aes(x = X, y = Y)) + geom_point(size = 20) 
Plot <- Plot + geom_text(data = TextFrame, 
aes(x = X, y = Y, label = LAB)) 
print(Plot) 

Como se puede ver, las etiquetas de texto negro son imposible percibir dónde se superponen los negros puntos geom en el fondo.

Answer 1

probar este geom, que está ligeramente modificado a partir de GeomText.

GeomText2 <- proto(GeomText, { 
    objname <- "text2" 
    draw <- function(., data, scales, coordinates, ..., parse = FALSE, 
        expand = 1.2, bgcol = "grey50", bgfill = NA, bgalpha = 1) { 
    lab <- data$label 
    if (parse) { 
     lab <- parse(text = lab) 
    } 

    with(coordinates$transform(data, scales), { 
     tg <- do.call("mapply", 
     c(function(...) { 
      tg <- with(list(...), textGrob(lab, default.units="native", rot=angle, gp=gpar(fontsize=size * .pt))) 
      list(w = grobWidth(tg), h = grobHeight(tg)) 
      }, data)) 
     gList(rectGrob(x, y, 
        width = do.call(unit.c, tg["w",]) * expand, 
        height = do.call(unit.c, tg["h",]) * expand, 
        gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))), 
      .super$draw(., data, scales, coordinates, ..., parse)) 
    }) 
    } 
}) 

geom_text2 <- GeomText2$build_accessor() 

Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas") 
SampleFrame <- data.frame(X = 1:10, Y = 1:10) 
TextFrame <- data.frame(X = 4:7, Y = 4:7, LAB = Labels) 

Plot <- ggplot(data = SampleFrame, aes(x = X, y = Y)) + geom_point(size = 20) 
Plot <- Plot + geom_text2(data = TextFrame, aes(x = X, y = Y, label = LAB), 
          size = 5, expand = 1.5, bgcol = "green", bgfill = "skyblue", bgalpha = 0.8) 
print(Plot) 

error corregido CÓDIGO Y MEJORADO

GeomText2 <- proto(GeomText, { 
    objname <- "text2" 
    draw <- function(., data, scales, coordinates, ..., parse = FALSE, 
        expand = 1.2, bgcol = "grey50", bgfill = NA, bgalpha = 1) { 
    lab <- data$label 
    if (parse) { 
     lab <- parse(text = lab) 
    } 
    with(coordinates$transform(data, scales), { 
     sizes <- llply(1:nrow(data), 
     function(i) with(data[i, ], { 
      grobs <- textGrob(lab[i], default.units="native", rot=angle, gp=gpar(fontsize=size * .pt)) 
      list(w = grobWidth(grobs), h = grobHeight(grobs)) 
     })) 

     gList(rectGrob(x, y, 
        width = do.call(unit.c, lapply(sizes, "[[", "w")) * expand, 
        height = do.call(unit.c, lapply(sizes, "[[", "h")) * expand, 
        gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))), 
      .super$draw(., data, scales, coordinates, ..., parse)) 
    }) 
    } 
}) 

geom_text2 <- GeomText2$build_accessor() 

Answer 2

En lugar de añadir un cuadro delimitador, sugeriría cambiar el color del texto a white que se puede hacer haciendo

Plot <- Plot + 
    geom_text(data = TextFrame, aes(x = X, y = Y, label = LAB), colour = 'white') 

El otro enfoque sería añadir un alpha a geom_point para que sea más transparente

Plot <- Plot + geom_point(size = 20, alpha = 0.5) 

EDITAR. Aquí hay una forma de generalizar la solución de Chase para calcular automáticamente el cuadro delimitador. El truco consiste en agregar width y height de texto directamente al marco de datos de texto. Aquí es un ejemplo

Labels <- c("Alabama", "Alaska", "Arizona", "Arkansas", 
    "Pennsylvania + California") 
TextFrame <- data.frame(X = 4:8, Y = 4:8, LAB = Labels) 
TextFrame <- transform(TextFrame, 
    w = strwidth(LAB, 'inches') + 0.25, 
    h = strheight(LAB, 'inches') + 0.25 
) 

ggplot(data = SampleFrame,aes(x = X, y = Y)) + 
    geom_point(size = 20) + 
    geom_rect(data = TextFrame, aes(xmin = X - w/2, xmax = X + w/2, 
    ymin = Y - h/2, ymax = Y + h/2), fill = "grey80") + 
    geom_text(data = TextFrame,aes(x = X, y = Y, label = LAB), size = 4) 

Answer 3

Una opción es añadir otra capa que corresponde a la capa de texto. Como ggplot agrega capas secuencialmente, coloque un geom_rect bajo la llamada al geom_text y creará la ilusión que busca. Sin duda, este es un proceso manual que intenta determinar el tamaño apropiado para la caja, pero es lo mejor que puedo hacer por ahora.

library(ggplot2) 
ggplot(data = SampleFrame,aes(x = X, y = Y)) + 
    geom_point(size = 20) + 
    geom_rect(data = TextFrame, aes(xmin = X -.4, xmax = X + .4, ymin = Y - .4, ymax = Y + .4), fill = "grey80") + 
    geom_text(data = TextFrame,aes(x = X, y = Y, label = LAB), size = 4) 

Answer 4

Actualización para ggplot2 v0.9

library(ggplot2) 
library(proto) 

btextGrob <- function (label,x = unit(0.5, "npc"), y = unit(0.5, "npc"), 
    just = "centre", hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, 
    default.units = "npc", name = NULL, gp = gpar(), vp = NULL, f=1.5) { 
    if (!is.unit(x)) 
     x <- unit(x, default.units) 
    if (!is.unit(y)) 
     y <- unit(y, default.units) 
    grob(label = label, x = x, y = y, just = just, hjust = hjust, 
     vjust = vjust, rot = rot, check.overlap = check.overlap, 
     name = name, gp = gp, vp = vp, cl = "text") 
    tg <- textGrob(label = label, x = x, y = y, just = just, hjust = hjust, 
        vjust = vjust, rot = rot, check.overlap = check.overlap) 
    w <- unit(rep(1, length(label)), "strwidth", as.list(label)) 
    h <- unit(rep(1, length(label)), "strheight", as.list(label)) 
    rg <- rectGrob(x=x, y=y, width=f*w, height=f*h, 
        gp=gpar(fill="white", alpha=0.3, col=NA)) 

    gTree(children=gList(rg, tg), vp=vp, gp=gp, name=name) 
    } 

GeomText2 <- proto(ggplot2:::GeomText, { 
    objname <- "text2" 

    draw <- function(., data, scales, coordinates, ..., parse = FALSE, na.rm = FALSE) { 
    data <- remove_missing(data, na.rm, 
     c("x", "y", "label"), name = "geom_text2") 

    lab <- data$label 
    if (parse) { 
     lab <- parse(text = lab) 
    } 

    with(coord_transform(coordinates, data, scales), 
     btextGrob(lab, x, y, default.units="native", 
     hjust=hjust, vjust=vjust, rot=angle, 
     gp = gpar(col = alpha(colour, alpha), fontsize = size * .pt, 
      fontfamily = family, fontface = fontface, lineheight = lineheight)) 
    ) 
    } 

}) 

geom_text2 <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", 
parse = FALSE, ...) { 
    GeomText2$new(mapping = mapping, data = data, stat = stat,position = position, 
    parse = parse, ...) 
} 


qplot(wt, mpg, data = mtcars, label = rownames(mtcars), size = wt) + 
    geom_text2(colour = "red") 

Answer 5

siguiente respuesta v0.9 baptiste, aquí está una actualización con control rudimentario o f la aparición caja (bgfill, bgalpha, bgcol, expand_w, expand_h):

btextGrob <- function (label,x = unit(0.5, "npc"), y = unit(0.5, "npc"), 
         just = "centre", hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, 
         default.units = "npc", name = NULL, gp = gpar(), vp = NULL, expand_w, expand_h, box_gp = gpar()) { 
    if (!is.unit(x)) 
    x <- unit(x, default.units) 
    if (!is.unit(y)) 
    y <- unit(y, default.units) 
    grob(label = label, x = x, y = y, just = just, hjust = hjust, 
     vjust = vjust, rot = rot, check.overlap = check.overlap, 
     name = name, gp = gp, vp = vp, cl = "text") 
    tg <- textGrob(label = label, x = x, y = y, just = just, hjust = hjust, 
       vjust = vjust, rot = rot, check.overlap = check.overlap) 
    w <- unit(rep(1, length(label)), "strwidth", as.list(label)) 
    h <- unit(rep(1, length(label)), "strheight", as.list(label)) 
    rg <- rectGrob(x=x, y=y, width=expand_w*w, height=expand_h*h, 
       gp=box_gp) 

    gTree(children=gList(rg, tg), vp=vp, gp=gp, name=name) 
} 

GeomTextbox <- proto(ggplot2:::GeomText, { 
    objname <- "textbox" 

    draw <- function(., data, scales, coordinates, ..., parse = FALSE, na.rm = FALSE, 
        expand_w = 1.2, expand_h = 2, bgcol = "grey50", bgfill = "white", bgalpha = 1) { 
    data <- remove_missing(data, na.rm, 
          c("x", "y", "label"), name = "geom_textbox") 
    lab <- data$label 
    if (parse) { 
     lab <- parse(text = lab) 
    } 

    with(coord_transform(coordinates, data, scales), 
     btextGrob(lab, x, y, default.units="native", 
        hjust=hjust, vjust=vjust, rot=angle, 
        gp = gpar(col = alpha(colour, alpha), fontsize = size * .pt, 
          fontfamily = family, fontface = fontface, lineheight = lineheight), 
        box_gp = gpar(fill = bgfill, alpha = bgalpha, col = bgcol), 
        expand_w = expand_w, expand_h = expand_h) 
    ) 
    } 

}) 

geom_textbox <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", 
         parse = FALSE, ...) { 
    GeomTextbox$new(mapping = mapping, data = data, stat = stat,position = position, 
       parse = parse, ...) 
} 


qplot(wt, mpg, data = mtcars, label = rownames(mtcars), size = wt) + 
    theme_bw() + 
    geom_textbox() 

Answer 6

Actualización para ggplot2 1.0.1

GeomText2 <- proto(ggplot2:::GeomText, { 
    objname <- "text2" 

    draw <- function(., data, scales, coordinates, ..., parse = FALSE, na.rm = FALSE 
        ,hjust = 0.5, vjust = 0.5 
        ,expand = c(1.1,1.2), bgcol = "black", bgfill = "white", bgalpha = 1) { 
    data <- remove_missing(data, na.rm, c("x", "y", "label"), name = "geom_text") 

    lab <- data$label 
    if (parse) { 
     lab <- parse(text = lab) 
    } 

    with(coord_transform(coordinates, data, scales),{ 
     sizes <- llply(1:nrow(data), 
      function(i) with(data[i, ], { 
       grobs <- textGrob(lab[i], default.units="native", rot=angle, gp=gpar(fontsize=size * .pt)) 
       list(w = grobWidth(grobs), h = grobHeight(grobs)) 
      }) 
     ) 
     w <- do.call(unit.c, lapply(sizes, "[[", "w")) 
     h <- do.call(unit.c, lapply(sizes, "[[", "h")) 
     gList(rectGrob(x, y, 
        width = w * expand[1], 
        height = h * expand[length(expand)], 
        just = c(hjust,vjust), 
        gp = gpar(col = alpha(bgcol, bgalpha), fill = alpha(bgfill, bgalpha))), 
      .super$draw(., data, scales, coordinates, ..., parse)) 
    }) 
    } 
}) 

geom_text2 <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity",parse = FALSE, ...) { 
    GeomText2$new(mapping = mapping, data = data, stat = stat, position = position, parse = parse, ...) 
} 

Answer 7

En el paquete development version of ggplot2 hay una nueva llamada geom geom_label() que implementa esto directamente. La transperencia se puede obtener con el parámetro alpha=.

ggplot(data = SampleFrame, 
     aes(x = X, y = Y)) + geom_point(size = 20)+ 
     geom_label(data = TextFrame, 
         aes(x = X, y = Y, label = LAB),alpha=0.5)