I plotted a 3d scatter plot in R using the scatter3d function.
Now, I want to plot the labels on every dot in the 3d scatter, such as every point has its ID next to it i.e., "1", "2" etc..
Here is what I tried:
library("car")
library("rgl")
scatter3d(geometry[,1],geometry[,2],geometry[,3] , surface=FALSE, labels = rownames(geometry), id.n=nrow(geometry))
This tutorial says that adding arguments labels=rownames(geometry), id.n=nrow(geometry) should display the labels on every dot but that did not work.
EDIT:
I uploaded the coordinate file here, you can read it like this
geometry = read.csv("geometry.txt",sep = " ")
colnames(geometry) = c("x","y","z")
EDIT:
Actually, even the example from the tutorial does not label the points and does not produce the plot displayed. There is probably something wrong with the package.
scatter3d(x = sep.l, y = pet.l, z = sep.w,
surface=FALSE, labels = rownames(iris), id.n=nrow(iris))
I can give you a quick fix if you want to use any other function other than scatter3d. This can be achieved using plot3d and text3d function. I have provided the basic code block of how it can be implemented. You can customize it to your needs.
plot3d(geometry[,1],geometry[,2],geometry[,3])
text3d(geometry[,1],geometry[,2],geometry[,3],rownames(geometry))
points3d(geometry[,1],geometry[,2],geometry[,3], size = 5)
After much messing around I got it (I also have the method for plot_ly if you,re interested)
test2 <- cbind(dataSet[,paste(d)],set.final$Groups,test)
X <- test2[,1]
Y <- test2[,2]
Z <- test2[,3]
# 3D plot with the regression plane
scatter3d(x = X, y = Y, z = Z, groups = test2$`set.final$Groups`,
grid = FALSE, fit = "linear",ellipsoid = FALSE, surface=FALSE,
surface.col = c("green", "blue", "red"),
#showLabels(x = x, y = y, z = z, labels=test2$test, method="identify",n = nrow(test2), cex=1, col=carPalette()[1], location=c("lr"))
#labels = test2$test,
id=list(method = "mahal", n = length(test2$test), labels = test2$test)
#id.n=nrow(test2$test)
)
#identify3d(x = X, y = Y, z = Z, labels = test2$test, n = length(test2$test), plot = TRUE, adj = c(-0.1, 0.5), tolerance = 20, buttons = c("right"))
rglwidget()
Related
I'd like to plot a function f(x,y,z) in xyz-space by HeatMap.
I have the following code by https://lazarusa.github.io/BeautifulMakie/surfWireLines/RGBcube/ .
using GLMakie, GeometryBasics, Colors
positions = vec([(i, j, k) for i=1:L,j=1:L,k=1:L]) #3D coordinate
F = zeros(Float64,length(positions)
for i = 1:length(positions) #convert f(x,y,z) to an array
x = positions[i][1]
y = positions[i][2]
z = positions[i][3]
F[i] = f(x,y,z)
end
fig, ax = mesh(HyperRectangle(Vec3f0(positions[1]...),Vec3f0(0.8)), color = RGBA(0,0,F[1],0.5), transparency = false) #HyperRectangle(::position,::length),color=(::red,::green,::blue,::alpha)
wireframe!(ax,HyperRectangle(Vec3f0(positions[1]...), Vec3f0(0.8)), linewidth = 0.1, overdraw = false)
for i in 2:length(positions)
mesh!(ax, HyperRectangle(Vec3f0(positions[i]...), Vec3f0(0.8)), color = RGBA(0,0,F[i],0.5))
wireframe!(ax, HyperRectangle(Vec3f0(positions[i]...), Vec3f0(0.8)), linewidth = 0.1, overdraw = false)
end
fig
This code has mostly helped, but there's still a little problem.:
How to move the camera? (update_camera! needs Scene, but ax is LScene. I don't know what this is.)
How to adjust the axis (labels, ticks, etc.)?
How to add the colorbar?
How to save the figure?
again.
I did another example. This one is really fast. There, you have most of the options you want.
https://lazarusa.github.io/BeautifulMakie/surfWireLines/volumeScatters/
For custom ticks, you can always do
ax.xticks = ([1,2,3], ["1","2", "3"])
also, consider joining https://discourse.julialang.org, there more people could help, much much faster.
Complete code here as well.
# by Lazaro Alonso
using GLMakie
let
x = 1:10
y = 1:10
z = 1:10
f(x,y,z) = x^2 + y^2 + z^2
positions = vec([(i, j, k) for i in x,j in y, k in z])
vals = [f(ix,iy,iz) for ix in x, iy in y, iz in z]
fig, ax, pltobj = meshscatter(positions, color = vec(vals),
marker = FRect3D(Vec3f0(0), Vec3f0(10)), # here, if you use less than 10, you will see smaller squares.
colormap = :Spectral_11, colorrange = (minimum(vals), maximum(vals)),
transparency = true, # set to false, if you don't want the transparency.
shading= false,
figure = (; resolution = (800,800)),
axis=(; type=Axis3, perspectiveness = 0.5, azimuth = 7.19, elevation = 0.57,
xlabel = "x label", ylabel = "y label", zlabel = "z label",
aspect = (1,1,1)))
cbar = Colorbar(fig, pltobj, label = "f values", height = Relative(0.5))
xlims!(ax,-1,11)
ylims!(ax,-1,11)
zlims!(ax,-1,11)
fig[1,2] = cbar
fig
#save("fileName.png", fig) # here, you save your figure.
end
I am analyzing difference scores with polynomial regression in R. Based on [Edwards and Parry's (1993)][1] recommendations I have been trying to combine a persp() plot with a contour() plot. I would also need to plot the first two principal axes on the contour plot. My attempts so far have only provided me with each individual plot, but I don't know how to combine them. An example for the end-result is :
Edwards & Parry (1993) example difference score visualisation
I manage to get the persp() plot just fine. I have also obtained the contour plot. I can't seem to find any way to combine the two. I have managed to make the plot in plotly using the add_surface() option in the pipeline. My problem with the output is that the surface is smooth, and the contourplot lacks the values in the plot. Basically: persp() and contour() are visualised in a way that is extremely similar to the look I'm aiming for, per the example in the source.
My current attempt (in minimalistic code) is as follows:
surface <- function(e, i){
y <- .2*e + .14*i + .08*e^2 + + .1*e*i + .2*i^2
}
e <- i <- seq(-3, 3, length= 20)
y <- outer(e, i, surface)
persp(e, i, y,
xlab = 'Explicit',
ylab = 'Implicit',
zlab = 'Depression',
theta = 45)
contour(e,i,y)
So basically my question is: how can I make a plot like Edwards and Parry (1993) make, with a similar visual style, in R. It does not have to be base-R, I'm happy with any method. I've been stuck on this problem for a week now.
My attempt in plotly (to compare it to my desired end-result) is:
if(!"plotly" %in% installed.packages){install.packages('plotly')}
library(plotly)
plot_ly(z = ~y) %>% add_surface(x = ~e, y= ~i, z= ~y,
contours = list(
z = list(
show=TRUE,
usecolormap=FALSE,
highlightcolor="#ff0000",
project=list(z=TRUE)
)
)
) %>%
layout(
scene=list(
xaxis = list(title = "Explicit"),
yaxis = list(title = "Implicit"),
zaxis = list(title = "Depression")
)
)
[1]: Edwards, J. R., & Parry, M. E. (1993). On the use of polynomial regression as an alternative to difference scores. Academy of Management Journal, 36(6), 1577–1613. https://doi.org/10.2307/256822
I have found an answer and I will share it here. It seems it cannot be done in base-R. But the RSM-package allows for the addition of contour lines to the base of the plot.
In this answer I will give a minimal example of:
the persp() plot
the contour lines in the base
addition of x=y and x=-y axis
calculation and addition of the first and second principal axis
The only thing I could not solve is that the lines now are drawn over the surface. I don't know how to solve it.
library(rsm)
x <- seq(-3,3,by=0.25)
y <- seq(-3,3,by=0.25)
d <- expand.grid(x=x,y=y)
z <- c(data=NA,1089)
b0 = .140; b1 = -.441; b2 = -.154; b3 = .161 ; b4 =-.106; b5 = .168
k=1
for (i in 1:25) {
for (j in 1:25) {
z[k]=b0+b1*x[i]+b2*y[j]+b3*x[i]*x[i]+b4*x[i]*y[j]+ b5*y[j]*y[j]
k=k+1
} }
data.lm <- lm(z~poly(x,y,degree=2),data=d)
res1 <- persp(data.lm,x~y,
zlim=c(-2,max(z)),
xlabs = c('X','Y'),
zlab = 'Z',
contour=list(z="bottom"),
theta=55,
phi=25)
# draw x=y line (lightly dotted)
xy_pos <- matrix(c(-3,-3,3,3),ncol=2,byrow = T)
lines(trans3d(xy_pos[,2], xy_pos[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 3,
col = 'darkgrey')
# draw x=-y line (lightly dotted)
xy_neg <- matrix(c(-3,3,3,-3),ncol=2,byrow = T)
lines(trans3d(xy_neg[,2], xy_neg[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 3,
col = 'darkgrey')
# Find stationary points:
X0 <- (b2*b4 - 2*b1*b5) / (4*b3*b5 - b4^2)
Y0 <- (b1*b4 - 2*b2*b3) / (4*b3*b5 - b4^2)
# First Principal Axis
p11 = (b5-b3+sqrt((b3-b5)^2+b4^2))/b4
p10 = Y0 - p11*X0
Ypaf1 = p10 + p11*x
# plot first principal axis (full line)
xypaf1 <- matrix(c(Ypaf1[1], -3, Ypaf1[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf1[,2], xypaf1[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 1,
col = 'black')
# Second Principal Axis
p21 = (b5-b3-sqrt((b3-b5)^2+b4^2))/b4
p20 = Y0 - p21*X0
Ypaf2 = p20 + p21*x
# plot second principal axis (dashed line)
xypaf2 <- matrix(c(Ypaf2[1], -3, Ypaf2[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf2[,2], xypaf2[,1], z=-2, pmat = res1$`y ~ x`$transf),
lty = 2,
col = 'black')
Problem: I am trying to reproduce a round filled 2d contour plot in R using plotly (have tried ggplot2 also but plotly seemed to be easier).
Data: Sample data download link -
https://drive.google.com/file/d/10Mr5yWVReQckPI6TKLY_vzPT8zWiijKl/view?usp=sharing
The data to be plotted for contour is in a column format and typically called z variable, there is x and y data also available for all values of z. A simple dataframe would look like this:
Please ignore the repeat common x and y as I have truncated decimals. The data has about 25000 rows.
Approach: I first use akima package to interpolate z variable values for given x and y to map z in 2d. This makes the z column data fit in a xy grid for 2d plotting and show contours.
Expected outcome:
Code used:
dens <- akima::interp(x = dt$`Xvalue(mm)`,
y = dt$`Yvalue(mm)`,
z = dt$Values,
duplicate = "mean",
xo=seq(min(dt$`Xvalue(mm)`), max(dt$`Xvalue(mm)`), length = 10),
yo=seq(min(dt$`Yvalue(mm)`), max(dt$`Yvalue(mm)`), length = 10))
plot_ly(x = dens$x,
y = dens$y,
z = dens$z,
colors = c("blue","grey","red"),
type = "contour")
Actual outcome:
Help Needed:
To refine edges of the actual outcome plot to something of a close match to the expected outcome image.
Many thanks in advance for your comments and help.
I found that I could increase the grid output z matrix from akima::interp() from default 40x40 to custom using nx and ny input in function.
And then in plot_ly() add contours = list(coloring = 'fill', showlines = FALSE) to hide contour lines to get output close to my expected outcome.
So working code is like this:
dens <- akima::interp(x = dt$`Xvalue(mm)`,
y = dt$`Yvalue(mm)`,
z = dt$Values,
nx = 50,
ny = 50,
duplicate = "mean",
xo=seq(min(dt$`Xvalue(mm)`), max(dt$`Xvalue(mm)`), length = 50),
yo=seq(min(dt$`Yvalue(mm)`), max(dt$`Yvalue(mm)`), length = 50))
plot_ly(x = dens$x,
y = dens$y,
z = dens$z,
colors = c("blue","grey","red"),
type = "contour",
contours = list(coloring = 'fill', showlines = FALSE))
Plotly contour plot reference was very helpful in this case:
https://plot.ly/r/reference/#contour
I am trying to create a map just to get a concept across, not actually display real data. So far I have the following code:
library(maps)
image(x=-100:10, y = -10:80, z = outer(-360:-250, -10:80), xlab = "lon", ylab = "lat")
map("world", col="gray", fill=TRUE, add=TRUE)
box()
Which in part I pulled together from some other forum posts. It creates this.
The bit I am struggling with is I want the gradational red-yellow-white colours to run N to S (it is just to demonstrate the direction of a trend). They are nearly there, but I cant seem to get the configuration of 'z' correct and I have a feeling I am doing a bad bodge and there is a proper solution. For info, I also want to create the same map with the gradient running E to W, ideally in a different colour palette.
Many thanks in advance.
This seems to work for making the color more even.
x <- -100:10
y <- -10:80
r <- outer(x, y^3, "+")
image(x, y, z = r, col = rev(heat.colors(30)), xlab = "lon", ylab = "lat")
map("world", col = "grey", fill = TRUE, add = TRUE)
And to change the direction of the color, adjust r,
x <- -100:10
y <- -10:80
r <- outer(x^3, y, "+")
image(x, y, z = r, col = heat.colors(30), xlab = "lon", ylab = "lat")
map("world", col = "grey", fill = TRUE, add = TRUE)
I'm about to create a hexbin (lattice) plot that includes vertical lines and margin text. The margin text of the MWE should be located above the line and it should simply state the x-value of the line. Here's what I've got so far:
library(hexbin)
test <- data.frame(VAR1 = rnorm(200), VAR2 = rnorm(200),
GROUP = c(rep(-1.5,60), rep(0.4,20), rep(1.9,120)))
plot(hexbinplot(test$VAR1 ~ test$VAR2,
panel = function(...){
panel.hexbinplot(...)
panel.abline(v = test$GROUP)},
legend = list(top =
list(fun = textGrob,
args = list(
x = unit(test$GROUP/5, "native"),
y = 0.5,
label = test$GROUP,
just = "center")))
))
As you can see from this example, I struggle finding out how to set the coordinates for the labels. Is there a way to use the "real" x-axis coordinates or do I have to somehow deal with the relative ones?
Following the advice of #baptiste , I've created a custom axis ticks and labels on the top which worked out perfectly and made the code much nicer. Here it is:
axisG <- function(side, ...){
if (side == "top"){
at <- unique(test$GROUP)
panel.axis(side = side, outside = TRUE, at = at, labels = at, rot = 0)
}
else axis.default(side = side, ...)
}
plot(hexbinplot(test$VAR1 ~ test$VAR2,
axis = axisG,
panel = function(...){
panel.hexbinplot(...)
panel.abline(v = test$GROUP)}
))