Существует ли функция R l oop (data.table) для запуска более 100 с результатов `gam` без превышения лимита памяти? - PullRequest
1 голос
/ 20 февраля 2020

Пространственная интерполяция с использованием gam

Заявление

Я надеюсь получить много выходных данных пространственной интерполяции с использованием обобщенных аддитивных моделей (GAM). Нет проблем для прогнозирования одной карты загрязнения, однако мне нужно более 100 карт. Если возможно, я бы хотел автоматизировать реализацию, а также получить результаты без превышения лимита памяти.

Процесс пространственной интерполяции с использованием GAM (mgcv пакет)

Просто чтобы сообщить вам, вот основные шаги для получения интерполированной карты.

  • Получить координаты X, Y станций мониторинга загрязнения
  • Получить данные о загрязнении для каждой станции
  • Добавить данные о загрязнении во фрейм данных, содержащий координаты X, Y
  • Выполнить gam(pollution ~ s(X,Y, k=20)) для каждого столбца загрязнения
  • Создать пустой фрейм данных с min и max X, Y координатами как пространственный экстент
  • Прогнозировать пространственный экстент, используя predict и gam результат
  • Выполнить одно и то же задание для всех полей загрязнения

Я покажу практический пример того, как я подошел к нему.

Пример данных

Чтобы привести пример, я создал набор данных, который показан ниже. Из df вы поймете, что у меня есть X Y и 3 переменных загрязнения.

library(data.table)
library(mgcv)

X <- c(197745.8,200443.8,200427.6,208213.4,203691.1,208303.0,202546.4,202407.9,202564.8,194095.5,194508.0,195183.8,185432.5,
       190249.0,190927.0,197490.1,193551.5,204204.4,199508.4,210201.4,212088.3,191886.5,201045.2,187321.7,205987.0)
Y <- c(451633.1,452496.8,448949.5,449753.3,449282.2,453928.5,452923.2,456347.9,461614.8,456729.3,453019.7,450039.7,449472.0,
       444348.1,447274.4,442390.0,443101.2,446446.5,445008.5,446765.2,449508.5,439225.3,460915.6,447392.0,461985.3)
poll1 <- c(34,29,29,33,33,38,35,30,41,43,35,34,41,41,40,36,35,27,53,40,37,32,28,36,33)
poll2 <- c(27,27,34,30,38,36,36,35,37,39,35,33,41,42,40,34,38,31,43,46,38,32,29,33,34)
poll3 <- c(26,30,27,30,37,41,36,36,35,35,35,33,41,36,38,35,34,24,40,43,36,33,30,32,36)

df <- data.table(X, Y, poll1, poll2, poll3)

Как я над этим работал

1. Жесткий код

Если вы посмотрите на приведенный ниже код, вы поймете, что я скопировал и вставил одно и то же задание во все переменные. Это будет чрезвычайно трудно реализовать много переменных.

# Run gam
gam1 <- gam(poll1 ~ s(X,Y, k=20), data = df)
gam2 <- gam(poll2 ~ s(X,Y, k=20), data = df)
gam3 <- gam(poll3 ~ s(X,Y, k=20), data = df)
         # "there are over 5000 variables that needs looping


# Create an empty surface for prediction
GAM_poll <- data.frame(expand.grid(X = seq(min(df$X), max(df$X), length=200),
                                   Y = seq(min(df$Y), max(df$Y), length=200)))


# Predict gam results to the empty surface
GAM_poll$gam1 <- predict(gam1, GAM_poll, type = "response")
GAM_poll$gam2 <- predict(gam2, GAM_poll, type = "response")
GAM_poll$gam3 <- predict(gam3, GAM_poll, type = "response")

2. Используя for L oop

Вместо этого я составил список и попытался l oop всех переменных, чтобы получить результаты. Это, конечно, не проблема per se , но перебор нескольких переменных займет всю память (это то, что я испытал).

# Run gam using list and for loop
myList <- list()

for(i in 3:length(df)){
  myList[[i-2]] <- gam(df[[i]] ~ s(X,Y, k=20), data = df)
}


# Create an empty surface for prediction
GAM_poll <- data.frame(expand.grid(X = seq(min(df$X), max(df$X), length=200),
                                   Y = seq(min(df$Y), max(df$Y), length=200)))


# Predict gam results to the empty surface
myResult <- list()

for(j in 1:length(myList)){
myResult[[j]] <- predict(myList[[j]], GAM_poll, type = "response")
}

Обращение за помощью

  • Есть ли лучший способ получить результаты gam по нескольким переменным?
  • Есть ли способ не превышать лимит памяти во время реализации?

Можете ли вы помочь мне data.table, purrr пользователей?

1 Ответ

0 голосов
/ 20 февраля 2020

Решение, которое я создал, сохраняет только самые последние прогнозы в памяти и сохраняет остальные на диск, прежде чем перезаписать его следующим решением. Файлы называются по имени столбца модели в папке с именем результатов. Я также расплавил data.table, главным образом потому, что я думаю, что код немного более понятен.

library(data.table)
library(mgcv)

X <- c(197745.8,200443.8,200427.6,208213.4,203691.1,208303.0,202546.4,202407.9,202564.8,194095.5,194508.0,195183.8,185432.5,
       190249.0,190927.0,197490.1,193551.5,204204.4,199508.4,210201.4,212088.3,191886.5,201045.2,187321.7,205987.0)
Y <- c(451633.1,452496.8,448949.5,449753.3,449282.2,453928.5,452923.2,456347.9,461614.8,456729.3,453019.7,450039.7,449472.0,
       444348.1,447274.4,442390.0,443101.2,446446.5,445008.5,446765.2,449508.5,439225.3,460915.6,447392.0,461985.3)
poll1 <- c(34,29,29,33,33,38,35,30,41,43,35,34,41,41,40,36,35,27,53,40,37,32,28,36,33)
poll2 <- c(27,27,34,30,38,36,36,35,37,39,35,33,41,42,40,34,38,31,43,46,38,32,29,33,34)
poll3 <- c(26,30,27,30,37,41,36,36,35,35,35,33,41,36,38,35,34,24,40,43,36,33,30,32,36)

df <- data.table(X, Y, poll1, poll2, poll3)


# melt the data.table
df <- melt.data.table(df, id.vars = c('X', 'Y'))

dir.create('results')
gam1 <- list()
for(i in unique(df$variable)){

  gam1[[i]] <- gam(value ~ s(X,Y, k=20), data = df[variable == i])

  GAM_poll <- data.table(expand.grid(X = seq(min(df$X), max(df$X), length=200),
                                     Y = seq(min(df$Y), max(df$Y), length=200)))


  GAM_poll[, 'prediction' := predict(gam1[[i]], GAM_poll, type = "response")]

  write.csv(GAM_poll$prediction, paste('results/model_', i, '.csv'), row.names = FALSE)

}
...