Создайте цикл по списку и добавьте выходные данные в фрейм данных

Question

Я хочу просмотреть список названий стран, содержащихся в файле миров, и создать отдельные файлы форм для каждой страны.Затем я хочу выполнить вычисление на растре каждого шейп-файла и привести результаты в массив данных с именем страны в качестве переменной ID.

Я успешно написал это для отдельной страны, но изо всех сил пытаюсь получить его взацикливание правильно.

liech.map <- world.polys[world.polys$NAME == "Liechtenstein",]
plot(liech.map)

rasters <- stack(raster_1, raster_2)
rasters.values <- extract(rasters, liech.map)
df <- as.data.frame(rasters.values)
var <- as.data.frame(weighted.mean(x=df$raster_1, w=df$raster_2, na.rm=TRUE))

Что я хочу сделать, это извлечь список названий стран из шейп-файла мирового полигона, создать отдельный полигон для этой страны и зациклить его для каждой страны.Затем выведите 1 кадр данных с `var 'для каждой страны с идентификатором страны.

РЕДАКТИРОВАТЬ

Вот что мне удалось сделать до сих пор, чтоЯ действительно хочу быть в состоянии сделать, это передать следующий код список ID кодов / имен для зацикливания.Я мог, конечно, скопировать и вставить это вручную 200 с лишним раз, но это кажется таким плохим использованием времени !!

### leichenstein map
## 69.67 sec elapsed
tic()
LTU.map <- world.polys[world.polys$ISO3 == "LTU",]
rasters.values <- extract(rasters, LTU.map)
df <- as.data.frame(rasters.values)
rugged_LTU <- as.data.frame(weighted.mean(x=df$raster_1, w=df$raster_2, na.rm=TRUE))
var_LTU$iso3 <- "LTU"
rm(LTU.map)
toc()

# define master dataframe once
var_master <- var_LTU

### UK map
## 127.31 sec elapsed
tic()
GBR.map <- world.polys[world.polys$ISO3 == "GBR",]
rasters.values <- extract(rasters, GBR.map)
df <- as.data.frame(rasters.values)
rugged_GBR <- as.data.frame(weighted.mean(x=df$raster_1, w=df$raster_2, na.rm=TRUE))
var_GBR$iso3 <- "GBR"
var_master <- rbind(var_master, var_GBR)
rm(GBR.map)
toc()

Answer 1

Итак, во-первых, мы создаем список для обработки. world.polys похоже на data.frame или подобное, мы хотим превратить его в именованный список.

polys_by_country <- split(world.polys, word.polys$ISO3)

Далее мы рефакторинг кода для одна страна в функцию:

extract_raster_value <- function(country_map) {
  # Here imagine country map is your LTU.mnap
  rasters.values <- extract(rasters, country_map)
  df <- as.data.frame(rasters.values)
  # compute weighted mean and implicitly return it (last value of function)
  weighted.mean(x=df$raster_1, w=df$raster_2, na.rm=TRUE)
}

ОК, так что extract_raster_value берет карту страны и возвращает одно число, взвешенное среднее. Обратите внимание, что нет необходимости «очищать» рабочее пространство, используя rm. Все локальные переменные, определенные в функции, являются только областью действия функции и не загрязняют глобальную среду.

Вы можете проверить это работает. Я должен предположить, что это так, поскольку вы не предоставили воспроизводимый пример.

LTU.map <- world.polys[world.polys$ISO3 == "LTU",]
extract_raster_value(LTU.map)

Следующим шагом является применение extract_raster_value к каждому элементу polys_by_country.

Вы можете использовать функции apply или lapply из базы R, но я предпочитаю использовать семейство функций map из пакета purrr.

library("purrr")

# Apply process_country to each element of the list and return the list of results
map(polys_by_country, process_country)

Возвращает именованный список, где имена - это имена ISO3, а значения - ваше средневзвешенное значение.

Вместо списка вы можете получить результат в именованном числовом векторе с помощью:

result <- map_dbl(polys_by_country, process_country)

Это полностью исключает петли (или, точнее, скрывает петли).

Вы можете легко превратить результат в data.frame, если хотите:

result_df <- data.frame(
  country = names(result),
  value = result
)

Конечно, может быть гораздо лучший способ сделать это в зависимости от того, что на самом деле находится в world.polys ... Как правило, если это data.frame, это будет намного быстрее запускаться:

library("dplyr")
world.polys %>%
  group_by(ISO3) %>%
  summarise(wm = weighted.mean(raster1, raster2))