R - images saved with rgl.snapshot turn blank after dev.off() - r

I have x, y, z coordinates for 15 markers that were collected via motion capture. I'm using the rgl package to create 3D images of the markers, and I would like to export each image as an individual png file. The motion capture recordings are 5-15 seconds in length, and I'm exporting images of the coordinates at a frame rate of 120 fps. So, I have to export 600-2000 images per recording.
I have written a loop that is supposed to plot the coordinates in each frame and save an image of each plot as a png. However, the "saved" images I'm getting are only temporary files - when I give dev.off(), the images disappear and the saved files convert to blank pages. Clearly there is something I'm misunderstanding about how to handle devices & write permanent image files!
I understand that rgl uses its own devices, and I've tried giving rgl.close() instead of dev.off() when the maximum device number is reached (i.e. after 63 images are exported). But without also giving dev.off(), I continue getting the "too many open devices" error.
My code looks like this:
for (i in seq(1,nrow(opti),by=2)) {
tframe <- data.frame(matrix(cbind(opti[i, c(seq(1,43,by=3))],
opti[i, c(seq(2,44,by=3))],
opti[i, c(seq(3,45,by=3))]),
nrow = 15, ncol = 3))
par3d("windowRect" = c(0,0,1200,800))
png("filename", res = 600, width = 1200, height = 800)
plot3d(tframe$X1, tframe$X2, tframe$X3, size = 4, box = F, axes = F,
xlab = "", ylab = "", zlab = "")
segments3d(x = as.vector(tframe$X1[c(5,6)]),
y = as.vector(tframe$X2[c(5,6)]),
z = as.vector(tframe$X3[c(5,6)]))
segments3d(x = as.vector(tframe$X1[c(5,7)]),
y = as.vector(tframe$X2[c(5,7)]),
z = as.vector(tframe$X3[c(5,7)]))
segments3d(x = as.vector(tframe$X1[c(6,7)]),
y = as.vector(tframe$X2[c(6,7)]),
z = as.vector(tframe$X3[c(6,7)]))
rgl.snapshot("filename")
}
And here is a sample frame:
tframe <- data.frame(matrix(c(1775.061, -1210.373, 901.3876, 2007.21,
-1324.62, 786.1902, 2021.581, -1122.637, 787.6369, 2020.769,
-1214.902, 953.5361, 1832.449, -1226.912, 1281.304, 1721.739,
-1207.299, 1225.152, 1839.68, -1116.221, 1208.916, 1869.173,
-1362.631, 1017.457, 1958.79, -1364.152, 972.9478, 1784.636,
-1489.286, 738.0247, 1874.096, -1460.005, 834.2597, 1880.647,
-1091.414, 1032.096, 1979.333, -1059.292, 958.2598, 1796.085,
-914.6528, 747.6667, 1865.53, -945.6564, 817.4066),
nrow = 15, ncol = 3, byrow = T))
How do I go about writing permanent image files that do not turn blank when devices are closed?

Related

Save plots generated by repeat function

Currently I am looking for a solution to save 72 plots to an PDF file.
Those 72 plots are created through a function and the below code of repeat.
The ID stands for a person within my dataset. This person has multiple rows of data attached to his ID. To go to the next person I use ID = ID + 1
With the below code I manage to create an PDF file but, this is a PDF file with 72 pages. I would like to have 4 plots on each row. Something in the idea of nrow = 4 like you use in grid.arrange. Preferably 4 on each row and 24 on each page.
pdf("plot1.pdf")
repeat {
ID = ID + 1
print(ggplot(ID))
if (ID == 72){
break}}
dev.off()
I am still not sure wether this is a legit solution but at least it is fixed now!
Apparently I was looking for a solution like this:
plot.list <- list()
for(i in 1:72){
plot.list[[length(plot.list) + 1]] <- plot_utility(i)
}
grid1 <- grid.arrange(grobs = plot.list, ncol = 4)
ggsave("plot1.pdf",
plot = grid1,
device = "pdf",
scale = 2,
width = 25,
height = 20,
units = c("cm")
)

Stop furrr::future_map from printing iteration AFTER finishing

