Here I have got two 3D objects with the object formed by vertices2 half the size of that formed by vertices. I wish to plot these two objects in rgl window such that smaller one really looks smaller. However, when I tried the following code, I get two EQUALLY SIZED objects. How could I display these two objects with the one on the right proportionally smaller than the one on the left?
library(rgl)
vertices <- c(
-1.0, -1.0, 0,
1.0, -1.0, 0,
1.0, 1.0, 0,
-1.0, 1.0, 0
)
indices <- c( 1, 2, 3, 4 )
vertices2 <- vertices * 0.5
mfrow3d(1,2,sharedMouse = T)
wire3d( mesh3d(vertices = vertices, quads = indices) )
next3d()
wire3d( mesh3d(vertices = vertices2, quads = indices) )
You are plotting the two objects in independent windows. rgl automatically centers and resizes them to fill the window, so they end up looking the same. The way it does this is by moving the imagined observer closer or further from the scene.
To prevent this, you should set the observer locations to match, e.g.
mfrow3d(1,2,sharedMouse = TRUE)
wire3d( mesh3d(vertices = vertices, quads = indices) )
obs <- par3d("observer")
next3d()
wire3d( mesh3d(vertices = vertices2, quads = indices) )
observer3d(obs)
The observer location is specified using coordinates relative to the center of the bounding box of each scene.
Related
I have 3D meshes representing closed surfaces not necessarily convex for which I would like to get orthographic projections onto arbitrary directions (to put in context, the 3D meshes represent satellites and the end goal is to use the projections to calculate atmospheric drag).
As a first step, I am just aiming to compute the surface area of the resulting projection. Is there any way to perform such operation with rgl? Since the meshes represent closed surfaces, the projections will not contain multiple disconnected polygons.
I believe I can get the set of triangles/quads visible from a given direction by using the facing3d() function, specifying the direction in the up argument. But I am unsure on how to proceed from there.
You can do the projections using the rgl::shadow3d() function, and calculate area using geometry::polyarea(). For example,
library(rgl)
library(geometry)
satellite <- translate3d(icosahedron3d(), x = 0, y = 0, z = 5)
vertices <- asEuclidean2(satellite$vb)
xrange <- range(vertices[1,])
yrange <- range(vertices[2,])
floor <- mesh3d(x = c(2*xrange, 2*rev(xrange)),
y = rep(2*yrange, each = 2),
z = 0, quads = 1:4)
open3d()
#> glX
#> 1
shadow <- shadow3d(floor, satellite, plot = FALSE,
minVertices=1000 # Need this to get a good shadow
)
shade3d(satellite, col= "red")
shade3d(floor, col = "white", polygon_offset = 1, alpha = 0.1)
shade3d(shadow, col = "gray")
vertices <- unique(t(asEuclidean2(shadow$vb)))[,1:2]
hull <- chull(vertices)
hullx <- vertices[hull,1]
hully <- vertices[hull,2]
plot(c(hullx, hullx[1]), c(hully, hully[1]), type = "l")
polyarea(hullx, hully)
#> [1] 3.266855
Created on 2022-12-13 with reprex v2.0.2
Is it possible to draw real solid circle with a radius in "user" coordinates?
I tried the following:
Polygons:
I don't want to use them because I need real circles in the resulting svg.
Segments
segments(x, y, x, y, lwd=px, lend=0)
With segments there is the problem that I don't find a way to specify the segment in "user" coordinates.
The resulting graph is at the end exported to PDF.
Update
I draw a graph with a lot of elements and the elements has a distinct width. The width of the elements depends on the width at the x-axis. If I don't use user coordinates the result in the PDF is not correct in dependence to the x-axis.
A Polygon is an approximation to a circle and if I use them the result e.g. PDF is very large and the performance is not good and memory usage is very high. I draw 10,000 circles and more on one graph.
I use the following code with the described performance problems:
circle <- function(x, y, r, col) {
edgeCount <- 50
intervals <- (1:edgeCount) / edgeCount * 2 * pi
for(i in 1:length(x)) {
polygon(r[i]*sin(intervals) + x[i], r[i]*cos(intervals) + y[i], col=col[i],border=NA)
}
}
If you're comfortable with using a wrapper for sp's SpatialLine object you can try the oceanmap package which has a quite useful function called SpatialCircle(). It essentially builds a circle via seq() and adjusts it for your center point coordinates x and y, and for your radius r. It's still a set of line segments (so not one curved line), but quite simple to use.
Result:
Code:
Pretty straightforward:
# Load libraries.
library(oceanmap)
# Generate plot window and data.
set.seed(1702)
plot.new()
plot.window(xlim = c(0, 20), ylim = c(0, 10),
asp = 1, xaxs = "i", yaxs = "i")
axis(1)
axis(2)
box()
n <- 1000
x <- runif(n, 0, 20)
y <- runif(n, 0, 10)
for (i in 1:n) {
circle <- SpatialCircle(x = x[i], y = y[i], r = 0.1, n = 1000)
lines(circle)
}
This also works with ggplot2 with some data wrangling.
Addendum: Precision of SpatialCircles
If you want to check out what n (precision) in the SpatialCircle() function really means, try the following:
nrow(circle#lines[[1]]#Lines[[1]]#coords)
Result:
[1] 1000
This means that the object has 1,000 coordinate pairs (x and y) through which a line can be drawn. Furthermore, this line will have 999 distinct line segments, as the first and the last coordinate pairs are always identical. Proof:
all.equal(circle#lines[[1]]#Lines[[1]]#coords[1, ],
circle#lines[[1]]#Lines[[1]]#coords[1000, ])
Result:
[1] TRUE
If found a solution myself with the help of Gregor2 which did lead me to the library "grid".
library(grid)
#draw frame using normal plot
plot(0, 0, cex=0)
margins <- par("mar")
#1: bottom 2:left 3:top 4:right
mb <- unit(margins[1], "lines")
ml <- unit(margins[2], "lines")
mt <- unit(margins[3], "lines")
mr <- unit(margins[4], "lines")
#create viewport equivalent to margins in par
pushViewport(viewport(x = ml, y = mb, width = unit(1, "npc") - ml - mr, height = unit(1, "npc") - mb - mt, just=c("left", "bottom"), clip=TRUE))
#draw circle in npc units (easily convertable to user units using grconvertX)
grid.draw(circleGrob(x=0.5, y=0.5, r=0.5, default.units="npc", gp=gpar(col="blue", fill="blue")))
popViewport()
I am trying to plot a network that changes in time. The network starts with a certain number of nodes and edges and each time step some of the nodes and edges are removed.
I want to be able to plot the network so that the nodes are in the same place in each. However when I try this. sometimes the nodes shift position in the plot frame even if the relation to each other is the same.
I am making the network change into a gif so even small changes are annoying. I think the change may occur when a large fraction of the nodes are removed but I am not sure.
The code below illustrates this using an ER graph.
library(igraph); library(dplyr)
#generate random graph
set.seed(500)
RandomGraph <- sample_gnm(1000, 2500)
#name nodes
V(RandomGraph)$name <- paste0("Node", 1:1000)
#Get the coordinates of the Nodes
Coords <- layout_with_fr(RandomGraph) %>%
as_tibble %>%
bind_cols(data_frame(names = names(V(RandomGraph))))
#Delete random vertices
deletevertex <-sample( V(RandomGraph)$name, 400)
RandomGraph2 <-delete.vertices(RandomGraph, deletevertex)
#get the coordinates of the remaining Nodes
NetCoords <- data_frame(names = names(V(RandomGraph2))) %>%
left_join(Coords, by= "names")
#plot both graphs
RandomGraph%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(Coords[,1:2]))
RandomGraph2%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(NetCoords[,2:3]))
#They nodes have the same relationship to each other but are not laid out in the same position in the frame
As you can see the plots have placed nodes in the same place relative to each other but not relative to the frame.
How can I have the plot position fixed.
plot.igraph rescales each axis by default (from -1 to +1 on both x and y).
You just need to turn that off: rescale = F and then explicitly set appropriate xlim and ylim values.
For your example code..
RandomGraph%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(Coords[,1:2]),rescale=F,xlim=c(-25,30),ylim=c(-20,35))
RandomGraph2%>%
plot(.,vertex.size=.8, edge.arrow.size=.4, vertex.label = NA, layout = as.matrix(NetCoords[,2:3]),rescale=F,xlim=c(-25,30),ylim=c(-20,35))
The problem is that
identical(range(Coords[1]), range(NetCoords[2]))
# [1] FALSE
Since igraph normalizes the coordinates on a range between -1 and 1 before plotting, this leads to slightly different coordinates for NetCoords compared to Coords. I'd just calculate the normalized coordinates for all nodes beforehand:
coords_rescaled <- sapply(Coords[-3], function(x) -1+((x-min(x))*2)/diff(range(x)))
rownames(coords_rescaled) <- Coords$names
And then assign the normalized coordinates (or the required subset) and set rescale=FALSE (as #jul) already suggested:
par(mfrow=c(1,2), mar=c(1,.5,1,.5))
RandomGraph%>%
plot(.,edge.arrow.size=.4, layout = coords_rescaled, rescale=F);box()
RandomGraph2%>%
plot(.,edge.arrow.size=.4, layout = coords_rescaled[NetCoords$names, ], rescale=F);box()
I have a matrix of the x,y,z coordinates of all amino acids. I plot the protein in 3D space using the following function:
make.Plot <- function(position.matrix, center, radius){
scatterplot3d(x = position.matrix[,4], y = position.matrix[,5], z = position.matrix[,6], type = 'o', color = 'blue')
}
Each row in the position.matrix is for a different amino acid. What I would like to do is modify the function so if I pass it a "center" which would correspond to a number in column 2 of position matrix (which lists the amino acid numberings), as well as a radius, I want a sphere with center at that amino acid.
For instance, if I pass it (position.matrix, 9, 3), I want it to plot a sphere of radius 3 around amino acid 9. I have uploaded a copy of the position data here:
http://temp-share.com/show/YgFHv2J7y
Notice that the row count is not always the canonical count as some residues are skipped. I will always pass it the "canonical" count...
Thanks for your help!
Here is a tested modification of your code. It adds a length-2 size vector for cex.symbols which is chosen by adding 1 to a logical vector:
make.Plot <- function(position.matrix, center, radius){
scatterplot3d(x = position.matrix[,4], y = position.matrix[,5],
z = position.matrix[,6], type = 'o',
cex.symbols=c(1,radius)[1+(position.matrix[,2]==center)], color = 'blue')
}
I wonder if what you really want is the rgl package. It has shapes and an interactive plotting environment. With scatterplot3d you could make the chose point red with this code:
myplot <- make.Plot(position.matrix, 3, 9)
myplot$points3d(position.matrix[3 , 4:6], col="red", cex=10)
I also located some code to draw a "parametric sphere" which can be adapted to creating a highlighting indicator:
myplot <- make.Plot(position.matrix, 3, 9)
a=seq(-pi,pi, length=10);
myplot$points3d(x=2*c(rep(1, 10) %*% t(cos(a)))+position.matrix[3 , 4] ,
y=2*c(cos(a) %*% t(sin(a)))+position.matrix[3 , 5],
z=2*c(sin(a) %*% t(sin(a)))+position.matrix[3 , 6],
col="red", cex=.2)
I have plotted a mesh in rgl to visualize data on it. I.e., the mesh has colors that originate from applying a colormap to its data (one scalar value at each vertex). Here is a minimal example that consists of a mesh with a single face:
library(rgl);
library(squash);
# create a mesh
vertices <- c(
-1.0, -1.0, 0, 1.0,
1.0, -1.0, 0, 1.0,
1.0, 1.0, 0, 1.0,
-1.0, 1.0, 0, 1.0
)
indices <- c( 1, 2, 3, 4 )
# add a data value for each vertex
morph_data = rnorm(length(indices), mean = 3, sd = 1)
# create colors from values by applying a colormap
col = squash::cmap(morph_data, map = squash::makecmap(morph_data, colFn = squash::jet));
# plot
open3d()
shade3d( qmesh3d(vertices, indices), col=col )
How can I add a colorbar to this plot in rgl?
An example for what exactly I mean with colorbar is shown in the right part of this example picture from octave.sourceforge.io.
You can use bgplot3d() to draw any sort of 2D plot in the background of an rgl plot. There are lots of different implementations of colorbars around; see Colorbar from custom colorRampPalette for a discussion. The last post in that thread was in 2014, so there may be newer solutions.
For example, using the fields::image.plot function, you can put this after your plot:
bgplot3d(fields::image.plot(legend.only = TRUE, zlim = range(morph_data), col = col) )
A documented disadvantage of this approach is that the window doesn't resize nicely; you should set your window size first, then add the colorbar. You'll also want to work on your definition of col to get more than 4 colors to show up if you do use image.plot.