13

以下のプロットでは、直接ラベルの位置が垂直方向に少し微調整されていますが、左右の端でクリップされています。クリッピングを回避する方法 ( と同様xpd=TRUE) や、プロット フレーム内でクリップされたラベルを内側に調整する方法はありますか?

ネストされた1

この例のコードは次のとおりです。

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

2 に答える 2

8

コメントで@rawrが指摘したように、リンクされた質問のコードを使用してクリッピングをオフにすることができますが、ラベルが収まるようにプロットのスケールを拡大すると、プロットが見栄えが良くなります. 私は directlabels を使用したことがなく、個々のラベルの位置を微調整する方法があるかどうかはわかりませんが、(1) クリッピングをオフにする、(2) ラベルが収まるようにプロット領域を拡張する、( 3) directlabels の代わりに 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)

ここに画像の説明を入力

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

ここに画像の説明を入力

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

ここに画像の説明を入力

于 2015-05-05T20:24:30.933 に答える