I want to plot a animated 3D scatterplot and save it as gif. I followed the code provided by the R Graph Gallery example: https://www.r-graph-gallery.com/3-r-animated-cube.html.
library(rgl)
library(magick)
options(rgl.printRglwidget = TRUE)
# Let's use the iris dataset
# iris
# This is ugly
colors <- c("royalblue1", "darkcyan", "oldlace")
iris$color <- colors[ as.numeric( as.factor(iris$Species) ) ]
# Static chart
plot3d( iris[,1], iris[,2], iris[,3], col = iris$color, type = "s", radius = .2 )
# We can indicate the axis and the rotation velocity
play3d( spin3d( axis = c(0, 0, 1), rpm = 20,dev = cur3d()),startTime = 0, duration = 10 )
# Save like gif
movie3d(
movie="3dAnimatedScatterplot",
spin3d( axis = c(0, 0, 1), rpm = 20,dev = cur3d()),
startTime = 0,
duration = 10,
dir = ".",
type = "gif",
clean = T,
fps=10,
convert=T
)
plot3d was successed output a 3d scatter plot.
Static 3d scatter plot
But the final output: 3dAnimatedScatterplot.gif,just a black image
3dAnimatedScatterplot.gif
when I set clean=F, all frame images are black. So, I guess the play3d() was not working.
Can anyone provide any help to me ? Thanks a lot !
Most likely snapshot3d isn't working for you. Try it with the option webshot = FALSE instead of the default webshot = TRUE. That uses a different mechanism for saving the image.
Related
My first querstion here, fantastic community.
I have a slight issue projecting some chl-a data across the 180 meridian (Fiji), using Oceanmap package. I can do this in GIS but would like to be able to produce these results in R. Please see below for code and images. Basically when I project a larger frame of the area I want to display the data projects perfectly, however when I zoom in closer to Fiji which is really what I want, I get a white line (0 value I assume) across the 180 meridian. Is this a coordinate projection issue and the stitching now working at such resolution?
library(oceanmap)
library(ncdf4)
library(raster)
library(viridis)
chl.win <- ('~/Desktop/A20200812020172.L3m_SNSP_CHL_chlor_a_4km.nc')
chl.dat <- nc_open(chl.win)
chl.dat.raster <- nc2raster(chl.dat, "chlor_a", lonname="lon", latname="lat", date=T)
chl.flip <- flip(chl.dat.raster, "y")
chl.360 <- shift(raster::rotate(shift(chl.flip, 180)), 180)
chl.360.crop = raster::crop(chl.360, extent(c(176, 183, -19.8, -15.5)))
vpal <- viridis(100, alpha = 1, begin = 0, end = 1, option = "mako")
v(chl.360.crop, cbpos = "r", pal = "jet", zlim = c(0,1), cb.xlab = expression("Chlorophyll-a (mg m"^-3*")"),
bwd = 0, grid = F, replace.na = F, Save = T, plotname = "First_Quarter_2020", fileformat = "png", width = 12,
height = 6)
Image showing white line on 180 meridian
I have vertices and indices data for human face here. I have a post one year ago on plotting 3D facial surface mesh based on these data. Now, I want to plot only the right half and mid-facial vertices while ignoring the left side vertices. Based on my earlier plot, I tried the following code:
library(tidyverse)
library(readxl)
library(rgl)
vb <- read_excel("...\\vb.xlsx", sheet = "Sheet1", col_names = F)
it <- read_excel("...\\it.xlsx", sheet = "Sheet1", col_names = F)
# Extract vertices for the right side
lm_right_ind <- which(vb[,1] < 0)
vb_mat_right <- t(vb[lm_right_ind, ])
vb_mat_right <- rbind(vb_mat_right, 1)
rownames(vb_mat_right) <- c("xpts", "ypts", "zpts", "")
vertices1_right <- c(vb_mat_right)
# Extract `it` whose rows do not contain vertices on the left side
# Left-side vertices have vb[,1] greater than 0
lm_left_ind <- which(vb[,1] > 0)
leftContain <- NULL
for (i in 1: dim(it)[1]) {
if (T %in% (it[i,] %in% lm_left_ind)) {
leftContain[i] <- i
} else {leftContain[i] <- NA}
}
leftContain <- leftContain[!is.na(leftContain)]
# Remove indices that involve left-side vertices
it_rightMid <- it[-leftContain,]
it_mat_right <- t(as.matrix(it_rightMid))
rownames(it_mat_right) <- NULL
indices_right <- c(it_mat_right)
# Plot
try1_right <- tmesh3d(vertices = vertices1_right, indices = indices_right, homogeneous = TRUE,
material = NULL, normals = NULL, texcoords = NULL)
# Use addNormals to smooth the plot. See my Stackoverflow question:
# https://stackoverflow.com/questions/53918849/smooth-3d-trangular-mesh-in-r
try12_right <- addNormals(try1_right)
shade3d(try12_right, col="#add9ec", specular = "#202020", alpha = 0.8)
I got an error whing trying to obtain try12_right:
Error in v[, it[3, i]] : subscript out of bounds.
I did exactly as what I did in my earlier plot but why something went wrong here? Thank you.
Here's an example of using a clipping plane to leave off the left hand side of a mesh object:
library(rgl)
open3d()
root <- currentSubscene3d()
newSubscene3d("inherit", "inherit", "inherit", parent = root) # Clipping limited to this subscene
shade3d(addNormals(subdivision3d(icosahedron3d(), 2)), col = "pink")
clipplanes3d(a = 1, b = 0, c = 0, d = 0)
useSubscene3d(root)
decorate3d()
The fiddling with subscenes limits the clipping to just the shaded sphere, not everything else in the picture.
This produces this output:
If there's nothing else there, it's simpler:
library(rgl)
open3d()
shade3d(addNormals(subdivision3d(icosahedron3d(), 2)), col = "pink")
clipplanes3d(a = 1, b = 0, c = 0, d = 0)
which produces
When I want to export a wordcloud2 picture, the wordcloud seems to be recalculated and looks very different from the one in the viewer.
How can I prevent R from creating another picture?
library(wordcloud2)
wordcloud2(demoFreq[demoFreq$freq>7,],minRotation = 0, maxRotation = 0)
Pictures: https://drive.switch.ch/index.php/s/8WIkGEM88wd4UXc
Adding shuffle = FALSE keeps the words in place.
Defining nonrandom colors fixes the colors. Maybe with a color vector.
library(wordcloud2)
minfreq=10
upperpart= demoFreq[demoFreq$freq>minfreq,]
colorvector = rep(c('red','skyblue'), length.out=nrow(upperpart))
wordcloud2(demoFreq[demoFreq$freq>minfreq,],minRotation = 0,
maxRotation = 0,shuffle=FALSE, color=colorvector)
you should just add shuffle = FALSE in your function and in case you want to control the colors you can create a color palette using the rainbowfunction with the number of rows of your data input:
dataInput <- demoFreq[demoFreq$freq>7,]
my_colors <- rainbow(nrow(dataInput), start = 0.1) # check ?rainbow for more infos
wordcloud2(dataInput, minRotation = 0, maxRotation = 0, shuffle = F, color = my_colors)
gives you:
Hope this helps!
When using chartSeries, by default it also shows on the top left of the plot the last value. Is there any way to prevent it from doing it?
When adding a new TA with addTA, you can avoid the last value on the plot by setting the argument legend = "", but only if you're making a new plot for the TA. If the TA is on a previously plotted graphic, it'll show the last value regardless of what you put in the legend argument.
getSymbols ("AAPL", src = "google")
chartSeries(AAPL)
What can I use here to prevent it from printing the last value on the plot?
addTA(EMA(Cl(AAPL)), on = 1, legend = "")
This still prints the last value on the top left of the plot. The weird part is that it doesn't do it if you're plotting on a new plot like this:
addTA(EMA(Cl(AAPL)), legend = "")
Is it like this by default, or is there something I can do to get around it?
The last value is shown by default (yes, annoyingly). You'll likely have to modify the source code to remove the last number showing in addTA.
I don't use addTA, but rather add_TA and chart_Series, because I think they look much better (second generation charts for quantmod). Here is a solution that removes the last number from showing for the add_TA version. But you must be willing to modify the source code.
In add_TA, you'll need to modify approximately lines 56-60 of the source:
Replace the text.exp, which is this:
# this is inside add_TA:
if (is.na(on)) {
plot_object$add_frame(ylim = c(0, 1), asp = 0.15)
plot_object$next_frame()
text.exp <- expression(text(x = c(1, 1 + strwidth(name)),
y = 0.3, labels = c(name, round(last(xdata[xsubset]),
5)), col = c(1, col), adj = c(0, 0), cex = 0.9,
offset = 0, pos = 4))
plot_object$add(text.exp, env = c(lenv, plot_object$Env),
with these modifications:
if (is.na(on)) {
plot_object$add_frame(ylim = c(0, 1), asp = 0.15)
plot_object$next_frame()
text.exp <- expression(text(x = c(strwidth(name)), # <- affects label on the subchart
y = 0.3, labels = name, col = c(col), adj = c(0), cex = 0.9,
offset = 1, pos = 4))
plot_object$add(text.exp, env = c(lenv, plot_object$Env),
expr = TRUE)
...
and assign this modified code to a new variable, called say add_TA.mine:
add_TA.mine <- function (x, order = NULL, on = NA, legend = "auto", yaxis = list(NULL,
NULL), col = 1, taType = NULL, ...)
{
lenv <- new.env()
lenv$name <- deparse(substitute(x))
lenv$plot_ta <- function(x, ta, on, taType, col = col, ...) {
xdata <- x$Env$xdata
....
[all the code for the rest of the function with modifications]....
}
}
plot_object
}
Now, just run the code with the modified function
library(quantmod)
getSymbols("AAPL")
environment(add_TA.mine) <- environment(get("add_TA", envir = asNamespace("quantmod")))
assignInNamespace(x = "add_TA", value = add_TA.mine, ns = "quantmod")
chart_Series(AAPL, subset = "2017")
add_TA(RSI(Cl(AAPL)))
quantmod:::add_TA(RSI(Cl(AAPL)))
You can see the last value is no longer printed:
(You could make the same kinds of changes in the old addTA code (perhaps via chartSeries if you really want to stick to the old plots)
If you're happy with the changes, and want to make them permament in add_TA, you can recompile the quantmod source code yourself with your modifications (i.e. you need to download the quantmod source code and recompile the package) . If you make a mess of things you can always redownload the original quandmod source code again.
I am trying to follow help and Internet examples to create a very simple animation of a 3d-line in R. This is just a test and my final goal is to use this functionality to visually verify results of some geometrical transformations on 3d-movement data that I am analysing. So basically I need nothing more than a ‘3d-player’ interface that allows for usual interaction (rotation, zoom, play, stop, slide).
I figured out that rgl package does the job and I am able to use it for the sphere/points animation. But now I need to use it on lines and I get very strange results. In the example below there are 4 points and two lines (cyan and red) that connect the same points but the red line is for some reason in the ‘wrong’ place. The animation doesn’t make sense neither. Now, I am thinking may be it is impossible to do >> to animate more than one vertex with more than one attribute? But I don’t see this in documentation and obviously it is possible because line is animated! I spent quite a long time trying to figure out what is going on and will appreciate any help/advise/directions. many thanks
Ps: Tthe code below is a chunk in the markdown file and I am using Rstudio.
require(rgl)
require(rglwidget)
p11=c(0,0,0)
p21=c(50,50,0)
p12=c(50,0,0)
p22=c(10,50,50)
saveopts <- options(rgl.useNULL = TRUE)
did=list()
did[[1]]=plot3d(rbind(p11,p21,p12,p22), type="s", alpha = 1, lwd = 5, col = c('brown','darkgreen','orange','green'))
did[[2]]=spheres3d(c(100,100,100), alpha = 1, lwd = 5, col = "blue",radius=2)
did[[3]]=lines3d(rbind(p11,p21),lwd=8, col='cyan',alpha=.9)
did[[4]]=planes3d(0, 0, 1, 0, alpha=.4, col='green')
did[[5]]=lines3d(rbind(p11,p21),lwd=2, col='red')
aspect3d(1, 1, 1)
did[[6]]=grid3d(c("x-", "z-"),at = NULL,col = "gray",lwd = .5,lty = 1,n = 5)
sceneT = rglwidget(elementId = "plot3dT",width=500, height=300) #%>%
rgl.ids()
rgl.attrib(id=did[[3]],attrib = c(1:length(did[[3]])))
playwidget(sceneT,list(
vertexControl(values = rbind(c(0,0,0,0,0,0),c(50,50,50,50,50,50)),
vertices = 1:6, attributes = "z", objid = did[[4]], param = 1:2,interp =T),
vertexControl(values = r1,
vertices = 1:2, attributes = c('x',"y","z",'x',"y","z"), objid = did[[5]], param = 1:2,interp =T)),
start = 1, stop = 2, step = .1, precision = 3)
options(saveopts)