Вычисление значения одного столбца из другого, с выводимыми данными

Question

Я пытаюсь создать функцию, которая суммирует фактические и выводимые значения из одного столбца для создания другого. Мои данные формы:

Nest <- c(a,b,c,d,e,a,c,a,d,c,b) 
Age <- c(5,5,4,6,5,7,6,9,10,8,10) 
Brood <- c(4,3,4,4,3,4,3,3,4,3,1) 
df <- data.frame(Nest, Age, Brood) 

Age в дни, и Brood это число птенцов в гнезде в этой поездке. То, что я пытаюсь сделать, заключается в том, что выкладывается на протяжении всех дней до нынешнего возраста, так что 1 день с 4 цыплятами стоит 4, а 2 дня с 3 цыплятами каждый стоит 6 и т. Д. Это требует, чтобы функция приписывала значения для дней без данных. Если цыпочка умерла между посещениями (то есть есть уменьшение в Brood), функция должна предположить, что они умерли в середине дня между посещениями. Мы можем предположить, что размер расплода при первом посещении правильный для всех предыдущих дней. Размер вывоза может только уменьшаться, а не увеличиваться.

Правильный выход для приведенных выше данных будет:

df$Sum.Br <- c(20,15,16,24,15,28,23,35,40,29,24) 

В качестве примера того, как это рассчитывается, возьмите Nest C. При первом посещении третьего ряда это гнездо было 4 дня и содержало 4 цыплят, поэтому Sum.Br = 4 * 4 = 16. В следующий раз, когда это видно, в строке 7 цыплятам исполнилось 6 дней, но осталось только 3. Поэтому Sum.Br берет предыдущее значение (16) и добавляет половину промежуточных дней со старым числом птенцов (4) и половину с новым номером (3), поэтому 16 + 4 + 3 = 23. В строке 10 цыплята 8 дней (+2 дня с последнего посещения), а в гнезде все еще 3, поэтому Sum.Br = 23 + 3 + 3 = 29.

Я пытался добиться этого с серией ifelse команд, завернутой в transform:

tmp <- transform(df, Sum.Br = ave(Brood, Nest, FUN = function(x) 
            c(df$Age*x[1], 
            ifelse(x[2] == x[1], 
              df$Age*x[2], 
              df$Age[x[1]]*x[1] + (df$Age[x[2]]-df$Age[x[1]])*((x[1]+x[2])/2)), 
            ifelse(x[3] == x[2], 
              ifelse(x[2]==x[1], 
                df$Age*x[3], 
                df$Age[x[1]]*x[1] + (df$Age[x[2]]-df$Age[x[1]])*((x[1]+x[2])/2) + (df$Age[[3]]-df$Age[x[2]])*x[3]), 
              ifelse(x[2]==x[1], 
                df$Age[x[2]]*x[2] + (df$Age[x[3]]-df$Age[x[2]])*((x[2]+x[3])/2), 
                df$Age[x[1]]*x[1] + (df$Age[x[2]]-df$Age[x[1]])*((x[1]+x[2])/2) + (df$Age[x[3]]-df$Age[x[2]])*((x[2]+x[3])/2)))) 

, но после того, как 3 повторов кодирования становится длинным и подверженные ошибкам (и я даже не уверен, что это все верно!).

Может ли кто-нибудь увидеть более простой способ сделать это? Благодаря!

Answer 1

Другие пользователи, могут интересоваться информацией, что я разрешил это.

Я использовал ddply в plyr пакете разделить dataframe на части, на гнездо:

tmp <- ddply(df, "Nest", function(x){ 
    df2 <- data.frame(Nest = x$Nest) # Create a dataframe with columns "Nest" 
    df2$Age = x$Age      # "Age" 
    df2$Brood = x$Brood     # and "Brood" from "df" 

# The next bit is a bit long-winded, but serves the purpose 
# Create an vector which contains the Sum.Brood values for each visit to that nest 
# This takes the Age*Brood for the first visit, and then adds the product of the difference in age between visits and the mean brood between visits 

    brood.sum = c(x$Age[1]*x$Brood[1],  
       x$Age[1]*x$Brood[1] + (x$Age[2]-x$Age[1])*((x$Brood[1]+x$Brood[2])/2), 
       x$Age[1]*x$Brood[1] + (x$Age[2]-x$Age[1])*((x$Brood[1]+x$Brood[2])/2) + (x$Age[3]-x$Age[2])*((x$Brood[2]+x$Brood[3])/2), 
       x$Age[1]*x$Brood[1] + (x$Age[2]-x$Age[1])*((x$Brood[1]+x$Brood[2])/2) + (x$Age[3]-x$Age[2])*((x$Brood[2]+x$Brood[3])/2) + (x$Age[4]-x$Age[3])*((x$Brood[3]+x$Brood[4])/2), 
       x$Age[1]*x$Brood[1] + (x$Age[2]-x$Age[1])*((x$Brood[1]+x$Brood[2])/2) + (x$Age[3]-x$Age[2])*((x$Brood[2]+x$Brood[3])/2) + (x$Age[4]-x$Age[3])*((x$Brood[3]+x$Brood[4])/2) + (x$Age[5]-x$Age[4])*((x$Brood[4]+x$Brood[5])/2), 
       x$Age[1]*x$Brood[1] + (x$Age[2]-x$Age[1])*((x$Brood[1]+x$Brood[2])/2) + (x$Age[3]-x$Age[2])*((x$Brood[2]+x$Brood[3])/2) + (x$Age[4]-x$Age[3])*((x$Brood[3]+x$Brood[4])/2) + (x$Age[5]-x$Age[4])*((x$Brood[4]+x$Brood[5])/2) + (x$Age[6]-x$Age[5])*((x$Brood[5]+x$Brood[6])/2)) 

# Add the non-NA elements of that vector to a new column in "df2" 

    df2$bs = brood.sum[!is.na(brood.sum)] 
    df}) 

Они могут быть добавлены к исходному dataframe с помощью матча:

df$Sum.Br <- tmp$bs[match(paste(df$Nest, df$Age, sep="_"), 
          paste(tmp$Nest, tmp$Age, sep="_"))]