Применение функции для нескольких групп с использованием dplyr - PullRequest
0 голосов
/ 17 мая 2018

У меня есть некоторые данные для нескольких местоположений и года

big.data <- data.frame(loc.id = rep(1:3, each = 10*3), 
                   year = rep(rep(1981:1983, each = 10),times = 3), 
                   day = rep(1:10, times = 3*3),
                   CN = rep(c(50,55,58), each = 10*3),
                   top.FC = rep(c(72,76,80),each = 10*3),
                   DC = rep(c(0.02,0.5,0.8), each = 10*3),
                   WAT0 = rep(c(20,22,26), each = 10*3),
                   Precp = sample(1:100,90, replace = T),
                   ETo = sample(1:10,90, replace = T)) 

У меня есть функция: water.model, которая использует вторую функцию с внутренним названием water.update

water.model <- function(dat){

     top.FC  <- unique(dat$top.FC)    

     dat$WAT <- -9.9
     dat$RO <- -9.9
     dat$DR <- -9.9

     dat$WAT[1] <- top.FC/2 # WAT.i is a constant 
     dat$RO[1] <- NA 
     dat$DR[1] <- NA

     for(d in 1:(nrow(dat)-1)){

       dat[d + 1,10:12] <- water.update(WAT0 = dat$WAT[d], 
                                        RAIN.i = dat$Precp[d + 1], 
                                        ETo.i = dat$ETo[d + 1], 
                                        CN = unique(dat$CN), 
                                        DC = unique(dat$DC),
                                        top.FC = unique(dat$top.FC))
     }
     return(dat)
   }



water.update <- function(WAT0, RAIN.i, ETo.i, CN, DC, top.FC){ 

        S = 25400/CN - 254;  IA = 0.2*S

        if (RAIN.i > IA) { RO = (RAIN.i - 0.2 * S)^2/(RAIN.i + 0.8 * S)
          } else { 
            RO = 0 
            }

          if (WAT0 + RAIN.i - RO > top.FC) { 
              DR = DC * (WAT0 + RAIN.i - RO - top.FC) 
              } else { 
              DR = 0 
            }    
        dWAT = RAIN.i - RO - DR - ETo.i
        WAT1 = WAT0 + dWAT
        WAT1 <- ifelse(WAT1 < 0, 0, WAT1) 
        return(list(WAT1,RO,DR))
    } 

Если язапустить указанную выше функцию для одного местоположения X год

big.data.sub <- big.data[big.data$loc.id == 1 & big.data$year == 1981,]
water.model(big.data.sub)

   loc.id year day CN top.FC   DC WAT0 Precp ETo      WAT        RO       DR
   1       1 1981   1 50     72 0.02   20    52   5  36.0000        NA       NA
   2       1 1981   2 50     72 0.02   20    12   9  39.0000 0.0000000 0.000000
   3       1 1981   3 50     72 0.02   20     3   2  40.0000 0.0000000 0.000000
   4       1 1981   4 50     72 0.02   20    81   9 107.8750 3.2091485 0.915817
   5       1 1981   5 50     72 0.02   20    37  10 133.4175 0.0000000 1.457501
   6       1 1981   6 50     72 0.02   20    61   7 184.5833 0.3937926 2.440475
   7       1 1981   7 50     72 0.02   20    14  10 186.0516 0.0000000 2.531665
   8       1 1981   8 50     72 0.02   20     9   6 186.5906 0.0000000 2.461032
   9       1 1981   9 50     72 0.02   20    77   9 248.3579 2.4498216 3.782815
   10      1 1981  10 50     72 0.02   20    18   6 256.4708 0.0000000 3.887159

Как выполнить это для всех местоположений и года?

big.data %>% group_by(loc.id, year) %>% # apply my function here.

Мои окончательные данные должны выглядеть, как указано выше, с тремя новымистолбцы с именами WAT, RO и DR, которые генерируются при запуске функции.

1 Ответ

0 голосов
/ 17 мая 2018

Мы можем разделить данные и применить water.model, зациклив list с map

library(tidyverse)
split(big.data, big.data[c('loc.id', 'year')], drop = TRUE) %>% 
           map_df(water.model)

Или применить функцию в do после group_by

big.data %>%
   group_by(loc.id, year) %>%
   do(data.frame(water.model(.)))
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...