Question

我有一个庞大的数据集，我想要执行一些操作。使用我当前的代码（如下所示）需要超过3个小时（尚未完成）。我通过对较小数据集的一些测试将其缩小到这个嵌套循环，并且需要使用apply函数族之一来帮助提高性能（希望）和代码清洁度。

file <- read.csv("file.csv")
dates <- unique(file$date)
names <- unique(file$name)

data<-c()
mat<-matrix(,nrow=length(dates),ncol=length(names)) # store % change for all names

# loop for every person
for (i in 1:length(names)) { 
  data[[names[i]]] <- file[file$name == names[i],]
  align = 0 # no data for some dates, need alignment score to align later on

  # if this object does not start on the same date as the earliest date we know,
  # then pad this object with a null row at the top
  if (!rownames(mat)[1] %in% data[[names[i]]]$date) {
    data[[names[i]]] <- rbind(c("0000-00-00",0,as.character(data[[names[i]]]$name[1]),NA,FALSE),data[[names[i]]])
  }

  # loop for every date, beginning at 2 because the first date will not be used
  for (j in 2:length(dates)) {
    if (!rownames(mat)[j] %in% data[[names[i]]]$date) {
      mat[j,i] = NA
      align <- align + 1
      next
    }

    current <- as.numeric(data[[names[i]]]$price[j-align])
    previous <- as.numeric(data[[names[i]]]$price[j-1-align])

    # actions based on current and previous cell values
    if (is.na(previous)) { 
      mat[j,i] <- NA
    } else if (current == 0 & previous == 0) {
      mat[j,i] <-  0
    } else if (current == 0) {
      mat[j,i] <- NA 
    } else if (previous == 0) { 
      mat[j,i] <- NA
    } else {
      mat[j,i] <- current/previous-1 
    }
  }
}

文件看起来像：

         date id      name price  paid
1  2001-01-01  1  redacted  0.00  TRUE     
2  2001-01-02  2  redacted  0.05  TRUE      
3  2001-01-03  1  redacted 200.0 FALSE

纲要：
我们为每个人循环，将它们的数据存储在一个名为data的矩阵列表中。人们不止一次出现（通过ID和名称，但我们现在只担心名称），这将构成data中每个矩阵的唯一行。

从这里开始，我们检查每个人的日期是否与最早的已知日期对齐，如果没有，则用一个空行填充其矩阵。

现在我们循环每个人的每个日期，检查他们的日期行是否被迭代到当前的日期（如果没有，然后用NA填充并进入下一步（见下文））然后计算如何改变百分比这个人支付了多少钱，具体取决于之前的价值（0和NA导致问题所以我们需要if语句），即。如果他们在2000-01-01支付20美元，在2000-01-02支付40美元，那么％变化是100％（显示为1），因为他们付了两倍。

所以最终结果mat看起来类似于：

              redacted    redacted      redacted
2001-01-01          NA          NA            NA          
2001-01-02           1         0.3           0.2       
2001-01-03         0.5           0            NA

有人可以帮忙吗？我尝试了很多apply个版本，但这些版本似乎都没有用，或者让我更接近解决方案。我知道这是一个巨大的阅读/问题，所以任何帮助或提示将不胜感激！

好像我可能需要嵌套apply，每个循环一个？

谢谢！

Answer 1

这是一个解决方案，但它需要几个非基础包：

price_diff <- function(x) {  
  zeroes <- sum(which(x == 0))
  if(zeroes == 1) NA else if (zeroes == 2) 0 else x[2] / x[1] - 1
}
file.dt <- data.table(file)[order(date)]
changes <- file.dt[, list(date, change=rollapply(price, 2, price_diff, align="right", fill=NA)),by=name]
dcast(changes, date ~ name, value.var="change")

结果：

#           date          Bat          Kat           Kit
# 1   2013-01-01           NA           NA            NA
# 2   2013-01-02 -0.044461024  0.391059725  0.0806087565
# 3   2013-01-03 -0.114559555 -0.342706723 -0.1174446516
# ... 197 more rows ...

这产生了与您的方法相同的结果，但我必须在您的方法中进行一些修复以使其运行。我的200天3人样本的速度也提高了约20倍。

我在这里做的是使用data.table按人分割数据，然后为每个人使用rollapply将price_diff功能应用到2天的窗口，最后data.table重新组装了这一切。这一切都发生在changes代码行上。最后，dcast步骤是将数据转换为您想要的格式（无需进一步计算，只需从长格式转换为宽格式）。

必需的包裹：

library(data.table)
library(zoo)
library(reshape2)

制作与您相同的数据：

dt.start <- as.Date("2013-01-01")
days <- 200
names <- c("Kat", "Kit", "Bat")
file <- data.frame(
  date=rep(seq(dt.start, length.out=days, by="+1 day"), each=length(names)),
  id=rep(1:length(names), each=days),
  name=rep(names, days),
  price=c(5, 10, 20) + runif(days * length(names), -3, 3),
  paid=sample(c(T, F), days * length(names), replace=T)
)

R适用于嵌套循环

1 个答案: