Как сгенерировать один и тот же сюжет с «джиттером» и как дрожать выбранные точки (не все точки)?

Question

Что я хотел бы сделать, это:

а) есть участок производства по ggplot кода будет таким же каждый раз, когда он работает [set.seed рода понятия?] И

б) имеют текстовые ярлыки только для ярлыков с одинаковым значением оси y - оставляйте другие текстовые метки в покое. Казалось бы, это какой-то условный дрожание, основанный на значении коэффициента для очков.

Вот некоторые данные:

dput(df) 
structure(list(Firm = c("a verylongname", "b verylongname", "c verylongname", 
"d verylongname", "e verylongname", "f verylongname", "g verylongname", 
"h verylongname", "i verylongname", "j verylongname"), Sum = c(74, 
77, 79, 82, 85, 85, 88, 90, 90, 92)), .Names = c("Firm", "Sum" 
), row.names = c(NA, 10L), class = "data.frame") 

Здесь ggplot код с помощью ДФ:

ggplot(df, aes(x = reorder(Firm, Sum, mean), y = Sum)) + 
    geom_text(aes(label = Firm), size = 3, show.guides = FALSE, position = position_jitter(height = .9)) + 
    theme(axis.text.x = element_blank()) + 
    scale_x_discrete(expand = c(-1.1, 0)) + # to show the lower left name fully 
    labs(x = "", y = "", title = "") 

Уведомление одна версия сюжета еще перекрывается ч и я - каждый раз, когда я запускаю приведенный выше код расположение текстовых меток меняется.

Кстати, этот вопрос conditional jitter сдвигает дискретные значения на оси х немного, но хотелось бы, чтобы сместить перекрывающиеся точки (только) на оси у.

Answer 1

Один из вариантов - добавить столбец для маркировки перекрывающихся точек, а затем построить их отдельно. Лучшим вариантом может быть прямое смещение значений y совпадающих точек, так что мы получим прямой контроль над их размещением. Я показываю оба варианта ниже.

Вариант 1 (джиттер): Сначала добавьте столбец для обозначения перекрытий. В этом случае, поскольку точки в значительной степени попадают на линию, мы можем пометить любые точки как перекрывающиеся, если их значения y слишком близки. Вы можете включить более сложные условия, если важно проверить, близко ли значения x.

df$overlap = lapply(1:nrow(df), function(i) { 
    if(min(abs(df[i, "Sum"] - df$Sum[-i])) <= 1) "Overlap" else "Ignore" 
}) 

В сюжете я окрашивал дрожащие точки красным, поэтому легко определить, какие из них были затронуты.

# Add set.seed() here to make jitter reproducible 
ggplot(df, aes(x = reorder(Firm, Sum, mean))) + 
    geom_text(data=df[df$overlap=="Overlap",], 
      aes(label = Firm, y = Sum), size = 3, 
      position = position_jitter(width=0, height = 1), colour="red") + 
    geom_text(data=df[df$overlap=="Ignore",], 
      aes(label = Firm, y = Sum), size = 3) + 
    theme(axis.text.x = element_blank()) + 
    scale_x_discrete(expand = c(-1.1, 0)) + # to show the lower left name fully 
    labs(x = "", y = "", title = "") 

Вариант 2 (прямое размещение): Другим вариантом является непосредственно контролировать, сколько метки смещаются, а не принимать все, что происходит jitter дать нам. В этом случае мы знаем, что мы хотим сдвинуть каждую пару точек с одинаковым значением y. Более сложная логика будет необходима в тех случаях, когда нам нужно беспокоиться о значениях x и y, более двух точек в одном и том же перекрытии и/или где нам нужно сдвигать близкие значения, но не совсем то же самое.

library(dplyr) 

# Create a new column that shifts pairs of points with the same y-value by +/- 0.25 
df = df %>% group_by(Sum) %>% 
    mutate(SumNoOverlap = if(n()>1) Sum + c(-0.25,0.25) else Sum) 

ggplot(df, aes(x = reorder(Firm, Sum, mean), y = SumNoOverlap)) + 
    geom_text(aes(label = Firm), size = 3) + 
    theme(axis.text.x = element_blank()) + 
    scale_x_discrete(expand = c(-1.1, 0)) + # to show the lower left name fully 
    labs(x = "", y = "", title = "") 

Примечание: Чтобы джиттера воспроизводимым, добавьте set.seed(153) (или независимо от того семени значение, которое вы хотите) до jittered кода участка.