Используя приведенные ниже данные (взятые у двух человек из 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 решит это)?Я могу получить результаты, которые я ищу, когда удаляю одного человека и помещаю его в вектор (отсюда и вложенный фрейм данных).Большое спасибо за любой вклад!