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
Related
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")
}
I am using the R package msa, a core Bioconductor package, for multiple sequence alignment. Within msa, I am using the MUSCLE alignment algorithm to align protein sequences.
library(msa)
myalign <- msa("test.fa", method=c("Muscle"), type="protein",verbose=FALSE)
The test.fa file is a standard fasta as follows (truncated, for brevity):
>sp|P31749|AKT1_HUMAN_RAC
MSDVAIVKEGWLHKRGEYIKTWRPRYFLL
>sp|P31799|AKT1_HUMAN_RAC
MSVVAIVKEGWLHKRGEYIKTWRFLL
When I run the code on the file, I get:
MUSCLE 3.8.31
Call:
msa("test.fa", method = c("Muscle"), type = "protein", verbose = FALSE)
MsaAAMultipleAlignment with 2 rows and 480 columns
aln
[1] MSDVAIVKEGWLHKRGEYIKTWRPRYFLL
[2] MSVVAIVKEGWLHKRGEYIKTWR---FLL
Con MS?VAIVKEGWLHKRGEYIKTWR???FLL
As you can see, a very reasonable alignment.
I want to write the gapped alignment, preferably without the consensus sequence (e.g., Con row), to a fasta file. So, I want:
>sp|P31749|AKT1_HUMAN_RAC
MSDVAIVKEGWLHKRGEYIKTWRPRYFLL
>sp|P31799|AKT1_HUMAN_RAC
MSVVAIVKEGWLHKRGEYIKTWR---FLL
I checked the msa help, and the package does not seem to have a built in method for writing out to any file type, fasta or otherwise.
The seqinr package looks somewhat promising, because maybe it could read this output as an msf format, albeit a weird one. However, seqinr seems to need a file read in as a starting point. I can't even save this using write(myalign, ...).
I wrote a function:
alignment2Fasta <- function(alignment, filename) {
sink(filename)
n <- length(rownames(alignment))
for(i in seq(1, n)) {
cat(paste0('>', rownames(alignment)[i]))
cat('\n')
the.sequence <- toString(unmasked(alignment)[[i]])
cat(the.sequence)
cat('\n')
}
sink(NULL)
}
Usage:
mySeqs <- readAAStringSet('test.fa')
myAlignment <- msa(mySeqs)
alignment2Fasta(myAlignment, 'out.fasta')
I think you ought to follow the examples in the help pages that show input with a specific read function first, then work with the alignment:
mySeqs <- readAAStringSet("test.fa")
myAlignment <- msa(mySeqs)
Then the rownames function will deliver the sequence names:
rownames(myAlignment)
[1] "sp|P31749|AKT1_HUMAN_RAC" "sp|P31799|AKT1_HUMAN_RAC"
(Not what you asked for but possibly useful in the future.) Then if you execute:
detail(myAlignment) #function actually in Biostrings
.... you get a text file in interactive mode that you can save
2 29
sp|P31749|AKT1_HUMAN_RAC MSDVAIVKEG WLHKRGEYIK TWRPRYFLL
sp|P31799|AKT1_HUMAN_RAC MSVVAIVKEG WLHKRGEYIK TWR---FLL
If you wnat to try hacking a function for which you can get a file written in code, then look at the Biostrings detail function code that is being used
> showMethods( f= 'detail')
Function: detail (package Biostrings)
x="ANY"
x="MsaAAMultipleAlignment"
(inherited from: x="MultipleAlignment")
x="MultipleAlignment"
showMethods( f= 'detail', classes='MultipleAlignment', includeDefs=TRUE)
Function: detail (package Biostrings)
x="MultipleAlignment"
function (x, ...)
{
.local <- function (x, invertColMask = FALSE, hideMaskedCols = TRUE)
{
FH <- tempfile(pattern = "tmpFile", tmpdir = tempdir())
.write.MultAlign(x, FH, invertColMask = invertColMask,
showRowNames = TRUE, hideMaskedCols = hideMaskedCols)
file.show(FH)
}
.local(x, ...)
}
You may use export.fasta function from bio2mds library.
# reading of the multiple sequence alignment of human GPCRS in FASTA format:
aln <- import.fasta(system.file("msa/human_gpcr.fa", package = "bios2mds"))
export.fasta(aln)
You can convert your msa alignment first ("AAStringSet") into an "align" object first, and then export as fasta as follows:
library(msa)
library(bios2mds)
mysequences <-readAAStringSet("test.fa")
alignCW <- msa(mysequences)
#https://rdrr.io/bioc/msa/man/msaConvert.html
alignCW_as_align <- msaConvert(alignCW, "bios2mds::align")
export.fasta(alignCW_as_align, outfile = "test_alignment.fa", ncol = 60, open = "w")
I am trying to save a jpeg picture in png format using the magick package in R and I'm facing an error.
Below is the error that I get using this code:
library(magick)
testPic <- "https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/President_Roosevelt_-_Pach_Bros.tif/lossy-page1-165px-President_Roosevelt_-_Pach_Bros.tif.jpg"
image <- image_read(testPic)
image_info(image)
image_convert(image, format = "png", depth = NULL)
Error in magick_image_write(image, format, quality) :
Magick: profile 'icc': 'RGB ': RGB color space not permitted on grayscale PNG `' # warning/png.c/MagickPNGWarningHandler/1656
This is a bug in imagemagick. The workaround is to add strip = TRUE to image_read():
library(magick)
testPic <- "https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/President_Roosevelt_-_Pach_Bros.tif/lossy-page1-165px-President_Roosevelt_-_Pach_Bros.tif.jpg"
image <- image_read(testPic, strip = TRUE)
image_info(image)
image_convert(image, format = "png", depth = NULL)
I'll try to ping upstream again to fix this.
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
I used R to create a series of images that took a long time to run. I'd like to use the animation package to make a video from them without re-running the analysis.
I can't find an example using existing images from file. The closest is Yihui Xie's demo('flowers') to create an HTML animation. I changed his code and can successfully make an mp4 of the flower images but I'm not sure how to access images already on file.
Based on his code, it should be something like this:
library(animation)
oopts = if (.Platform$OS.type == "windows") {
ani.options(ffmpeg = "C:/Software/ffmpeg/ffmpeg-20151015-git-0418541-win64-static/bin/ffmpeg.exe")}
#My list of images from disk
extList = list.files(myDir, pattern='.jpg', full.names=T)
saveVideo({
for (i in 1:length(extList)) {
#Yihui Xie's example downloads jpegs from web
#This code works to make an mp4 but I want to use images from disk
#extList = c('http://i.imgur.com/rJ7xF.jpg',
# 'http://i.imgur.com/Lyr9o.jpg',
# 'http://i.imgur.com/18Qrb.jpg')
#download.file(url = extList[i], destfile = sprintf(ani.options('img.fmt'), i), mode = 'wb')
someFunctionToAccessImage(extList[i])
}
}, video.name='notFlowers.mp4',
use.dev = FALSE,
ani.type = 'jpg',
interval = 2,
single.opts = "'dwellMultiplier': 1")
Bonus question - Can I do this with PNGs or other image types?
I found there to be a couple of problems with this. saveVideo uses a temporary directory to process the files and make the movie. Also, the postfix it was adding to the image name wasn't working correctly. So, here is a way to do it where you copy the images from the folder you have them stored in into the temporary directory used by saveVideo. The tricky part is finding the path to that directory, which is done using sys.frame from a function defined in the expression.
Note: another possible option could be to manually copy the images to the temporary folder that you know saveVideo will use (it will call tempdir()), or redefine tempdir() to return the path to your current images, but I haven't tested that.
library(animation)
oopts = if (.Platform$OS.type == "windows")
ani.options(ffmpeg = "C:\\home\\src\\ffmpeg-20151017-git-e9299df-win64-static\\bin\\ffmpeg.exe")
## Some variables
dirPath <- normalizePath("images/") # path to folder containing images
postfix <- "%03d" # I created my files with "Rplot%03d"
## Make the animation
saveVideo({
## Need to retrieve some variables from environments up the call stack
env.info <- (function() { list(wd = sys.frame(-1)$owd, fmt=sys.frame(-2)$img.fmt,
e=sys.frame(-2)) })()
postfix <- postfix
img.fmt <- gsub("%d", postfix, env.info$fmt, fixed=TRUE)
assign('img.fmt', img.fmt, envir=env.info$e)
file.copy(list.files(dirPath, full.names = TRUE), to=env.info$wd, overwrite = TRUE)
}, video.name='heatBalls.mp4', img.name='Rplot', interval = .05, use.dev=FALSE)
Full example
## Random function to save some images to disk
circ <- function(x,y,r) { s <- seq(-pi,pi,len=30); data.frame(x=x+r*cos(s), y=y+r*sin(s)) }
imgFun <- function(n, ncircs, dirPath) {
if (!require(scales)) stop("install scales package")
rads <- runif(ncircs, 0.5, 3)
xs <- runif(ncircs, 0.1+rads, 19.9-rads)
ys <- runif(ncircs, 0.1+rads, 19.9-rads)
vs <- matrix(runif(ncircs*2), 2)
cols <- colorRampPalette(c('lightblue','darkblue'), alpha=0.3)(ncircs)
png(file.path(dirPath, 'Rplot%03d.png'))
for (i in seq_len(n)) {
image(x=seq(0, 20, length=20), y=seq(0, 20, length=20),
z=matrix(rnorm(400),20), col=heat.colors(20, alpha=0.6), xlab='', ylab='')
for(j in 1:ncircs) polygon(x=circ(xs[j], ys[j], rads[j]), col=alpha(cols[j],0.7))
condx <- (xs + rads) > 20 | (xs - rads) < 0
condy <- (ys + rads) > 20 | (ys - rads) < 0
vs[1,condx] <- -vs[1,condx]
vs[2,condy] <- -vs[2,condy]
xs <- xs + vs[1,]
ys <- ys + vs[2,]
}
dev.off()
}
## Create some images on disk in a folder called "images"
dirPath <- normalizePath("images/")
dir.create(dirPath)
imgFun(50, 18, dirPath)
Then run the above code and a movie like the following should be made.