R - add title to images with rasterImage - r

I have 12 twelve PNG files which I want to combine in a single plot with 4x3 grid in R.
So far I can create the grid with,
plot(c(0,4), c(0,3), type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
and I can add images to it with,
rasterImage(readPNG("image1.png"), 0, 3, 1, 2)
rasterImage(readPNG("image2.png"), 1, 3, 2, 2)
etc.
I get what I want, but I also want to add a title to each image in the plot. Like image1 should have a. Image1 and image2 should have b. Image2 on top of the images. Is there a way to do in R?
Thanks in advance.

#BondedDust's suggestion to use text is perfect, but using the mfrow (or mfcol) graphic parameter in par to layout the grid of plots might be sensible. You can then use plot(..., main='foo') or title(main='foo') to add the titles. For example:
Download some example png graphics, and read them into a list:
library(png)
pngs <- lapply(LETTERS[1:12], function(x) {
u <- 'http://icons.iconarchive.com/icons/mattahan/umicons/64'
download.file(mode='wb', sprintf('%s/Letter-%s-icon.png', u, x),
f <- tempfile(fileext='.png'))
readPNG(f)
})
Use mfrow to set the plot to have 4 rows and 3 columns, and add an upper margin for titles with mar. Then use sapply (for example) to iterate over elements of pngs (well, actually the indexes, 1 through 12, of the elements), plotting each in turn:
par(mfrow=c(4, 3), mar=c(0, 0, 3, 0))
sapply(seq_along(pngs), function(i) {
plot.new()
plot.window(xlim=c(0, 1), ylim=c(0, 1), asp=1)
rasterImage(pngs[[i]], 0, 0, 1, 1)
title(paste0(letters[i], '. Image ', i), font.main=2)
})

Try this:
text(x=0.5,y=2.95, labels="a. Image1")
text(x=1.5,y=2.95, labels="b. Image1")
If it needed to be bold, then plotmath expressions are needed:
text(x=1.5,y=2.95, labels=expression( bold(b.~Image1) ) )

Related

Extracting top 2-3 hex colors from images in R

I am wondering if it is possible to extract out the main hex colors from image files containing team sports logos. I have the following vector of logos:
dput(team.logos[1:5))
c("https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/399.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/2066.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/42.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/311.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/160.png")
Using the following website (https://html-color-codes.info/colors-from-image/) - I am able to see that the hex color values in the first image (UAlbany) are #FEBE10 for yellow, and #3F1E6B for the purple, as well as white.
My question is - is there any way to scrape these hex values for each image in my vector in R (so I don't have to manually load each image and click to find each hex value).
Thanks!
Another option using the imager package...
require('imager')
require('data.table')
team.logos <- c("https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/399.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/2066.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/42.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/311.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/160.png")
#this function takes an image in imager's cimg format and
#returns the hex colour codes for any colours covering more than
#a threshold proportion of pixels (default is set to 0.05)
getHexPrimaries <- function(img, pcnt.threshold = 0.05){
#convert cimg to workable format
channel.labels <- c('R','G','B','A')[1:dim(img)[4]]
img <- as.data.table(as.data.frame(img))
img[,channel := factor(cc ,labels=channel.labels)]
img <- dcast(img, x+y ~ channel, value.var = "value")
#sort by unique rgb combinations and identify the primary colours
colours.sorted <- img[, .N, by=list(R,G,B)][order(-N)]
colours.sorted[ , primary := N/sum(N) > pcnt.threshold]
#convert to hex
hex.primaries <-
apply(colours.sorted[primary==TRUE], 1, function(row){
hex <- rgb(row[1], row[2], row[3], maxColorValue=1)
hex
})
hex.primaries
}
hex.list <- lapply(team.logos, function(logo.url) {
download.file(logo.url,'temp.png', mode = 'wb')
img <- load.image('temp.png')
getHexPrimaries(img)
})
Give this a try. The png library allows one to load a RGB file and then it is a matter of converting the three channels into the Hex codes.
I confirmed the codes are correct for the first image, good luck with the rest.
logos<-c("https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/399.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/2066.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/42.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/311.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/160.png")
plot(NA, xlim = c(0, 2), ylim = c(0, 5), type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
library(png)
for (filen in seq_along(logos)) {
#download and read file
#this will overwrite the file each time,
#create a list if you would like to save the files for the future.
download.file(logos[filen], "file1.png")
image1<-readPNG("file1.png")
#plot if desired
#plot(NA, xlim = c(0, 2), ylim = c(0, 5), type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
rasterImage(image1, 0, filen-1, 1, filen)
#convert the rgb channels to Hex
outR<-as.hexmode(as.integer(image1[,,1]*255))
outG<-as.hexmode(as.integer(image1[,,2]*255))
outB<-as.hexmode(as.integer(image1[,,3]*255))
#paste into to hex value
hex<-paste0(outR, outG, outB)
#remove the white and black
hex<-hex[hex != "ffffff" & hex != "000000"]
#print top 5 colors
print(head(sort(table(hex), decreasing = TRUE)))
}
Here is the sample output, the hex color with the number of pixels with that color.
print(head(sort(table(hex), decreasing = TRUE)))
#hex
#c3c4c6 00275d 00265c c2c3c5 001e57 00255c
#67929 39781 838 744 649 633

R: Export 3D scatterplots non-interactively

Creating 3D plots in R opens up an interactive window where the user can rotate the view. For example below using package rgl:
library(rgl)
plot3d(iris[,1:3],col=c("red","green","blue")[iris$Species],size=5)
Is there some way to set a predefined view and export the plot as a regular image. I would like to do this in an automated non-interactive manner for many datasets.
Use scatterplot3d package.
library(scatterplot3d)
graphics.off()
png(filename = "test.png", width = 8, height = 6, units = "in", res = 300)
par(mai = c(0.5, 0.5, 0.5, 0.5))
scatterplot3d(x = iris$Sepal.Length, y = iris$Sepal.Width, z = iris$Petal.Length,
color = c("red","green","blue")[iris$Species],
cex.symbols = 1, pch = 19, angle = -30)
dev.off()
Besides #d.b's answer using scatterplot3d instead of rgl, you could save results using R Markdown. The advantage of doing it this way is that you get an interactive display instead of a static one; the disadvantage is that the format is HTML, not PNG or another bitmap format.
Before knitting the document, run code like this and interactively choose
the initial display you want:
library(rgl)
options(rgl.useNULL = FALSE)
plot3d(iris[,1:3],col=c("red","green","blue")[iris$Species],size=5)
Once you have it oriented correctly, run this code:
M <- par3d("userMatrix")
dput(M)
You'll get something like
structure(c(0.776694416999817, 0.198224693536758, -0.597873568534851,
0, -0.629868388175964, 0.249577552080154, -0.735511302947998,
0, 0.00341932475566864, 0.947849154472351, 0.318700969219208,
0, 0, 0, 0, 1), .Dim = c(4L, 4L))
as output. Then start your R Markdown document with something like
library(rgl)
options(rgl.useNULL = TRUE)
M <- structure(c(0.776694416999817, 0.198224693536758, -0.597873568534851,
0, -0.629868388175964, 0.249577552080154, -0.735511302947998,
0, 0.00341932475566864, 0.947849154472351, 0.318700969219208,
0, 0, 0, 0, 1), .Dim = c(4L, 4L))
(which you would probably choose not to echo), and in each code chunk that produces a plot, write code like this:
plot3d(iris[,1:3],col=c("red","green","blue")[iris$Species],size=5)
par3d(userMatrix = M)
rglwidget()
(If this is in a loop or isn't at the top level for some other reason, you'll need print(rglwidget()) instead.)
Then all of your plots will initially have the same orientation, but all of them will be user-rotatable.

Add color legend based on values in a column in R

This may be a very basic plotting question, but I am unable to resolve it even after reading many posts. I created a basic plot for this data-
ID ID_chr IVC10_BB_0048 IVC10_BB_0049 .......
mrna5.cds1 mal_mito_2 295.53 362.80
mrna4.cds1 mal_mito_3 297.33 359.69
mrna3.cds1 mal_mito_3 292.88 361.13
mrna2.cds1 mal_mito_4 298.19 360.76
mrna1.cds1 mal_mito_4 295.43 359.47
mrna5.cds1 mal_mito_5 429.18 520.89
mrna4.cds1 mal_mito 419.21 518.53
mrna3.cds1 mal_mito 431.56 527.69
mrna2.cds1 mal_mito 429.69 521.14
mrna1.cds1 mal_mito 423.87 509.44
mrna5.cds1 mal_mito 231.26 246.93
mrna4.cds1 mal_mito 206.76 231.48
mrna3.cds1 mal_mito 234.60 260.17
mrna2.cds1 mal_mito 230.75 254.36
mrna1.cds1 mal_mito 233.56 254.04
mrna5.cds8 PF3D7_01 5.745 8.022
mrna5.cds7 PF3D7_01 3.821 4.744
mrna5.cds6 PF3D7_01 3.847 4.794
mrna5.cds5 PF3D7_01 3.821 4.645
mrna5.cds4 PF3D7_02 5.542 7.004
mrna5.cds3 PF3D7_03 4.479 5.663
mrna5.cds2 PF3D7_04 4.252 5.266
.
.
.
.
The data has around 100columns and 20000 rows. There are 14 unique categories in the 2nd column ie mal_mito, PF3D7_01, PF3D7_02, PF3D7_03 ...etc and I am coloring values in plots based on these.
IVC_all = read.table("input.txt")
pdf(file="test.pdf")
par(mfrow =c(3,1))
family <- as.factor(IVC_all[,1])
for ( i in seq(2,length( IVC_all ),1) ) plot(IVC_all[,i],ylab=names(IVC_all[i]),col=family,pch=19)
dev.off()
I am trying to add a color legend in this plot showing which color corresponds to which 2nd column value. I end up with a pdf file with line plots for all the columns with 3 plots per page. I tried using image.plot but I am not able to get it right. Thanks!
Use legend(); see example
# Generate data
x = rnorm(1:10000)
# Default palette() only contains 8 colors.
library(RColorBrewer)
# Plot, change `Spectral` to whatever you palette you want in `?brewer.pal`
plot(x, col = rep(brewer.pal(10, "Spectral"), each = 1000))
# Manually add legend, you need to set the x, y coordinates. `legend` args are the labels, so you need something like `unique(IVC_all[,1])`
legend(x = 1, y = 2, legend = c("hoho", "haha", paste(8:10)), col = brewer.pal(10, "Spectral"), lty = 1, cex = 1)
Update your code to add legend at the bottom:
#update
par(mfrow =c(4,1))
for ( i in seq(2,length( IVC_all ),1) )
plot(IVC_all[,i],ylab=names(IVC_all[i]),col=family,pch=19)
#add
unique.family <- unique(family)
plot(0, 0, type = "n", bty = "n", xaxt = "n", yaxt = "n")
legend("bottom", as.character(unique.family),
lwd=rep(2,length(unique.family)),
col=unique.family, horiz=TRUE)

levelplot (R lattice package) with 2 yaxis labels

I want to place 2 sets of y-axis labels on the graph I created using levelplot function from lattice library at R. I was able to get two sets of labels to show but they are overlapping. Below please see a minimum example. I also tried a few options at par.settings such as ylab.axis.padding and axis.components padding, but nothing seemed to change the superimposition of 2 y-labels. Perhaps they have been overwritten somehow? Any ideas will be appreciated.
My example codes :
A = matrix( c(3, 1, 0, 1, 2, 3, 1, 0,
rep(1,4), 2, 0, 1), nrow=3, ncol=5, byrow = TRUE)
colnames(A)= c("XXX5", "XXX4", "XXX3", "XXX2", "XXX1")
axis.build=function(side,...){
if(side == "left"){
panel.axis(side=side, outside=TRUE, at=1:5,tck=0,
text.col="black", labels=colnames(A), text.cex=0.5)
panel.axis(side=side, outside=TRUE, at=1:5,tck=0,
text.col="brown", labels=seq(ncol(A)), text.cex=0.9 )
} else axis.default(side=side, ...)
}
levelplot(A, aspect="iso", shrink = c(0.8, 0.8),
scales= list(x=list(draw=F),cex=0.5, font=2),
axis=axis.build,, xlab= NULL, ylab=NULL,
col.regions=c("black", "orange", "red","purple"),
at=c(-1, 0, 1, 2, 3), colorkey = FALSE,
par.settings = list(axis.line=list(col="transparent"),
axis.components=list(bottom=list(pad1=1, pad2=3)) ))
I think I have found the solution. In case anyone interested : I changed the first tck=0 to tck=2, and added line.col= "transparent", thus two left axis are stacked next to each other. Voila ! However, I can't seem to find where the documentation is for using pad1 and pad2 parameters. Any suggestion?

Stretched plots in R when plotting multiple figures to PDF

I'm trying to create a pdf with multiple plots in pdf, when I create a pdf with 2 X 2 plots the plots are square and looks nice:
pdf(file=paste0("Test.pdf"), paper = "a4")
par(mfrow=(c(2,2)), omi=c(0,0,0,0), mar=c(2, 2, 0, 0))
for (i in 1:4)
{
plot(1:10)
}
dev.off()
However if I try to generate a pdf with 3 rows and 2 columns the plots are not square. The plots seems to be stretched so that the entire 3 x 2 matrix of plots are squared:
pdf(file=paste0("Test 2.pdf"), paper = "a4")
par(mfrow=(c(3,2)), omi=c(0,0,0,0), mar=c(2, 2, 0, 0))
for (i in 1:6)
{
plot(1:10)
}
dev.off()
How do I get the individual plots to be square in a configuration where the number of rows and columns are not equal?
Thanks in advance.
Apparantly you can use layout instead
pdf(file=paste0("Test 2.pdf"), paper = "a4")
layout(matrix(1:6, 3, 2, byrow = TRUE), respect = TRUE)
par(omi=c(0,0,0,0), mar=c(2, 2, 0, 0))
for (i in 1:6)
{
plot(1:10)
}
dev.off()

Resources