#r
#r
Вопрос:
Я ищу какой-то вид условной скользящей суммы, я думал, что цикл while сделает то, что мне нужно, но у меня возникли проблемы с его реализацией. Таким образом, это должно выглядеть как PCAR [1] * time [1] PCAR [2] * time [2] PCAR [3] * time [3] и т.д., Где [] ссылается на строку столбца, и это будет повторяться до тех пор, пока совокупное значение времени не достигнет <= 100 лет, затем цикл должен добавить это значение в столбец, а затем начать снова, пока совокупное время не составит от 100 до <= 200, и так далее до нижней части набора данных. Он будет применяться к наборам данных разного размера, насчитывающим десятки тысяч лет.
Я надеюсь, что это имеет смысл. В приведенном ниже примере данных столбец PCAR_BIN — это то, к чему я стремлюсь в качестве результата.
df <- tibble(cumulative.time = c(20,40,60,80,100, 120,140,160,180,200),
PCAR =1:10,
time = 1:10,
depth.along.core = 1:10,
Age.cal.BP = 1:10,
AFBD = 1:10,
assumed.C = rep(0.5, 10),
PCAR_BIN = c(55,330,NA,NA,NA,NA,NA,NA,NA,NA))
Функция выглядит следующим образом
MBA <- function(data) {
require(dplyr)
data %>% mutate(PCAR=((lead(depth.along.core) - depth.along.core )/(lead(Age.cal.BP) - Age.cal.BP))*AFBD*assumed.C*10000,
PCA_NCP = PCAR*(lead(Age.cal.BP)-Age.cal.BP),
PCA_NCP[is.na(PCA_NCP)] <- 0,
CCP_Bottom_Up = rev(cumsum(rev(PCA_NCP))),
CCP_Top_Down = CCP_Bottom_Up[1]- CCP_Bottom_Up,
PCAR_BIN = ifelse(cumulative.time <= 100, sum(PCAR*time lead(PCAR)*lead(time),NA)
)}
Очевидно, мне не повезло с решением ifelse, поскольку оно будет работать только в течение одной итерации времени, а сумма неверна. Я пробовал подобное с циклами while и for, но безуспешно. Частично проблема в том, что я не уверен, как выразить нужную мне сумму. Я также пытался объединить данные с помощью case_when и отработать это, но снова безуспешно.
Спасибо, люди 🙂
Редактировать
Следуя методу Мартинса, теперь у меня есть функция, работающая до создания столбца ROLLSUM, теперь мне нужно создать столбец, который будет давать максимальное значение для каждой группы century. Запуск кода из slicemax и далее выдает ошибку: Ошибка в eval (lhs, parent, родительский): объект ‘tmp‘ не найден
Я также добавил реальные данные.
dput(head(EMC))
structure(list(depth.along.core = c(0.5, 1.5, 2.5, 3.5, 4.5,
5.5), Age.cal.BP = c(-56.016347625, -55.075825875, -54.201453125,
-53.365755375, -52.541258625, -51.700488875), time = c(0.94052175,
0.87437275, 0.83569775, 0.82449675, 0.84076975, 0.88451675),
cumulative.time = c(0.94052175, 1.8148945, 2.65059225, 3.475089,
4.31585875, 5.2003755), AFBD = c(0.0711, 0.057, 0.0568, 0.0512,
0.0559, 0.0353), assumed.C = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5
)), row.names = c(NA, 6L), class = "data.frame")
MBA <- function(data) {
require(dplyr)
data %>% mutate(PCAR=((lead(depth.along.core) - depth.along.core )/(lead(Age.cal.BP) - Age.cal.BP))*AFBD*assumed.C*10000,
PCA_NCP = PCAR*(lead(Age.cal.BP)-Age.cal.BP),
PCA_NCP[is.na(PCA_NCP)] <- 0,
CCP_Bottom_Up = rev(cumsum(rev(PCA_NCP))),
CCP_Top_Down = CCP_Bottom_Up[1]- CCP_Bottom_Up)%>%
slice(1:(n()-1))%>%
group_by(Century = cut(cumulative.time, breaks = seq(0, max(cumulative.time), 100)))%>%
mutate(ROLLSUM = rev(cumsum(PCAR*time)))%>%
slice_max(order_by = ROLLSUM, n = 1) %>%
pull(ROLLSUM)%>%
df$ROLLSUM <- c(groupMaxima, rep(NA, nrow(df) - length(groupMaxima)))}
Ответ №1:
Вы могли бы попробовать это:
# Get cumulative sums by group (assuming per century groups)
df <- df %>%
group_by(Century = cut(cumulative.time,
breaks = seq(0, max(cumulative.time), 100))) %>%
mutate(ROLLSUM = rev(cumsum(PCAR * time)))
# Get maximum of each group
groupMaxima <- df %>%
slice_max(order_by = ROLLSUM, n = 1) %>%
pull(ROLLSUM)
# Fill column as desired
df$ROLLSUM <- c(groupMaxima, rep(NA, nrow(df) - length(groupMaxima)))
Мы просто создаем столбец factor, чтобы сгруппировать столбец кумулятивного времени по столетиям, и используем этот коэффициент для суммирования значений. Наконец, мы редактируем столбец скользящей суммы, чтобы он содержал только максимальные значения, и заполняем остальные строки NA .
# A tibble: 10 x 10
# Groups: Group [2]
cumulative.time PCAR time depth.along.core Age.cal.BP AFBD assumed.C PCAR_BIN Group ROLLSUM
<dbl> <int> <int> <int> <int> <int> <dbl> <dbl> <fct> <int>
1 20 1 1 1 1 1 0.5 55 (0,100] 55
2 40 2 2 2 2 2 0.5 330 (0,100] 330
3 60 3 3 3 3 3 0.5 NA (0,100] NA
4 80 4 4 4 4 4 0.5 NA (0,100] NA
5 100 5 5 5 5 5 0.5 NA (0,100] NA
6 120 6 6 6 6 6 0.5 NA (100,200] NA
7 140 7 7 7 7 7 0.5 NA (100,200] NA
8 160 8 8 8 8 8 0.5 NA (100,200] NA
9 180 9 9 9 9 9 0.5 NA (100,200] NA
10 200 10 10 10 10 10 0.5 NA (100,200] NA
Редактировать:
Для этого особого случая:
MBA <- function(data) {
require(dplyr)
data <- data %>% mutate(PCAR = ((lead(depth.along.core) - depth.along.core )/(lead(Age.cal.BP) - Age.cal.BP))*AFBD*assumed.C*10000,
PCA_NCP = PCAR*(lead(Age.cal.BP)-Age.cal.BP),
PCA_NCP[is.na(PCA_NCP)] <- 0,
CCP_Bottom_Up = rev(cumsum(rev(PCA_NCP))),
CCP_Top_Down = CCP_Bottom_Up[1]- CCP_Bottom_Up)
data <- data %>%
group_by(CTIME = cut(cumsum(cumulative.time),
breaks = seq(0, max(cumsum(cumulative.time), na.rm = T), 100))) %>%
mutate(ROLLSUM = rev(cumsum(PCAR*time)))
groupMaxima <- data %>% slice_max(order_by = ROLLSUM, n = 1) %>%
pull(ROLLSUM)
data$ROLLSUM <- c(groupMaxima, rep(NA, nrow(data) - length(groupMaxima)))
data
}
Комментарии:
1. Привет, спасибо за оба ваших ответа, я должен был сказать в своем вопросе, что мое фактическое совокупное время не указано в заданных интервалах, оно получено в результате байесовского моделирования радиоуглеродных дат и поэтому является довольно случайным и с точностью до 6 знаков после запятой, я, возможно, чрезмерно упростил его в моем примере данных. Я попытался добавить ответ Мартинса в свою функцию, но он возвращает ошибку: проблема с
mutate()вводомCentury. x ‘to’ должно быть конечным числом. Я думаю, что это, вероятно, связано с тем, что мои данные о совокупном времени не попадают на 1002. Что ж, попробуйте использовать
dput(head(yourData)), чтобы предоставить нам снимок ваших реальных данных.3. Привет, Мартин, большое спасибо за вашу помощь, все получается. Я понятия не имел, что могу использовать dput подобным образом, очень полезно! Пожалуйста, посмотрите правку.
4. Итак, вы хотите суммировать значения до тех пор, пока совокупное время не достигнет 100, затем начать с нуля, пока не будет достигнута следующая общая продолжительность 100?
5. Привет, Мартин, да, так что это было бы так, как ты показал мне в первый раз, с максимумом для 0-100, затем 100-200 и т.д. Это отлично сработало с данными примера. Первая ошибка была связана с тем, что конечное значение в моих реальных данных было NA, поэтому я использовал slice для удаления этой строки, поскольку это необходимо только для первых нескольких вычислений. Теперь я просто застрял, пытаясь включить последний фрагмент вашего кода в свою функцию.
Ответ №2:
Существует несколько способов, если ваши шаги действительно составляют 100 лет, а значения изменяются на 0,20,40 с постоянными интервалами — вы можете сделать это изначально:
steps = 100
intervals = 20
ratio = steps / intervals
columns = df[,c("PCAR","time")]
indices = rep(ratio,nrow(df)) %>% cumsum
PCAR_BIN = lapply(indices,function(x){
localRange = (x-ratio):x
sum(columns[localRange,1] * columns[localRange,2])
})%>% unlist
теперь мы можем привязать PICAR_BIN :
df = cbind(df,PICAR_BIN)