＆＃34; R＆＃34; ify代码以节省内存和CPU能力和/或如何显示代码执行进度？

时间：2016-02-04 01:16:56

标签： r for-loop data.table dplyr

我编写了一个非常类似于R的代码来进行一些相对简单的计算，但是虽然代码似乎有用，但效率非常低，而且我的计算机内存无法将其拉下来。 / p>

我有一个名为data.frame的{​​{1}}，其中有四列包含dat（firm_id），character（pnum），{{ 1}}（numeric）和class（character）。我总共有100,000行：200个不同的date，90,000个唯一Date，大约31,000个唯一firm_id和大约pnum。

每个class对于单个date都是唯一的。 pnum已分配给多个firm_id元素（因此，如果有5个pnum元素，则数据框中会重复class 5次。pnum会不会因class而异，但同一date的多个pnum可能在同一天。pnum。

这是一个简短的firm_id 

zero NAs

该代码旨在执行以下操作：

对于每一个dput：

  1. 查看每个dput(dat[1:50]) structure(list(firm_id = c("A&O", "A&O", "A&O", "A&O", "A&O","A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "A&O", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT", "AAT"), pnum = c(5259588, 5259588, 5259588, 5259588, 7049668, 7049668, 7049668, 7049668, 7049668, 7049668, 7049668, 7183616, 7183616, 7183616, 7183616, 7183616, 7183616, 7183616, 7183616, 7208818, 7208818, 7208818, 7208818, 7208818, 7208818, 7208818, 7122882, 7122882, 7122882, 7122882, 7122882, 7122882, 7122882, 7122882, 6413822, 6413822, 6413822, 6413822, 6413822, 6413822, 6413822, 6413822, 6413822, 6750507, 6750507, 6750507, 6750507, 6750507, 6750507, 6750507), class = c("184/1.5", "222/110", "251/100", "251/324", "257/330", "257/331", "257/401", "257/E29.027", "257/E29.134", "257/E29.136", "257/E29.146", "257/341", "257/342", "257/343", "257/401", "257/723", "257/E23.052", "257/E23.079", "257/E25.016", "257/666", "257/676", "257/E23.024", "257/E23.026", "257/E23.037", "257/E23.044", "257/E23.052", "257/48", "257/666", "257/723", "257/778", "257/E23.052", "257/E25.013", "257/E25.029", "257/E29.267", "257/331", "257/E29.027", "257/E29.066", "257/E29.133", "257/E29.146", "438/268", "438/270", "438/272", "438/430", "257/302", "257/328", "257/330", "257/396", "257/E29.027", "257/E29.066", "257/E29.133"), date = structure(c(7953, 7953, 7953, 7953, 10463, 10463, 10463, 10463, 10463, 10463, 10463, 11777, 11777, 11777, 11777, 11777, 11777, 11777, 11777, 12619, 12619, 12619, 12619, 12619, 12619, 12619, 12724, 12724, 12724, 12724, 12724, 12724, 12724, 12724, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703, 10703), class = "Date")), .Names = c("firm_id", "pnum", "class", "date"), class = c("data.table", "data.frame"), row.names = c(NA, -50L)) 的{​​{1}}元素。
  2. 将这些firm_id元素与同一class的每个pnum个class元素进行比较，前提是class之间的差距（与相应的pnum相关联的比较小于5年。 [以大写字母添加，以避免混淆。迈克尔下面提供的解决方案将焦点firm_id与公司前五年dates的投资组合进行了比较]

    3. 我目前的代码如下:(我知道，相信我，我知道）

    pnum

    编辑1：代码会生成一个data.frame pnum，第一列pnum包含原始#Step 1: Create a vector of unique firms and a data.frame with all # `pnum`, `firm_id`, and `date` but without the `class` data firms <- (unique(dat$firm_id)) patents <- data.frame(unique(dat$pnum)) patents$id <- dat$firm_id[match(patents$unique.dat.pnum, dat$pnum)] patents$date <- dat$date[match(patents$unique.dat.pnum, dat$pnum)] colnames(patents) <- c("pnum", "id", "date") #Step 2: Set-up variables needed to store the results library(gtools) startrow <- 0 df <- data.frame() #Step 3: Loop around all firms for(i in 1:length(firms)){ startrow <- startrow + length(patents$id[patents$id == firms[i - 1]]) subdat <- dat[dat$firm_id == firms[i]] subpat <- unique(subdat$pnum) dt <- data.frame() #Step 4: Find which of the `pnum` fit within the 5 year time frame for(j in 1:length(subpat)){ # Number of unique patents in subdat class.now <- subdat$class[subdat$pnum == subpat[j]] ref.pat <- unique(subdat$pnum[(subdat$date > (patents$date[startrow + j] - 5*365) & subdat$date < (patents$date[startrow + j]))]) if (invalid(ref.pat) == T ) ref.pat <- NA m <- data.frame(cbind(orig.pat = rep(patents$pnum[startrow + j],length(ref.pat))),ref.pat = NA, jac = NA) #Step 5: Compare the focal `pnum` with each of the prior ones within the # 5 year time frame and calculate a Jaccard index for(k in 1:length(ref.pat)){ class.ref <- subdat$class[subdat$pnum == ref.pat[k]] m$ref.pat[k] <- ref.pat[k] m$jac[k] <- sum(class.now %in% class.ref)/(length(class.now) + length(class.ref) - length(class.now %in% class.ref))} dt <- data.frame(rbind(dt, m)) ; rm(m) } df <- data.frame(rbind(df, dt)) rm(dt) ; print(i) } ，第二列df包含与之相关的专利比较了origpat，第三列pnum是ref.pat和orig.pat的Jaccard索引。

    非常欢迎任何有关改善这项工作的建议！

1 个答案:

答案 0 :(得分：1)

我相信这是正确的，我承认我在原始代码中丢失了一些东西。描述

# helper function for conciseness below
jac <- function(cn, cr) sum(idx <- cn %in% cr) /
  (length(cn) + length(cr) - length(idx))

setkey(dat, pnum, firm_id) #for faster exclusive subsetting

dat[ , {x<-date[1]; cs <- class #assign these so there's no scoping issue below
#Now that we're within a (firm_id, pnum) subset,
#  we go back to the original table and subset to
#  the _same_ firm but NOT the same patent
#  (note that the current firm and pnum are stored
#   in .BY[[1]] and .BY[[2]], respectively)
dat[firm_id == .BY[[1]] & pnum != .BY[[2]]
      #having subsetted to everything by the same firm
      #  (except things with the same `pnum`), we
      #  check which `pnum` satisfy the within-five-years
      #  criterium; for those that do, we calculate `jac`
      ][abs(date - x) <= 365 * 5,  jac(cs, class)]}, 
by = .(firm_id, pnum)] #we do this for each `firm_id` and `pnum`
相关问题
最新问题