Ich bin ein Noob R-Programmierer. Ich habe einen Code geschrieben, der eine Funktion auf einen Datenrahmen anwenden muss, der nach Faktoren aufgeteilt ist. Der Datenrahmen selbst enthält ungefähr 1 Million 324961 Beobachtungen mit 64376 Faktoren in der Variablen, die wir verwenden, um den Datenrahmen zu teilen.Verwendung von parallel in R
Der Code ist wie folgt:
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")
Wenn der Code tl ist; dr, die Zusammenfassung ist wie folgt:
Ich habe einen Datenrahmen bod_fb. Ich muss die Funktion gen_fuzzy_blau auf diesen Datenrahmen anwenden, indem ich den Datenrahmen mit Faktoren von bod_fb$code_year zerschneide.
Da die Funktion sehr groß ist, dauert die sequentielle Verarbeitung mehr als einen Tag und führt dazu, dass der Arbeitsspeicher knapp wird. Die Funktion gen_fuzzy_blau gibt für jedes code_year des Datenrahmens eine numerische Variable fuzzy_blau_index zurück. Ich verwende by, um die Funktion auf jede Scheibe anzuwenden. Ich wollte wissen, ob es eine Möglichkeit gibt, diesen Code parallel zu implementieren, so dass mehrere Instanzen der Funktion gleichzeitig auf verschiedenen Schichten des Datenrahmens ausgeführt werden. Ich habe keine by Implementierung für parallel Paket gefunden und ich wusste nicht, wie die Datenrahmen als Iteratoren übergeben werden, während foreach und doParallel Pakete verwenden.
Ich habe einen AMD A8 Laptop mit 4 GB RAM und Windows 7 SP1 Home Basic. Ich habe 20GB als Seitendateispeicher gegeben (das war, nachdem ich den Speicherfehler bekam).
Danke
EDIT 1: @milkmotel ich die Redundanz im Code beseitigt und entfernt der für Schleifen, sondern eine riesige Menge an Zeit in gen_sim_index in der Funktion verschwendet wird, ich bin mit dem proc.time() Funktion, um die Zeit zu messen, die jeder Teil des Codes dauert.
Die Funktion soll zu einer Zeile folgendermaßen lauten: Wenn wir eine Zeile (kein Vektor) haben sagen: a a b c wird der Ähnlichkeitsindex (2/4)^2 + (1/4)^2 + sein (1/4)^2 dh Summierung von (Anzahl der Vorkommen jedes einzelnen Elements jeder Zeile/Gesamtzahl der Elemente in der Zeile)^2
Ich kann die Funktion apply nicht direkt in der Zeile verwenden, weil jedes Element in einer Reihe, weil jedes Element in der Reihe verschiedene Faktoren hat und table() die Frequenzen nicht richtig ausgibt.
Was ist ein effizienter Weg, die gen_sim_index Funktion zu kodieren?