使用推断数据从另一列计算一列值

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为例来说明这是如何计算的。第一次访问时，第 3 行，这个巢有 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.

我试图通过包含在 transform:

中的一系列 ifelse 命令来实现这一点

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

其他用户可能有兴趣知道我已经解决了这个问题。

我在 plyr 包中使用 ddply 将数据帧拆分为多个部分，嵌套：

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})

然后可以使用匹配将这些添加到原始数据框中：

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

使用推断数据从另一列计算一列值

Computing one column value from another, with inferred data

r

if-statement

transform

calculated-columns