I have a series of points that exist in 3 dimensional space (x, y, and z) and an adjacency matrix that determines connections between those points (see example below). How would I plot that? Thanks!
points = matrix(c(2,3,2, 5,4,9, 4,1,8), byrow = TRUE, ncol = 3) #each row is a point and the colums are x, y, and z respectively
adj_mat = matrix(c(0,1,0, 1,0,1, 0,1,0), byrow = TRUE, ncol = 3)
There may be a more elegant way to handle the adjacency matrix, but as far as I can tell rgl::segments3d() turns sequential points into segments, so you need to repeat points for each connection. The below approach is slightly redundant; set the upper or lower triangle to 0 if you like, but you won't be able to see the difference anyway since the segments will overplot.
points = matrix(
c(2,3,2, 5,4,9, 4,1,8),
byrow = TRUE, ncol = 3,
dimnames = list(NULL, c('x', 'y', 'z'))
)
adj_mat = matrix(c(0,1,0, 1,0,1, 0,1,0), byrow = TRUE, ncol = 3)
segments <- points[as.vector(matrix(
c(row(points)[as.logical(adj_mat)],
col(points)[as.logical(adj_mat)]),
byrow = TRUE, nrow = 2
)), ]
library(rgl)
plot3d(points)
segments3d(segments)
Related
How do I compute the dot product for
movies <- matrix(c(3,1,1,2,1,4,3,1,1,3), ncol = 2, byrow = T)
users <- matrix(c(1,0,0,1,1,0,1,1), ncol = 2, byrow = T)
expected <- matrix(c(3,1,1,3,1,
1,2,4,1,3,
3,1,1,3,1,
4,3,5,4,4), ncol = 5, byrow = T)
This example is from
https://www.youtube.com/watch?v=ZspR5PZemcs
at 12:55
Answer is
users %*% t(movies)
I have been confused by "dot product" I think this is something different from matrix multiplication.
I have an array Q which has size nquantiles by nfeatures by nfeatures. In this, essentially the slice Q[1,,] would give me the first quantile of my data, across all nfeatures by nfeatures of my data.
What I am interested in, is using another matrix M (again of size nfeatures by nfeatures) which represents some other data, and asking the question to which quantile do each of the elements in M lie in Q.
What would be the quickest way to do this?
I reckon I could do double for loop across all rows and columns of the matrix M and come up with a solution similar to this: Finding the closest index to a value in R
But doing this over all nfeatures x nfeatures values will be very inefficient. I am hoping that there might exist a vectorized way of approaching this problem, but I am at a lost as to how to approach this.
Here is a reproducible way of the slow way I can approach the problem with O(N^2) complexity.
#Generate some data
set.seed(235)
data = rnorm(n = 100, mean = 0, sd = 1)
list_of_matrices = list(matrix(data = data[1:25], ncol = 5, nrow = 5),
matrix(data = data[26:50], ncol = 5, nrow = 5),
matrix(data = data[51:75], ncol = 5, nrow = 5),
matrix(data = data[76:100], ncol = 5, nrow = 5))
#Get the quantiles (5 quantiles here)
Q <- apply(simplify2array(list_of_matrices), 1:2, quantile, prob = c(seq(0,1,length = 5)))
#dim(Q)
#Q should have dims nquantiles by nfeatures by nfeatures
#Generate some other matrix M (true-data)
M = matrix(data = rnorm(n = 25, mean = 0, sd = 1), nrow = 5, ncol = 5)
#Loop through rows and columns in M to find which index of the array matches up closest with element M[i,j]
results = matrix(data = NA, nrow = 5, ncol = 5)
for (i in 1:nrow(M)) {
for (j in 1:ncol(M)) {
true_value = M[i,j]
#Subset Q to the ith and jth element (vector of nqauntiles)
quantiles = Q[,i,j]
results[i,j] = (which.min(abs(quantiles-true_value)))
}
}
'''
Is there a way to find the dimension of an 3D object (face) in R defined by a set of vertices (the object is the convex hull of the vertices). That is, defining the function getDim().
vertices<-matrix(c(1,1,1,1,1,1), ncol = 3, byrow = TRUE)
getDim(vertices) # should return 0
vertices<-matrix(c(0,0,0,1,1,1,2,2,2,3,3,3), ncol = 3, byrow = TRUE)
getDim(vertices) # should return 1
vertices<-matrix(c(0,0,0,0,1,1,0,2,2,0,0,2), ncol = 3, byrow = TRUE)
getDim(vertices) # should return 2
vertices<-matrix(c(0,0,0,0,1,1,0,2,2,0,0,2,1,1,1), ncol = 3, byrow = TRUE)
getDim(vertices) # should return 3
Thanks to Stephane Laurent for a hint
getDim3D<-function(points) {
x <- unique(points)
if (dim(x)[1]==1) return(0)
x <- x[2:dim(x)[1],,drop=F] - matrix(rep(x[1,], times = dim(x)[1]-1), ncol = dim(x)[2], byrow = TRUE)
return(Matrix::rankMatrix(x)[1])
}
I am trying to simulate the shape of the rings from a trunk section in R, but each time that I want to approach the real shape it get more difficult. I started doing it with four radii measurements, and I got a nice solution (see here).
However, now I want to plot more than four radii but at different angles, and connect these points with a line simulating the rings like this sketch that I did:
My first approach was to rotate the matrix of data, but I could not make that all radii started in the same position (0,0). I also tried to rate the axes without success.
That is why I would like to ask for some direction to do it, and finally calculate the area of each ring.
Any help will be welcome
I am using the spline.poly function from here.
spline.poly
spline.poly <- function(xy, vertices, k=3, ...) {
# Assert: xy is an n by 2 matrix with n >= k.
# Wrap k vertices around each end.
n <- dim(xy)[1]
if (k >= 1) {
data <- rbind(xy[(n-k+1):n,], xy, xy[1:k, ])
} else {
data <- xy
}
# Spline the x and y coordinates.
data.spline <- spline(1:(n+2*k), data[,1], n=vertices, ...)
x <- data.spline$x
x1 <- data.spline$y
x2 <- spline(1:(n+2*k), data[,2], n=vertices, ...)$y
# Retain only the middle part.
cbind(x1, x2)[k < x & x <= n+k, ]
}
DATA
df = data.frame(A = c(1, 4, 5, 8, 10),
B = c(1, 3, 7, 9, 10),
C = c(2, 6, 8, 9, 10),
D = c(1, 3, 4, 7, 9),
E = c(1, 2, 3, 4, 5))
DRAW
#Calculate angles based on number of columns
angles = 0:(NCOL(df) - 1) * 2*pi/NCOL(df)
#Calculate x and y corresponding to each radial distance
toplot = lapply(1:NCOL(df), function(i){
data.frame(x = df[,i]*cos(angles[i]),
y = df[,i]*sin(angles[i]))
})
#Split toplot and merge back together the same rows
toplot2 = lapply(toplot, function(x) data.frame(x, ID = sequence(NROW(x))))
toplot2 = do.call(rbind, toplot2)
toplot2 = split(toplot2, toplot2$ID)
#Create empty plot
graphics.off()
plot(do.call(rbind, toplot), type = "n", axes = FALSE, ann = FALSE, asp = 1)
#Allow drawing outside the plot region just in case
par(xpd = TRUE)
#Draw polygons
lapply(toplot2, function(a){
polygon(spline.poly(xy = cbind(a$x, a$y), vertices = 100, k = 3))
})
#Draw points
lapply(toplot, function(a){
points(a)
})
#Draw radial lines
lapply(toplot, function(a){
lines(a)
})
AREA
area_data = lapply(toplot2, function(a){
spline.poly(xy = cbind(a$x, a$y), vertices = 100, k = 3)
})
library(geometry)
lapply(area_data, function(P) polyarea(P[,1], P[,2]))
#$`1`
#[1] 4.35568
#$`2`
#[1] 38.46985
#$`3`
#[1] 96.41331
#$`4`
#[1] 174.1584
#$`5`
#[1] 240.5837
I am looking for a procedure that allows me to generate a sequence of equidistant points (coordinates) along the sides of an arbitrary polygon.
Imaging a polygon defined by the coordinates of its vertexes:
poly.mat <- matrix(c(0,0,
0,1,
0.5,1.5,
0.5,0,
0,0 # last row included to close the polygon
), byrow = T, ncol = 2)
colnames(poly.mat) <- c("x", "y")
plot(poly.mat, type = "l")
If the length of the sequence I want to generate is n (adjustable), how I can produce a sequence, starting at (0,0), of equidistant coordinates.
I got as far as calculating the perimeter of the shape with the geosphere package (which I believe I need)
library(geosphere)
n <- 50 # sequence of length set to be 50
perim <- perimeter(poly.mat)
perim/n # looks like every section needs to be 8210.768 something in length
You will have to write the code yourself. Sorry, there isn't a library function for every last detail of every last assignment. Assuming that each pair of points defines a line segment, you could just generate N points along each segment, as in
begin = [xbegin, ybegin ];
end = [xend, yend ];
xdist = ( xend - xbegin ) / nintervals;
ydist = ( yend - ybegin ) / nintervals;
then your points are given by [ xbegin + i * xdist, ybegin + i * ydist ]
Here is the solution I came up with.
pointDistance <- function(p1, p2){
sqrt((p2[,1]-p1[,1])^2) + sqrt((p2[,2]-p1[,2])^2)
}
getPos <- function(shp.mat, ll){
greaterLL <- shp.mat$cumdis > ll
if(all(greaterLL == FALSE)) return(poly.mat[nrow(poly.mat), c("x", "y")])
smallRow <- min(which(greaterLL)) # the smallest coordinate that has greater length
p.start <- shp.mat[smallRow-1, c("x","y")]
p.end <- shp.mat[smallRow, c("x","y")]
cumVal <- shp.mat$cumdis[smallRow]
prop <- (ll-shp.mat$cumdis[smallRow-1])/(shp.mat$cumdis[smallRow]-shp.mat$cumdis[smallRow-1])
p.start + (prop)* (p.end-p.start)
}
# shp1
poly.mat <- matrix(c(0,0,
0,1,
0.5,1.5,
0.5,0,
0,0
),byrow = T, ncol = 2)
colnames(poly.mat) <- c("x", "y")
poly.mat <- as.data.frame(poly.mat)
# Main fun
pointsOnPath <- function(shp.mat, n){
dist <- vector(mode = "numeric", length = nrow(shp.mat)-1)
for(i in 2:nrow(shp.mat)){
dist[i] <- pointDistance(p1 = shp.mat[i,], p2 = shp.mat[i-1,])
}
shp.mat$dist <- dist
shp.mat$cumdis <- cumsum(shp.mat$dist)
dis <- matrix(seq(from = 0, to = max(shp.mat$cumdis), length.out = n+1), ncol = 1)
out <- lapply(dis, function(x) getPos(shp.mat = shp.mat, ll = x))
out <- do.call("rbind", out)
out$dis <- dis
out[-nrow(out),]
}
df <- pointsOnPath(shp.mat = poly.mat, 5)
# Plot
plot(poly.mat$x, poly.mat$y, type = "l", xlim = c(0,1.5), ylim = c(0,1.5))
points(df$x, df$y, col = "red", lwd = 2)
There is room for improving the code, but it should return the correct result