Использование al oop в функции для прогнозирования на 20 лет вперед - PullRequest
0 голосов
/ 18 июня 2020

Контекст: я создаю математическую модель того, сколько жизней было бы спасено, если бы мы подняли цену на алкоголь. У меня разные вероятности смерти от трех причин, связанных с алкоголем, и вероятность смерти от всех других причин. Я хочу заглянуть вперед на 20 лет, рассчитывая ежегодно новое население и количество людей, которые умирают ie по всем другим причинам, а также по каждой из трех моих проблем со здоровьем. Я написал функцию, так как мне нужно варьировать уровень политики и запускать ее отдельно для мужчин и женщин. Проблема в том, что внутри функции очень много повторений, и поэтому я надеялся написать al oop внутри функции, чтобы разобраться с этим. Я даже не уверен, что это правильный способ спросить. Приносим извинения, если я ошибаюсь!

run_projection <-
  function(data, prob_death_ii, prob_death_hiv, prob_death_road, group_var) {
    prob_death_ii <- enquo(prob_death_ii)
   prob_death_hiv <- enquo(prob_death_hiv)
   prob_death_road <- enquo(prob_death_road)
   group_var <- enquo(group_var)

     data %>% 
      arrange(age) %>% 
      group_by(!! group_var) %>%

       # time period 1 (theres got to be a better way to do this!)  
      mutate(deaths_ii_t1 =  lag(pop_t0 * (!! prob_death_ii))) %>% 
      mutate(deaths_hiv_t1 =  lag(pop_t0 * (!! prob_death_hiv))) %>% 
      mutate(deaths_road_t1 =  lag(pop_t0 * (!! prob_death_road))) %>% 
      mutate(deaths_non_alc_t1 =  lag(pop_t0 * prob_death_non_alc)) %>%  
      mutate(pop_t1 =  if_else(age >= 16, lag(pop_t0) - deaths_non_alc_t1 - deaths_ii_t1 - deaths_hiv_t1 - deaths_road_t1,
        if_else(age >= 1 & age < 16, lag(pop_t0) * (1 - prob_death), lag(pop_t0)))) %>% 

     # time period 2
       mutate(deaths_ii_t2 =  lag(pop_t1 * (!! prob_death_ii))) %>% 
       mutate(deaths_hiv_t2 =  lag(pop_t1 * (!! prob_death_hiv))) %>% 
       mutate(deaths_road_t2 =  lag(pop_t1 * (!! prob_death_road))) %>%
       mutate(deaths_non_alc_t2 =  lag(pop_t1 * prob_death_non_alc)) %>%  
       mutate(pop_t2 =  if_else(age >= 16, lag(pop_t1) - deaths_non_alc_t2 - deaths_ii_t2 - deaths_hiv_t2 - deaths_road_t2,
                                if_else(age >= 1 & age < 16, lag(pop_t1) * (1 - prob_death), lag(pop_t1)))) %>% 

     # time period 3
       mutate(deaths_ii_t3 =  lag(pop_t2 * (!! prob_death_ii))) %>% 
       mutate(deaths_hiv_t3 =  lag(pop_t2 * (!! prob_death_hiv))) %>% 
       mutate(deaths_road_t3 =  lag(pop_t2 * (!! prob_death_road))) %>%
       mutate(deaths_non_alc_t3 =  lag(pop_t2 * prob_death_non_alc)) %>%  
       mutate(pop_t3 =  if_else(age >= 16, lag(pop_t2) - deaths_non_alc_t3 - deaths_ii_t3 - deaths_hiv_t3 - deaths_road_t3,
                                if_else(age >= 1 & age < 16, lag(pop_t2) * (1 - prob_death), lag(pop_t2)))) %>% 

    #### THIS REPEATS UP TO TIME PERIOD 20, REMOVED HERE FOR BREVITY ####

      ungroup() %>% 
      mutate_at(vars(matches("pop_t"), matches("deaths_")), round, 0) %>%
      filter(age >= 15) %>%
      select(matches("pop_t"), matches("deaths_"), 'age', 'wealtha')

  }  
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...