R: Creating colorized barplot from segments() - r

I am plotting several hundreds of graphs in a loop using the segments() function. Here is some somple data which creates two graphs.
xy <- structure(list(NAME = structure(c(2L, 2L, 1L, 1L), .Label = c("CISCO", "JOHN"), class = "factor"), ID = c(41L, 41L, 57L, 57L), X_START_YEAR = c(1965L, 1932L, 1998L, 1956L), Y_START_VALUE = c(960L, -45L, 22L, -570L), X_END_YEAR = c(1968L, 1955L, 2002L, 1970L), Y_END_VALUE = c(960L, -45L, 22L, -570L), LC = structure(c(1L, 1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR","Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE", "LC"), class = "data.frame", row.names = c(NA,-4L))
ind <- split(xy,xy$ID)
# Plots
for (i in ind){
xx = unlist(i[,grep('X_',colnames(i))])
yy = unlist(i[,grep('Y_',colnames(i))])
fname <- paste0(i[1, 'ID'],'.png')
png(fname, width=1679, height=1165, res=150)
par(mar=c(6,8,6,5))
plot(xx,yy,type='n',main=unique(i[,1]), xlab="Time [Years]", ylab="Value [mm]",ylim = range(c(yy,-.5,.5)))
i <- i[,-1]
segments(i[,2],i[,3],i[,4],i[,5],lwd=2)
points(xx, yy, pch=21, bg='white', cex=0.8)
abline(h=0, col = "gray60")
dev.off()
}
What I am attempting to do is to change this to a barplot with colorized groups (e.g. every value above 0 is in blue and below 0 in red). I have added a visualisation of what I am trying to achieve from one of the resulting plots.
As I understand from the barplot() function I could use my segments() command (segments(i[,2],i[,3],i[,4],i[,5]) for the setting of width option of each barplot.
My question: Does anyone have an idea how I could change this in order to get the height command out of my data? I am looking for a solution in baseR.

You can use rect for this:
lapply(ind, function(x) {
plot(unlist(x[, c(3, 5)]), unlist(x[, c(4, 6)]), type='n',
xlab='Time [Years]', ylab='Value [mm]', main=x[1, 1])
apply(x, 1, function(y) {
rect(y[3], min(y[4], 0), y[5], max(y[4], 0),
col=if(as.numeric(y[4]) < 0) 'red' else 'blue')
abline(h=0)
})
})

Related

A plot with different colors and pch

I have this table:
structure(list(Samples = structure(1:7, .Label = c("Sample1",
"Sample2", "sample3", "sample4", "sample5", "sample6", "sample7"
), class = "factor"), number_cycle = c(22L, 22L, 26L, 26L, 26L,
22L, 22L), Quality = structure(c(2L, 2L, 3L, 1L, 1L, 1L, 3L), .Label = c("Bad",
"Good", "Middle"), class = "factor"), Concentration = c(14L,
24L, 22L, 40L, 10L, 27L, 12L), Raw_reads = c(100000L, 5000L,
70000L, 340000L, 4789L, 50000L, 25000L)), class = "data.frame", row.names = c(NA,
-7L))
I would like to do a scatter plot (raw_reads ~ concentration) which I can observe the dispersion of two factors: quality (colors) and number of cycles (pch). When I try this code, I have a plot without any point.
palette(rainbow(3))
plot(test$Raw_reads ~ test$Concentration,
col = test$Quality,
pch = test$number_cycle)
legend(x = "topleft",
legend = levels(test$Quality),
col = rainbow(3),
pch = test$number_cycle)
So what can I do to obtain my scatter plot?
Thank you for your help.
when you use base R plot, for colors and pch,
you need to specify a vector that is as long as your datapoints. For pch, you need to specify valid numbers 1:20 i think and for colours, either a factor, or characters. One way to get around is to call out a predefined pch or col vector:
palette(rainbow(3))
PCH = c(18,19)
names(PCH) = as.character(unique(test$number_cycle))
COL = palette(rainbow(3))
names(COL) = unique(test$Quality)
plot(test$Raw_reads,test$Concentration,
col = COL[test$Quality], pch = PCH[as.character(test$number_cycle)])
legend(x = "topleft", legend = names(COL), fill = COL)
legend(x = 80000,y=42, legend = names(PCH), col = "black",pch = PCH)
You also need two legends, one for color, one for pch.

R: crop multiple pngs and combine them into a single plot

I am plotting data into two plots like this:
xy <- structure(list(NAME = structure(c(2L, 2L, 1L, 1L), .Label = c("CISCO", "JOHN"), class = "factor"), ID = c(41L, 41L, 57L, 57L), X_START_YEAR = c(1965L, 1932L, 1998L, 1956L), Y_START_VALUE = c(960L, -45L, 22L, -570L), X_END_YEAR = c(1968L, 1955L, 2002L, 1970L), Y_END_VALUE = c(960L, -45L, 22L, -570L), LC = structure(c(1L, 1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR","Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE", "LC"), class = "data.frame", row.names = c(NA,-4L))
ind <- split(xy,xy$ID)
# Plots
for (i in ind){
xx = unlist(i[,grep('X_',colnames(i))])
yy = unlist(i[,grep('Y_',colnames(i))])
fname <- paste0(i[1, 'ID'],'.png')
png(fname, width=1679, height=1165, res=150)
par(mar=c(6,8,6,5))
plot(xx,yy,type='n', xlab=NA, ylab="Value [mm]",ylim = range(c(yy,-.5,.5)))
i <- i[,-1]
segments(i[,2],i[,3],i[,4],i[,5],lwd=2)
abline(h=0)
dev.off()
}
After that I am adding the resulting pngs into one png file like this.
library(grid)
library(png)
plots <- lapply(ll <- list.files(patt='.*[.]png'),function(x){
img <- as.raster(readPNG(x))
rasterGrob(img, interpolate = FALSE)
})
library(ggplot2)
library(gridExtra)
ggsave("Plots_Combined.png",width=8.5, height=11,
do.call(marrangeGrob, c(plots, list(nrow=2, ncol=1,top=NULL))))
My question: I was wondering if there is a way of cropping the sides of the single pngs after they are created in R? I know that you could change this in the plot loop by changing the mar parameters, but I was wondering if you could also do this outside after the pngs are created? I would be mainly interested in cropping the lower part of plot 1 (41.png) and the upper part of plot 2 (57.png) -> red area in the sample sketch below should be cropped. Is it possible to add a title or simple text to the resulting png (e.g. title)?
you can subset the image,
img <- readPNG(system.file("img", "Rlogo.png", package="png"))
grid.raster(img[10:50,20:90,])

R: plot several graphs below each other into one window (in a loop)

I am trying to create some plots in a loop in the following way: What I want to achieve is to plot the plots below each other into one single plot. For this I've read that I could use par(mfrow) but I am unsure where to put it in my loop. At the moment single graphs are created which are divided into two but only the upper part is plotted.
I know that I could do it the following way:
par(mfrow=2:1)
plot(...)
plot(...)
but with this solution I would have to call the plot command everytime for each plot. In the end I would like to have about 20 very narrow plots stacked on top of each other and I don't want to call them everytime. How could I do this independently?
Here is the code I've been using so far:
xy <- structure(list(NAME = structure(c(2L, 2L, 1L, 1L), .Label = c("CISCO", "JOHN"), class = "factor"), ID = c(41L, 41L, 57L, 57L), X_START_YEAR = c(1965L, 1932L, 1998L, 1956L), Y_START_VALUE = c(960L, -45L, 22L, -570L), X_END_YEAR = c(1968L, 1955L, 2002L, 1970L), Y_END_VALUE = c(960L, -45L, 22L, -570L), LC = structure(c(1L, 1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR","Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE", "LC"), class = "data.frame", row.names = c(NA,-4L))
ind <- split(xy,xy$ID)
# Plots
for (i in ind){
xx = unlist(i[,grep('X_',colnames(i))])
yy = unlist(i[,grep('Y_',colnames(i))])
fname <- paste0(i[1, 'ID'],'.png')
png(fname, width=1679, height=1165, res=150)
par(mar=c(6,8,6,5))
par(mfrow=2:1)
plot(xx,yy,type='n', xlab=NA, ylab="Value [mm]",ylim = range(c(yy,-.5,.5)))
i <- i[,-1]
segments(i[,2],i[,3],i[,4],i[,5],lwd=2)
abline(h=0)
dev.off()
}
EDIT: Up until now I tried to use an approach by adding the resulting pngs in one plot after they are being created as described here (R: crop multiple pngs and combine them into a single plot), but this approach is not that straightforward because of problems with cropping and output resolution...

R: (list) object cannot be coerced to type 'double' error in for loop

I am trying to convert some code with commands from the apply() family into a for loop but when executing the script I get an error when converting to as.numeric(): (list) object cannot be coerced to type 'double'.
The reason why I want to use a for loop is because of the implementation of a progress bar by using txtProgressBar which to my understanding cannot be used in an apply/lapply command. I've found the pbapply package but as I am calling multiple scripts with the source() command which all run with txtProgressBar as progress indicator, I'd like to use it for consistency reasons.
Here is the code I tried to convert into a for loop.
xy <- structure(list(NAME = structure(c(2L, 2L, 1L, 1L), .Label = c("CISCO", "JOHN"), class = "factor"), ID = c(41L, 41L, 57L, 57L), X_START_YEAR = c(1965L, 1932L, 1998L, 1956L), Y_START_VALUE = c(960L, -45L, 22L, -570L), X_END_YEAR = c(1968L, 1955L, 2002L, 1970L), Y_END_VALUE = c(960L, -45L, 22L, -570L), LC = structure(c(1L, 1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR","Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE", "LC"), class = "data.frame", row.names = c(NA,-4L))
ind <- split(xy,xy$ID)
# Progress bar
pb = txtProgressBar(min = 0, max = length(ind), initial = 0,title=Test, style=3)
progress <- 1
# Plots
for (i in ind){
xx = unlist(i[, c(3, 5)])
yy = unlist(i[, c(4, 6)])
fname <- paste0(i[1, 'ID'],'.png')
png(fname, width=1679, height=1165, res=150)
par(mar=c(6,8,6,5))
plot(xx,yy,type='n',main=unique(i[,1]), xlab="Time [Years]", ylab="Value [mm]",ylim = range(c(yy,-.5,.5)))
i <- i[,-1]
rect(i[3], min(i[4], 0), i[5], max(i[4], 0), col=if(as.numeric(i[4]) < 0) 'red' else 'blue')
abline(h=0, col = "gray60")
progress = progress + 1
setTxtProgressBar(pb,progress)
dev.off()
}
Here is the original code which works by using lapply and apply functions, however txtProgressBar couldn't be implemented.
xy <- structure(list(NAME = structure(c(2L, 2L, 1L, 1L), .Label = c("CISCO", "JOHN"), class = "factor"), ID = c(41L, 41L, 57L, 57L), X_START_YEAR = c(1965L, 1932L, 1998L, 1956L), Y_START_VALUE = c(960L, -45L, 22L, -570L), X_END_YEAR = c(1968L, 1955L, 2002L, 1970L), Y_END_VALUE = c(960L, -45L, 22L, -570L), LC = structure(c(1L, 1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR","Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE", "LC"), class = "data.frame", row.names = c(NA,-4L))
ind <- split(xy,xy$ID)
lapply(ind, function(x) {
plot(unlist(x[, c(3, 5)]), unlist(x[, c(4, 6)]), type='n',
xlab='Time [Years]', ylab='Value [mm]', main=x[1, 1])
apply(x, 1, function(y) {
rect(y[3], min(y[4], 0), y[5], max(y[4], 0),
col=if(as.numeric(y[4]) < 0) 'red' else 'blue')
abline(h=0)
})
})
My question: Does anyone see how to suppress the conversion error mentioned above and complete the for loop in order to include the progress bar with txtProgressBar()?
This at least runs and makes plots.
as.numeric in the code below is expecting a single element or a vector, but i[4] is a list, so you need to i[, 4] it
xy <- structure(list(NAME = structure(c(2L, 2L, 1L, 1L), .Label = c("CISCO", "JOHN"), class = "factor"), ID = c(41L, 41L, 57L, 57L), X_START_YEAR = c(1965L, 1932L, 1998L, 1956L), Y_START_VALUE = c(960L, -45L, 22L, -570L), X_END_YEAR = c(1968L, 1955L, 2002L, 1970L), Y_END_VALUE = c(960L, -45L, 22L, -570L), LC = structure(c(1L, 1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR","Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE", "LC"), class = "data.frame", row.names = c(NA,-4L))
ind <- split(xy,xy$ID)
# Progress bar
pb = txtProgressBar(min = 0, max = length(ind), initial = 0,title=Test, style=3)
progress <- 1
# Plots
## changed these next two lines
for (i in seq_along(ind)){
i <- ind[[i]]
xx = unlist(i[, c(3, 5)])
yy = unlist(i[, c(4, 6)])
fname <- paste0(i[1, 'ID'],'.png')
# png(fname, width=1679, height=1165, res=150)
par(mar=c(6,8,6,5))
plot(xx,yy,type='n',main=unique(i[,1]), xlab="Time [Years]", ylab="Value [mm]",ylim = range(c(yy,-.5,.5)))
# i <- i[,-1]
apply(i, 1, function(y)
rect(y[3], min(y[4], 0), y[5], max(y[4], 0),
col=if(as.numeric(y[4]) < 0) 'red' else 'blue'))
abline(h=0, col = "gray60")
progress = progress + 1
setTxtProgressBar(pb,progress)
# dev.off()
}
# |==========================================================================| 100%

R: Define ylim at abline y=0 in several plots, axis scaling

I am plotting several plots like in the code below (the sample code should generate three different graphs). What I am having problems with is the scaling of the y axis.
My question: How could I define my ylimit so that the abline at y=0 is always visible in my plots?
At the moment the yaxis is scaled automatically. I am looking for a solution in baseR.
xy <- structure(list(NAME = structure(c(2L, 3L, 1L, 1L), .Label = c("CISCO","JOHN", "STEPH"), class = "factor"), ID = c(41L, 49L, 87L, 87L), X_START_YEAR = c(1965L, 1948L, 1959L, 2003L), Y_START_VALUE = c(940L,-1760L, 110L, 866L), X_END_YEAR = c(2005L, 2000L, 2000L, 2007L), Y_END_VALUE = c(940L, -1760L, 110L, 866L), LC = structure(c(1L,1L, 2L, 2L), .Label = c("CA", "US"), class = "factor")), .Names = c("NAME", "ID", "X_START_YEAR", "Y_START_VALUE", "X_END_YEAR", "Y_END_VALUE","LC"), class = "data.frame", row.names = c(NA, -4L))
ind <- split(xy,xy$ID) # split by ID for different plots
# Plots
for (i in ind){
xx = unlist(i[,grep('X_',colnames(i))])
yy = unlist(i[,grep('Y_',colnames(i))])
fname <- paste0(i[1, 'ID'],'.png')
png(fname, width=1679, height=1165, res=150)
# Define ylim so that y=0 (abline) is always in plots
par(mar=c(6,8,6,5))
plot(xx,yy,type='n',main=unique(i[,1]), xlab="Time [Years]", ylab="Value [mm]")
abline(h=0, col = "gray60")
i <- i[,-1]
segments(i[,2],i[,3],i[,4],i[,5],lwd=2)
points(xx, yy, pch=21, bg='white', cex=0.8)
dev.off()
}
Just make sure to include some numbers above/below 0 and use range() to give max and min values above and below zero. How about including
ylim = range(c(yy,-.5,.5))
as a parameter to plot()

Resources