I am trying to run the following loop for calculating MLE as
l = matrix(0, tj, n)
For n or tj greater than 1000 this loop will be supper slow, is there anyway to improve this code in a more efficient way?
Thanks,
for (t in 1:tj) {
for (k in 1:n) {
if(S[t]==1) {
for(c in 1:C) {
l[t,k]=l[t,k]+(dt*(exp(alpha[c])*exp(-(X[k]-mx[c])^2/2/sx[c]^2))*mvnpdf(x=matrix(m[t,]),mean=mu[[c]],varcovM=sig[[c]], Log = FALSE))*exp(-LAN2[k]*dt)
}
} else {
l[t,k]=exp(-LAN2[k]*dt)
}
}
}
Related
My initial code for double sampling is the following. I did only one sample.
# Data
samples<-matrix(NA,nrow = 12, ncol = 2000)
for (i in 1:12) {
samples[i,]<- rbinom(2000,1,prob = 0.05)
}
# Double Sampling Plan
accept<-rep(0,12)
for (i in 1:12) {
if (sum(samples[i,1:80])<=5){
accept[i]<-1
} else if (sum(samples[i,1:80]<=8) & sum(samples[i,1:80]>5) ) {
if (sum(samples[i,1:160])<=12) {
accept[i]<-1
}
}
}
sum(accept)
Since I generated randomly from Bernoulli, every time you run the code, the results will not be the same.
I want 100 repetitions of this double sample.
My solution:
nm=double(100)
for (j in 1:100){
# Data
samples<-matrix(NA,nrow = 12, ncol = 2000)
for (i in 1:12) {
samples[i,]<- rbinom(2000,1,prob = 0.05)
}
# Double Sampling Plan
accept<-rep(0,12)
for (i in 1:12) {
if (sum(samples[i,1:80])<=5){
accept[i]<-1
} else if (sum(samples[i,1:80]<=8) & sum(samples[i,1:80]>5) ) {
if (sum(samples[i,1:160])<=12) {
accept[i]<-1
}
}
}
nm[j]=sum(accept)
}
mean(nm)
What do you think?
If we follow the proposition of #Onyambu, we can embeded one simulation inside a function and call it in a loop like this :
one_double_sampling <- function(){
# Data
samples<-matrix(NA,nrow = 12, ncol = 2000)
for (i in 1:12) {
samples[i,]<- rbinom(2000,1,prob = 0.05)
}
# Double Sampling Plan
accept<-rep(0,12)
for (i in 1:12) {
if (sum(samples[i, 1:80])<=5){
accept[i]<-1
} else if (sum(samples[i,1:80]<=8) & sum(samples[i,1:80]>5) ) {
if (sum(samples[i,1:160])<=12) {
accept[i]<-1
}
}
}
return(sum(accept))
}
set.seed(123)
# number of sample
n <- 100
# stock the result
res <- rep(0, n)
for(i in 1:n){
res[i] <- one_double_sampling()
}
# mean
mean(res)
Definitly your code is correct. For people interresting by the double sampling method I advise you to see this.
Edit 1
In one line code based on Onyambu advise :
mean(replicate(n, one_double_sampling()))
I am trying to optimize an equation in R, but it seems like I can only minimize it. My question is: How do I maximize my equation?
p = 0.00379
W_0 = 0.3*10^6
L = 0.1489*10^6
u <- function(x,n){
if(n != 1){
(x^{1-n})/1-n
}
else{
log(x)
}
}
aslan <- function(a,n,l){
p*u(W_0-L+a*L-a*p*L*(1+l),n)+(1-p)*u(W_0-a*p*L*(1+l),n)
}
optimize(aslan,c(0,1),n=0.8,l=0.5)
I am trying to generate a vector of random numbers based on a finite random variable X
With probGen function I generate a variable X, l1 is the first line and l2 is the second one.
And at this point if(sum1 >= U) I recive this error Error in if (sum1 >= U) { : argument is of length zero
This is my code:
probGen=function(n)
{
v=vector()
k=sample(1:n,1)
v=rep(0,k)
for(i in 1:n)
{
aux=sample(1:k,1)
v[aux]=v[aux]+1
}
vfinal=vector()
klen=0
for(i in 1:k)
{
if(v[i]!=0) klen=klen+1
}
for(i in 1:k)
{
if(v[i]!=0)
vfinal=c(vfinal,rep(1/(klen*v[i]),v[i]))
}
vfinal=sample(vfinal)
return (vfinal)
}
n=22
l1=c(1:n)
l2=probGen(n)
l1
l2
simVar=function(l1,l2)
{
variante=vector()
U=runif(1,0,1)
for(i in 1:length(l1))
{
sum1=1-1
for(j in 1:i-1)
{
if(i-1>=1)
{
sum1=sum1+l2[j]
}
}
sum2=0.0
for(j in 1:i)
{
sum2=sum2+l2[j]
}
if(sum1 >= U)
{
if(U<sum2)
{
variante=c(variante,l1[i])
}
}
}
return (variante)
}
varR=simVar(l1,l2)
varR
Any idea?
Thanks!
The for(j in 1:i-1) near the top of the code for simVar is evaluating as (1:i)-1, resulting in a zero j which produces a NA value of sum1. Use for(j in 1:(i-1)) instead.
I need to find write a formula to breakdown a matrix using the blockwise inversion method.This what I have so far
func <- function(matrix=M) {
n = nrow(M)
if (n==1) M^-1
} else if (n==2) {
1/DetM*(M)
CMHope=matrix(c(M[2,2],-1*M[2,1]))
CMHope2=matrix(c(-1*M[1,2],M[1,1]))
Rbbin=cbind(CMHope,CMHope2)
1/det(M)*Rbbin
} else {
}
return(end matrix)
}
Since I have not found an R package for analysis of electrophysiological data, I have used a function for spike pruning from my group:
prune.spikes <- function(spikes, min.isi) {
# copy spike matrix
prunedspikes <- spikes
# initialise index of last spike: infinitely before the first one.
for (i in 1:ncol(spikes)) {
last <- -Inf
for (j in 1:nrow(spikes)) {
if (spikes[j, i] == 1) {
if (j - last < min.isi) {
prunedspikes[j, i] <- 0; # remove the spike
}
else {
last <- j
}
}
}
}
return(prunedspikes)
}
The function takes a spike vector or matrix consisting of 0 and 1 values and removes any 1 if it occurred within a minimum interval.
Because of the two nested loops it takes ages to run. In order to optimise it I have come up with this solution (removes one loop):
prune.cols <- function(spikes, min.isi) {
prunedspikes <- apply(spikes, 2, FUN = prune.rows, min.isi = min.isi)
return(prunedspikes)
}
prune.rows <- function(spikes, min.isi) {
prunedspikes <- spikes
last <- -Inf
for (i in 1:length(spikes)) {
if (spikes[i] == 1) {
if (i - last < min.isi) {
prunedspikes[i] <- 0; # remove the spike
}
else {
last <- i
}
}
}
return(prunedspikes)
}
Calling prune.cols on a large data set is noticeable faster compared to the original version (~60 times). One loop remains, though. So far I could not come up with a nice and simple solution. How can the function be even further improved?
Like #Khashaa proposed, I implemented the function with the help of Rcpp:
NumericMatrix prunespikes(NumericMatrix spikes, double minisi) {
NumericMatrix prunedspikes = spikes;
int ncol = spikes.ncol();
int nrow = spikes.nrow();
for (int i = 0; i < ncol; i++) {
int last = 0;
while (spikes(last, i) == 0) {
last++;
}
for (int j = last + 1; j < nrow; j++) {
if (spikes(j, i) == 1) {
if (j - last < minisi) {
prunedspikes(j, i) = 0;
} else {
last = j;
}
}
}
}
return prunedspikes;
}
If the speed difference is not a problem yet, it may be better to keep the loop instead of using Rcpp.
According to Hadley Wickham's article Loops that should be left as is, it is not a bad idea to have this loop as it can be categorized into the Recursive relationship case.
Once the speed is the bottleneck, then resorting to Rcpp or this page (suggested by the article too) may be the solution.