Is it possible to remove the background of images with the magick package?
I know how to use edge detection with Gimp/Inkscape to crop out silhouettes; however, I'm looking to automate the process for a large batch of images with R.
My ultimate goal is to use the ggimage package to plot these images as x,y coordinates but the background of these images is currently overlapping the plot (the dog compared to fink)
library("ggplot2")
library("ggimage")
set.seed(2017-02-21)
d <- data.frame(x = rnorm(10),
y = rnorm(10),
image = sample(c("http://www.supercoloring.com/sites/default/files/silhouettes/2015/05/cairn-terrier-black-silhouette.svg", "https://jeroenooms.github.io/images/frink.png"),
size=10, replace = TRUE)
)
ggplot(d, aes(x, y)) + geom_image(aes(image=image))
One can trim the edges of an image using image magick's image_trim()
img <- image_read_svg("http://www.supercoloring.com/sites/default/files/silhouettes/2015/05/cairn-terrier-black-silhouette.svg")
image_trim(img)
but this isn't exactly what I would like.
Any ideas?
The image_transparent() function does this, e.g.:
logo <- image_read("logo:")
image_transparent(logo, 'white')
The white parts of the image will be made transparent, which should be enough for the simple image in your example.
see my answer in https://yulab-smu.github.io/treedata-book/image-processing-using-magick-package.html#example-1-remove-background-of-images.
You can pass image processing function provided by magick package to geom_image via the image_fun parameter.
Related
I am trying to insert a logo in my plot using geom_image(). The original logo is available here:
https://www.itvoice.in/wp-content/uploads/2016/12/zebronics_footer_logo.png
and looks like this:
When I make a ggplot using the code below, I get this image where the logo is shrunk along the x axis.
When I used reprex to make this post, the resulting logo was shrunk along Y axis. Neither of them is the correct rendition. I can't figure out what's going on here. I tried to play around with various parameters such as size and asp but I can't reproduce the original logo correctly.
library(ggplot2)
library(ggimage)
df <- data.frame(imglink = "https://www.itvoice.in/wp-content/uploads/2016/12/zebronics_footer_logo.png",
x = 1,
y = 1)
ggplot(df, aes(x = x, y = y, image = imglink)) +
geom_image(size = 0.5) +
theme_bw()
Created on 2020-03-07 by the reprex package (v0.3.0)
This issue got resolved after I installed development versions of ggimage and ggplot2 and restarted RStudio.
I'm looking for any solution to this problem, regardless of packages used.
The problem at hand is that plotted images get distorted when you save them using ggsave. Let me give an example:
image_links = data.frame(id = c(1,2,3,4,5),
image = c("https://cdn.shopify.com/s/files/1/1061/1924/products/Smiling_Emoji_with_Eyes_Opened_large.png",
"https://cdn.shopify.com/s/files/1/1061/1924/products/Smiling_Emoji_with_Smiling_Eyes_large.png",
"https://cdn.shopify.com/s/files/1/1061/1924/products/Hushed_Face_Emoji_large.png",
"https://cdn.shopify.com/s/files/1/1061/1924/products/Disappointed_but_Relieved_Face_Emoji_large.png",
"https://cdn.shopify.com/s/files/1/1061/1924/products/Expressionless_Face_Emoji_large.png"))
mydata = data.frame(x = rnorm(100, mean = 50, sd = 20),
y = rnorm(100, mean = 50, sd = 5),
id = rep(c(1,2,3,4,5), 20))
mydata$y = mydata$y - 10*mydata$id
mydata = mydata %>% left_join(image_links, by='id')
g <- ggplot(mydata) + geom_image(aes(x=x, y=y, image=image), size=0.05)
ggsave(g, filename='[INSERT PATH HERE].png', width=width, height=height, dpi=300)
This works fine:
The problem arises when you adjust the width and height parameters of ggsave, for instance because you want the x and y-axis to be in the correct proportion:
width = (max(mydata$x) - min(mydata$x))/10
height = (max(mydata$y) - min(mydata$y))/10
ggsave(g, filename='[INSERT PATH HERE].png', width = width, height=height, dpi=300)
The x and y-axis are now fine, but the images are distorted:
This happens in ANY situation where you plot an image but the width/height aspect ratio is different than what was the original aspect ratio of the image you want to add.
I'm looking for any solution to this problem, not necessarily restricted to ggimage. It seems very weird to me that you can't properly add images to a ggplot, as I image it's very common for people to want to do that.
I don't know a lot about ggsave, but this seems like an issue related to relative versus absolute units. Probably the geom_image() calculates positions relative to the axes, which get distorted when the axes get resized (such as within ggsave). For example:
ggplot(mydata) + geom_image(aes(x=x, y=y, image=image), size=0.05)
Can look like:
Or can look like:
Depending on the device window that I can resize at will.
There are two ways I can see this getting fixed, both of which will involve re-calculating the sizes of the rasters at drawtime. The easier fix will be the one below.
# Get plot
g <- ggplot(mydata) + geom_image(aes(x=x, y=y, image=image), size=0.05)
# Convert to gtable
gt <- ggplotGrob(g)
# Get the imagegrobs, correct slots found by trial and error
imagegrobs <- gt$grobs[[6]]$children[[3]]$children
# Re-class them to a custom, made-up class
imagegrobs <- lapply(imagegrobs, function(image) {
class(image) <- c("fixasp_raster", class(image))
image
})
# Put them back into the gtable
gt$grobs[[6]]$children[[3]]$children <- imagegrobs
So now that we have a custom class for these images, we can write a piece of code that gets executed at the time of drawing by writing a method for our class using the S3 generic makeContent from the grid package.
library(grid)
makeContent.fixasp_raster <- function(x) {
# Convert from relative units to absolute units
h <- convertHeight(x$height, "cm", valueOnly = TRUE)
w <- convertWidth(x$width, "cm", valueOnly = TRUE)
# Decide how the units should be equal
x$height <- x$width <- unit(sqrt(h * w), "cm")
x
}
Note that taking the square root of the product is improvised, I don't know if this is the optimal procedure.
When we plot the data now, we'll have a consistent size of the images, regardless of the aspect ratio:
grid.newpage(); grid.draw(gt)
The second way to fix this is to file an issue in the github page of the ggimage package, motivating your use case and convice them to implement something that adresses your concerns. If they want, they could make a fix at the ggproto level, so that you don't have dabble with gtables.
#teunbrand's answer has been implemented in dev version 0.2.4 of ggimage. You can install the latest dev version like this:
setRepositories(ind=1:2)
## install.packages("devtools")
devtools::install_github("GuangchuangYu/ggimage")
This should fix the aspect ratio issues.
I have a ggplot object. Let's call it plot. I would like to convert it to png format, but I don't want to save it to a file on my local drive. I'm trying to work with that png object but I want to keep everything in the environment. Everything I've found, including ggsave, appears to force one to save the image as a file on the local drive first. I know image files can be stored as values, but I can't seem to get over the "save as" image and "import" image steps.
Here's some code for repoducibility:
library(tidyverse)
df <- as.data.frame(Titanic)
gg <- ggplot(data = df, aes(x = Survived, y = Freq))
plot <- gg + geom_bar(stat = "identity")
Now, I'd like to convert plot to a png to png without having to save it to a file. Something like:
png <- save.png(plot)
Thanks for the help!
It looks like the goal here would be to convert plot (the ggplot object) directly to a Magick image that you can operate on with functions in the magick package. Something like this:
mplot = image_graph(width=400, height=500)
plot
dev.off()
image_graph opens a graphics device that produces a Magick image and assigns it to mplot so that you'll have the object available in your environment. Then, when you type mplot in the console, you'll see the following:
format width height colorspace matte filesize density
1 PNG 400 500 sRGB TRUE 0 +72x+72
However, when I try to display the mplot image (type mplot in the console), I see the following:
even though the original plot looks like this:
I'm not sure what's going wrong, but hopefully someone with greater familiarity with magick will drop by and provide a solution.
I was faced with a similar issue and followed #eipi12 approach of using magick. The code bellow should work:
library(ggplot2)
library(magrittr)
ggsave_to_variable <- function(p, width = 10, height = 10, dpi = 300){
pixel_width = (width * dpi) / 2.54
pixel_height = (height * dpi) / 2.54
img <- magick::image_graph(pixel_width, pixel_height, res = dpi)
on.exit(utils::capture.output({
grDevices::dev.off()}))
plot(p)
return(img)
}
p <- data.frame(x = 1:100, y = 1:100) %>%
ggplot(aes(x = x, y = y)) +
geom_line()
my_img <- ggsave_to_variable(p)
my_img %>%
magick::image_write("my_img.png")
I am using tikzDevice package to obtain Latex-friendly graphs in R. I am having trouble in removing excessive white spaces from top and bottom of the graph below:
I have tried using par(mar) but it does not seem to work with ggplot2. Also, theme(plot.margins) seems to unresponsive as well. The white space is introduced as I try to alter the aspect ratio of the figure with theme(aspect.ratio).
Any suggestions?
Thanks!
EDIT: Here is a MWE:
library(tikzDevice)
library(reshape2)
x = seq(0,1,0.1)
y1 = x^2+2*x+7
y2= x^+2*x+2
df = data.frame(x,y1,y2)
df <- melt(df, id.vars=c("x"))
names(df) <- c("x","$latex~Name$","value")
plot <- ggplot(df,aes(x=x,y=value,color=`$latex~Name$`,group=`$latex~Name$`)) + geom_line() +
theme(aspect.ratio = 0.4)
plot
tikzDevice(file="mweTex.tex")
plot
dev.off()
The problem seems to be caused by some tikz statements that affect the bounding box of the image. Since there doesn't seem to be any option in tikzDevice for minimizing whitespace, I had to think of something else. I managed to fix the generated tikz file by adding the following R code at the end of your MWE:
# remove all lines that invisibly mess up the bounding box
lines <- readLines(con="mweTex.tex")
lines <- lines[-which(grepl("\\path\\[clip\\]*", lines,perl=F))]
lines <- lines[-which(grepl("\\path\\[use as bounding box*", lines,perl=F))]
writeLines(lines,con="mweTex.tex")
I've tested it on your MWE:
The left image is without the fix, the right image is with the fix.
I'm constructing a plot that uses geom_tile and then outputting it to .pdf (using pdf("filename",...)). However, when I do, the .pdf result has tiny lines (striations, as one person put it) running through it. I've attached an image showing the problem.
Googling let to this thread, but the only real advice in there was to try passing size=0 to geom_tile, which I did with no effect. Any suggestions on how I can fix these? I'd like to use this as a figure in a paper, but it's not going to work like this.
Minimal code:
require(ggplot2)
require(scales)
require(reshape)
volcano3d <- melt(volcano)
names(volcano3d) <- c("x", "y", "z")
v <- ggplot(volcano3d, aes(x, y, z = z))
pdf("mew.pdf")
print(v + geom_tile(aes(fill=z)) + stat_contour(size=2) + scale_fill_gradient("z"))
This happens because the default colour of the tiles in geom_tile seems to be white.
To fix this, you need to map the colour to z in the same way as fill.
print(v +
geom_tile(aes(fill=z, colour=z), size=1) +
stat_contour(size=2) +
scale_fill_gradient("z")
)
Try to use geom_raster:
pdf("mew.pdf")
print(v + geom_raster(aes(fill=z)) + stat_contour(size=2) + scale_fill_gradient("z"))
dev.off()
good quality in my environment.
I cannot reproduce the problem on my computer (Windows 7), but I remember it was a problem discussed on the list for certain configurations. Brian Ripley (if I remember) recommended
CairoPDF("mew.pdf") # Package Cairo
to get around this
In the interests of skinning this cat, and going into waaay too much detail, this code decomposes the R image into a mesh of quads (as used by rgl), and then shows the difference between a raster plot and a "tile" or "rect" plot.
library(raster)
im <- raster::raster(volcano)
## this is the image in rgl corner-vertex form
msh <- quadmesh::quadmesh(im)
## manual labour for colour scaling
dif <- diff(range(values(im)))
mn <- min(values(im))
scl <- function(x) (x - mn)/dif
This the the traditional R 'image', which draws a little tile or 'rect()' for every pixel.
list_image <- list(x = xFromCol(im), y = rev(yFromRow(im)), z = t(as.matrix(im)[nrow(im):1, ]))
image(list_image)
It's slow, and though it calls the source of 'rect()' under the hood, we can't also set the border colour. Use 'useRaster = TRUE' to use 'rasterImage' for more efficient drawing time, control over interpolation, and ultimately - file size.
Now let's plot the image again, but by explicitly calling rect for every pixel. ('quadmesh' probably not the easiest way to demonstrate, it's just fresh in my mind).
## worker function to plot rect from vertex index
rectfun <- function(x, vb, ...) rect(vb[1, x[1]], vb[2,x[1]], vb[1,x[3]], vb[2,x[3]], ...)
## draw just the borders on the original, traditional image
apply(msh$ib, 2, rectfun, msh$vb, border = "white")
Now try again with 'rect'.
## redraw the entire image, with rect calls
##(not efficient, but essentially the same as what image does with useRaster = FALSE)
cols <- heat.colors(12)
## just to clear the plot, and maintain the plot space
image(im, col = "black")
for (i in seq(ncol(msh$ib))) {
rectfun(msh$ib[,i], msh$vb, col = cols[scl(im[i]) * (length(cols)-1) + 1], border = "dodgerblue")
}