Saat ini saya sedang mengerjakan metode Bayesian yang membutuhkan beberapa langkah optimasi model multinomial logit per iterasi. Saya menggunakan optim () untuk melakukan optimasi tersebut, dan fungsi objektif yang ditulis dalam profil R. mengungkapkan bahwa optim () adalah hambatan utama.
Setelah menggali sekitar, saya menemukan pertanyaan ini di mana mereka menyarankan bahwa pengodean ulang fungsi tujuan dengan Rcppdapat mempercepat proses. Saya mengikuti saran itu dan mencatat kembali fungsi obyektif saya Rcpp, tetapi akhirnya menjadi lebih lambat (sekitar dua kali lebih lambat!).
Ini adalah pertama kalinya saya dengan Rcpp(atau apa pun yang berhubungan dengan C ++) dan saya tidak dapat menemukan cara vektorisasi kode. Adakah yang tahu cara membuatnya lebih cepat?
Tl; dr: Implementasi fungsi saat ini di Rcpp tidak secepat R vektor; bagaimana membuatnya lebih cepat?
Contoh yang dapat direproduksi :
1) Menentukan fungsi obyektif dalam Rdan Rcpp: log-kemungkinan model intersep hanya multinomial
library(Rcpp)
library(microbenchmark)
llmnl_int <- function(beta, Obs, n_cat) {
n_Obs <- length(Obs)
Xint <- matrix(c(0, beta), byrow = T, ncol = n_cat, nrow = n_Obs)
ind <- cbind(c(1:n_Obs), Obs)
Xby <- Xint[ind]
Xint <- exp(Xint)
iota <- c(rep(1, (n_cat)))
denom <- log(Xint %*% iota)
return(sum(Xby - denom))
}
cppFunction('double llmnl_int_C(NumericVector beta, NumericVector Obs, int n_cat) {
int n_Obs = Obs.size();
NumericVector betas = (beta.size()+1);
for (int i = 1; i < n_cat; i++) {
betas[i] = beta[i-1];
};
NumericVector Xby = (n_Obs);
NumericMatrix Xint(n_Obs, n_cat);
NumericVector denom = (n_Obs);
for (int i = 0; i < Xby.size(); i++) {
Xint(i,_) = betas;
Xby[i] = Xint(i,Obs[i]-1.0);
Xint(i,_) = exp(Xint(i,_));
denom[i] = log(sum(Xint(i,_)));
};
return sum(Xby - denom);
}')
2) Bandingkan efisiensinya:
## Draw sample from a multinomial distribution
set.seed(2020)
mnl_sample <- t(rmultinom(n = 1000,size = 1,prob = c(0.3, 0.4, 0.2, 0.1)))
mnl_sample <- apply(mnl_sample,1,function(r) which(r == 1))
## Benchmarking
microbenchmark("llmml_int" = llmnl_int(beta = c(4,2,1), Obs = mnl_sample, n_cat = 4),
"llmml_int_C" = llmnl_int_C(beta = c(4,2,1), Obs = mnl_sample, n_cat = 4),
times = 100)
## Results
# Unit: microseconds
# expr min lq mean median uq max neval
# llmnl_int 76.809 78.6615 81.9677 79.7485 82.8495 124.295 100
# llmnl_int_C 155.405 157.7790 161.7677 159.2200 161.5805 201.655 100
3) Sekarang memanggil mereka optim:
## Benchmarking with optim
microbenchmark("llmnl_int" = optim(c(4,2,1), llmnl_int, Obs = mnl_sample, n_cat = 4, method = "BFGS", hessian = T, control = list(fnscale = -1)),
"llmnl_int_C" = optim(c(4,2,1), llmnl_int_C, Obs = mnl_sample, n_cat = 4, method = "BFGS", hessian = T, control = list(fnscale = -1)),
times = 100)
## Results
# Unit: milliseconds
# expr min lq mean median uq max neval
# llmnl_int 12.49163 13.26338 15.74517 14.12413 18.35461 26.58235 100
# llmnl_int_C 25.57419 25.97413 28.05984 26.34231 30.44012 37.13442 100
Saya agak terkejut bahwa implementasi vectorised di R lebih cepat. Menerapkan versi yang lebih efisien dalam Rcpp (katakanlah, dengan RcppArmadillo?) Dapat menghasilkan keuntungan? Apakah ide yang lebih baik untuk mengode ulang semua yang ada di Rcpp menggunakan pengoptimal C ++?
PS: posting pertama kali di Stackoverflow!
ObssebagaiIntegerVectormenghapus beberapa gips.