#r
#r
Вопрос:
Я понятия не имел, как сформулировать этот вопрос, поэтому извините, если вопрос немного сбивает с толку. Итак, я создаю функцию, которая требует, чтобы мой столбец PCAR * мой столбец time был сгруппирован в блоки по 100 лет на основе столбца кумулятивного времени. Благодаря этому сайту я добрался туда, используя функцию вырезания с помощью group_by, чтобы создать то, что мне было нужно. Однако я только что понял, что это не совсем правильно, кумулятивное время взято из радиоуглеродных дат, которые не попадают точно на 100-летние блоки, поэтому некоторые из данных, которые мне нужны в первом 100-летнем блоке, содержатся во втором 100-летнем блоке. То, что делает код, который у меня есть, эффективно PCAR[1] * time [1] PCAR [2] * time [2] PCAR [3] * time [3] и т.д., Где [] ссылается на строку столбца.
РЕДАКТИРОВАТЬ (Я использовал индексацию строк из Excel, поэтому я обновил ее индексацией строк из r)
Проблема в том, что, например, в первом 100-летнем блоке конечная дата заканчивается на 99,6, поэтому мне нужны данные за еще 0,4 года в первой группе. Эта группа заканчивается на 29-й ячейке, поэтому для достижения этой цели концом формулы для первой группы будет PCAR[26] * time[26] PCAR [27] * 0.4 (разница между конечной датой и отсечением на 100 лет). Тогда это означает, что вторая группа из 100, вместо того, чтобы начинаться с PCAR[27], время [27] должно быть PCAR[27](время[27]-0,4), чтобы учесть разницу.Затем группе 2 нужно сделать то же самое, что группа 1 сделала выше, и так далее вниз по столбцу. Разрыв между датой, ближайшей к 100-летнему отрезку, изменяется случайным образом по мере продвижения вниз по столбцу.
Я надеюсь, что это имеет смысл. Боюсь, я не нашел ничего, что могло бы помочь в поиске, и, честно говоря, на самом деле не знаю, как сформулировать поисковые запросы, чтобы найти что-нибудь релевантное.
Извините, что включаю все данные, но я не смог понять, как охватить только первые 200 лет. У меня также есть только соответствующий бит функции, но эта проблема действительно выходит из-под контроля в остальной части функции из-за экспонент.
Большое спасибо 🙂
Функция
Mega_bog <- function(data) {
require(tidyverse)
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(PCA_NCP_Bin = rev(cumsum(PCAR*time)))%>%
group_by(Century) %>%
arrange(desc(PCA_NCP_Bin))%>%
slice(1)%>%
ungroup()}
Данные:
df <- structure(list(depth.along.core = c(0.5, 1.5, 2.5, 3.5, 4.5,
5.5, 6.5, 7.5, 8.5, 9.5, 10.5, 11.5, 12.5, 13.5, 14.5, 15.5,
16.5, 17.5, 18.5, 19.5, 20.5, 21.5, 22.5, 23.5, 24.5, 25.5, 26.5,
27.5, 28.5, 29.5, 30.5, 31.5, 32.5, 33.5, 34.5, 35.5, 36.5, 37.5,
38.5, 39.5, 40.5, 41.5, 42.5, 43.5, 44.5, 45.5, 46.5, 47.5, 48.5,
49.5, 50.5, 51.5, 52.5, 53.5, 54.5, 55.5, 56.5, 57.5, 58.5, 59.5,
60.5, 61.5, 62.5, 63.5, 64.5, 65.5, 66.5, 67.5, 68.5, 69.5),
Age.cal.BP = c(-56.016347625, -55.075825875, -54.201453125,
-53.365755375, -52.541258625, -51.700488875, -50.815972125,
-49.860234375, -48.805801625, -47.625199875, -46.290955125,
-44.775593375, -43.051640625, -41.091622875, -38.868066125,
-36.353496375, -33.520439625, -30.341421875, -26.788969125,
-22.835607375, -18.453862625, -13.616260875, -8.295328125,
-2.463590375, 5.95591868125, 22.32324118125, 43.58107818125,
69.41386328125, 99.52472368125, 133.63548018125, 171.48664718125,
212.83743268125, 257.46573828125, 305.16815918125, 355.75998418125,
409.07519568125, 464.96646968125, 523.30517578125, 583.98137718125,
646.90383068125, 711.99998668125, 779.21598918125, 848.51667578125,
919.88557768125, 993.32491968125, 1068.85562018125, 1146.51729118125,
1226.36823828125, 1308.48546068125, 1392.96465118125, 1479.92019618125,
1569.48517568125, 1661.81136328125, 1757.06922618125, 1855.44792518125,
1957.15531468125, 2062.41794268124, 2171.48105078125, 2284.60857418125,
2402.08314168125, 2524.20607568125, 2651.29739218124, 2783.69580078125,
2921.75870468125, 3065.86220068125, 3216.40107918125, 3373.78882418125,
3538.45761328125, 3710.85831768125, 3900), time = c(0.94052175,
0.87437275, 0.83569775, 0.82449675, 0.84076975, 0.88451675,
0.95573775, 1.05443275, 1.18060175, 1.33424475, 1.51536175,
1.72395275, 1.96001775, 2.22355675, 2.51456975, 2.83305675,
3.17901775, 3.55245275, 3.95336175, 4.38174475, 4.83760175,
5.32093275, 5.83173775, 8.41950905625, 16.3673225, 21.257837,
25.8327851, 30.1108604, 34.1107565, 37.851167, 41.3507855,
44.6283056, 47.7024209, 50.591825, 53.3152115, 55.891274,
58.3387061, 60.6762014, 62.9224535, 65.096156, 67.2160025,
69.3006866, 71.3689019, 73.439342, 75.5307005, 77.66167099999,
79.8509471, 82.1172224, 84.4791905, 86.955545, 89.5649795,
92.3261876, 95.2578629, 98.378699, 101.7073895, 105.262628,
109.0631081, 113.1275234, 117.4745675, 122.12293400001, 127.09131649999,
132.39840860001, 138.0629039, 144.10349600001, 150.5388785,
157.387745, 164.6687891, 172.4007044, 189.14168231875, NA
), cumulative.time = c(0.94052175, 1.8148945, 2.65059225,
3.475089, 4.31585875, 5.2003755, 6.15611325, 7.210546, 8.39114775,
9.7253925, 11.24075425, 12.964707, 14.92472475, 17.1482815,
19.66285125, 22.495908, 25.67492575, 29.2273785, 33.18074025,
37.562485, 42.40008675, 47.7210195, 53.55275725, 61.97226630625,
78.33958880625, 99.59742580625, 125.43021090625, 155.54107130625,
189.65182780625, 227.50299480625, 268.85378030625, 313.48208590625,
361.18450680625, 411.77633180625, 465.09154330625, 520.98281730625,
579.32152340625, 639.99772480625, 702.92017830625, 768.01633430625,
835.23233680625, 904.53302340625, 975.90192530625, 1049.34126730625,
1124.87196780625, 1202.53363880625, 1282.38458590625, 1364.50180830625,
1448.98099880625, 1535.93654380625, 1625.50152330625, 1717.82771090625,
1813.08557380625, 1911.46427280625, 2013.17166230625, 2118.43429030624,
2227.49739840625, 2340.62492180625, 2458.09948930625, 2580.22242330625,
2707.31373980624, 2839.71214840625, 2977.77505230625, 3121.87854830625,
3272.41742680625, 3429.80517180625, 3594.47396090625, 3766.87466530625,
3956.016347625, NA), AFBD = c(0.0711, 0.057, 0.0568, 0.0512,
0.0559, 0.0353, 0.0273, 0.0404, 0.0403, 0.0351, 0.0999, 0.0793,
0.0852, 0.0702, 0.077, 0.0746, 0.0524, 0.1157, 0.0845, 0.0539,
0.1228, 0.0926, 0.1109, 0.1209, 0.106, 0.1031, 0.1118, 0.0894,
0.1003, 0.1442, 0.1693, 0.1774, 0.1504, 0.1966, 0.1879, 0.1898,
0.1946, 0.1877, 0.1574, 0.1461, 0.1906, 0.1958, 0.187, 0.1793,
0.1937, 0.1747, 0.2101, 0.1908, 0.1269, 0.2057, 0.1434, 0.2153,
0.2161, 0.223, 0.234, 0.2239, 0.2295, 0.2518, 0.2266, 0.1909,
0.2241, 0.1697, 0.2064, 0.2298, 0.186, 0.2076, 0.1714, 0.1579,
0.1658, NA), assumed.C = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, NA)), class = "data.frame", row.names = c(NA,
-70L))
Редактировать
Ожидаемый результат:
PCAR_Bin <- c(9605.655668,1694.332276,1988.4491,1774.200903,1761.35507,1649.741418,369.141504,
1220.473114,1414.491133,1292.768015,1251.928368,1163.970347,1283.087441,1015.96199,971.2475692,
937.7646391,1072.787868,1139.929522,1133.495179,1148.405794,1074.991721,1054.23838,1096.194291,
1024.730421,887.8396176,801.4013676,881.6495343,658.4457289,705.1585605,758.5538921,797.3435981,
657.1049034,629.3000396,659.5176772,561.8841903,517.0014731,457.9447646,451.4409487,438.2957737)
century <- (1:39)
df1 <- data.frame(PCAR_Bin, century)
РЕДАКТИРОВАТЬ: я добавил обходной путь, который я пытаюсь, но не могу приступить к работе, на случай, если это кому-нибудь поможет. Я думаю, что либо я все вместе иду в неправильном направлении, либо меня останавливает ошибка в математике (не мой самый сильный предмет), а не сбой кода.
Обходной путь основан на разделении столбцов, как предложил Дэн, предоставляя мне необходимые различия и размещая их там, где они должны быть. Затем я получаю желаемый результат, с которым я борюсь. Первая часть суммы работает PCAR*(Time - the difference) однако использование задержки разницы означает, что только одна строка умножается на разницу, а не на сумму строк.
Mega_bog <- function(data) {
require(tidyverse)
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)%>%
mutate_all(~replace(., is.na(.), 0))%>%
group_by(Century = cut(cumulative.time, breaks = seq(0, max(cumulative.time), 100)))%>%
separate(Century,c(NA, "time_bin"), sep = ",")%>%
mutate(time_bin = as.numeric(gsub("]", "", time_bin)),
dif = time_bin - cumulative.time)%>%
group_by(time_bin) %>%
mutate(dif = case_when(dif != min(dif) ~ 0, TRUE ~ dif))%>%
ungroup()%>%
mutate(dif1 = lag(dif))}
Ответ №1:
Какая интересная проблема у вас была!
Возможно, существует более чистое решение, но вот обходной путь, сосредоточенный на tidyr::separate_rows :
library(tidyverse)
library(tidyr)
df2 = df %>%
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
) %>%
select(PCAR, time, cumulative.time) %>%
filter(!is.na(PCAR))
df3 = df2 %>%
mutate(
century=ceiling(cumulative.time/100)-1, #same as cut, but outputs a numeric value
cumulative.time2 = ifelse(!is.na(lag(century)) amp; century!=lag(century),
paste0(century*100, ";",cumulative.time-century*100),
cumulative.time),
time2 = ifelse(!is.na(lag(century)) amp; century!=lag(century),
paste0(century*100-lag(cumulative.time), ";",
time-century*100 lag(cumulative.time)),
time),
PCAR2 = ifelse(!is.na(lag(century)) amp; century!=lag(century),
paste0(PCAR*(century*100)/cumulative.time, ";", PCAR*(cumulative.time-century*100)/cumulative.time),
PCAR),
) %>%
separate_rows(time2, cumulative.time2, PCAR2, sep=";") %>%
mutate(
century2=ifelse(!is.na(lag(century)) amp; century!=lag(century),
century-1,
century), #rescaling century
across(c(time2, cumulative.time2, PCAR2), as.numeric),
check=cumsum(time2)
)
Сначала я вычислил centuries как числовое значение с округленным евклидовым делением. Если столетие отличалось от столетия в предыдущей строке, я вычислил взвешенную разницу между текущим временем и ближайшим столетием для PCAR , time (и cum.time но бесполезно), затем я вставил 2 значения, разделенные ; . Это позволило separate_rows разделить строки на два дочерних элемента.
Здесь строка 5 ( cumulative.time==125, PCAR==21.6 ) была разделена на строки 5 ( cumulative.time==100 , PCAR ==17,2) и 6 ( cumulative.time==25 , PCAR ==4,3).
Вы можете проверить, что сумма одинакова, несмотря на разное количество строк:
sum(df2$PCAR)
# [1] 5112.765
sum(df3$PCAR2)
# [1] 5112.765
nrow(df2)
# [1] 69
nrow(df3)
# [1] 103
Наконец, вы можете рассчитать свою совокупную сумму-произведение:
df3 %>%
group_by(century2) %>%
summarise(result=sum(PCAR2*time2))
#> # A tibble: 40 x 2
#> century2 result
#> <dbl> <dbl>
#> 1 0 9604.
#> 2 1 1233.
#> 3 2 1502.
#> 4 3 1496.
#> 5 4 1515.
#> 6 5 1287.
#> 7 6 786.
#> 8 7 1165.
#> 9 8 931.
#> 10 9 1216.
#> # ... with 30 more rows
Этот алгоритм немного сложный и, вероятно, потребует множества проверок, чтобы убедиться, что он добился правильных результатов. Тем не менее, я надеюсь, что это немного поможет.
Комментарии:
1. Привет, Дэн, большое спасибо за это, действительно ценю это. Однако, похоже, я получаю сообщение об ошибке: Ошибка: Проблема с
mutate()вводомtime2. x нечисловой аргумент двоичного оператора, который я ввожу,time2равенifelse(...). Я пытаюсь решить это, но не очень далеко продвинулся, есть идеи?2. @PaulTansley Упс, я забыл выбрать один столбец. Теперь это работает.
3. @ Dan Chaltiel. Еще раз спасибо за ваш вклад, теперь все работает нормально. Однако, я боюсь, что вывод отключен. Я добавил правку к своему исходному вопросу, которая показывает результат, который мне нужен.
4. @Paul не могли бы вы объяснить, как вы добрались до
9605.655668, например?5. Я получил число, используя формулу Excel, которая выглядит следующим образом: PCAR4*TIME4 PCAR5*TIME5 PCAR6*TIME6 PCAR7*TIME7 PCAR8*TIME8 PCAR9*TIME9 PCAR10*TIME10 PCAR11*TIME11 PCAR12*TIME12 PCAR13*TIME13 PCAR14*TIME14 PCAR15*TIME15 PCAR16*TIME16 PCAR17*TIME17 PCAR18*TIME18 PCAR19*TIME19 PCAR20*TIME20 PCAR21*TIME21 PCAR22*TIME22 PCAR23*TIME23 PCAR24*TIME24 PCAR25*TIME25 PCAR26*TIME26 PCAR27*TIME27 PCAR28*TIME28 PCAR29*TIME29 PCAR30*0.4