2015-05-05 182 views
6

在下面的图中,直接标签位置垂直调整了一些,但它们在左/右边缘被裁剪。有没有办法避免裁剪(类似于xpd=TRUE)或在绘图框中向内调整裁剪标签?直接标签:避免裁剪(如xpd = TRUE)

nested1

下面是这个例子的代码:

library(car) 
library(reshape2) 
library(ggplot2) 
library(directlabels) 
library(nnet) 

## Sec. 8.2 (Nested Dichotomies) 

# transform data 

Womenlf <- within(Womenlf,{ 
    working <- recode(partic, " 'not.work' = 'no'; else = 'yes' ") 
    fulltime <- recode(partic, 
    " 'fulltime' = 'yes'; 'parttime' = 'no'; 'not.work' = NA")}) 

mod.working <- glm(working ~ hincome + children, family = binomial, 
        data = Womenlf) 
mod.fulltime <- glm(fulltime ~ hincome + children, family = binomial, 
        data = Womenlf) 

predictors <- expand.grid(hincome = 1:50, 
          children = c("absent", "present")) 
fit <- data.frame(predictors, 
    p.working = predict(mod.working, predictors, type = "response"), 
    p.fulltime = predict(mod.fulltime, predictors, type = "response"), 
    l.working = predict(mod.working, predictors, type = "link"), 
    l.fulltime = predict(mod.fulltime, predictors, type = "link") 
) 

fit <- within(fit, { 
    `full-time` <- p.working * p.fulltime 
    `part-time` <- p.working * (1 - p.fulltime) 
    `not working` <- 1 - p.working 
    }) 

# Figure 8.10 
fit2 = melt(fit, 
      measure.vars = c("full-time","part-time","not working"), 
      variable.name = "Participation", 
      value.name = "Probability") 

gg <- ggplot(fit2, 
      aes(x = hincome, y = Probability, colour = Participation)) + 
     facet_grid(~ children, labeller = function(x, y) sprintf("%s = %s", x, y)) + 
     geom_line(size = 2) + theme_bw() 

direct.label(gg, list("top.bumptwice", dl.trans(y = y + 0.2))) 
+0

