Using R to read out excel-colorinfo - r

Is there any way to read out the color-index of cells from excel files with R?
While I can set the cell color with packages like XLConnect or XLSX, I have found no way to extract the color-information from existing workbooks.

R-Bloggers provided a function that will do the job for you. I am including the answer here for future reference.
Read the excel file using xlsx package:
library(xlsx)
wb <- loadWorkbook("test.xlsx")
sheet1 <- getSheets(wb)[[1]]
# get all rows
rows <- getRows(sheet1)
cells <- getCells(rows)
This part extracts the information that later will be used for getting background color (or other style information) of the cells:
styles <- sapply(cells, getCellStyle) #This will get the styles
This is the function that identifies/extracts the cell background color:
cellColor <- function(style)
{
fg <- style$getFillForegroundXSSFColor()
rgb <- tryCatch(fg$getRgb(), error = function(e) NULL)
rgb <- paste(rgb, collapse = "")
return(rgb)
}
error will handle the cells with no background color.
Using sapply you can get the background color for all of the cells:
sapply(styles, cellColor)
You can also categorize/identify them by knowing the RGb codes:
mycolor <- list(green = "00ff00", red = "ff0000")
m <- match(sapply(styles, cellColor), mycolor)
labs <-names(mycolor)[m]
You can read more and learn how to apply it at R-bloggers
You can get the RGB codes from RapidTables.com

Old question but maybe it can help someone in the future.
There is a strange behavior in the POI (java) library (at least on my computer). It is not getting the colors correctly. The code provided in the #M--'s answer works well when the color is a basic color (indexed color), but does not work when the color is, for example, in grayscale. To get around you can use the following code using the getTint () function. Tint is a number between -1 (dark) and 1 (light), and combining it with the RGB (getRgb ()) function, you can completely recover the color.
cell_color <- function(style){
fg <- style$getFillForegroundXSSFColor()
hex <- tryCatch(fg$getRgb(), error = function(e) NULL)
hex <- paste0("#", paste(hex, collapse = ""))
tint <- tryCatch(fg$getTint(), error = function(e) NULL)
if(!is.null(tint) & !is.null(hex)){ # Tint varies between -1 (dark) and 1 (light)
rgb_col <- col2rgb(col = hex)
if(tint < 0) rgb_col <- (1-abs(tint))*rgb_col
if(tint > 0) rgb_col <- rgb_col + (255-rgb_col)*tint
hex <- rgb(red = rgb_col[1, 1],
green = rgb_col[2, 1],
blue = rgb_col[3, 1],
maxColorValue = 255)
}
return(hex)
}
Some references to help:
https://poi.apache.org/apidocs/dev/org/apache/poi/hssf/usermodel/HSSFExtendedColor.html#getTint--
https://bz.apache.org/bugzilla/show_bug.cgi?id=50787
Getting Excel fill colors using Apache POI

Related

R baseline package saving plots in a loop

