ggplot2

Question

के साथ बॉक्सिंग geom_text मैं ggplot2 के साथ एक ग्राफिक विकसित कर रहा हूं जिसमें मुझे अन्य ग्राफिकल तत्वों पर पाठ को अतिरंजित करने की आवश्यकता है। पाठ के अंतर्निहित तत्वों के रंग के आधार पर, पाठ को पढ़ना मुश्किल हो सकता है। अर्द्ध पारदर्शी पृष्ठभूमि वाले बाउंडिंग बॉक्स में geom_text को आकर्षित करने का कोई तरीका है?

मैं 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) 

लेकिन मैं 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) 

आप देख सकते हैं, काले पाठ लेबल हैं यह समझना असंभव है कि वे पृष्ठभूमि में काले geom_points ओवरलैप करते हैं। बाउंडिंग बॉक्स जोड़ने की

Answer 1

इस geom, जो थोड़ा 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) 

बग को ठीक और कोड बैप्टिस्ट v0.9 जवाब निम्नलिखित सुधार

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

इसके बजाय, मैं जो

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

कर अन्य दृष्टिकोण से किया जा सकता white पाठ के रंग को बदलने में कोई alphageom_point में जोड़ने के लिए इसे और अधिक पारदर्शी बनाने के लिए

होगा सुझाव है

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

संपादित करें। बाउंडिंग बॉक्स को स्वचालित रूप से गणना करने के लिए चेस के समाधान को सामान्यीकृत करने का एक तरीका यहां दिया गया है। चाल सीधे पाठ डेटा फ्रेम पर width और height टेक्स्ट जोड़ने के लिए है। यहाँ एक उदाहरण

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

एक विकल्प एक और परत कि पाठ परत से मेल खाती है जोड़ने के लिए है। चूंकि ggplot क्रमशः परतों को जोड़ता है, को geom_text पर कॉल के तहत रखें और यह आपके बाद के भ्रम पैदा करेगा। यह स्वीकार्य रूप से बॉक्स के लिए उपयुक्त आकार को समझने की कोशिश कर रहे एक मैन्युअल प्रक्रिया का थोड़ा सा है, लेकिन यह अब तक का सबसे अच्छा है।

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

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

के लिए अद्यतन, यहाँ के साथ एक अद्यतन है प्राथमिक नियंत्रण ओ च बॉक्स उपस्थिति (bgfill, bgalpha, bgcol, expand_w, expand_h): ggplot2 1.0 के लिए

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

अद्यतन।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

development version of ggplot2 पैकेज में वहाँ एक नया geom geom_label() कहा जाता है कि इस सीधे लागू करता है। Transperency 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)