Применение весов к фрейму данных и их масштабирование в R

Question

У меня есть датафрейм в R, который выглядит так:

А затем другой весовой массив данных, который выглядит следующим образом:

То, что я хочу сделать, - это применить веса к кадру данных, что довольно просто, и я могу сделать это, используя следующий код:

dataframe$month <- as.numeric(dataframe$month)
dataframe_weight<-dataframe

for (i in 1:15){
  dataframe_weight[i,]<-dataframe[i,]*weights
}

, который возвращает мне следующий фрейм данных:

Однако это не учитывает НС. Что мне нужно сделать, так это каким-то образом перемасштабировать веса, чтобы они равнялись 1 во всех строках, но каждый возраст по-прежнему имеет пропорциональные веса. Например, в месяце 201408, age1, значение все равно должно быть 1, когда применяются веса, потому что нет других значений, и поэтому значение получает весь вес. За второй месяц, 201409, поскольку существует только два значения, пропорционально возраст 1 получит ок. 53% веса и возраст2 47% веса (0,1809143 / (0,1809143 + 0,1590556))

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

month <- c("201408", "201409", "201410", "201411", "201412", "201501", "201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age1 <- c(1, 0.9464432, 0.9661004, 2.2874682, 0.6786986, 0.7456758, 1.1342144, 0.9981846, 1.0592016, 0.8341938, 1.1630893, 0.9972508, 1.0716317, 1.0424335, 1.075181)
age1 <- data.frame(month, age1)

month <- c("201409", "201410", "201411", "201412", "201501", "201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age2 <- c(1, 0.9397603, 1.0692599, 2.2361409, 0.5877691, 0.8220721, 1.087845, 0.9934881, 1.0479094, 0.8770588, 1.107826, 1.0017968, 1.0764996,1.034393)
age2 <- data.frame(month, age2)

month <- c("201410", "201411", "201412", "201501", "201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age3 <- c(1, 0.9078398, 1.0619787, 1.4231532, 0.937846, 0.8444599, 1.0654393, 1.0079098, 0.994476, 0.6992733, 1.4121658, 1.025296, 1.0913576)
age3 <- data.frame(month, age3)

month <- c("201411", "201412", "201501", "201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age4 <- c(1, 0.8942244, 0.9099405, 1.5851158, 1.0059785, 0.8506144, 1.0508878, 0.9639585, 0.6992876, 1.0276086, 1.4123104, 1.0038351)
age4 <- data.frame(month, age4)

month <- c("201412", "201501", "201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age5 <- c(1, 0.7264975, 1.1133892, 1.4952122, 1.0502483, 0.8943884, 1.0049447, 0.7233516, 0.9075124, 1.1223967, 1.2951269)
age5 <- data.frame(month, age5)

month <- c("201501", "201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age6 <- c(1, 0.9679026, 1.0168767, 1.5844894, 1.0294516, 0.9014677, 0.6664228, 1.0717137, 0.8909056, 1.1459715)
age6 <- data.frame(month, age6)

month <- c("201502", "201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age7 <- c(1, 0.9403795, 1.1877307, 1.359906, 1.1427003, 0.5717126, 0.9550687, 1.1257902, 0.8886474)
age7 <- data.frame(month, age7)

month <- c("201503", "201504", "201505", "201506", "201507", "201508", "201509", "201510")
age8 <- c(1, 0.9701066, 1.1289901, 1.4153004, 0.756067, 0.7669884, 1.0004406, 1.1310102)
age8 <- data.frame(month, age8)

month <- c("201504", "201505", "201506", "201507", "201508", "201509", "201510")
age9 <- c(1, 0.8378029, 1.3229611, 0.9690153, 1.0648304, 0.7414129, 1.0042986)
age9 <- data.frame(month, age9)

month <- c("201505", "201506", "201507", "201508", "201509", "201510")
age10plus <- c(1, 0.9856009, 0.9402859, 0.9949159, 1.0224494, 0.9917433) 
age10plus <- data.frame(month, age10plus)

library(dplyr)
library(purrr)
dataframe <- list(age1, age2, age3, age4, age5, age6, age7, age8, age9, age10plus) %>% reduce(left_join, by= "month")


weights <- c(0.18091432, 0.15905558, 0.13518614, 0.11459798, 0.09552710, 0.07757876, 0.06265265, 0.05057607, 0.03761133, 0.08630005)
weights <- data.frame(cbind(c(1), t(weights)))




dataframe$month <- as.numeric(dataframe$month)
dataframe_weight<-dataframe

for (i in 1:15){
  dataframe_weight[i,]<-dataframe[i,]*weights
}

Answer 1

dataframe$month <- as.numeric(dataframe$month)

Создание фрейма данных 1 в формальной форме. Мне нужно ответить на поставленный выше вопрос

dataframe_weight <- dataframe
dataframe_weight[!is.na(dataframe_weight)] <- 1
dataframe_weight[,1] <- dataframe$month

Умножить новый фрейм данных (фрейм данных 1) на весовой фрейм данных

rescaled_weight<-dataframe_weight

    for (i in 1:15){
         rescaled_weight[i,]<-dataframe_weight[i,]*weights
    }

Масштабирование / нормализация весов

rescaled_weight <- rescaled_weight[,-1]/rowSums(rescaled_weight[,-1], na.rm=T)

Проверить новую сумму весов до 1

rescaled_weight <- rescaled_weight %>%
  mutate(aggregate=rowSums(rescaled_weight[,1:10], na.rm=TRUE))

rescaled_weight <- rescaled_weight[,-11]
dataframe <- dataframe[,-1]

Применение весов к исходному фрейму данных

weightsapplied <- rescaled_weight * dataframe

Answer 2

#more appropriate data structures
m <- as.matrix(dataframe[,-1])
rownames(m) <- dataframe[, 1]

weights <- as.numeric(weights)

#first value of weights seems superfluous
weights <- weights[-1]

#create matrix of normalized weights
w <- t(outer(weights, 
             c((!is.na(m)) %*% weights), #matrix multiplication to sum weights for non-NA values
             "/"))

#check that weights sum to 1
is.na(w) <- is.na(m) 
rowSums(w, na.rm = TRUE)
#[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

#multiply
m * w
#            age1      age2       age3       age4       age5       age6       age7       age8       age9  age10plus
#201408 1.0000000        NA         NA         NA         NA         NA         NA         NA         NA         NA
#201409 0.5036479 0.4678519         NA         NA         NA         NA         NA         NA         NA         NA
#201410 0.3678400 0.3145790 0.28450894         NA         NA         NA         NA         NA         NA         NA
#201411 0.7017091 0.2883774 0.20809923 0.19431488         NA         NA         NA         NA         NA         NA
#201412 0.1791765 0.5190143 0.20949767 0.14953908 0.13939841         NA         NA         NA         NA         NA
#201501 0.1768391 0.1225493 0.25219649 0.13669266 0.09097372 0.10169464         NA         NA         NA         NA
#201502 0.2485675 0.1583927 0.15358190 0.22004641 0.12883977 0.09096008 0.07589546         NA         NA         NA
#201503 0.2061274 0.1975004 0.13030563 0.13158841 0.16303521 0.09004573 0.06725035 0.05772940         NA         NA
#201504 0.2097239 0.1729450 0.15763668 0.10668567 0.10980320 0.13453292 0.08144301 0.05369835 0.04116377         NA
#201505 0.1509176 0.1666758 0.13625544 0.12042962 0.08543833 0.07986358 0.08520172 0.05709988 0.03151088 0.08630005
#201506 0.2104195 0.1395011 0.13443937 0.11046770 0.09599945 0.06993475 0.07159320 0.07158033 0.04975833 0.08505741
#201507 0.1804170 0.1762059 0.09453206 0.08013695 0.06909968 0.05170026 0.03581931 0.03823890 0.03644595 0.08114672
#201508 0.1938735 0.1593414 0.19090525 0.11776187 0.08669203 0.08314222 0.05983759 0.03879126 0.04004969 0.08586129
#201509 0.1885912 0.1712233 0.13860581 0.16184792 0.10721930 0.06911535 0.07053374 0.05059835 0.02788553 0.08823744
#201510 0.1945156 0.1645260 0.14753642 0.11503748 0.12371972 0.08890305 0.05567612 0.05720205 0.03777301 0.08558750