I'm trying to optimize the parameters for baseline in the R baseline package by changing each parameters in a loop and comparing plots to determine which parameters give me the best baseline.
I currently have the code written so that the loop produces each plot, but I'm having trouble with getting the plot saved as the class of each object I'm creating is a baseline package-specific (which I'm suspecting is the problem here).
foo <- data.frame(Date=seq.Date(as.Date("1957-01-01"), by = "day",
length.out = ncol(milk$spectra)),
Visits=milk$spectra[1,],
Old_baseline_visits=milk$spectra[1,], row.names = NULL)
foo.t <- t(foo$Visits)
#the lines above were copied from https://stackoverflow.com/questions/37346967/r-packagebaseline-application-to-sample-dataset to make a reproducible dataset
df <- expand.grid(lambda=seq(1,10,1), p=seq(0.01,0.1,0.01))
baselinediff <- list()
for(i in 1:nrow(df)){
thislambda <- df[i,]$lambda
thisp <- df[i,]$p
thisplot <- baseline(foo.t, lambda=thislambda, p=thisp, maxit=20, method='als')
print(paste0("lambda = ", thislambda))
print(paste0("p = ", thisp))
print(paste0("index = ", i))
baselinediff[[i]] <- plot(thisplot)
jpeg(file = paste(baselinediff[[i]], '.jpeg', sep = ''))
dev.off()
}
I know that I would be able to extract corrected spectra using baseline.als but I just want to save the plot images with the red baseline so that I can see how well the baselines are getting drawn. Any baseline users out there that can help?
I suggest you change your loop in the following way:
for(i in 1:nrow(df)){
thislambda <- df[i,]$lambda
thisp <- df[i,]$p
thisplot <- baseline(foo.t, lambda=thislambda, p=thisp, maxit=20, method='als')
print(paste0("lambda = ", thislambda))
print(paste0("p = ", thisp))
print(paste0("index = ", i))
baselinediff[[i]] <- thisplot
jpeg(file = paste('baseline', i, '.jpeg', sep = ''))
plot(baselinediff[[i]])
dev.off()
}
Note that this does not try to capture the already plotted element (thisplot) inside of the list. Instead, the plotting is done after you call the jpeg command. This solves your export issue. Another problem was the naming of the file. If you call baselinediff[[i]] inside of paste, you apparently end up with an error. So I switched it to a simpler name. To plot your resulting list, call:
lapply(baselinediff, plot)
If you are determined on storing the already plotted element, the capture.plotfunction from the imager package might be a good start.

I am trying to run mosaic for two multi-band images.Output saved as Single band

This is final output I got, I'm supposed to get the final output as a single file with two bands:
Following is the code which I am using:
A11 <-brick("E:/Official/PROJECTS/R_Progrm/1.tif") // to read multiband image
B11<-brick("E:/Official/PROJECTS/R_Progrm/3.tif") // To read multiband image
mos1 <- mosaic(A11,B11,fun=max,tolerance=0.5,
filename="Mosaic_new",overwrite=TRUE)
plot(mos1,main="Mosaic_new1")
writeRaster(x=mos1,file="E:/Official/PROJECTS/R_Progrm/M11.tif",options="INTERLEAVE=BAND",format="GTiff",datatype="FLT8S",overwrite=TRUE)
The plot that you have shown in your question, is showing both the bands of your output image. So, there should not be any problem with your code and its output. If the problem is related to visualizing all the bands as an RGB Image, then you have to modify the parameters of plot function that means you have to provide the band combination. For example:
plotRGB(a, r = 4, g = 3, b = 2, axes=TRUE, main="3 Band Color Composite Image")
box(col="white")
Also, you can try the code given below which is working fine for me, and I hope it will resolve your problem.
a <- stack("Path to first raster")
b <- stack("Path to second raster")
rast.list <- list(a,b)
rast.list$fun <- mean
rast.mosaic <- do.call(mosaic,rast.list)
plot(rast.mosaic)
writeRaster(rast.mosaic,"Output_Raster_Name",format="GTiff",overwrite=TRUE)
rm(list = ls())
gc()
memory.limit(size= 2000)
library(rgdal)
library(raster)
install.packages("gdalUtils")
library(gdalUtils)
library(sp)
setwd("E:/Official/PROJECTS/R_Progrm/MOs/")
list.files()
file1=file.path(getwd(), "", "1.tif")
gdal_setInstallation()
valid_install <- !is.null(getOption("gdalUtils_gdalPath"))
if(require(raster) && require(rgdal) && valid_install)
{
layer1 <- file.path(getwd(), "", "1.tif")
layer2 <- file.path(getwd(), "", "3.tif")
file_list=c(layer1,layer2)
mosaic_rasters(gdalfile=file_list,dst_dataset="E:/Official/PROJECTS/R_Progrm/MOs//test_mosaic.GTiff",separate=TRUE,of="GTiff",verbose=TRUE)
gdalinfo("test_mosaic.GTiff")
}

R gif with function

I am trying to make a gif out of an R-Script using a function to generate the images.
I have a function that given some information creates a Map with dots on it.
I use this function on a Vector obtaining a series of different images, and I would like to put them together in a gif. It looks more or less like that:
createMap <- function(my_variable){
my_map <- a_map() + geom_point() # some variable missing
png(filename = paste(aDate, ".png", sep = ""), width = 3149, height = 2183, units = "px")
plot(mw_map)
dev.off()
}
ImageMagick is installed on my pc and the conversion file "converter.exe" also. Later I try to generate the gif using
saveGIF({
lapply(my_vector, createMap)
}, movie.name = "MY_GIF.gif")
but I get an error message:
> convert: improper image header `Rplot1.png' #
> error/png.c/ReadPNGImage/4362. convert: no images defined `MY_GIF.gif'
> # error/convert.c/ConvertImageCommand/3254.
an error occurred in the conversion...
does anybody know what I did wrong?
After creating the map png files. Use the below code. You don't need ImageMagick is installed on PC.
library(magick)
png.files <- sprintf("Rplot%02d.png", 1:10) #Mention the number of files to be read
GIF.convert <- function(x, output = "animation.gif")#Create a function to read, animate and convert the files to gif
{
image_read(x) %>%
image_animate(fps = 1) %>%
image_write(output)
}
GIF.convert(png.files)
For more details check this link: Link

How can I combine several heatmaps using R in a signal figure

I have created 36 heatmaps with the function pheatmap, and I want to display them in just one figure. I have tried to using the function par(), but it did not work, I do not know why. Could someone tell me what should I do? Thank you very much. This is my code:
require(graphics);require(grDevices);library("pheatmap", lib.loc="D:/Program Files/R/R-3.1.1/library");library(gplots)
filenames<-list.files("D:/Project/bladder cancer/heatmap0829/heatmap/"); # detect all of the files in the fold
filename2<-strtrim(filenames,nchar(filenames)-4); # all of the filenames without extension names
par(mfrow=c(18,2)) #divide the graphics windows into a 18x2 matrix
for(i in 1:length(filename2)){
rt<-read.table(paste("D:/Project/bladder cancer/heatmap0829/heatmap/",filenames[i],sep = ""), header = T, sep = '\t') # Import the data with the ith file name
size=dim(rt) # the dimensional of the datafram
cw=400/size[1] #the width of the cell in the heatmap
rt<-log10(rt)
x <- t(data.matrix(rt))
pheatmap(x,color=greenred(256),main=filename2[i],cluster_rows = F, cluster_cols = T,cellwidth = cw, cellheight = 60,border_color =F,fontsize = 8,fontsize_col = 15)}
This is one dataset
ScaBER 5637
1 1.010001e+02
1.341186e+00 2.505067e+01
1.669456e+01 8.834190e+01
7.141351e+00 3.897474e+01
1.585592e+04 5.858210e+04
1 3.137979e+01
1.498863e+01 7.694948e+01
1.115443e+02 3.642917e+02
1.157677e+01 5.036716e+01
4.926492e+02 8.642784e+03
3.047117e+00 1.872154e+01
I have 36 txt files like this, but I can not put all of them here
"ScaBER 5637" is the column name of this dataset
See this previous answer: Histogram, error: Error in plot.new() : figure margins too large
par(mfcol=c(3,12), oma=c(1,1,0,0), mar=c(1,1,1,0), tcl=-0.1, mgp=c(0,0,0))
for(i in 1:36){
plot(runif(2), runif(2), type="l")
}
dev.off()

Create a custom color palette in R

I know that R is loaded with some color palettes automatically, such as palette, rainbow , heat.colors and gray. I'm also aware of RColorBrewer. But, what if I want to use a custom color palette and assign colors by name? Is that possible?
My company's color palette is as follows:
#1A73BA (R: 26 G: 115 B: 186) - this is a blue
#FFDB43 (R:255 G:219 B:67) - this is a yellow
#B54B05 (R:181 G:75 B:5) - this is an orange
My company's initials are AT.
I'd like to be able to call those colors via a name rather than by the HEX or RGB because I don't remember them. Ideally, I could create a file that would load into R automatically that would initiate these colors.
ATBlue <- #1A73BA
ATYellow <- #FFDB43
ATOrange <- #B54B05
Then, I could call the colors:
plot(x,y, col = "ATBlue")
I could put the values into a dataframe, then call them like so:
ATColors <- data.frame(name = c("ATBlue", "ATYellow", "ATOrange"), color= c("#1A73BA", "#F7D364", "#B54B05"))
plot(x,y, col = ATColors[3,2])
But I would need to know the location in the dataframe in order to call it correctly.
Can I create an element that will automatically load when R launches that would allow me call a custom color name into a plot?
This answers (or at least is one possible answer to) your comments and edits:
ATblue <- rgb(26/255, 115/255, 186/255, 1)
ATyellow <- rgb(255/255, 219/255, 67/255, 1)
ATorange <- rgb(181/255, 75/255, 5/255, 1)
plot(1:10, col= c(ATblue, ATyellow, ATorange), pch=20)
The definition method with rgb allows you to set an alpha level , thus allowing transparency on graphic devices that support it (at a minimum: 'pdf', 'windows', 'quartz' and 'X11').
You can also name a 'palette-vector'
palvec <- c(ATblue=ATblue, ATyellow=ATyellow, ATorange=ATorange)
That vector could be accessed with either numbers or names:
plot(1,1) # to set up plot window
abline(h=c(0.8,1,1.2), col= palvec[ c( 'ATblue', 'ATyellow', 'ATorange' ) ] , lwd=40)
In general I think you will find that if you use all lower case there will be good correspondence for the base and graphics packages (loaded by default so no renaming will be necessary) with that gif-list. So it's already part of R. Let's say you wanted to find the R color name of "LavenderBlush". The vector of assigned color names is returned from colors() but it's rather big, so you can whittle it down with:
grep("lavender", colors(), ignore.case=TRUE, value=TRUE)
#[1] "lavender" "lavenderblush" "lavenderblush1" "lavenderblush2"
# "lavenderblush3" "lavenderblush4"
And say you wanted to see whether the Hex code for that color were the same as the one on your unreadable gif table:
ccodes <- as.hexmode( c(256^(2:0) %*% col2rgb("lavenderblush")) )
ccodes
#[1] "fff0f5"
Yep. And for your example just use "seagreen":
> ccodes <- as.hexmode( c(256^(2:0) %*% col2rgb("seagreen")) )
> ccodes
[1] "2e8b57
If you have a hex-code value you can append "#" to it with paste0:
paste0("#", ccodes)
#[1] "#2e8b57"
plot(1,1, col=paste0("#", ccodes) )
If you have a vector of such values, paste0 is also vectorized:
ccodes <- as.hexmode( c(256^(2:0) %*% col2rgb(colors()[20:25])) )
paste0("#", ccodes)
#[1] "#ffe4c4" "#eed5b7" "#cdb79e" "#8b7d6b" "#000000" "#ffebcd"
I would put the colours in a named vector like this:
ATcols <- c(blue = "#1A73BA", yellow = "#FFDB43", orange = "#B54B05")
Then you can get, say, blue like this: ATcols["blue"].
If you want to be a bit fancier, you could create a named vector and a function:
AT_color_data <- c(blue = "#1A73BA", yellow = "#FFDB43", orange = "#B54B05")
ATcolor <- function(color="blue") {
if (is.numeric(color)) AT_color_data[color]
else AT_color_data[tolower(color)]
}
This gives you a few options for getting your colours:
ATcolor(2:3)
# yellow orange
# "#FFDB43" "#B54B05"
ATcolor("orange")
# orange
# "#B54B05"
ATcolor(c("orange", "blue"))
# orange blue
# "#B54B05" "#1A73BA"
Alternatively, you could make your function behave a bit more like rainbow when providing a numeric argument:
AT_color_data <- c(blue = "#1A73BA", yellow = "#FFDB43", orange = "#B54B05")
ATcolor <- function(color="blue") {
if (is.numeric(color)) AT_color_data[1:color[1]]
else AT_color_data[tolower(color)]
}
then, for example:
ATcolor(2)
# blue yellow
# "#1A73BA" "#FFDB43"
library("grDevices")
plot(1:20,pch=20,col=col)
col=colorRampPalette(c("white", "red"))(20)
M <- matrix(runif(100),10,10)
M[lower.tri(M)] <- NA
image(M,col = col,frame=F,xaxt="n",yaxt="n")

Resources