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)
}
Related
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)
}
}
}
Given matrices A and B the tropical product is defined to be the usual matrix product with multiplication traded out for addition and addition traded out for minimum. That is, it returns a new matrix C such that,
C_ij = minimum(A_ij, B_ij, A_i1 + B_1j, A_i2 + B_12,..., A_im + B_mj)
Given the underlying adjacency matrix A_g of a graph g, the nth "power" with respect to the tropical product represents the connections between nodes reachable in at most n steps. That is, C_ij = (A**n)_ij has value m if nodes i and j are separated by m<=n edges.
In general, given some graph with N nodes. The diameter of the graph can only be at most N; and, given a graph with diameter k, A**n = A**k for all n>k and the matrix D_ij = A**k is called the "distance matrix" entries representing the distances between all nodes in the graph.
I have written a tropical product function in chapel and I want to write a function that takes an adjacency matrix and returns the resulting distance matrix. I have tried the following approaches to no avail. Guidance in getting past these errors would be greatly appreciated!
proc tropicLimit(A:[] real,B:[] real) {
var R = tropic(A,B);
if A == R {
return A;
} else {
tropicLimit(R,B);
}
}
which threw a domain mismatch error so I made the following edit:
proc tropicLimit(A:[] real,B:[] real) {
var R = tropic(A,B);
if A.domain == R.domain {
if && reduce (A == R) {
return R;
} else {
tropicLimit(R,B);
}
} else {
tropicLimit(R,B);
}
}
which throws
src/MatrixOps.chpl:602: error: control reaches end of function that returns a value
proc tropicLimit(A:[] real,B:[] real) {
var R = tropic(A,B);
if A.domain == R.domain {
if && reduce (A == R) { // Line 605 is this one
} else {
tropicLimit(R,B);
}
} else {
tropicLimit(R,B);
}
return R;
}
Brings me back to this error
src/MatrixOps.chpl:605: error: halt reached - Sparse arrays can't be zippered with anything other than their domains and sibling arrays (CS layout)
I also tried using a for loop with a break condition but that didn't work either
proc tropicLimit(B:[] real) {
var R = tropic(B,B);
for n in B.domain.dim(2) {
var S = tropic(R,B);
if S.domain != R.domain {
R = S; // Intended to just reassign the handle "R" to the contents of "S" i.o.w. destructive update of R
} else {
break;
}
}
return R;
}
Any suggestions?
src/MatrixOps.chpl:605: error: halt reached - Sparse arrays can't be zippered with anything other than their domains and sibling arrays (CS layout)
I believe you are encountering a limitation of zippering sparse arrays in the current implementation, documented in #6577.
Removing some unknowns from the equation, I believe this distilled code snippet demonstrates the issue you are encountering:
use LayoutCS;
var dom = {1..10, 1..10};
var Adom: sparse subdomain(dom) dmapped CS();
var Bdom: sparse subdomain(dom) dmapped CS();
var A: [Adom] real;
var B: [Bdom] real;
Adom += (1,1);
Bdom += (1,1);
A[1,1] = 1.0;
B[1,1] = 2.0;
writeln(A.domain == B.domain); // true
var willThisWork = && reduce (A == B);
// dang.chpl:19: error: halt reached - Sparse arrays can't be zippered with
// anything other than their domains and sibling arrays (CS layout)
As a work-around, I would suggest looping over the sparse indices after confirming the domains are equal and performing a && reduce. This is something you could wrap in a helper function, e.g.
proc main() {
var dom = {1..10, 1..10};
var Adom: sparse subdomain(dom) dmapped CS();
var Bdom: sparse subdomain(dom) dmapped CS();
var A: [Adom] real;
var B: [Bdom] real;
Adom += (1,1);
Bdom += (1,1);
A[1,1] = 1.0;
B[1,1] = 2.0;
if A.domain == B.domain {
writeln(equal(A, B));
}
}
/* Some day, this should be A.equals(B) ! */
proc equal(A: [], B: []) {
// You could also return 'false' if domains do not match
assert(A.domain == B.domain);
var s = true;
forall (i,j) in A.domain with (&& reduce s) {
s &&= (A[i,j] == B[i,j]);
}
return s;
}
src/MatrixOps.chpl:602: error: control reaches end of function that returns a value
This error is a result of not returning something in every condition. I believe you intended to do:
proc tropicLimit(A:[] real,B:[] real) {
var R = tropic(A,B);
if A.domain == R.domain {
if && reduce (A == R) {
return R;
} else {
return tropicLimit(R,B);
}
} else {
return tropicLimit(R,B);
}
}
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 have four nested for loops. How can I optimize this ? I implement the following code but it takes too long.
p1=0.1
q1=0.3
p2=0.2
q2=0.4
n=10
r1=2
bincoeff=function(k,S1, R2, S2) {
return ( factorial(k+S1+R2+S2)/(factorial(k)*factorial(S1)*factorial(R2)*factorial(S2)) )
}
out=0
applyFormula= function(n, r1, p1, q1, p2, q2){
if (r1 < 0) {out <- 0}
else{
for (k in 0:r1) {
nmk= n-k
for (S1 in 0:nmk) {
for (R2 in 0:nmk) {
for (S2 in 0:nmk) {
if ( S1+R2+S2 == nmk ) {
out = out+ (bincoeff(k,S1,R2,S2)*(p1^k)*(q1^S1)*(p2^R2)*(q2^S2))
}
}
}
}
}
return (out)
}
}
I have after to apply this function to each row of my big data so it takes several minutes...
All the help you can offer me is appreciated. Thank you!
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.