I am using future_map to create several plots where I iterate through a list of variables and output/save a png file per variable to a folder. So there is no output that needs to be shown in the console or the "plot" pane.
The plotting part of the function:
ggplot(aes(sample = value,
color = key)) +
stat_qq(alpha = 0.8, size = 0.5) +
theme_light() +
theme(legend.position = "none") +
stat_qq_line() +
facet_wrap(~key,
ncol = 4) +
ggtitle(.var) +
ggsave(filename = here::here(paste0(.path,
.var,
".png")),
units = "cm",
width = 25,
height = 10)}
How I map the function:
plan(multiprocess(workers = 10))
future_map(names_list,
~check_dists(df_lips_imputed, .x, "doc/distributions/testing2/"),
verbose = FALSE)
However, after all files are created, I can see they are in the folder, this is slowly printed (takes a while, ~1k iterations):
[[1]]
[[2]]
[[3]]
...
Does anyone know how to suppress this output?
Many thanks!
If you install the development version of furrr with
devtools::install_github("DavisVaughan/furrr")
You can then use future_walk, which is acts like walk does versus map. With walk the function acts by side effects and so the return value is simply the input.
I was having the same issue. I'm not sure if this will change the time that it takes to print out the list elements at the end, but if you save your future_map call as a throwaway variable, it will save the output in that variable instead of printing out and clogging up your console or log file:
x <- future_map(names_list,
~check_dists(df_lips_imputed, .x, "doc/distributions/testing2/"),
verbose = FALSE)

Adding symbols and information to Phylogenetic tree

I am drawing a phylogenetic tree, and I would like to add something like a 'dead symbol̈́̈́' (e.g a skull) in the tips of the extinct species.
I would also like to add an x-axes bar with latex symbols in the branching times (e.g $\Delta t_i$ or numbers) marked with dots.
What I have so far is this tree. I would like to add the dead symbol right after the green dotted line in this case.
library(ape)
rec1 = '((B:1,A:1):1,(F:1,C:1.5):0.5);'
rec1 = read.tree(text = rec1)
plot(rec1,show.tip.label = F,edge.color = c("black","black","black","black","darkgreen","black"),edge.width = 2,edge.lty = c(rep(1,4),4,1))
One possibility is using ggtree. As in:
https://guangchuangyu.github.io/2018/03/annotating-phylogenetic-tree-with-images-using-ggtree-and-ggimage/
#source("https://bioconductor.org/biocLite.R")
#biocLite("BiocUpgrade") # you may need this
#biocLite("ggtree")
library(ggtree)
tree<-rtree(10)
pg<-ggtree(tree)
d <- data.frame(node = as.character(10:15),
images = c("https://i.imgur.com/8VA9cYw.png",
"https://i.imgur.com/XYM1T2x.png",
"https://i.imgur.com/EQs5ZZe.png",
"https://i.imgur.com/2xin0UK.png",
"https://i.imgur.com/hbftayl.png",
"https://i.imgur.com/3wDHW8n.png"))
pg %<+% d + geom_nodelab(aes(image=images), geom="image")
With phylopic
#install.packages('rphylopic')
library(rphylopic)
string<-name_search(text = "Homo sapiens")
selectstr<-string[2,]
string2<-name_images(uuid = selectstr)$same[[1]]$uid
tree<-rtree(10)
phylopic_info <- data.frame(node = c(12,13),
phylopic = string2)
nt<-ggtree(tree)
nt %<+% phylopic_info +
geom_nodelab(aes(image=phylopic), geom="phylopic", alpha=.5, color='steelblue')
I can see two options how to display an "extinct" symbol on a tree tip.
Use a Unicode symbol with an appropriate font that can display it as per this blog.
Add a raster image onto the tree plot.
The following code will display an extinction symbol next to the green edge in your tree. It draws on information found here.
library(jpeg)
logo <- readJPEG("Downloads/Symbol1.jpg")
logo2 <- as.raster(logo)
r <- nrow(logo2)/ncol(logo2) # aspect ratio
s <- 0.4 # symbol size
# display plot to obtain its size
plot(rec1, edge.color = c("black","black","black","black","darkgreen","black"),
edge.width = 2, edge.lty = c(rep(1,4),4,1))
lims <- par("usr") # plot area size
file_r <- (lims[2]-lims[1]) / (lims[4]-lims[3]) # aspect ratio for the file
file_s <- 480 # file size
# save tree with added symbol
png("tree_logo.png", height=file_s, width=file_s*file_r)
plot(rec1, show.tip.label = F,
edge.color = c("black","black","black","black","darkgreen","black"),
edge.width = 2, edge.lty = c(rep(1,4),4,1))
rasterImage(logo2, 1.6, 2.8, 1.6+s/r, 2.8+s)
# add axis
axisPhylo()
mtext(expression(Delta*italic("t")["i"]), side = 1, line = 3)
dev.off()

Saving a plot from R and then copying it to a Word text file [duplicate]

