Блог

У меня есть большой фрейм данных, alldata , для которого я пытаюсь выполнить ряд вычислений, которые ранее выполнялись в более старой версии и записывались в базе R. Моя цель — создать новые столбцы с результатами этих вычислений с использованием dplyr. Предыдущая версия этого кода использовала десятки промежуточных фреймов данных и записывала эти вычисления в отдельные файлы с использованием функций.

Мне любопытно, возможно ли сохранить эти функции в том виде, в каком они написаны, но встроить их в dplyr для ссылки на столбцы alldata вместо этих временных матриц из исходной версии.

Вот примерный раздел кода, над которым я работаю. Как вы можете видеть в комментариях, я перевел старый код R в dplyr для простой функции взвешенного среднего.

 d_weighted = alldata %>% 
    # equivalent to by = list(regspp = data$regspp[inds]) from old code
    group_by(regspp, year) %>% 
    # equivalent to wgtmean = function(x, na.rm=FALSE) wtd.mean(x=x[,1], weights=x[,2], na.rm=na.rm) from old code
    mutate(lat_wgtmean = wtd.mean(x=lat, weights=wtcpue, na.rm=FALSE))
 

Однако, поскольку функции становятся более сложными wgtmean , я бы хотел просто включить функцию как есть.

Следующая функция из старого кода вычисляет взвешенное стандартное отклонение от матрицы, где первый столбец состоит из значений, а второй — из весов:

 wgtsd = function(mat, ...){
    x = mat[,1][mat[,2]>0]    # trim to values with weight > 0
    w = mat[,2][mat[,2]>0]
    sqrt(wtd.var(x=x, weights=w, ...))
}
 

Можно ли встроить эту функцию в dplyr::mutate со значением = lat (широта) и весом = wtcpue (улов на единицу усилия, преобразованный в веса), чтобы создать новый столбец alldata , содержащий взвешенные стандартные отклонения?

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

 wgtskew = function(mat, na.rm=FALSE){ 
    x = mat[,1][mat[,2]>0]    # trim to values with weight > 0
    w = mat[,2][mat[,2]>0]
    if(na.rm){
        s = !is.na(x w)
        x = x[s]
        w = w[s]
    }
    n = length(x)
    w = n * w / sum(w)     # normalize
    if(n>2){
        c3 = n / ((n - 1) * (n - 2))
        sdv = wgtsd(cbind(x, w), normwt = TRUE, na.rm = na.rm)
        xbar = wtd.mean(x, w, na.rm = na.rm)
        sk = c3 * sum(w ^ (3 / 2) * ((x - xbar) / sdv) ^ 3)
        return(sk)
    } else {
        return(NA)
    }
}
 

Пакеты matrixStats и Weighted.Desc.Stat содержат многие функции, которые могут вам понадобиться.

Затем вы можете либо найти и заменить с помощью своего текстового редактора, либо, например:

 wgtsd <- function(...) matrixStats::weightedSd(...)
 

и запустите свой скрипт, как и раньше.