Как использовать цикл while над вектором с длиной> 1 в R? - PullRequest
0 голосов
/ 31 мая 2019

Используя приведенные ниже данные (взятые у двух человек из 400), каждый человек должен быть включен в цикл while.Цикл while понижает значение каждого индивидуума до 1 одновременно с тем, как формула в функции выполняет вычисление.Я включил код, который строит таблицу жизни, и формулу, которую я поместил в функцию.Я хотел бы, чтобы цикл while взял ответ из функции, вычел из нее 1 и выполнил условия, указанные в цикле.Он прекратит работу, как только X будет иметь значение, равное одному для каждого человека.Я надеялся сохранить обе функции как функции и использовать для этого функцию map2 purrr, однако для обоих это не похоже.Просто на функцию, представленную ниже.В конце концов, я хотел бы сохранить новые значения в виде вектора, однако на данный момент у меня есть набор для печати, чтобы увидеть, что он делает.

library(tidyverse)*

pop<-structure(list(x = c(0L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 
10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 
23L, 24L, 25L, 26L, 27L, 28L, 0L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 
8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 
21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L), id = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A1_CP100_16C", 
"A2_CP100_16C"), class = "factor"), ind = structure(c(1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A1_", "A2_"), class = "factor"), 
    trt = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L), .Label = "CP100_", class = "factor"), temp = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = "16C", class = "factor"), 
    no = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L
    ), nx = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    0L), mx = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 7L, 0L, 
    0L, 13L, 0L, 0L, 6L, 12L, 0L, 0L, 19L, 0L, 0L, 18L, 0L, 0L, 
    0L, 21L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 6L, 
    0L, 0L, 12L, 0L, 0L, 13L, 0L, 0L, 0L, 23L, 0L, 0L, 20L, 0L, 
    0L, 0L, 18L, 0L)), .Names = c("x", "id", "ind", "trt", "temp", 
"no", "nx", "mx"), row.names = c(NA, 58L), class = "data.frame")

 pop <- pop %>% 
 #Calculating lx and adding it to your population data
 mutate(lx = no/nx,
     #Calculating R0 and adding it to your population data
     Ro = lx*mx, 
     #Calculating Gt and adding it to your population data
     Gt = x*lx*mx) %>% 
 group_by(id) %>% 
 mutate(SumR0 = sum(Ro, na.rm = TRUE),
     #Sum of Gt and adding it to your population data
     SumGt = sum(Gt, na.rm = TRUE),
     # Mean Gt and a rough estimate of R - I'm leaving the data.frame 
     #grouped by ID, because SumGt and SumR0 are always the same per each 
     #individual.
     MeanGT = SumGt/SumR0,
     approx.r = log(SumR0)/MeanGT)

#After, I am nesting the data frame so I can iterate over each individual. 
pop_nest<-pop %>% 
group_by (id) %>% 
nest()

x<-function(pop_nest) { 
sum(exp(-pop_nest["approx.r"]*pop_nest["x"])*pop_nest["Ro"], na.rm = TRUE) 
}

X<-pop_nest$data %>% map_dbl(x)

#Everything seems to work once I get to this point.....

Я также пытался поместить цикл while в функцию, однако получаю ошибку, указанную ниже ....

Eular <- function (pop_nest) { 
while(abs(X-1) >= 0.000001) {
r<-if_else (X-1>0,  
            pop_nest$data["approx.r"]+0.00000001,  
            pop_nest$data["approx.r"]-0.00000001)
  }
}

pop_nest$data %>% map(Eular)

# Warning messages below..... 
 Error: `true` must be length 2 (length of `condition`) or one, not 0
 Call `rlang::last_error()` to see a backtrace
 In addition: Warning messages:
 1: In while (abs(X - 1) >= 1e-06) { :
 the condition has length > 1 and only the first element will be used

 Error: `true` must be length 2 (length of `condition`) or one, not 0

Я ищу предложения, чтобы этот цикл выполнялся при каждомчеловек в моем вложенном фрейме данных, чтобы соответствовать условиям, указанным в цикле.Любые другие предложения, кроме использования цикла while, также приветствуются (то есть, uniroot решит это)?Я могу получить результаты, которые я ищу, когда удаляю одного человека и помещаю его в вектор (отсюда и вложенный фрейм данных).Большое спасибо за любой вклад!

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