Assume we have a set of identical images imgs (see below). Note that the set length may vary in practice.
library(magick)
library(rsvg)
img <- image_read_svg("https://image.flaticon.com/icons/svg/132/132233.svg", width = 30)
imgs <- replicate(8, img)
The goal is to print a square image containing all the images within imgs (even though the set length may not be a square number):
I played around with image_append() and image_append(..., stack = TRUE) from the magick package without success [ref]. Ideally I would like a function (e.g. printMosaic(imgs)) that takes as input imgs and outputs the squared image displayed above. Maybe it would be easier to achieve with a different package?
That's a very nice question!
First, lets randomly select how many images we want and then automatically calculate how many rows/columns we will need.
# Number of images from 1 to 100
N <- sample(1:1e2, 1)
print(N)
[1] 84
# How many rows/columns we will need
X <- ceiling(sqrt(N))
print(X)
[1] 10
Create empty panel using multipanelfigure package with X rows and columns:
library(multipanelfigure)
figure <- multi_panel_figure(columns = X, rows = X)
# Iterate from 1 to N images and append them to figure
for(i in seq_len(N)) {
# "./R.png" is path to image I'm using
# With this package you don't need to worry about importing images
figure %<>% fill_panel("./R.png", label = "", scaling = "shrink")
}
Related
I am trying to split a pdf into multiple pdfs but all of them must be of similar size. I want the pdf split by size, not by some markers or every 10 pages or so. I understand some pages are of a bigger size because of elements like colors, figures, etc.
I tried using the function select_pages of the staplr package and a for loop to create pdf, checking size and removing it if not met the wanted size. But, this process is so slow.
I need something to fast get the size of every page of the pdf so I can split it by size.
If I got it right, you can achieve it by using pdftools:
# Arguments
pdf_file <- "input.pdf" # file name
thres = 2 # size in Mb
# Create temporary folder based on local time
tmp <- gsub(":|-| ", "", Sys.time())
dir.create(tmp)
# Split pages
invisible(pdf_split(pdf_file, paste0(tmp, '/page')))
# Get page files' names
pages <- list.files(tmp, full.names = T)
# Get page files' sizes
page_sizes <- sapply(pages, function(page) file.info(page)$size) / 10^6
# Remove pages with sizes bigger than a threshold
pages_ok <- pages[page_sizes <= size]
# Do whatever you wanna do (here, I'm creating a pdf with acceptable page sizes)
pdf_combine(pages_ok, output = "output.pdf")
# Remove temporary folder
unlink(tmp, recursive = T)
I have hundreds of small (300x300 pixel) pure black and white PNG images. I want to convert them to different two colors in R and save them again as PNG. (Firstly I want to actually invert them: all black to white and all white to black - but later I will need other colors, e.g. black to red and white to green, etc.) This seems real simple, but whatever I try I run into problems.
For example, the simplest solution seems using as.raster in base R and the png package (at least for reading):
img = readPNG(newfile) # read black (background) and white (figure) image
img <- as.raster(img)
img_white = img
img_white[img_white == "#000000"] <- 'red' # temporarily convert back to red as placeholder
img_white[img_white == "#FFFFFF"] <- '#000000' # convert white to black
img_white[img_white == "red"] <- '#FFFFFF' # convert originally black to white
(Here by the way I needed a placeholder because the goal color is the same as the other original - but that's beside the point.)
So this works nicely and I can plot it with plot(img_white), but incredibly I find no way of automatically saving the image as file. I tried e.g. writePNG, writeRaster, writeGDAL, but they all give various error messages due to wrong class or wrong format or similar. (I also tried various conversions without success.)
Among others I also tried the imager package, which nicely saves the image after manipulating it, but I cannot find the way to convert a single specified color in the entire image.
All in all, I'm open to any possible solutions as long as it gives a full working code. I don't much care whatever package I need to use, though if possible I'd prefer as simple code as possible and hence as few packages as possible.
SOLUTION:
Based on Allan Cameron's answer, I wrote this function:
change_cols = function(replace_black, replace_white, theimg) {
r_b = col2rgb(replace_black) / 255
r_w = col2rgb(replace_white) / 255
theimg[theimg == 1] <- 2
for (i in 1:3) {
theimg[,,i][theimg[,,i] == 0] <- r_b[i]
}
for (i in 1:3) {
theimg[,,i][theimg[,,i] == 2] <- r_w[i]
}
return(theimg)
}
Then it's as simple as:
img = readPNG(newfile)
newimg = change_cols("#FF0000", "#00FF00", img)
writePNG(newimg, "fileout.png")
(See also Allan Cameron's function which converts the raster object.)
You need to write the PNG as a numeric array, just as it was when you loaded it. Since you only have black and white images, it shouldn't be a problem to manually swap black and white (they have value black = 0, white = 1).
You only need to convert it to a raster for plotting:
library(png)
newfile = "~/face.png"
img = readPNG(newfile) # read black (background) and white (figure) image
img_white = 1-img
Now
plot(raster::as.raster(img))
And
plot(raster::as.raster(img_white))
Or if you want to invert a single channel (in this case red):
img[,,1] <- 1 - img[,,1]
plot(raster::as.raster(img))
EDIT
After further comments from the OP, I thought it was reasonable to take this answer to its conclusion by writing a function that takes a raster object and saves it as a PNG file:
save_raster_as_PNG <- function(raster_object, path)
{
if(class(raster_object) != "raster") stop("This is not a raster object.")
dims <- dim(raster_object)
red <- as.numeric(paste0("0x", substr(raster_object, 2 , 3)))/255
dim(red) <- rev(dims)
green <- as.numeric(paste0("0x", substr(raster_object, 4 , 5)))/255
dim(green) <- rev(dims)
blue <- as.numeric(paste0("0x", substr(raster_object, 6 , 7)))/255
dim(blue) <- rev(dims)
result <- numeric(3 * dims[1] * dims[2])
dim(result) <- c(dims, 3)
result[,,1] <- t(red)
result[,,2] <- t(blue)
result[,,3] <- t(green)
tryCatch(png::writePNG(result, path), error = function(e) stop(e))
cat("Raster successfully saved to", path.expand(path))
}
img <- raster::as.raster(img)
save_raster_as_PNG(img, "~/face3.png")
# Raster successfully saved to C:/Users/AllanCameron/SO/R/face3.png
So I have a folder with some n images which I want to open and save with the readImage function. Right now a colleague had written something similar for opening and storing the name only of the images. I'd like to do the following:
setwd("~/ABC/One_Folder_Up")
img_src <- "FolderOfInterest"
image_list <- list.files(path=img_src, pattern = "^closed")
But with the actual .tif images named for example: closed100, closed101,....closed201
The above code works great for getting the names. But how can I get this type of pattern but instead open and save images? The output is a large matrix for each image.
So for n = 1 to n, I want to perform the following:
closed175 <- readImage("closed175.tif")
ave175 <- mean(closed175)
SD175 <- SD(closed175)
I'm assuming the image list shown in the first part could be used in the desired loop?
Then, after the images are saved as their own matricies, and all averages and SDs are calculated, I want to put the averages and SDs in a matrix like this:
imavelist <- c(ave175, ave176,......ave200)
Sorry, not an expert coder. Thank you!
edit: maybe lapply?
edit2: if I use this suggestion,
require(imager)
closed_images <- lapply(closed_im_list, readImage)
closed_im_matrix = do.call('cbind', lapply(closed_images, as.numeric))
Then I need a loop to save each element of the image stack matrix as its own individual image.
setwd("~/ABC/One_Folder_Up/FolderOfInterest/")
#for .tif format
image_list=list.files(path=getwd(), pattern = "*.tif")
# for other formats replace tif with appropriate format.
f=function(x){
y=readImage(x)
mve=mean(y)
sd=sd(y)
c(mve,sd)
}
results=data.frame(t(sapply(image_list,f)))
colnames(results)=c("average","sd")
the resul for 3 images:
> results
average sd
Untitled.tif 0.9761128 0.1451167
Untitled2.tif 0.9604224 0.1861798
Untitled3.tif 0.9782997 0.1457034
>
To minimize 3rd party package dependencies & reserve the ability to parallelize the code; this reproduceable example below is intended to create png images for each row step of a plot using R's Base graphics (no Tidyverse or GGPlot).
It, however, produces the entire series for each image, & not the intended iterative build required:
#
setwd("///images")
data(mtcars) # load DF
frames = 50 # set image qty rate
for(i in 1:frames){
# creating a name for each plot file with leading zeros
if (i < 10) {name = paste('000',i,'plot.png',sep='')}
if (i < 100 && i >= 10) {name = paste('00',i,'plot.png', sep='')}
if (i >= 100) {name = paste('0', i,'plot.png', sep='')}
png(name)
# plot(mtcars$mpg,type="l")
plot(mtcars$mpg)
dev.off()
}
my_cmd <- 'convert *.png -delay 5 -loop 5 mpg.gif'
system(my_cmd)
#
My own attempts to unsuccessfully resolve the issue include:
1) Remove the frame iteration & used nrows (mtcars) as the loop controlling agent?
2) Reference the row index somehow for each plot call?
3) Insert a sleep() call inside the loop after each plot?
4) Use the apply() function instead of a loop?
Any pointers or alternative coding to be more R efficient to make this work as intended?
Thanks.
This code will create one .png file for series of plots where each successive plot has one additional point on it:
# load data
data(mtcars)
# specify number of files to create (one per row of mtcars)
frames <- nrow(mtcars)
# figure out how many leading zeros will be needed in filename
ndigits <- nchar(as.character(frames))
for(i in 1:frames){
# name each file
zeros <- ndigits - nchar(as.character(i))
ichar <- paste0(strrep('0',zeros), i)
name <- paste0(ichar, 'plot.png')
# plot as .png
png(filename = name)
plot(x=1:i, y=mtcars$mpg[1:i], pch=20, col="blue",
xlim=c(0,frames), ylim=range(mtcars$mpg))
dev.off()
}
I have 500+ points in a SpatialPointsDataFrame object; I have a 1.7GB (200,000 rows x 200,000 cols) raster object. I want to have a tabulation of the values of the raster cells within a buffer around each of the 500+ points.
I have managed to achieve that with the code below (I got a lot of inspiration from here.). However, it is slow to run and I would like to make it run faster. It actually runs OK for buffers with "small" widths, say 5km ro even 15km (~1 million cells), but it becomes super slow when buffer increases to say 100km (~42 million cells).
I could easily improve on the loop below by using something from the apply family and/or a parallel loop. But my suspicion is that it is slow because the raster package writes 400Mb+ temporary files for each interaction of the loop.
# packages
library(rgeos)
library(raster)
library(rgdal)
myPoints = readOGR(points_path, 'myLayer')
myRaster = raster(raster_path)
myFunction = function(polygon_obj, raster_obj) {
# this function return a tabulation of the values of raster cells
# inside a polygon (buffer)
# crop to extent of polygon
clip1 = crop(raster_obj, extent(polygon_obj))
# crops to polygon edge & converts to raster
clip2 = rasterize(polygon_obj, clip1, mask = TRUE)
# much faster than extract
ext = getValues(clip2)
# tabulates the values of the raster in the polygon
tab = table(ext)
return(tab)
}
# loop over the points
ids = unique(myPoints$ID)
for (id in ids) {
# select point
myPoint = myPoints[myPoints$ID == id, ]
# create buffer
myPolygon = gBuffer(spgeom = myPoint, byid = FALSE, width = myWidth)
# extract the data I want (projections, etc are fine)
tab = myFunction(myPolygon, myRaster)
# do stuff with tab ...
}
My questions:
Am I right to partially blame the writing operations? If I managed to avoid all those writing operations, would this code run faster? I have access to a machine with 32GB of RAM -- so I guess it is safe to assume I could load the raster to the memory and need not to write temporary files?
What else could I do to improve efficiency in this code?
I think you should approach it like this
library(raster)
library(rgdal)
myPoints <- readOGR(points_path, 'myLayer')
myRaster <- raster(raster_path)
e <- extract(myRaster, myPoints, buffer=myWidth)
And then something like
etab <- sapply(e, table)
It is hard to answer your question #1 as we do not know enough about your data (we do not know how many cells are covered by a "100 km" buffer). But you can set options about when to write to file with the rasterOptions function. You notice that getValues is faster than extract, based on the post you link to, but I think that is wrong, or at least not very important. The combination of crop, rasterize and getValues should have a similar performance as extract (which does almost exactly that under the hood). If you go this route anyway, you should pass an empty RasterLayer, created by raster(myRaster) for faster cropping.