R заполнить матрицу за строкой, используя имена строк и столбцов матрицы - PullRequest
Новая
       12

R заполнить матрицу за строкой, используя имена строк и столбцов матрицы

1 голос
/ 15 марта 2019

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

set.seed(2)
origin <- rep(c("DEU", "GBR", "ITA", "NLD", "CAN", "MEX", "USA", "CHN", "JPN", "KOR","DEU", "GBR", "ITA", "NLD", "CAN", "MEX", "USA", "CHN", "JPN", "KOR"), 2)
year <- rep(c(1998,1998,1998,1998,1998,1998,1998,1998,1998,1998,2000,2000,2000,2000,2000,2000,2000,2000,2000,2000), 2)
value <- sample(1:10000, size=length(origin), replace=TRUE)
test.df <- as.data.frame(cbind(origin, year, value))
rm(origin, year, value)

Затем у меня есть 2 списка.

Первый - это список стран по регионам, созданным с помощью библиотеки ISOcodesследующим образом: 

library("ISOcodes")
list.continent <- list(asia = c("Central Asia", "Eastern Asia", "South-eastern Asia", "Southern Asia", "Western Asia"),
             africa = c("Northern Africa", "Sub-Saharan Africa", "Eastern Africa", "Middle Africa", "Southern Africa", "Western Africa"),
             europe = c("Eastern Europe", "Northern Europe", "Channel Islands", "Southern Europe", "Western Europe"),
             oceania = c("Australia and New Zealand", "Melanesia", "Micronesia", "Polynesia"),
             northamerica = c("Northern America"),
             latinamerica = c("South America", "Central America", "Caribbean"))

country.list.continent <- sapply(list.continent, function(item) {    
    region <- subset(UN_M.49_Regions, Name %in% item)
    sub <- subset(UN_M.49_Countries, Code %in% unlist(strsplit(region$Children, ", ")))
    return(sub$ISO_Alpha_3)
}, simplify = FALSE)
rm(list.continent)

И другой список с годами: 

year.list <- levels(as.factor(unique(test.df$year)))

Я хочу заполнить матрицу вычисленными числами, соответствующими точной области для определенного года.Матрица выглядит следующим образом: 

ncol <- length(year.list)
nrow <- length(country.list.continent)

matrix.extraction <- matrix(, nrow = nrow, ncol = ncol)
rownames(matrix.extraction) <- names(country.list.continent)
colnames(matrix.extraction) <- year.list

Для моих вычислений у меня есть цикл, чтобы иметь возможность подмножество набора данных слишком велико, иначе ... цикл основан на годах (эквивалент colnames(matrix.extraction)),Идея состоит в том, чтобы вычислить, что представляет (в%) ценность каждой страны в течение каждого года.Вычислительная часть достаточно проста и работает хорошо.Моя проблема возникает, когда мне нужно приписать значение каждой строке.

for(i in 1:length(colnames(matrix.extraction))){
    ### I subset and compute what I want
    table.temp <- test.df %>%
                subset(year == colnames(matrix.extraction)[i]) %>%
                group_by(origin) %>%
                summarise(value = sum(value, na.rm = TRUE))
    table.temp$percent <-  prop.table(table.temp$value)
    ### then I need to attribute the wanted values
    matrix.extraction["ROWNAME",i]  <- table.temp %>% 
                                subset(origin %in% country.list.continent$"ROWNAME") %>% 
                                summarise(. ,sum = sum(percent)))
}

Я действительно понятия не имею, как я могу сделать такую ​​вещь.

Ожидаемый результат представляет собой матрицу типа: 

             1998 2000
asia         here   NA
africa         NA   NA
europe         NA   NA
oceania        NA   NA
northamerica   NA   NA
latinamerica   NA   NA

с вместо "здесь" в [1,1] суммы значений каждой страны области в имени строкиза год в colname.

Любая помощь будет оценена.

Ответы [ 2 ]

1 голос
/ 15 марта 2019

Мы могли бы сделать это за tidyverse. Преобразуйте именованный list в набор данных из двух столбцов (enframe или stack), затем выполните full_join с файлом 'test.df' после filter, указав только год, содержащийся в файле year.list ', сгруппированные по' name, 'year', получают sum значения 'value' и spread его в формате 'wide' 

library(tidyverse)
enframe(country.list.continent, value = "origin") %>%
   unnest %>%
   full_join(test.df %>% 
   filter(year %in% year.list)) %>%
   group_by(name, year) %>% 
   summarise(value = sum(value, na.rm = TRUE)) %>% 
   spread(year, value, fill = 0) %>%
   select(-4)
# A tibble: 6 x 3
# Groups:   name [6]
#  name         `1998` `2000`
#  <chr>         <dbl>  <dbl>
#1 africa            0      0
#2 asia          33038  18485
#3 europe        36658  35874
#4 latinamerica  14323  14808
#5 northamerica  15697  27405
#6 oceania           0      0

Или в base R, это можно сделать, stack вставив list в двухколонный data.frame, merge с 'test.df' после subset ing и xtabs создать таблицу 

xtabs(value ~ ind + year, merge(stack(country.list.continent), 
  subset(test.df, year %in% year.list), by.x = "values", by.y = "origin"))
#            year
#ind             1998  2000
#  asia         33038 18485
#  africa           0     0
#  europe       36658 35874
#  oceania          0     0
#  northamerica 15697 27405
#  latinamerica 14323 14808
* * Данные тысяча двадцать-один 
test.df <- data.frame(origin, year, value)
1 голос
/ 15 марта 2019

Используя double sapply, мы можем выполнить цикл по всем комбинациям year.list и country.list.continent и вычислить sum из value для каждой комбинации. 

sapply(year.list, function(x) sapply(names(country.list.continent), function(y) {
     with(test.df, sum(value[origin %in% country.list.continent[[y]] & year == x]))
 }))

#              1998  2000
#asia         21759 20059
#africa           0     0
#europe       39700 35981
#oceania          0     0
#northamerica 21347 17324
#latinamerica 10847  8672

Если мызаинтересован в tidyverse решении 

library(tidyverse)

crossing(x = year.list, y = names(country.list.continent)) %>%
     mutate(sum = map2_dbl(x, y, ~ 
               test.df %>% 
                 filter(year == .x & origin %in% country.list.continent[[.y]]) %>%
                 summarise(total = sum(value)) %>%
                 pull(total)))

#    x     y              sum
#   <chr> <chr>        <dbl>
# 1 1998  africa           0
# 2 1998  asia         21759
# 3 1998  europe       39700
# 4 1998  latinamerica 10847
# 5 1998  northamerica 21347
# 6 1998  oceania          0
# 7 2000  africa           0
# 8 2000  asia         20059
# 9 2000  europe       35981
#10 2000  latinamerica  8672
#11 2000  northamerica 17324
#12 2000  oceania          0

У вас есть числа, хранящиеся в виде коэффициентов в test.df, нам нужно изменить их на действительные числа.Запустите ниже, прежде чем применять вышеуказанные методы.

test.df[-1] <- lapply(test.df[-1], function(x) as.numeric(as.character(x)))
...