Подтвердить что ты не робот

Функции внутри aes

Вопрос: почему я не могу вызвать sapply внутри aes()?

Цель следующего рисунка: создать гистограмму, показывающую пропорцию, которая умерла/жила, чтобы пропорция для каждой комбинации сумм группы/типа была равна 1 (пример был вдохновлен предыдущим сообщением ).

Я знаю, что вы можете сделать цифру, обобщая вне ggplot, но вопрос в том, почему функция не работает внутри aes.

## Data
set.seed(999)
dat <- data.frame(group=factor(rep(1:2, 25)),
                  type=factor(sample(1:2, 50, rep=T)),
                  died=factor(sample(0:1, 50, rep=T)))

## Setup the figure
p <- ggplot(dat, aes(x=died, group=interaction(group, type), fill=group, alpha=type)) +
  theme_bw() +
  scale_alpha_discrete(range=c(0.5, 1)) +
  ylab("Proportion")

## Proportions, all groups/types together sum to 1 (not wanted)
p + geom_histogram(aes(y=..count../sum(..count..)), position=position_dodge())

enter image description here

## Look at groups
stuff <- ggplot_build(p)
stuff$data[[1]]

## The long way works: proportions by group/type
p + geom_histogram(
    aes(y=c(..count..[..group..==1] / sum(..count..[..group..==1]),
            ..count..[..group..==2] / sum(..count..[..group..==2]),
            ..count..[..group..==3] / sum(..count..[..group..==3]),
            ..count..[..group..==4] / sum(..count..[..group..==4]))),
        position='dodge'
)

enter image description here

## Why can't I call sapply there?
p + geom_histogram(
    aes(y=sapply(unique(..group..), function(g)
        ..count..[..group..==g] / sum(..count..[..group..==g]))),
        position='dodge'
)

Ошибка в get (as.character(FUN), mode = "function", envir = envir):   объект 'expr' режима 'function' не найден

4b9b3361

Ответ 1

Итак, проблема возникает из-за рекурсивного вызова ggplot2:::strip_dots для любой эстетики, которая включает в себя "рассчитанную эстетику". Существует некоторая дискуссия вокруг вычисленной эстетики в этом SO-вопросе и ответе. Соответствующий код в layer.r находится здесь:

new <- strip_dots(aesthetics[is_calculated_aes(aesthetics)])

то есть. strip_dots вызывается только в том случае, если вычисленная эстетика определена с помощью регулярного выражения "\\.\\.([a-zA-z._]+)\\.\\.".

strip_dots in принимает рекурсивный подход, работая через вложенные вызовы и удаляя точки. Код выглядит так:

function (expr) 
{
    if (is.atomic(expr)) {
        expr
    }
    else if (is.name(expr)) {
        as.name(gsub(match_calculated_aes, "\\1", as.character(expr)))
    }
    else if (is.call(expr)) {
        expr[-1] <- lapply(expr[-1], strip_dots)
        expr
    }
    else if (is.pairlist(expr)) {
        as.pairlist(lapply(expr, expr))
    }
    else if (is.list(expr)) {
        lapply(expr, strip_dots)
    }
    else {
        stop("Unknown input:", class(expr)[1])
    }
}

Если мы предоставим анонимную функцию для этого кода следующим образом:

anon <- as.call(quote(function(g) mean(g)))
ggplot2:::strip_dots(anon)

мы воспроизводим ошибку:

#Error in get(as.character(FUN), mode = "function", envir = envir) : 
#  object 'expr' of mode 'function' was not found

Используя это, мы видим, что anon является call. Для call s, strip_dots будет использовать lapply для вызова strip_dots для второго и третьего элементов call. Для анонимной функции, подобной этой, вторым элементом является formals функции. Если мы посмотрим на formals of anon, используя dput(formals(eval(anon))) или dput(anon[[2]]), мы видим следующее:

#pairlist(g = )

Для pairlist s, strip_dots пытается выполнить lapply сам. Я не уверен, почему этот код существует, но, конечно, в этом случае он приводит к ошибке:

expr <- anon[[2]]
lapply(expr, expr)

# Error in get(as.character(FUN), mode = "function", envir = envir) : 
#  object 'expr' of mode 'function' was not found

TL; DR На этом этапе ggplot2 не поддерживает использование анонимных функций в aes, где используется расчетная эстетика (например, ..count..).

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

newDat <- dat %>%
  group_by(died, type, group) %>%
  summarise(count = n()) %>%
  group_by(type, group) %>%
  mutate(Proportion = count / sum(count))

p <- ggplot(newDat, aes(x = died, y = Proportion, group = interaction(group, type), fill=group, alpha=type)) +
  theme_bw() +
  scale_alpha_discrete(range=c(0.5, 1)) +
  geom_bar(stat = "identity", position = "dodge")

Final output

ggplot2 fix

Я разветкил ggplot2 и сделал два изменения в aes_calculated.r, которые исправляют проблему. Первым было исправить обработку pairlist до lapply strip_dots вместо expr, что, я думаю, должно было быть предполагаемым поведением. Во-вторых, для формалей без значения по умолчанию (например, в приведенных здесь примерах) as.character(as.name(expr)) выдает ошибку, поскольку expr является пустым именем, и хотя это допустимая конструкция, невозможно создать ее из пустая строка.

Закупоренная версия ggplot2 на https://github.com/NikNakk/ggplot2 и вытащить запрос только что сделано.

Наконец, после всего, приведенный пример sapply не работает, потому что он возвращает матрицу с двумя столбцами на 4 столбца, а не 8 длиной. Исправленная версия выглядит следующим образом:

p + geom_histogram(
    aes(y=unlist(lapply(unique(..group..), function(g)
        ..count..[..group..==g] / sum(..count..[..group..==g])))),
    position='dodge'
)

Это дает тот же результат, что и решение dplyr выше.

Еще одна вещь, которую следует отметить, заключается в том, что этот код lapply предполагает, что данные на этом этапе сортируются по группам. Я думаю, что это всегда так, но если по какой бы то ни было причине, вы бы не закончили с данными y не в порядке. Альтернативой, которая сохраняет порядок строк в вычисленных данных, будет:

p + geom_histogram(
  aes(y={grp_total <- tapply(..count.., ..group.., sum);
  ..count.. / grp_total[as.character(..group..)]
  }),
  position='dodge'
)

Также стоит знать, что эти выражения оцениваются в baseenv(), пространстве имен базового пакета. Это означает, что любые функции из других пакетов, даже стандартных, таких как stats и utils, должны использоваться с оператором :: (например, stats::rnorm).

Ответ 2

После небольшой игры проблема заключается в использовании анонимных функций с помощью..group.. или..count.. внутри aes:

xy <- data.frame(x=1:10,y=1:10) #data

ggplot(xy, aes(x = x, y = sapply(y, mean))) + geom_line() #sapply is fine

ggplot(xy, aes(x = x, group = y)) + 
       geom_bar(aes(y = sapply(..group.., mean))) #sapply with ..group.. is fine

ggplot(xy, aes(x = x, group = y)) + 
       geom_bar(aes(y = sapply(..group.., function(g) {mean(g)})))
#broken, with same error

ggplot(xy, aes(x = x, group = y)) + 
    geom_bar(aes(y = sapply(y, function(g) {mean(g)})), stat = "identity")
#sapply with anonymous functions works fine!

Кажется, это действительно странная ошибка, если я не пропущу что-то глупое.