This question already has answers here:
How to save a plot as image on the disk?
(11 answers)
Closed 8 years ago.
What I have tried so far:
par( mfrow = c( 1, 2 ) )
matplot(rOU,type="l", ylim=range(rOU))
matplot(rEM,type="l", ylim=range(rEM))
here is sample code taken from The R Statistics Website
Basically you have to
Create a new Word file
Create headers and sub-headers
Move to a new pages in the document
Write text
Insert tables (that is “data.frame” and “matrix”objects)
Insert plots
Save and close the Word document
Code:
# install.packages("R2wd")
# library(help=R2wd)
require(R2wd)
wdGet(T) # If no word file is open, it will start a new one - can set if to have the file visiable or not
wdNewDoc("c:\\This.doc") # this creates a new file with "this.doc" name
wdApplyTemplate("c:\\This.dot") # this applies a template
wdTitle("Examples of R2wd (a package to write Word documents from R)") # adds a title to the file
wdSection("Example 1 - adding text", newpage = T) # This can also create a header
wdHeading(level = 2, "Header 2")
wdBody("This is the first example we will show")
wdBody("(Notice how, by using two different lines in wdBody, we got two different paragraphs)")
wdBody("(Notice how I can use this: '\ n' (without the space), to \n go to the next
line)")
wdBody("האם זה עובד בעברית ?")
wdBody("It doesn't work with Hebrew...")
wdBody("O.k, let's move to the next page (and the next example)")
wdSection("Example 2 - adding tables", newpage = T)
wdBody("Table using 'format'")
wdTable(format(head(mtcars)))
wdBody("Table without using 'format'")
wdTable(head(mtcars))
wdSection("Example 3 - adding lm summary", newpage = T)
## Example from ?lm
ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
group <- gl(2,10,20, labels=c("Ctl","Trt"))
weight <- c(ctl, trt)
# This wouldn't work!
# temp <- summary(lm(weight ~ group))
# wdBody(temp)
# Here is a solution for how to implent the summary.lm output to word
wdBody.anything <- function(output)
{
# This function takes the output of an object and prints it line by line into the word document
# Notice that in many cases you will need to change the text font into courier new roman...
a <- capture.output(output)
for(i in seq_along(a))
{
wdBody(format(a[i]))
}
}
temp <- summary(lm(weight ~ group))
wdBody.anything(temp)
wdSection("Example 4 - Inserting some plots", newpage = T)
wdPlot(rnorm(100), plotfun = plot, height = 10, width =20, pointsize = 20)
wdPlot(rnorm(100), plotfun = plot, height = 10, width =20, pointsize = 20)
wdPlot(rnorm(100), plotfun = plot, height = 10, width =20, pointsize = 50)
# wdPageBreak()
wdSave("c:\\This.doc") # save current file (can say what file name to use)
wdQuit() # close the word file

Rotate persp3d plot and save images as png

With R, I am using the persp3d function of the rgl package to get a nice 3d plot.
Now I want to rotate the persp3d function and save each small rotated image as a png file. I want then to include the png in my latex presentation with the command animategraphic.
I therefore want to aks, how I can do this?
I need them in a way that I can implement them in latex, so the names of the png files should somehow be like a1,a2 and so on...
My code to create the persp3d plot is:
persp3d(x, y, z, theta=50, phi=25, expand=0.75, col=color[zcol2],
ticktype="detailed", xlab="", ylab="", zlab="",axes=FALSE)
I then tried to spin it with the spin3d command:
spind3d(rpm=3)
which does not work. Also this would not save pngs to my drive?
Here is an alternative using the functions spin3d to change the view, and movie3d to save the images.
library(rgl)
x <- seq(-10, 10, length= 30)
y <- x
f <- function(x,y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
z[is.na(z)] <- 1
persp3d(x,y,z,theta=0,phi=25, col = "lightblue",
ticktype="detailed", xlab="", ylab="", zlab="",axes=FALSE)
movie3d(spin3d(axis = c(0,0,1), rpm = 10), duration=6, type = "png")
Note that by default movie3d saves the files in the folder set by tempdir().
x=1:10
y=1:10
z=matrix(runif(100),10,10)
persp3d(x,y,z,theta=50,phi=25)
then loop over theta or phi, use view3d to set the angle, snapshot3d to make a PNG
theta = seq(0,360,len=10)
for(i in 1:10){
snapshot3d(file=paste0("spin-",i,".png"))
view3d(theta=theta[i])
}
You might want to loop over phi instead of theta. Anyway, that gets you the PNGs you want, doesn't it?
May be someone need. I used the following combination for persp3Drgl:
userMat = matrix(data = c( 0.4892255, 0.8709987, 0.04464279, 0,
-0.5228708, 0.2519508, 0.81430787, 0,
0.6980215, -0.4217298, 0.57868713, 0,
0.0000000, 0.0000000, 0.0000000, 1
), nrow = 4, ncol = 4)
persp3Drgl(..., userMatrix = userMat )
par3d( windowRect=c( 0,0,100,100 ) )
snapshot3d( file.path(plotDir, "3D.png"), top = TRUE )
Besides, I used to track userMatrix value (after rotation the plot by mouse) the following command
userMat = par3d(no.readonly=TRUE)$userMatrix

Resources