Related
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()
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'm working with 3 dimensional coordinates data, which i'm plotting in a scatterplot, i have ~30.000 datapoints, and i've included the first 10 here so that you can reproduce it
library(rgl)
library(plot3D)
library(car)
df <- data.frame(meanX = c(147.34694,
173.89244,
135.73004,
121.93766,
109.72152,
92.53709,
165.46588,
169.77744,
127.01796,
99.34347),
meanY = c(140.40816,
110.99128,
134.56023,
164.18703,
166.04051,
155.97329,
105.29377,
104.42683,
130.17066,
155.99696),
avgDist = c(40.788118,
12.957329,
14.24348,
39.10424,
34.694258,
25.532335,
21.491695,
23.528944,
9.309201,
31.916879))
I've been using the scatter3d function to plot this
scatter3d(x = df$meanX, y = df$meanY, z = df$avgDist, surface = FALSE)
Now my "problem", is that I would like to have a 2d surface with an external image file overlayed onto it at z=0, and as a bonus, if i could project a heatmap/contours from the scatterplot data (meanX and meanY used for the contours) over that image as well, that would be great.
This is the image i'd like to have draped at z = 0:
http://i.imgur.com/m6j4q3M.png
That image was made with this ggplot:
map.colors <- colorRampPalette(c("green","yellow","red"))
densityPlot <- ggplot(direData, aes(x = meanX, y = ,meanY)) +
stat_density2d(geom="tile", aes(fill=..density.., alpha=sqrt(sqrt(..density..))), contour=FALSE, n=100) +
scale_alpha(range = c(0, 1.0)) + scale_fill_gradientn(colours = map.colors(5)) +
xlim(70,185) + ylim(70,185)
minimap <- readPNG('~/yasp/minimap.png')
densityPlot + annotation_raster(minimap, ymin = 70 ,ymax=185 ,xmin = 70,xmax = 185) +
stat_density2d(geom="tile", aes(fill=..density.., alpha=10*sqrt(..density..)), contour=FALSE, n=100)
Is there any way to do this? I've googled quite a bit for a solution but found no real way of doing this. I don't mind creating the image first in ggplot2 with the heatmap, saving that, and then using that as input for the surface draping, but it would of course be quite cool if it could all be done in one call to plot.
(2nd Edit) I try to write something better code and confirm two xy-coordinates are the same. ggplot2 theme with no axes or grid help me to plot only the panel region.
library(rgl); library(grid); library(gtable)
df <- data.frame(meanX = c(147.34694, 173.89244, 135.73004, 121.93766,
109.72152, 92.53709, 165.46588, 169.77744,
127.01796, 99.34347),
meanY = c(140.40816, 110.99128, 134.56023, 164.18703,
166.04051, 155.97329, 105.29377, 104.42683,
130.17066, 155.99696),
avgDist = c(40.788118, 12.957329, 14.24348, 39.10424,
34.694258, 25.532335, 21.491695,23.528944,
9.309201, 31.916879))
map.colors <- colorRampPalette(c("green","yellow","red"))
# set scale_*_continuous() to plot only the panel region. limits mean xlim (or ylim)
# change "tile" into "raster" because of making noise lines on my screen
densityPlot <- ggplot(df[,1:2], aes(x = meanX, y = ,meanY)) +
stat_density2d(geom="raster", aes(fill=..density.., alpha=sqrt(sqrt(..density..))), contour=FALSE, n=100) +
scale_alpha(range = c(0, 1.0)) + scale_fill_gradientn(colours = map.colors(5)) +
scale_x_continuous(limits=c(70,185), expand = c(0,0)) + scale_y_continuous(limits=c(70,185), expand = c(0,0)) +
geom_point(size=4) # to test XY-coordinate (black points on the map)
open3d()
plot3d( df, type="s", radius=1, col="red", axes=F,
xlim = c(70,185), ylim = c(70,185),
expand = 1 )
plot3d( df, type="h", col="blue", add=T ) # to test XY-coordinate (line segments from z = 0)
axes3d(c("x","y","z") )
show2d({ # show2d uses 2D plot function's output as a texture on a box.
grid.draw(gtable_filter(ggplotGrob(densityPlot), "panel"))
},
expand = 1 , texmipmap = F ) # texmipmap = F makes tone clear (not essential)
# I think this is clearly better than using a intermediate file,
# so I deleted related code. Thanks Mike !
How about this?
I stored your lined image file in a png in the local directory, there is probably a way to do that without an intermediate file, but I would ask that as a separate question.
Note that this is actually a simple case of texture mapping. The texture is saved in the gameshot.png file you specified. You could warp the text around a more complicated object by adding more points to the geometry and adjusting the texture map coordinates accordingly.
While they should not have been absolutely necessary here, I added texture map coordinates as it looked like the file and the data were not aligned by default - and in fact the gameshot.png file was displaying reversed. It looks to me like the png file you specified does not quite match the data, I think there is an inversion somewhere before you saved it.
library(rgl)
library(plot3D)
library(car)
df <- data.frame(meanX = c(147.34694, 173.89244, 135.73004, 121.93766,
109.72152, 92.53709, 165.46588, 169.77744,
127.01796, 99.34347),
meanY = c(140.40816, 110.99128, 134.56023, 164.18703,
166.04051, 155.97329, 105.29377, 104.42683,
130.17066, 155.99696),
avgDist = c(40.788118, 12.957329, 14.24348, 39.10424,
34.694258, 25.532335, 21.491695,23.528944,
9.309201, 31.916879))
car::scatter3d(x = df$meanX, y = df$meanY, z = df$avgDist, surface = FALSE)
xvek <- c(0,1)
yvek <- c(0,1)
lnx <- length(xvek)
lny <- length(yvek)
zmat <- matrix(0,lnx,lny)
# Setup the Texture coordinates - defaults seem to invert image
# tms <- matrix(c(0,0,1,1),lnx,lny) # generic case (xy-maped texture looks like png file)
# tmt <- matrix(c(0,1,0,1),lnx,lny)
tmt <- matrix(c(1,1,0,0),lnx,lny) # "correct case" (ball density look more like picture)
tms <- matrix(c(1,0,1,0),lnx,lny) # I think the gameshot.png is in error
# Texture file specified in question was stored locally in "gameshot.png"
surface3d(xvek,yvek,zmat,coord=c(3,1),texture_s=tms,texture_t=tmt,
lit=F,fog=T,color="white",textype="rgb",texture="gameshot.png",add=T)
Yields this:
From the parametric equations on wiki page ( http://en.wikipedia.org/wiki/Parametric_equation ), I can plot 2d equations as follows:
#for a circle:
x = seq(-pi, pi, length.out=30)
plot(sin(x),cos(x))
# for a star:
a=10; b=10/1.8
x=seq(-50,50,length.out=500)
plot((a-b)*cos(x)+b*cos(x*((a/b)-1)), (a-b)*sin(x)-b*sin(x*((a/b)-1)), ylim=range(-13,13))
How can I plot 3d equations on a 3d plot of a Helix given by equations:
x=a*cos(t)
y=a*sin(t)
z=b*t
From searching I found that the 3d plotting functions take either a matrix or x,y,z values but not math curve functions.
You can plot 3D equations like you did the 2D ones.
library(lattice)
t<-seq(-2*pi, 2*pi, length.out=200)
cloud(z~x+y,data.frame(x=3*cos(t),y=3*sin(t), z=2*t))
So yes, you can't supply a raw function directly, but you can easily calculate points to plot based on those functions. Let me know if you had something else in mind.
Here's a two-parameter torus
t <- seq(0, 2*pi, length.out=50);
u <- seq(0, 2*pi, length.out=50);
tu<-expand.grid(t=t,u=u)
R <- 6;
r <- 3;
tu <- transform(tu,
x = cos(t)*(R+r*cos(u)),
y = sin(t)*(R+r*cos(u)),
z = r*sin(u)
)
rr<-c(-10,10)
cloud(z~x+y, tu, xlim=rr, ylim=rr, zlim=rr, screen=list(y=20));
Actually, I just realized wireframe is better, just took me a bit longer to figure out the syntax.
xm<-outer(t,u,function(t, u)cos(t)*(R+r*cos(u)))
ym<-outer(t,u,function(t, u)sin(t)*(R+r*cos(u)))
zm<-outer(t,u,function(t, u) r*sin(u))
rr<-c(-10,10)
wireframe(zm~xm+ym, xlim=rr, ylim=rr, zlim=rr, screen=list(y=30))
More details found on the ?cloud help page
With plotly:
library(plotly)
t <- seq(-2*pi, 2*pi, length.out=200)
dat <- data.frame(x=3*cos(t), y=3*sin(t), z=2*t)
plot_ly(dat, x = ~x, y = ~y, z = ~z, type = 'scatter3d', mode = 'lines',
line = list(width = 4))
I want to plot a matrix of z values with x rows and y columns as a surface similar to this graph from MATLAB.
Surface plot:
Code to generate matrix:
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 0.240)# 2013 length
y<-seq(from = -241.440, to = 241.440, by = 0.240)
matrix_fun<-matrix(data = 0, nrow = length(x), ncol = length(y))
# Generate two dimensional travel distance probability density function
for (i in 1:length(x)) {
for (j in 1:length(y)){
dxy<-sqrt(x[i]^2+y[j]^2)
prob<-1/(scale^(shape)*gamma(shape))*dxy^(shape-1)*exp(-(dxy/scale))
matrix_fun[i,j]<-prob
}}
# Rescale 2-d pdf to sum to 1
a<-sum(matrix_fun)
matrix_scale<-matrix_fun/a
I am able to generate surface plots using a couple methods (persp(), persp3d(), surface3d()) but the colors aren't displaying the z values (the probabilities held within the matrix). The z values only seem to display as heights not as differentiated colors as in the MATLAB figure.
Example of graph code and graphs:
library(rgl)
persp3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
surface3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
persp(x=x, y=y, z=matrix_scale, theta=30, phi=30, col=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)), border=NA)
Image of the last graph
Any other tips to recreate the image in R would be most appreciated (i.e. legend bar, axis tick marks, etc.)
So here's a ggplot solution which seems to come a little bit closer to the MATLAB plot
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 2.40)
y<-seq(from = -241.440, to = 241.440, by = 2.40)
df <- expand.grid(x=x,y=y)
df$dxy <- with(df,sqrt(x^2+y^2))
df$prob <- dgamma(df$dxy,shape=shape,scale=scale)
df$prob <- df$prob/sum(df$prob)
library(ggplot2)
library(colorRamps) # for matlab.like(...)
library(scales) # for labels=scientific
ggplot(df, aes(x,y))+
geom_tile(aes(fill=prob))+
scale_fill_gradientn(colours=matlab.like(10), labels=scientific)
BTW: You can generate your data frame of probabilities much more efficiently using the built-in dgamma(...) function, rather than calculating it yourself.
In line with alexis_laz's comment, here is an example using filled.contour. You might want to increase your by to 2.40 since the finer granularity increases the time it takes to generate the plot by a lot but doesn't improve quality.
filled.contour(x = x, y = y, z = matrix_scale, color = terrain.colors)
# terrain.colors is in the base grDevices package
If you want something closer to your color scheme above, you can fiddle with the rainbow function:
filled.contour(x = x, y = y, z = matrix_scale,
color = (function(n, ...) rep(rev(rainbow(n/2, ...)[1:9]), each = 3)))
Finer granularity:
filled.contour(x = x, y = y, z = matrix_scale, nlevels = 150,
color = (function(n, ...)
rev(rep(rainbow(50, start = 0, end = 0.75, ...), each = 3))[5:150]))