Question

我是一个菜鸟R程序员。我编写了一个代码，需要将函数应用于按因子分割的数据帧。数据框本身包含大约100万个324961个观测值，其中64376个因子位于我们用于切割数据帧的变量中。

代码如下：

library("readstata13")
# Reading the Stata Data file into R
bod_fb <- read.dta13("BoD_nonmissing_fb.dta")

gen_fuzzy_blau <- function(bod_sample){

  # Here we drop the Variables that are not required in creating the Fuzzy-Blau index

  bod_sample <- as.data.frame(bod_sample)

  bod_sample$tot_occur <- as.numeric(bod_sample$tot_occur)
  bod_sample$caste1_occ <- as.numeric(bod_sample$caste1_occ)
  bod_sample$caste2_occ <- as.numeric(bod_sample$caste2_occ)
  bod_sample$caste3_occ <- as.numeric(bod_sample$caste3_occ)
  bod_sample$caste4_occ <- as.numeric(bod_sample$caste4_occ)


  # Calculating the Probabilites of a director belonging to a caste
  bod_sample$caste1_occ <- (bod_sample$caste1_occ)/(bod_sample$tot_occur)
  bod_sample$caste2_occ <- (bod_sample$caste2_occ)/(bod_sample$tot_occur)
  bod_sample$caste3_occ <- (bod_sample$caste3_occ)/(bod_sample$tot_occur)
  bod_sample$caste4_occ <- (bod_sample$caste4_occ)/(bod_sample$tot_occur)

  #Dropping the Total Occurances column, as we do not need it anymore
  bod_sample$tot_occur<- NULL

  # Here we replace all the blanks with NA
  bod_sample <- apply(bod_sample, 2, function(x) gsub("^$|^ $", NA, x))
  bod_sample <- as.data.frame(bod_sample)

  # Here we push all the NAs in the caste names and caste probabilities to the end of the row
  # So if there are only two castes against a name, then they become caste1 and caste2
  caste_list<-data.frame(bod_sample$caste1,bod_sample$caste2,bod_sample$caste3,bod_sample$caste4)

  caste_list = as.data.frame(t(apply(caste_list,1, function(x) { return(c(x[!is.na(x)],x[is.na(x)]) )} )))
  caste_list_prob<-data.frame(bod_sample$caste1_occ,bod_sample$caste2_occ,bod_sample$caste3_occ,bod_sample$caste4_occ)

  caste_list_prob = as.data.frame(t(apply(caste_list_prob,1, function(x) { return(c(x[!is.na(x)],x[is.na(x)]) )} )))

  # Here we write two functions: 1. gen_castelist
  #                              2. gen_caste_prob
  # gen_castelist: This function takes the row number (serial number of the direcor)
  #                and returns the names of all the castes for which he has a non-zero
  #                probability.
  # gen_caste_prob: This function takes the row number (serial number of the director)
  #                and returns the probability with which he belongs to the caste
  #
  gen_castelist <- function(x){
    y <- caste_list[x,]
    y <- as.vector(y[!is.na(y)])
    return(y)
  }

  gen_caste_prob <- function(x){
    z <- caste_list_prob[x,]
    z <- z[!is.na(z)]
    z <- as.numeric(z)
    return(z)
  }

  caste_ls <-list()
  caste_prob_ls <- list()
  for(i in 1:nrow(bod_sample)) 
  { 
    caste_ls[[i]]<- gen_castelist(i)
    caste_prob_ls[[i]]<- gen_caste_prob(i)
  }

  gridcaste <- expand.grid(caste_ls)
  gridcaste <- data.frame(lapply(gridcaste, as.character), stringsAsFactors=FALSE)

  gridcasteprob <- expand.grid(caste_prob_ls)

  # Generating the Joint Probability
  gridcasteprob$JP <- apply(gridcasteprob,1,prod)

  # Generating the Similarity Index
  gen_sim_index <- function(x){
    x <- t(x)
    a <- as.data.frame(table(x))
    sim_index <- sum(a$Freq^2)/(sum(a$Freq))^2
    return(sim_index)
  }
  gridcaste$sim_index <- apply(gridcaste,1,gen_sim_index)

  # Generating fuzzyblau
  gridcaste$fb <- gridcaste$sim_index * gridcasteprob$JP

  fuzzy_blau_index <- sum(gridcaste$fb)
  remove_list <- c("gridcaste","")
  return(fuzzy_blau_index) 

}

fuzzy_blau_output <- by(bod_fb,bod_fb$code_year,gen_fuzzy_blau)

# Saving the output as a dataframe with two columns
# Column 1 is the fuzzy blau index
# Column 2 is the code_year
code_year <- names(fuzzy_blau_output)
fuzzy_blau <- as.data.frame(as.vector(unlist(fuzzy_blau_output)))
names(fuzzy_blau) <- c("fuzzy_blau_index")
fuzzy_blau$code_year <- code_year

bod_fb <- merge(bod_fb,fuzzy_blau,by = "code_year")
save.dta13(bod_fb,"bod_fb_example.dta")

如果代码是tl; dr，摘要如下：

我有一个数据框bod_fb。我需要通过使用gen_fuzzy_blau因子对数据帧进行切片来应用此bod_fb$code_year函数。

由于功能非常庞大，顺序处理花费了一天多的时间，最终导致内存不足。函数gen_fuzzy_blau为数据帧的每个code_year返回一个数字变量fuzzy_blau_index。我使用by在每个切片上应用该函数。我想知道是否有一种方法可以并行实现此代码，以便在数据帧的不同切片上同时运行该函数的多个实例。我没有找到by包的parallel实现，我不知道在使用foreach和doParallel包时如何将数据帧作为迭代器传递。

我有一台配备4GB RAM的AMD A8笔记本电脑和windows 7 sp1 home basic。我已经给了20GB作为页面文件内存（这是在我收到内存错误之后）。

谢谢

编辑1： @milkmotel我已经消除了代码中的冗余并删除了for循环，但是函数中gen_sim_index浪费了大量时间，我是使用proc.time()函数来衡量代码的每个部分所花费的时间。

该函数应该是以下一行：如果我们有一行（不是矢量）说：a a b c相似性指数将是（2/4）^ 2 +（1/4）^ 2 +（1/4）^ 2即（的总和）没有每行的每个唯一元素的出现/行中元素的总数没有）^ 2

我无法直接在行上使用apply函数，因为行中的每个元素都因为行中的每个元素都有不同的因子而table()不能正确输出频率。

对gen_sim_index函数进行编码的有效方法是什么？

Answer 1

您将数据保存在6个不同的变量中6次。尽量不这样做。

并且需要一天的时间，因为您使用gsub（）对大量数据进行字符索引。

从gen_fuzzy_blau函数中取出代码，因为它没有提供任何值将其包装到一个函数中，而不是单独运行它。然后一次运行一行。如果运行时间太长，请重新考虑您的方法。你的代码非常低效。

在R

1 个答案: