Как получить условные средневзвешенные значения для нескольких столбцов

Для следующего кадра данных:

eu <- structure(list(land = structure(c(1L, 4L, 5L, 12L, 9L, 13L, 16L, 18L, 27L, 10L, 25L, 21L, 28L, 19L, 8L, 26L, 6L, 3L, 15L, 14L, 11L, 17L, 20L, 23L, 24L, 2L, 22L, 7L), .Label = c("Belgie", "Bulgarije", "Cyprus", "Denemarken", "Duitsland", "Estland", "Europese Unie", "Finland", "Frankrijk", "Griekenland", "Hongarije", "Ierland", "Italie", "Letland", "Litouwen", "Luxemburg", "Malta", "Nederland", "Oostenrijk", "Polen", "Portugal", "Roemenie", "Slovenie", "Slowakije", "Spanje", "Tsjechie", "Verenigd Koninkrijk", "Zweden"), class = "factor"), `1979` = c(91.36, 47.82, 65.73, 63.61, 60.71, 85.65, 88.91, 58.12, 32.35, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 61.99), `1981` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 81.48, NA, NA, NA, NA, NA, NA, NA,  NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1984` = c(92.09, 52.38, 56.76, 47.56, 56.72, 82.47, 88.79, 50.88, 32.57, 80.59, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 58.98), `1987` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 68.52, 72.42, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1989` = c(90.73, 46.17, 62.28, 68.28, 48.8, 81.07, 87.39, 47.48, 36.37, 80.03, 54.71, 51.1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 58.41), `1994` = c(90.66, 52.92, 60.02, 43.98, 52.71, 73.6, 88.55, 35.69, 36.43, 73.18, 59.14, 35.54, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 56.67), `1995` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 41.63, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1996` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 67.73, 57.6, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), `1999` = c(91.05, 50.46, 45.19, 50.21, 46.76, 69.76, 87.27, 30.02, 24, 70.25, 63.05, 39.93, 38.84, 49.4, 30.14, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 49.51), `2004` = c(90.81, 47.89, 43, 58.58, 42.76, 71.72, 91.35, 39.26, 38.52, 63.22, 45.14, 38.6, 37.85, 42.43, 39.43, 28.3, 26.83, 72.5, 48.38, 41.34, 38.5, 82.39, 20.87, 28.35, 16.97, NA, NA, 45.47), `2007` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 29.22, 29.47, NA), `2009` = c(90.39, 59.54, 43.3, 58.64, 40.63, 65.05, 90.75, 36.75, 34.7, 52.61, 44.9, 36.78, 45.53, 45.97, 40.3, 28.2, 43.9, 59.4, 20.98, 53.7, 36.31, 78.79, 24.53, 28.33, 19.64, 38.99, 27.67, 43), inwoners = c(11161642, 5602628, 80523746, 4591087, 65578819, 59685227, 537039, 16779575, 63896071, 11062508, 46727890, 10487289, 9555893, 8451860, 5426674, 10516125, 1320174, 865878, 2971905, 2023825, 9908798, 421364, 38533299, 2058821, 5410836, 7284552, 20020074, 501403599), plicht = structure(c(1L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("ja", "nee"), class = "factor")), .Names = c("land", "1979", "1981", "1984", "1987", "1989", "1994", "1995", "1996", "1999", "2004", "2007", "2009", "inwoners", "plicht"), row.names = c(NA, -28L), class = "data.frame")

Мне нужно условное значение столбца. Я могу сделать это с помощью:

verplicht <- c("Europese Unie (stemplicht)", colMeans(eu[eu$plicht=="ja",c(2:13)], na.rm=TRUE), NA)
vrij <- c("Europese Unie (geen stemplicht)", colMeans(eu[eu$plicht=="nee",c(2:13)], na.rm=TRUE), NA)
eu2 <- rbind(eu, verplicht, vrij)

Однако мне нужны взвешенные значения столбца с населением страны (столбец inwoners) в качестве весов. Я пытался сделать это с помощью:

verplicht <- c("Europese Unie (stemplicht)", lapply(eu[eu$plicht=="ja",c(2:13)], weighted.mean(x, eu[eu$plicht=="ja",14], na.rm=TRUE)), NA)

но это привело к следующей ошибке:

Error in weighted.mean.default(x, eu[eu$plicht == "ja", 14], na.rm = TRUE) : 
  'x' and 'w' must have the same length

Я понимаю, что говорит сообщение об ошибке, но не знаю, как это решить. Какие-либо предложения?


r mean weighted-average
person Jaap    schedule 08.05.2014    source источник

Ответы (2)


arrow_upward
2
arrow_downward

Проблема в том, как вы используете lapply. Вот правильный код:

lapply(eu[eu$plicht=='ja',2:13], weighted.mean, eu[eu$plicht=='ja','inwoners'], na.rm=TRUE)
lapply(eu[eu$plicht=='nee',2:13], weighted.mean, eu[eu$plicht=='nee','inwoners'], na.rm=TRUE)

Обратите внимание, как weighted.mean используется в качестве аргумента, а не внутри анонимной функции с x в качестве аргумента. Вы могли бы сделать то же самое:

lapply(eu[eu$plicht=='ja',2:13], function(x) weighted.mean(x, eu[eu$plicht=='ja','inwoners'], na.rm=TRUE))
lapply(eu[eu$plicht=='nee',2:13], function(x) weighted.mean(x, eu[eu$plicht=='nee','inwoners'], na.rm=TRUE))

Но сейчас вы как бы смешиваете два разных способа использования lapply.

person Thomas    schedule 08.05.2014
comment
Спасибо! С помощью verplicht <- c("Europese Unie (stemplicht)", lapply(eu[eu$plicht=='ja',2:13], weighted.mean, eu[eu$plicht=='ja','inwoners'], na.rm=TRUE), NA, NA) я получаю список из 15 элементов. Однако, когда я хочу объединить eu и verplicht в новый df с eu2 <- rbind(eu, verplicht), я получаю: Error in match.names(clabs, nmi) : names do not match previous names. В моей первой попытке с colMeans это сработало. Любые идеи, как это решить? - person Jaap; 08.05.2014
comment
@Jaap Попробуйте sapply вместо lapply. lapply возвращает список, тогда как colMeans возвращает вектор, который, вероятно, вызывает проблему. - person Thomas; 08.05.2014
comment
или с lapply это работает rbind(eu,setNames(as.data.frame(verplicht),colnames(eu))) - person Silence Dogood; 08.05.2014
comment
@Thomas Это решает проблему только частично. Перед частью "Europese Unie (stemplicht)" теперь включена часть NA. - person Jaap; 08.05.2014
comment
@Vivek, который также приводит к NA для первого столбца - person Jaap; 08.05.2014
comment
@ Томас Я решил это. Хитрость заключалась в том, чтобы преобразовать первый столбец в символьную переменную. - person Jaap; 08.05.2014

arrow_upward
1
arrow_downward

Если inwoners это население, то

> (weights <- with(eu, inwoners/sum(inwoners)))
#  [1] 0.0111303968 0.0055869443 0.0802983327 0.0045782350 0.0653952416 
#  [6] 0.0595181478 0.0005355356 0.0167326033 0.0637172042 0.0110315403 
# [11] 0.0465970828 0.0104579315 0.0095291428 0.0084282004 0.0054114829
# [16] 0.0104866868 0.0013164784 0.0008634541 0.0029635856 0.0020181596 
# [21] 0.0098810599 0.0004201845 0.0384254312 0.0020530577 0.0053956892 
# [26] 0.0072641601 0.0199640310 0.5000000000

а средневзвешенное значение столбца 2004, например, равно

> weighted.mean(eu$`2004`, w = weights, na.rm = TRUE)
# [1] 45.31782

Чтобы получить средневзвешенное значение каждого столбца года для plicht == 'ja',

> s <- subset(eu, plicht == "ja")
> w2 <- weights[as.numeric(rownames(s))]
> newDF <- do.call(rbind, lapply(2:13, function(i){
      data.frame(wtMean.ja = weighted.mean(s[,i], w = w2, na.rm = TRUE))
      }))
> rownames(newDF) <- names(s)[2:13]
> newDF
#      wtMean.ja
# 1979  86.56735
# 1981  81.48000
# 1984  83.56127
# 1987  68.52000
# 1989  72.30636
# 1994  69.86950
# 1995       NaN
# 1996       NaN
# 1999  69.28708
# 2004  63.17060
# 2007       NaN
# 2009  58.99465
person Rich Scriven    schedule 08.05.2014