可能重复[GGPLOT2 - 诠释剧情之外(http://stackoverflow.com/questions/ 12409960/GGPLOT2-注释-外的积) – rawr

回答

5

由于@rawr在评论中指出,可以使用在linked question的代码以关闭裁剪,但情节看起来如果您扩大剧情的规模,以便标签贴合,则更好。我没有使用过直接标签,也不确定是否有办法调整各个标签的位置,但这里有三个选项:(1)关闭裁剪,(2)扩大绘图区域,使标签适合,( 3)使用geom_text代替直接标签来放置标签。

# 1. Turn off clipping so that the labels can be seen even if they are 
# outside the plot area. 
gg = direct.label(gg, list("top.bumptwice", dl.trans(y = y + 0.2))) 

gg2 <- ggplot_gtable(ggplot_build(gg)) 
gg2$layout$clip[gg2$layout$name == "panel"] <- "off" 
grid.draw(gg2) 

enter image description here

# 2. Expand the x and y limits so that the labels fit 
gg <- ggplot(fit2, 
      aes(x = hincome, y = Probability, colour = Participation)) + 
    facet_grid(~ children, labeller = function(x, y) sprintf("%s = %s", x, y)) + 
    geom_line(size = 2) + theme_bw() + 
    scale_x_continuous(limits=c(-3,55)) + 
    scale_y_continuous(limits=c(0,1)) 

direct.label(gg, list("top.bumptwice", dl.trans(y = y + 0.2))) 

enter image description here

# 3. Create a separate data frame for label positions and use geom_text 
# (instead of directlabels) to position the labels. I've set this up so the 
# labels will appear at the right end of each curve, but you can change 
# this to suit your needs. 
library(dplyr) 
labs = fit2 %>% group_by(children, Participation) %>% 
    summarise(Probability = Probability[which.max(hincome)], 
      hincome = max(hincome)) 

    gg <- ggplot(fit2, 
      aes(x = hincome, y = Probability, colour = Participation)) + 
    facet_grid(~ children, labeller = function(x, y) sprintf("%s = %s", x, y)) + 
    geom_line(size = 2) + theme_bw() + 
    geom_text(data=labs, aes(label=Participation), hjust=-0.1) + 
    scale_x_continuous(limits=c(0,65)) + 
    scale_y_continuous(limits=c(0,1)) + 
    guides(colour=FALSE) 

enter image description here

3

更新到ggplot2 V2.0.0和directlabels v2015.12.16

一种方法是更改​​direct.label的方法。标签线没有太多其他的好选择,但angled.boxes是一种可能性。

gg <- ggplot(fit2, 
      aes(x = hincome, y = Probability, colour = Participation)) + 
     facet_grid(. ~ children, labeller = label_both) + 
     geom_line(size = 2) + theme_bw() 

direct.label(gg, method = list(box.color = NA, "angled.boxes")) 

OR

ggplot(fit2, aes(x = hincome, y = Probability, colour = Participation, label = Participation)) + 
     facet_grid(. ~ children, labeller = label_both) + 
     geom_line(size = 2) + theme_bw() + scale_colour_discrete(guide = 'none') + 
     geom_dl(method = list(box.color = NA, "angled.boxes")) 

enter image description here



原来的答复

一种方法是改变direct.label的方法。标签线没有太多其他的好选择,但angled.boxes是一种可能性。不幸的是,angled.boxes不能开箱即用。需要加载函数far.from.others.borders(),并且我修改了另一个函数draw.rects(),将框边界的颜色更改为NA。 (两个功能available here。)

(或修改答案from here)的

## Modify "draw.rects" 

draw.rects.modified <- function(d,...){ 
    if(is.null(d$box.color))d$box.color <- NA 
    if(is.null(d$fill))d$fill <- "white" 
    for(i in 1:nrow(d)){ 
    with(d[i,],{ 
     grid.rect(gp = gpar(col = box.color, fill = fill), 
       vp = viewport(x, y, w, h, "cm", c(hjust, vjust), angle=rot)) 
    }) 
    } 
    d 
} 




## Load "far.from.others.borders" 

far.from.others.borders <- function(all.groups,...,debug=FALSE){ 
    group.data <- split(all.groups, all.groups$group) 
    group.list <- list() 
    for(groups in names(group.data)){ 
    ## Run linear interpolation to get a set of points on which we 
    ## could place the label (this is useful for e.g. the lasso path 
    ## where there are only a few points plotted). 
    approx.list <- with(group.data[[groups]], approx(x, y)) 
    if(debug){ 
     with(approx.list, grid.points(x, y, default.units="cm")) 
    } 
    group.list[[groups]] <- data.frame(approx.list, groups) 
    } 
    output <- data.frame() 
    for(group.i in seq_along(group.list)){ 
    one.group <- group.list[[group.i]] 
    ## From Mark Schmidt: "For the location of the boxes, I found the 
    ## data point on the line that has the maximum distance (in the 
    ## image coordinates) to the nearest data point on another line or 
    ## to the image boundary." 
    dist.mat <- matrix(NA, length(one.group$x), 3) 
    colnames(dist.mat) <- c("x","y","other") 
    ## dist.mat has 3 columns: the first two are the shortest distance 
    ## to the nearest x and y border, and the third is the shortest 
    ## distance to another data point. 
    for(xy in c("x", "y")){ 
     xy.vec <- one.group[,xy] 
     xy.mat <- rbind(xy.vec, xy.vec) 
     lim.fun <- get(sprintf("%slimits", xy)) 
     diff.mat <- xy.mat - lim.fun() 
     dist.mat[,xy] <- apply(abs(diff.mat), 2, min) 
    } 
    other.groups <- group.list[-group.i] 
    other.df <- do.call(rbind, other.groups) 
    for(row.i in 1:nrow(dist.mat)){ 
     r <- one.group[row.i,] 
     other.dist <- with(other.df, (x-r$x)^2 + (y-r$y)^2) 
     dist.mat[row.i,"other"] <- sqrt(min(other.dist)) 
    } 
    shortest.dist <- apply(dist.mat, 1, min) 
    picked <- calc.boxes(one.group[which.max(shortest.dist),]) 
    ## Mark's label rotation: "For the angle, I computed the slope 
    ## between neighboring data points (which isn't ideal for noisy 
    ## data, it should probably be based on a smoothed estimate)." 
    left <- max(picked$left, min(one.group$x)) 
    right <- min(picked$right, max(one.group$x)) 
    neighbors <- approx(one.group$x, one.group$y, c(left, right)) 
    slope <- with(neighbors, (y[2]-y[1])/(x[2]-x[1])) 
    picked$rot <- 180*atan(slope)/pi 
    output <- rbind(output, picked) 
    } 
    output 
} 



## Draw the plot 

angled.boxes <- 
    list("far.from.others.borders", "calc.boxes", "enlarge.box", "draw.rects.modified") 

gg <- ggplot(fit2, 
      aes(x = hincome, y = Probability, colour = Participation)) + 
     facet_grid(~ children, labeller = function(x, y) sprintf("%s = %s", x, y)) + 
     geom_line(size = 2) + theme_bw() 

direct.label(gg, list("angled.boxes")) 

enter image description here