2016-07-05 8 views
0

私はnoob Rのプログラマーです。私は因子で分割されたデータフレームに関数を適用する必要があるコードを書いています。データフレーム自体には、データフレームをスライスするために使用する変数に64376個の要因を含む約1百万の324961個の観測値が含まれています。次のように並行してRを使用する

コードは:コードはTLである

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

場合、DRは、概要は以下の通りである:

Iはデータフレームbod_fbを有します。 bod_fb$code_yearのデータフレームをスライスして、このデータフレームにgen_fuzzy_blau関数を適用する必要があります。

この関数は非常に巨大であるため、順次処理では1日以上かかるため、メモリ不足になります。 gen_fuzzy_blau関数は、データフレームの各code_yearに数値変数fuzzy_blau_indexを返します。私はbyを使って、各スライスに関数を適用します。このコードを並列に実装して、関数の複数のインスタンスがデータフレームの異なるスライス上で同時に実行できるようにする方法があるかどうかを知りたかったのです。 parallelパッケージでbyの実装が見つかりませんでしたが、foreachdoParallelパッケージを使用している間は、イテレータとしてデータフレームを渡す方法がわかりませんでした。

私は4GBのRAMとWindows 7 sp1ホームの基本AMD A8のラップトップを持っています。私はページファイルのメモリとして20GBを与えました(これは私がメモリエラーを得た後でした)。

EDITありがとう1:私はコード内の冗長性を排除してきた @milkmotel削除forループが、関数でgen_sim_indexに浪費される時間の膨大な量は、私が使用していますproc.time()は、コードの各部分が取っている時間を測定する機能です。 行(ベクトルではない)がある場合、a a b c類似点は(2/4)^ 2 +(1/4)^ 2 + 2となります。 (1/4)^ 2の合計(各行の各固有要素の発生数/行の要素数の合計)^ 2

apply関数を行に直接使用することはできません。行の各要素が異なる要素を持ち、table()が適切に周波数を出力しないため、各要素が1つの行にあります。

gen_sim_index機能を効率的にコーディングする方法を教えてください。

答えて

0

6つの異なる変数に6回データを保存しています。それをしないでください。

gsub()でばかげた量のデータで文字インデックスを実行しているので、1日かかる。

gen_fuzzy_blau関数からコードを取り出すと、独立して実行するのではなく、関数を1つの関数にまとめることができます。その後、一度に1行ずつ実行します。実行に時間がかかりすぎる場合は、方法を再考してください。あなたのコードは非常に非効率的です。

関連する問題