I am working with a function that outputs an svg object. As I see the SVG object is essentially a string of characters.
I was wondering how to
1) plot the svg output from the function
2) save this svg object to disk under an svg extension? I tried ggsave but just resulted in an error.
I am fairly new to svg handling, so would appreciate any inputs.
Thanks!
1) I tried that for a package I was developing and it was not straightforward. In the end, I needed two libraries: rsvg and grImport2. Here is the code I used:
tfile <- tempfile(fileext = ".svg")
tfile2 <- tempfile(fileext = ".png")
cat(svg_code, file=tfile)
if (requireNamespace("rsvg", quietly = TRUE) && requireNamespace("grImport2", quietly = TRUE)) {
rsvg::rsvg_svg(svg = tfile, tfile2)
p <- grImport2::readPicture(tfile2)
grImport2::grid.picture(p)
} else {
if (systemShow == FALSE && outFile == ''){
warning("The figure cannot be rendered in the plot window. Please, use the arguments outFile and/or systemShow.")
}
}
if (systemShow){
utils::browseURL(tfile)
}
The first conditional is in case the system does not allow the installation of either package. As you can see, you first need to write the svg code (svg_code) to a file, in this case temporary (tfile). Then, rsvg_svg writes a temporary png file (tfile2). Finally, grImport2::readPicture and grImport2::grid.picture show the converted file in the plot window. I also left the part where the user can set a boolean variable (systemShow) and the package will attempt to open the file on the default system svg viewer.
2) That one is much easier. You just need to write the code to a file as text, like cat(svg_code, file='path_to_file.svg').
Related
I'd like to use the jpeg package (or similar) to detect corrupted .jpg files. I am sharing this code with users who have had trouble installing exiftool so I'd prefer to use packages that do not require that program.
I want my code to catch images that are completely corrupt or that are partially corrupt (i.e., you can see part of the image, but some of it is cut off).
When an image is corrupt, the readJPEG function returns:
Error in readJPEG(photos[35]) :
JPEG decompression error: Not a JPEG file: starts with 0x7b 0x28
When an image is partially corrupt, the function returns:
JPEG decompression: Corrupt JPEG data: premature end of data segment
I want to write a function that will return FALSE if the image is "good" and TRUE if it is corrupted or partially corrupted. So far, I can't get my function to work if the image is partially corrupted (it returns FALSE). What am I doing wrong?
Here's an example of a "partially corrupt" image - the bottom half got cut off when it was transferred to a new device.
library(jpeg)
# Function to "catch" bad photos
is_corrupted <- function(x){
tryCatch({
check <- readJPEG(x)
return(FALSE)
},
error = function(e)
return(TRUE),
warning = function(w)
return(TRUE),
message = function(m)
return(TRUE)
)
}
EDIT: Try number 2...
I created a modified function based on Ben's suggestions, but it still isn't returning TRUE if an image is completely corrupt. I also don't like how it tests the photo twice. Any recommendations appreciated!
To test the function, you can use three jpgs... (1) any valid jpg from your computer, (2) the "partially corrupt" file linked in this question, and (3) reference a file that doesn't exist to throw an error that will be caught by tryCatch (e.g., is_corrupted("").
is_corrupted <- function(x){
message <- capture.output(check2 <- readJPEG(x), type = "message")
if(length(message) > 0) {
corrupt <- TRUE
} else {
corrupt <- tryCatch({
check <- readJPEG(x)
return(FALSE)
},
error = function(e) # catch "corrupt" images
return(TRUE)
)
}
return(corrupt)
}
I agree, this one is tricky. I think you need to have the error checking before the capturing part. I will post a temporary (ugly) solution, and hopefully someone else posts a more elegant and straightforward one.
readJPEG2 <- purrr::safely(readJPEG)
Let purrr do the error checking and if there is none, proceed with examining the output:
fun <- function(x){
if(is.null(readJPEG2(x)$error)){
message2 <- capture.output(readJPEG(x), type = "message")
if(length(message2) > 0){
return("partially corrupted")
} else {
return("complete")
}
} else {
return("corrupted")
}
}
I do not know how robust this solution is but maybe it helps you even so.
I am trying to batch-read a series of ply-meshes (as mesh3D objects), in order to slide semilandmarks with 'slider3d'. However, when I try to use a loop to read those files, I am told that the object 'Mesh' could not be found. This indicates that a mesh object must first be created in order to then be altered in a loop. How do I solve this?
Is there a simple function in the 'rgl' package that I overlooked?
Or is there an alternative to read all 3D-meshes in one folder, and create a list that I can use to match files downstream?
library(Morpho)
FilesPLY <- list.files("HumerusPLY",pattern="*.ply")
for(j in 1:length(FilesPLY)){
Mesh[j] <- file2mesh(paste("HumerusPLY/",FilesPLY[j],sep=""), clean = TRUE, readcol = FALSE)
}
Error: Object 'Mesh' could not be found.
One way to solve the problem is by creating a list of empty files, and then reading the meshes into the empty files. Oddly enough the first read-out results in an error, but it sets up the system for the read-in. I don't understand the problem behind it, but it works. Thus, here is the temporary solution:
library(Morpho)
# Read ply-list from subfolder "HumerusPLY/"; Create Mesh series of objects, and fill them
FilesPLY <- list.files("HumerusPLY/",pattern="*.ply")
for(i in 1:length(FilesPLY)) {
assign(paste("Mesh",i,sep=""), i)
}
meshlist <- c(1:length(FilesPLY))
for (i in 1:length(meshlist)){
meshlist[i] <- paste("Mesh",meshlist[i],sep="")
}
meshlist <- noquote(meshlist)
ls()
##read ply-files; the second read fixes an error, but does not work without the first read
for(j in 1:length(meshlist)){
meshlist[j] <- file2mesh(paste("HumerusPLY/",FilesPLY[j],sep=""), clean = TRUE, readcol = FALSE)
}
for(j in 1:length(meshlist)){
meshlist[[j]] <- file2mesh(paste("HumerusPLY/",FilesPLY[j],sep=""), clean = TRUE, readcol = FALSE)
}
I would like to know if there is any function which makes it easy to visualize an html object in the RStudio's viewer pane. For instance, I would like to know if it would be possible to view an html table in the viewer pane.
library("Quandl")
library("knitr")
df <- Quandl("FBI_UCR/USCRIME_TYPE_VIOLENTCRIMERATE")
kable(head(df[,1:9]), format = 'html', table.attr = "class=nofluid")
I have a solution that works for kable tables.
kable(iris) %>% kableExtra::kable_styling()
This is automatically displayed in the viewer pane. No need for tempfile.
I have this functionality in my htmlTable package and the function is rather simple:
print.htmlTable<- function(x, useViewer = TRUE, ...){
# Don't use viewer if in knitr
if (useViewer &&
!"package:knitr" %in% search()){
htmlFile <- tempfile(fileext=".html")
htmlPage <- paste("<html>",
"<head>",
"<meta http-equiv=\"Content-type\" content=\"text/html;charset=UTF-8\">",
"</head>",
"<body>",
"<div style=\"margin: 0 auto; display: table; margin-top: 1em;\">",
x,
"</div>",
"</body>",
"</html>", sep="\n")
cat(htmlPage, file=htmlFile)
viewer <- getOption("viewer")
if (!is.null(viewer) &&
is.function(viewer)){
# (code to write some content to the file)
viewer(htmlFile)
}else{
utils::browseURL(htmlFile)
}
}else{
cat(x)
}
}
RStudio recommends that you use the getOption("viewer") instead of #Ramnath's suggestion, the raw RStudio::viewer(). My solution also adds the utils::browserURL() in case you are not using RStudio. I got the idea from this blog post.
Here is a quick way to do this in RStudio
view_kable <- function(x, ...){
tab <- paste(capture.output(kable(x, ...)), collapse = '\n')
tf <- tempfile(fileext = ".html")
writeLines(tab, tf)
rstudio::viewer(tf)
}
view_kable(head(df[,1:9]), format = 'html', table.attr = "class=nofluid")
If the kable function can return an object of class kable, then one could rename view_kable as print.kable in which case merely calling the kable function would open the table in the viewer. If you think this is useful, please go ahead and file a feature request on the knitr github page.
As was explained on this RStudio Support page, the key is to use tempfile() :
Note that the Viewer pane can only be used for local web content. This
content can either be static HTML files written to the session
temporary directory (i.e. files with paths generated by the tempfile
function) or a locally run web application.
See my answer to this question for a bare-bones example.
For kable objects, we can use print.kableExtra
library(knitr)
x <- kable(head(iris), format = "html")
library(kableExtra)
class(x) <- c("kableExtra", class(x))
print(x)
I wish to insert a 'loading' GIF image to my tcltk window but just can't get my head around it. Following is a reproducible example:-
backg <- 'white'
pdlg <- tktoplevel(background=backg)
tcl('wm', 'geometry', pdlg, '500x100+450+350')
tilg <- 'Package installation in progress'
tkwm.title(pdlg, tilg)
fn <- tkfont.create(family = 'helvetica', size = 12)
nwlabel <- " The requisite packages are being installed. This may take several \nminutes... \n"
tllab <- tklabel(pdlg, text = nwlabel, font = fn, pady = 0, background=backg)
clickEv <- tclVar(0)
OK.but <- tkbutton(pdlg, text=' Stop ', command=function() tclvalue(clickEv) <- 1, font=fn, background='grey', pady=0)
tkgrid(tllab, columnspan=1)
tkgrid(OK.but, row=3)
tkbind(pdlg, "<Destroy>", function() tclvalue(done) <- 2)
tkfocus(pdlg)
#This allows me to insert a GIF image but the animation is lost. Also it would be convenient if the output can be obtained using 'tkgrid' instead of 'tkpack'
pdlg2 <- tktoplevel(background='white')
loading <- tclVar()
tcl('image', 'create', 'photo', loading,
file='file path to GIF file')
trial <- tklabel(pdlg2, image=loading)
tkpack(trial)
An example GIF file can be downloaded from here -http://www.dlfpramericalife.com/library/images/final_loading_big.gif
Ideally, the GIF image should be placed above the 'Stop' button but below the text. Many thanks for your help!
In Tcl/Tk, it's quite easy.
set img [image create photo -file nameofthefile.gif]
label .l -image $img
I don't know R, but taking your code as a guide, I imagine something like this, but please check it!
img <- tkimage.create('photo', file='nameofthefile.gif')
imglab <- tklabel(pdlg, image = img)
... then you grid/pack/place it wherever you want. Please note that this don't work with animated gifs and I think animation must be hand-handler, using a timer which updates periodically the image content, but I never did it, nor I know how to do. You may check the Tcl/Tk wiki for more help.
I want to save the my tab delim files manually. I mean that I want user to choose the directory and file name when he wants to save the data. (For an example I have merged individual files into single file and want to save it.)
Usually I use write.table but in write.table we define the directory path and file name within that function but I want a function in which user can save file with any name in his desired directory.
Just use the file.choose() function,like this:
write.table(yerdata, file = file.choose(new = TRUE))
On Windows, at least, that will bring up a dialog for save-as commands.
Annoyingly the tcltk package doesn't have a function for 'Save As', it only has a file selector for choosing an existing file.
Luckily you can take the DIY approach via some tcl calls:
require(tcltk)
write.table(yerdata,file = tclvalue(tcl("tk_getSaveFile")))
The tk_choose.files function source could be used as a template to write a nicer interface to tcl("tk_getSaveFile") if needed. Does seem to be a glaring omission in package:tcltk though...
Using gWidgets:
gfile("Save yerdata", type = "save", handler = function(h, ...)
{
write.table(yerdata, file = h$file)
})
One (perhaps less than ideal) option would be to use readline to prompt the user for the full path and file name (or just the file name if you want to programmatically choose the directory) and then simply pass that value on the write.table. Here's a sketch:
FILE_PATH <- readline(prompt = "Enter a full path and file name: ")
#Some checking to make sure you got a valid file path...
write.table(yerdata, file = FILE_PATH)
Note that as per ?readline this will really only work when running R interactively.
As it is 2017 now, the tcltk2 package is an improvement of tcltk:
library(tcltk2)
filename <- tclvalue(tkgetSaveFile())
if (!nchar(filename)) {
tkmessageBox(message = "No file was selected!")
} else {
tkmessageBox(message = paste("The file selected was", filename))
}
And the use of filters, let's say one should only save as JPG/JPEG:
jpeg_filename <- tclvalue(
tkgetSaveFile(initialfile = "foo.jpg",
filetypes = "{ {JPEG Files} {.jpg .jpeg} } { {All Files} * }")
)