una funcio que fa la ponderacio de forma mes facil, rapid, i robust, a veure

ponderacio_tim_marc.R

library(tidyverse)


# dd <-
#   structure(list(n = structure(c(10, 10, 10, 10, 10, 20, 5, 1), format.spss = "F8.2"), 
# contin = c(1, 2, 3, 4, 5, 1, 2, 3), esp = c(0, 0.5, 0.25, 
# 1, 1, 0, 0.5, 0.25), eur = c(0.5, 0, 0.75, 1, 1, 0.5, 0, 
# 0.75), ame = c(0.25, 0.75, 0, 0.75, 0.75, 0.25, 0.75, 0), 
# afr = c(1, 1, 0.75, 0, 0.75, 1, 1, 0.75), asi = c(1, 1, 0.75, 
# 0.75, 0, 1, 1, 0.75), cont_def = c(NA, NA, NA, NA, NA, NA, 
# NA, NA)), row.names = c(NA, -8L), class = c("tbl_df", "tbl", 
# "data.frame"))

# no fa falta tots els columnes aqui
dd_minim <-
  dd %>% 
  select(n, contin)
# locs <- colnames(dd)[3:7]
# reftabla <- tibble(contin = 1:5,
#                    nom = locs)

# objecte per associar noms amb continents
reftabla <-
structure(list(contin = 1:5, nom = c("esp", "eur", "ame", "afr", "asi")), 
          class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -5L))
# W <- as.matrix(dd[1:5,locs], dimnames = list(locs,locs))
# rownames(W) <- locs

# matriu de pesos
W <- structure(c(0, 0.5, 0.25, 1, 1, 0.5, 0, 0.75, 1, 1, 0.25, 0.75, 
              0, 0.75, 0.75, 1, 1, 0.75, 0, 0.75, 1, 1, 0.75, 0.75, 0), dim = c(5L, 
              5L), 
            dimnames = list(c("esp", "eur", "ame", "afr", "asi"), c("esp", 
                                                                                                                                             "eur", "ame", "afr", "asi")))
# fer cas de prova (del full de calcul)
test <-
  dd_minim %>% 
  left_join(reftabla,  by = "contin") %>% 
  select(-contin) %>% 
  select(n, nom)

# una funcio que fa el exercici mes facil
pes_fun <- function(n, nom, W){
  nn <- length(n)
  cont_def <- rep(NA, nn)
  N <- sum(n)
  for (i in 1:nn){
    
    # extreure el columne que fa falta
    ww <- W[, nom[i]] %>% 
      # vector amb noms
      c() %>% 
      # seleccionar / expandir pels nom que tenim
      '['(nom)
    
    # calcul directe; tot alineat
    cont_def[i] <- sum(ww * n) / (N-  1)
  }
  cont_def
}


# prova: resultat identic
test %>% 
  # aplicar la funcio nostre
  mutate(cont_def = pes_fun(n, nom, W))


test_mes_gran <- 
  # dades simulades:
  tibble(sec_cen = rep(1:10,each = 8),
         n = rpois(80, lambda = 10),
         nom = sample(locs, 80, replace = TRUE)) %>% 
  # declarar grups independents
  group_by(sec_cen) %>% 
  # aplicar la funcio nostre
  mutate(cont_def = pes_fun(n, nom, W)) %>% 
  ungroup()