I have 100 points representing the boundary of a sphere of radius .1 and center (.5,.5,.5). I would like to represent this sphere in an array of points on a 3-D gird. The values of the array would be binary. 1 to represent inside the sphere and 0 to represent outside the sphere. The representation would be upon the unit cube.
I forsee the array looking something like this. For an array 100 by 100 by 100. The (1,1,1) value would be 0. The (50,50,50) value would be 1, since this grid point is inside the sphere.
Here is the code that creates and plots the 100 (or more) points. These points all lay on the boundary of the sphere.
library(scatterplot3d)
n <- 100
r <- rep(.1,n)
theta <- runif(n,0,pi)
phi <- runif(n,0,2*pi)
x <- r*sin(theta)*cos(phi)+.5
y <- r*sin(theta)*sin(phi)+.5
z <- r*cos(theta)+.5
graphic <- scatterplot3d(x,y,z,xlim=c(0,1),ylim=c(0,1),zlim=c(0,1))
Maybe this helps you on your way. I'm guessing that visualization is no the main objective here, but I've included a series of image plots to show the sections of the 3d array.
Example:
n=25
cen <- c(0.5,0.5,0.5)
rad <- 1
xs <- seq(cen[1]-rad,cen[1]+rad,,n)
ys <- seq(cen[2]-rad,cen[2]+rad,,n)
zs <- seq(cen[3]-rad,cen[3]+rad,,n)
grd <- expand.grid(x=xs, y=ys, z=zs)
a <- array(0, dim=c(n,n,n))
for(i in seq(a)){
a[i] <- as.numeric(dist(rbind(grd[i,], cen)) <= rad)
}
png("sections.png", units="in", width=10, height=4, res=400)
op <- par(mfrow=c(1,n), mar=rep(0.1,4))
for(i in seq(n)){
image(x=xs, y=ys, z=a[,,i], col=c("white", "black"), axes=FALSE, xlab="", ylab="")
abline(h=xs, col=8, lwd=0.2)
abline(v=ys, col=8, lwd=0.2)
#box()
}
par(op)
dev.off()
n <- 3
x <- 1:n
y <- 1:n
z <- 1:n
grid <- expand.grid(x,y,z)
vec <- ((grid[,1]-rep(n/2+.5,n^3))^2 +
(grid[,2]-rep(n/2+.5,n^3))^2 +
(grid[,3]-rep(n/2+.5,n^3))^2)^.5
a <- array(round(vec,3),dim=c(n,n,n)) #in array (pixel) scale
a.metric <- a*(1/n) #in "metric" scale
a
a.metric
STACK <- array(as.numeric(a.metric <=.1),dim=c(n,n,n))
STACK
Related
I am new to R and would like to use it for my data analysis and visualization.
I have a dataframe with about 38575 rows (pixels) and 600 columns. Each column contains the intensity of an analyte, resulting in a spectrum per pixel.
I also have x and y coordinates for each pixel to create a data cube(array), in the sense that if I say image_cube[1,1,] gives me the first spectrum and if I say image_cube[,,1], I get an image of all pixels showing the intensity for the first analyte.
Not all pixels have a spectrum and they are not in the dataframe, these should just be empty pixels (black).
EDIT
I tried to use the following code with ROI data being the big dataframe and sample_overview the variable containing x and y coordinates for each pixel:
ROI_cube <- array(rep(0, 311*381*603), dim=c(311, 381, 603))
for (i in 1:dim(ROI_data)[1]) {
ROI_cube[sample_overview[i,2], sample_overview[i,1],] = ROI_data[i,]
}
But I get the following error:
Error in ROI_cube[sample_overview[i, 1], sample_overview[i, 2], ] <- ROI_data[i, :
incorrect number of subscripts
If i get your question correctly you want to map a 2D Dataframe of Spectra through known x-y Coordinates to a 3D-Array.
If thats all you want, you don't need any packages, it's just a matter of mapping the data in the dataframe to an Array
#Simulate some gaussian spectra
set.seed(1234)
simSpec <- function()
{
x <- 1:400
y <- stats::dnorm(x,mean=runif(1,min=0,max=400),sd=runif(1,min=2,max=50))
return(y)
}
#build a dataframe
data <- data.frame(matrix(data=NA,nrow=400,ncol=20))
for(i in 1:20) data[,i] <- simSpec()
#assume data is ordered in ascending x/y pixels
#=> data[,1] -> x=1, y=1 ; data[,2] -> x=2, y=1; data[,length(x)] -> x=length(x), y=y;
#data[,m+(n-1)*length(x)] -> x=m, y=n
Array <- array(data=t(data),dim=c(5,4,400)) #Build Array of format [X,Y,NSpectralVariables]
#transpose dataframe because default order is to first increase Columnnumber
plot(Array[1,1,],type="l") # Plot Spectrum at x=1, y=1
contour(Array[,,1]) #Contour Intensity at first Analyte
I am trying to optimise the code designed to compute double sums of product of the elements of two square matrices. Let’s say we have two square matrices of size n, W and V. The object that needs to be computed is a vector B with elements
In simple terms: compute element-by-element products of two different rows in two different matrices and take their sum, then take an extra sum over all rows of the second matrix (sans identical indices).
The problem is, the computational complexity of this task seemingly O(n3) because the length of this object we are creating, B, is n, and each element requires two summations. This is what I have come up with:
For given i and j (i≠j), start with the inner sum over k. Sum for all k, then subtract the terms for k=i and k=j, and multiply by the indicator of j≠i.
Since the restriction j≠i has been taken care of in the inner sum, the outer sum is taken just for j=1,...,n.
If we denote , then the two steps will look like
and .
However, writing a loop turned out to be very inefficient. n=100 works quickly (0.05 seconds). But, for instance, when n=500 (we are talking about real-world applications here), the average computation time is 3 seconds, and for n=1000, it jumps to 22 s.
The inner loop over k can be easily replaced by a sum, but the outer one... In this question, the suggested solution is sapply, but it implies that the summation must be done over all elements.
This is the code I am trying to evaluate before the heat death of the Universe for large n.
set.seed(1)
N <- 500
x1 <- rnorm(N)
x2 <- rchisq(N, df=3)
bw1 <- bw.nrd(x1)
bw2 <- bw.nrd(x2)
w <- outer(x1, x1, function(x, y) dnorm((x-y)/bw1) )
w <- w/rowSums(w)
v <- outer(x2, x2, function(x, y) dnorm((x-y)/bw2) )
v <- v/rowSums(v)
Bij <- matrix(NA, ncol=N, nrow=N)
for (i in 1:N) { # Around 22 secs for N=1000
for (j in 1:N) {
Bij[i, j] <- (sum(w[i, ]*v[j, ]) - w[i, i]*v[j, i] - w[i, j]*v[j, j]) * (i!=j)
}
}
Bi <- rowSums(Bij)
How would an expert R programmer vectorise such kind of loops?
Update:
In fact, given your expression for B_{ij}, we may also do the following
diag(w) <- diag(v) <- 0
BBij <- tcrossprod(w, v)
diag(BBij) <- 0
range(rowSums(BBij) - Bi)
# [1] -2.220446e-16 0.000000e+00
range(BBij - Bij)
# [1] -6.938894e-18 5.204170e-18
Hence, while somewhat obvious, it may also be an interesting observation for your purposes that neither B_{ij} nor B_i depend on the diagonals of W and V.
Initial answer:
Since
where the diagonals of W and V can be set to zero and V_{.k} denotes the sum of the k-th column of V, we have
diag(w) <- diag(v) <- 0
A <- w * v
rowSums(sweep(w, 2, colSums(v), `*`)) - rowSums(A) + diag(A)
where
range(rowSums(sweep(w, 2, colSums(v), `*`)) - rowSums(A) + diag(A) - Bi)
# [1] -1.110223e-16 1.110223e-16
Without looking into the content of your matrices w and v, your double for-loop can be replaced with simple matrix operations, using one matrix multiplication (tcrossprod), transpose (t) and diagonal extraction:
Mat.ij <- tcrossprod(w, v) -
matrix(rep(diag(w), times = N), nrow = N) * t(v) -
w * matrix(rep(diag(v), each = N), nrow = N)
diag(Mat.ij) <- 0
all.equal(Bij, Mat.ij)
[1] TRUE
This question, probably has a simple solution but I cannot think of how to do it...
So I have a script as follows:
# ------------------ MODEL SETUP ----------------------------------------# simulation length
t_max <- 50
# arena
arena_x <- 100
arena_y <- 100
# plant parameters
a <- 0.1
b <- 0.1
g <- 1
# list of plant locations and initial sizes
nplants <-dim(plantLocsX)[1]*dim(plantLocsX)[2]
iterations<-5
totalBiomass<-matrix(0,nrow=iterations,ncol=1)
# starting loop
sep <- 10
# Original matrix
plantLocsX <- matrix(rep(seq(0,arena_x,sep), arena_y/sep),
nrow=1+arena_x/sep,
ncol=1+arena_y/sep)
plantLocsY <- t(plantLocsX)
plantSizes <- matrix(1,nrow=nplants,ncol=1)
# Plot the plants
radius <- sqrt( plantSizes/ pi )
symbols(plantLocsX, plantLocsY, radius, xlim = c(0,100), ylim=c(0,100), inches=0.05, fg = "green",
xlab = "x domain (m)", ylab = "y domain (m)", main = "Random Plant Locations", col.main = 51)
# Calculate distances between EACH POSSIBLE PAIR of plants
distances <- matrix(0,nrow=nplants,ncol=nplants)
for (i in 1:nplants){
for (j in 1:nplants){
distances[i,j] <- sqrt( (plantLocsX[i]-plantLocsX[j])^2 + (plantLocsY[i]-plantLocsY[j])^2 )
}
}
# ------------------ MODEL RUNNING ---------------------------------------
I need to alter the arrays containing plant locations and plant sizes so that at each time step, entries are removed and added (simulating mortality/reproduction, respectively). The "distances" must be updated with plant locations and sizes after each iteration...I can only think of complex ways to do this: destructing and constructing new matrices at each time step to fit the new number of elements but there must be functions to make this simpler....any advice?
Many thanks!!
When I have an array with the dimension (i,j,k) and a matrix with the dimension (j,q). How could I multiply each (,,k) with that matrix. An example makes more sense.
A <- array(c(rep(1,20), rep(2,20), rep(3,20)),dim = c(10,2,3))
B <- matrix(c(1:10), nrow = 2)
# multiply each A[,,i]%*%B
C <- array(NA, dim=c(nrow(A), ncol(B), 3))
C[] <- apply(A, 3, function(x) x%*%B)
I could get the results in this way, but I am looking for a more efficient way, for example with the ATensor package. I hope someone could help me with this problem.
I wish to create an array. Each element will be assigned to be a list, and each list will be of a different length (unknown before the script is executed). A simple example would be to let a[1] be the list q and a[2] be the list. Is there a construct that I can use, perhaps different than array, that would allow for such assignments.
q <- c(1,2,3,4,5)
w <- c(6,7,8)
a <- array(2)
a[1] <- q
Warning message:
In a[1] <- q : number of items to replace is not a multiple of replacement length
Since you want an array of lists, try:
a[1] <- list(q)
As has been pointed out in the comments, you are likely looking for list and not array (the latter being more akin to a multi-dimensional matrix or mathematical vector.)
However in addition to that is the issue if indexing:
In R there is a major difference between a[1] <- q and a[[1]] <- q
Try the following to spot the diff:
a <- list()
a[[1]] <- q
a[[2]] <- w
a
Compare with
a <- list()
a[1] <- q
a[2] <- w
a
I think what you want is a list of vectors.
q <- c(1,2,3,4,5)
w <- c(6,7,8)
a <- list()
a[[1]] <- q
list works - thanks! it allows me to partition an array of positions into a list of lists according to some separation cutoff.
delta <- 200
pcls <- list(nrow=pctot)
v <- posvec[1]
pcind <- 0
jtest <- 0
for (j in 2:nr) {
dist <- posvec[j]-posvec[j-1]
if (dist <= delta) {
v <- c(v,posvec[j])
jtest <- 1
}
if (dist > delta) {
if (jtest > 0) {
pcind <- pcind + 1
pcls[[pcind]] <- v
v <- posvec[j]
}
jtest <- 0
}
}