Я потратил слишком много времени, пытаясь найти решение для включения weighted.mean (или wtd.mean) в stat_summary и заставить его работать должным образом.
Я просмотрел несколько страниц, пытаясь решить одну и ту же проблему, но ни одна из них не имела окончательного решения.
Основная проблема заключается в том, что weighted.mean, когда-то помещенный в stat_summary, не может найти компонент веса, который, очевидно, не может быть передан из эстетики ggplot и / или stat_summary (поверьте, я пробовал; см. Примеры).
Теперь, я попробовал различные подходы и даже подготовил план взвешенных средних, используя функцию на основе ddplyr (как предложено на другой странице), но, будучи немного неуклюжим, он не допускает фасетирование, поскольку он изменяет исходный кадр данных.
Ниже приведен фрейм данных, специально созданный для этой проблемы.
elements <- c("water","water","water","water","water","water","air","air","air","air","air","air","earth","earth","earth","earth","earth","earth","fire","fire","fire","fire","fire","fire","aether","aether","aether","aether","aether","aether")
shapes <- c("icosahedron","icosahedron","icosahedron","icosahedron","icosahedron","icosahedron","octahedron","octahedron","octahedron","octahedron","octahedron","octahedron","cube","cube","cube","cube","cube","cube","tetrahedron","tetrahedron","tetrahedron","tetrahedron","tetrahedron","tetrahedron","dodecahedron","dodecahedron","dodecahedron","dodecahedron","dodecahedron","dodecahedron")
greek_letter <- c("alpha","beta","gamma","delta","epsilon","zeta","alpha","beta","gamma","delta","epsilon","zeta","alpha","beta","gamma","delta","epsilon","zeta","alpha","beta","gamma","delta","epsilon","zeta","alpha","beta","gamma","delta","epsilon","zeta")
existence <- c("real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","real","not real","not real","not real","not real","not real","not real")
value <- c(0,0,0,5,7,0,0,1,0,20,3,0,0,2,2,1,8,0,0,8,10,4,2,0,0,0,0,1,1,0)
importance <- c(20,20,20,20,20,20,10,10,10,10,10,10,3,3,3,3,3,3,9,9,9,9,9,9,50,50,50,50,50,50)
platonic <- data.frame(elements,shapes,greek_letter,existence,value,importance)
(Примечание: я также добавил столбец "shape", даже если я не буду его использовать, просто чтобы напомнить мне, что я не хочу потерять какие-либо данные в процессе, но он должен быть доступен в конец.)
Первоначальной настройкой был ggplot только со «средним», который включает фасетирование, как в:
ggplot(data = platonic)+
stat_summary(mapping = aes(x=platonic$greek_letter, y=platonic$value), fun.y = "mean", geom = "bar", na.rm = TRUE, inherit.aes = FALSE)+
facet_wrap(~elements~existence)
Ниже приведен соответствующий код, но при использовании «weighted.mean» -> эстетика «w» игнорируется, поэтому предполагается, что все веса равны (по определению функции weighted.mean), что приводит к простое среднее
ggplot(data = platonic)+
stat_summary(mapping = aes(x=platonic$greek_letter, y=platonic$value, w=platonic$importance), fun.y = "weighted.mean", geom = "bar", na.rm = TRUE, inherit.aes = FALSE)
Как видите, выдает предупреждение
Предупреждение: игнорирование неизвестной эстетики: w
Я пробовал несколько способов заставить его «видеть» переменную веса, но безуспешно. В конце я понял, что наиболее многообещающим способом было бы переопределить функцию weight.mean так, чтобы ее значение по умолчанию «w» было функцией «x». Weighted.mean по-прежнему не видит никакой "w" -эстетики, но вычисляет ее по умолчанию. Чтобы добиться этого, я попытался вложить встроенную функцию (weighted.mean) в универсальную функцию, которая позволяет мне изменять аргументы.
Шаг за шагом.
Сначала я попробовал с "значит" (и это работает).
mean.modif <- function(x) {
mean(x)
}
ggplot(data = platonic)+
stat_summary(mapping = aes(x=platonic$greek_letter, y=platonic$value), fun.y = "mean.modif", geom = "bar", na.rm = TRUE, inherit.aes = FALSE)
Затем с weighted.mean
weighted.mean.modif <- function(x,w) {
weighted.mean(x,w)
}
ggplot(data = platonic)+
stat_summary(mapping = aes(x=platonic$greek_letter, y=platonic$value), fun.y = "mean.modif", geom = "bar", na.rm = TRUE, inherit.aes = FALSE)
но он по-прежнему не читает "w" (так как "w" не указано), поэтому возвращает нормальное среднее значение.
Затем я попытался указать аргумент "w" в качестве столбца весов в кадре данных
weighted.mean.modif1 <- function(x,w=platonic$importance) {
weighted.mean(x,w)
}
ggplot(data = platonic)+
stat_summary(mapping = aes(x=platonic$greek_letter, y=platonic$value), fun.y = "mean.modif", geom = "bar", na.rm = TRUE, inherit.aes = FALSE)
но это не работает. Предупреждающее сообщение гласит:
Сбой вычисления в stat_summary():
'x' и 'w' должны иметь одинаковую длину
Застряв, я попытался сгенерировать случайную серию чисел, но такой же длины, что и "x", и это неожиданно сработало.
weighted.mean.modif2 <- function(x,w=runif(x, min = 0, max = 100)) {
weighted.mean(x,w)
}
ggplot(data = platonic)+
stat_summary(mapping = aes(x=platonic$greek_letter, y=platonic$value), fun.y = "weighted.mean.modif2", geom = "bar", na.rm = TRUE, inherit.aes = FALSE)
Очевидно, что есть способ обмануть его, но бесполезно, если я могу использовать только случайные веса.
Я попытался напечатать «х» внутри функции, а затем применил ее, и, хотя она что-то производит, даже «среднее» больше не работает должным образом.
mean.modif3 <- function(x) {
mean(x)
print(x)
}
Итак, сложная часть, которую я не могу понять, это как правильно соотнести значение по умолчанию «w» с «x», чтобы при вызове weighted.mean в stat_summary не читать «w» , в любом случае использует правильные веса.
Как я уже упоминал, существует также обходной путь ddply для получения средневзвешенного графика - поскольку он основан на создании нового исходного кадра данных с только уже организованными переменными и взвешенными средними, но не допускает огранки !!!
weighted.fictious <- function(xxxx, yyyy) {
ddply(xxxx, .(yyyy), function(m) data.frame(fictious_weightedmean=weighted.mean(m$value, m$importance, na.rm = FALSE)))
}
ggplot(data = weighted.fictious(xxxx = platonic, yyyy = platonic$greek_letter), aes(x=yyyy, y=fictious_weightedmean))+
geom_bar(stat = "identity")
Спасибо!