2015-05-05 15 views
6

(XPD = TRUE gibi), direkt etiket pozisyonları dikey biraz tweaked, ama onlar sağ/sol kenarlarına kırpılıyordu. Kırpmayı önlemek için herhangi bir yol var mı (xpd=TRUE'a benzer) veya kırpılan etiketleri çizim çerçevelerinde içeriye doğru ayarlayınız mı? İşte directlabels: kırpma önlemek aşağıda arsa

nested1

Bu örnek için kod: @rawr yorumunda belirttiği gibi

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

olası yinelenen

(. Her iki fonksiyon available here vardır) [ggplot2 - arsa dışında açıklama] (http://stackoverflow.com/questions/ 12409960/ggplot2-notasyon dışında-of-arsa) – rawr

cevap

5

, kırpmanın kapatmak için linked question kodu kullanabilirsiniz, ancak arsa bakacağız etiketlerin sığdırmak için arsa ölçeğini genişletirseniz daha iyi. Doğrudan etiket kullanmıyorum ve münferit etiketlerin yerlerini değiştirmenin bir yolu olup olmadığından emin değilim, fakat burada üç seçenek daha var: (1) kırpmayı kapatın, (2) etiket alanını sığdırmak için çizim alanını genişletin ve (3) etiketleri yerleştirmek için directlabels yerine geom_text kullanın.

# 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

güncellenmesi v2.0.0 ggplot2 ve directlabels v2015.12.16

Bir yaklaşım, direct.label yöntemini değiştirmektir. Etiketleme için çok fazla iyi seçenek yoktur, ancak angled.boxes bir olasılıktır.

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")) 

VEYA

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



Orijinal cevap

bir yaklaşım direct.label 'ın yöntemini değiştirmektir. Etiketleme için çok fazla iyi seçenek yoktur, ancak angled.boxes bir olasılıktır. Ne yazık ki, angled.boxes kutunun dışında çalışmıyor. far.from.others.borders() işlevinin yüklenmesi gerekiyor ve kutu sınırlarının rengini NA olarak değiştirmek için başka bir işlev, draw.rects() değiştirdim. (from here Ya cevapları adapte) ait

## 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