Add a line to coplot {graphics}, classic approaches don't work - r

I found coplot {graphics} very useful for my plots. However, I would like to include there not only one line, but add there one another. For basic graphic I just need to add = TRUE to add another line, or tu use plot(..) and lines(..). For {lattice} I can save my plots as objects
a<-xyplot(..)
b<-xyplot(..)
and display it simply by a + as.layer(b). No one of these approaches works for coplot(), apparently because creating objects as a<-coplot() doesn't produce trellis graphic but NULL object.
Please, any help how to add data line in coplot()? I really like its graphic so I wish to keep it. Thank you !!
my exemle data are here: http://ulozto.cz/xPfS1uRH/repr-exemple-csv
My code:
sub.tab<-read.csv("repr_exemple.csv", , header = T, sep = "")
attach(sub.tab)
cells.f<-factor(cells, levels=c(2, 25, 100, 250, 500), # unique(cells.in.cluster)???
labels=c("size2", "size25", "size100", "size250", "size500"))
perc.f<-factor(perc, levels=c(5, 10), # unique(cells.in.cluster)???
labels=c("perc5", "perc10"))
# how to put these plots together?
a<- coplot(max_dist ~ time |cells.f + perc.f, data = sub.tab,
xlab = "ticks", type = "l", col = "black", lwd = 1)
b<- coplot(mean_dist ~ time |cells.f * perc.f, data = sub.tab,
xlab = "ticks", type = "l", col = "grey", lwd = 1)
a + as.layer(b) # this doesn't work
Please, how to merge these two plots (grey and black lines)? I couldn't figure it out... Thank you !

Linking to sample data isn't really as helpful. Here's a randomly created sample data set
set.seed(15)
dd <- do.call("rbind",
do.call("Map", c(list(function(a,b) {
cbind.data.frame(a,b, x=1:5,
y1=cumsum(rpois(5,7)),
y2=cumsum(rpois(5,9)))
}),
expand.grid(a=letters[1:5], b=letters[20:22])))
)
head(dd)
# a b x y1 y2
# 1 a t 1 8 16
# 2 a t 2 13 28
# 3 a t 3 25 35
# 4 a t 4 33 45
# 5 a t 5 39 57
# 6 b t 1 4 12
I will note the coplot is a base graphics function, not Lattice. But it does have a panel= parameter. And you can have the coplot() take care of subsetting your data for you (well, calculating the indexes at least). But, like other base graphics functions, plotting different groups isn't exactly trivial. You can do it in this case with
coplot(y~x|a+b,
# make a fake y col to cover range of all y1 and y2 values
cbind(dd, y=seq(min(dd$y1, dd$y2), max(dd$y1, dd$y2), length.out=nrow(dd))),
#request subscripts to be sent to panel function
subscripts=TRUE,
panel=function(x,y,subscripts, ...) {
# draw group 1
lines(x, dd$y1[subscripts])
# draw group 2
lines(x, dd$y2[subscripts], col="red")
})
This gives

Related

Generate multiple plots in base R with loop function then concatenate by matching group variables

I have a data frame (below, my apologies for the verbose code, this is my first attempt at generating reproducible random data) that I'd like to loop through and generate individual plots in base R (specifically, ethograms) for each subject's day and video clip (e.g. subj-1/day1/clipB). After generating n graphs, I'd like to concatenate a PDF for each subj that includes all days + clips, and have each row correspond to a single day. I haven't been able to get past the generating individual graphs, however, so any help would be greatly appreciated!
Data frame
n <- 20000
library(stringi)
test <- as.data.frame(sprintf("%s", stri_rand_strings(n, 2, '[A-Z]')))
colnames(test)<-c("Subj")
test$Day <- sample(1:3, size=length(test$Subj), replace=TRUE)
test$Time <- sample(0:600, size=length(test$Subj), replace=TRUE)
test$Behavior <- as.factor(sample(c("peck", "eat", "drink", "fly", "sleep"), size = length(test$Time), replace=TRUE))
test$Vid_Clip <- sample(c("Clip_A", "Clip_B", "Clip_C"), size = length(test$Time), replace=TRUE)
Sample data from data frame:
> head(test)
Subj Day Time Behavior Vid_Clip
1 BX 1 257 drink Clip_B
2 NP 2 206 sleep Clip_B
3 ZF 1 278 peck Clip_B
4 MF 2 391 sleep Clip_A
5 VE 1 253 fly Clip_C
6 ID 2 359 eat Clip_C
After adapting this code, I am able to successfully generate a single plot (one at a time):
Subset single subj/day/clip:
single_subj_day_clip <- test[test$Vid_Clip == "Clip_B" & test$Subj == "AA" & test$Day == 1,]
After which, I can generate the graph I'm after by running the following lines:
beh_numb <- nlevels(single_subj_day_clip$Behavior)
mar.default <- c(5,4,4,2) + 0.1
par(mar = mar.default + c(0, 4, 0, 0))
plot(single_subj_day_clip$Time,
xlim=c(0,max(single_subj_day_clip$Time)), ylim=c(0, beh_numb), type="n",
ann=F, yaxt="n", frame.plot=F)
for (i in 1:length(single_subj_day_clip$Behavior)) {
ytop <- as.numeric(single_subj_day_clip$Behavior[i])
ybottom <- ytop - 0.5
rect(xleft=single_subj_day_clip$Subj[i], xright=single_subj_day_clip$Time[i+1],
ybottom=ybottom, ytop=ytop, col = ybottom)}
axis(side=2, at = (1:beh_numb -0.25), labels=levels(single_subj_day_clip$Behavior), las = 1)
mtext(text="Time (sec)", side=1, line=3, las=1)
Example graph from randomly generate data(sorry for link - newb SO user so until I'm at 10 reputation pts, I can't embed an image directly)
Example graph from actual data
Ideal per subject graph
Thank you all in advance for your input.
Cheers,
Dan
New and hopefully correct answer
The code is too long to post it here, so there is a link to the Dropbox folder with data and code. You can check this html document or run this .Rmd file on your machine. Please check if all required packages are installed. There is the output of the script.
There are additional problem in the analysis - some events are registered only once, at a single time point between other events. So there is no "width" of such bars. I assigned width of such events to 1000 ms, so some (around 100 per 20000 observations) of them are out of scale if they are at the beginning or at the end of the experiment (and if the width for such events is equal to zero). You can play with the code to fix this behavior.
Another problem is the different colors for the same factors on the different plots. I need some fresh air to fix it as well.
Looking into the graphs, you can notice that sometimes, it seems that some observation with a very short time are overlapping with other observations. But if you zoom the pdf to the maximum - you will see that they are not, and there is a 'holes' in underlying intervals, where they are supposed to be.
Lines, connecting the intervals for different kinds of behavior are helping to follow the timecourse of the experiment. You can uncomment corresponding parts of the code, if you wish.
Please let me know if it works.
Old answer
I am not sure it is the best way to do it, but probably you can use split() and after that lapply through your tables:
Split your data.frame by Subj, Day, and Vid_clip:
testl <- split(test, test[, c(1, 2, 5)], drop = T)
testl[[1123]]
# Subj Day Time Behavior Vid_Clip
#8220 ST 2 303 fly Clip_A
#9466 ST 2 463 fly Clip_A
#9604 ST 2 32 peck Clip_A
#10659 ST 2 136 peck Clip_A
#13126 ST 2 47 fly Clip_A
#14458 ST 2 544 peck Clip_A
Loop through the list with your data and plot to .pdf:
mar.default <- c(5,4,4,2) + 0.1
par(mar = mar.default + c(0, 4, 0, 0))
nbeh = nlevels(test$Behavior)
pdf("plots.pdf")
invisible(
lapply(testl, function(l){
plot(x = l$Time, xlim = c(0, max(l$Time)), ylim = c(0, nbeh),
type = "n", ann = F, yaxt = "n", frame.plot = F)
lapply(1:nbeh, function(i){
ytop <- as.numeric(l$Behavior[i]); ybot <- ytop - .5
rect(l$Subj[i], ybot, l$Time[i + 1], ytop, col = ybot)
})
axis(side = 2, at = 1:nbeh - .25, labels = levels(l$Behavior), las = 1)
mtext(text = "Time (sec)", side = 1, line = 3, las = 1)
})
)
dev.off()
You should probably check output here before you run code on your PC. I didn't edit much your plot-code, so please check it twice.

R blueprints / floorplan

I'm working on trying to represent an office building in R. Later, I'll need to represent multiple floors, but for now I need to start with one floor. There are clusters of cubes all in a regular structure. There are four small cubes for junior staff (4x4), and two larger cubes for a senior engineer and a manager (4x6). Once these are mapped out, I need to be able to show if they are occupied or free for new hires -- by color (like red for occupied, green for available). These are all laid out the same way, with the big ones on one end. For example,
+----+--+--+
| S |J1|J2|
+----+--+--+
<-hallway-->
+----+--+--+
| M |J3|J4|
+----+--+--+
I first thought I could use ggplot and just scatter plot everybody out, but I can't figure out how to capture the different size cubes with geom_point. I spent some time looking at maps, but it seems like I can't really take advantage of the regular structure of my floorplan -- maybe that really is the way to go and I take advantage of my regular structure in building out a map? Does R have a concept I should Google for this kind of structure?
In the end, I'll get a long data file, with the type of cubicle, the x and y coordinates of the cluster, and a "R" or "G" (4 columns).
You could also write a low-level graphic function; it's sometimes easier to tune than removing more and more components from a complex plot,
library(grid)
library(gridExtra)
floorGrob <- function(S = c(TRUE, FALSE), J = c(TRUE, FALSE, TRUE, TRUE),
draw=TRUE, newpage=is.null(vp), vp=NULL){
m <- rbind(c(1,3,4), # S1 J1 J2
c(7,7,7), # hall
c(2,5,6)) # S2 J3 J4
fills <- c(c("#FBB4AE","#CCEBC5")[c(S, J)+1], "grey90")
cellGrob <- function(f) rectGrob(gp=gpar(fill=f, col="white", lwd=2))
grobs <- mapply(cellGrob, f=fills, SIMPLIFY = FALSE)
g <- arrangeGrob(grobs = grobs, layout_matrix = m, vp = vp, as.table = FALSE,
heights = unit(c(4/14, 1/14, 4/14), "null"),
widths = unit(c(6/14, 4/14, 4/14), "null"), respect=TRUE)
if(draw) {
if(newpage) grid.newpage()
grid.draw(g)
}
invisible(g)
}
floorGrob()
How about?
df <- expand.grid(x = 0:5, y = 0:5)
df$color <- factor(sample(c("green", "red"), 36, replace = T))
head(df)
# x y color
# 1 0 0 green
# 2 1 0 green
# 3 2 0 green
# 4 3 0 red
# 5 4 0 green
# 6 5 0 red
library(ggplot2)
ggplot(df, aes(x, y, fill = color)) +
geom_tile() +
scale_fill_manual(name = "Is it open?",
values = c("lightgreen", "#FF3333"),
labels = c("open", "not open"))

Overlap plots in R - from zoo package

Using the following code:
library("ggplot2")
require(zoo)
args <- commandArgs(TRUE)
input <- read.csv(args[1], header=F, col.names=c("POS","ATT"))
id <- args[2]
prot_len <- nrow(input)
manual <- prot_len/100 # 4.3
att_name <- "Entropy"
att_zoo <- zoo(input$ATT)
att_avg <- rollapply(att_zoo, width = manual, by = manual, FUN = mean, align = "left")
autoplot(att_avg, col="att1") + labs(x = "Positions", y = att_name, title="")
With data:
> str(input)
'data.frame': 431 obs. of 2 variables:
$ POS: int 1 2 3 4 5 6 7 8 9 10 ...
$ ATT: num 0.652 0.733 0.815 1.079 0.885 ...
I do:
I would like to upload input2 which has different lenght (therefore, different x-axis) and overlap the 2 curves in the same plot (I mean overlap because I want the two curves in the same plot size, so I will "ignore" the overlapped axis labels and tittles), I would like to compare the shape, regardles the lenght of input.
First I've tried by generating toy input2 changing manual value, so that I have att_avg2 in which manual equals e.g. 7. In between original autoplot and new autoplot-2 I add par(new=TRUE), but this is not my expected output. Any hint on how doing this? Maybe it's better to save att_avg from zoo series to data.frame and not use autoplot? Thanks
UPDATE, response to G. Grothendieck:
If I do:
[...]
att_zoo <- zoo(input$ATT)
att_avg <- rollapply(att_zoo, width = manual, by = manual, FUN = mean, align = "left") #manual=4.3
att_avg2 <- rollapply(att_zoo, width = 7, by = 7, FUN = mean, align = "left")
autoplot(cbind(att_avg, att_avg2), facet=NULL) +
labs(x = "Positions", y = att_name, title="")
I get
and a warning message:
Removed 1 rows containing missing values (geom_path).
par is used with classic graphics, not for ggplot2. If you have two zoo series just cbind or merge the series together and autoplot them using facet=NULL:
library(zoo)
library(ggplot2)
z1 <- zoo(1:3) # length 3
z2 <- zoo(5:1) # length 5
autoplot(cbind(z1, z2), facet = NULL)
Note: The question omitted input2 so there could be some additional considerations from aspects not shown.

Print frequencies (as numbers) in plot

In R, I would like to insert frequencies (as numbers) in a plot:
my code to create the plot:
par(mar=c(4.5,4.5,9.5,4), xpd=TRUE)
plot(factor(ArtMehrspr)~Mehrspr_Vielf, data=datProjektMehr, col=terrain.colors(4),
bty='L', main="Vielfalt nutzen")
legend("topright", inset=c(0,-.225), title="Art der Mehrsprachigkeit", levels(factor(datProjektMehr$ArtMehrspr)),
fill=terrain.colors(4), horiz=TRUE)
par(mar=c(5,4,4,2)+0.1)
In the plot, 2 columns of my dataframe are depicted: ArtMehrspr and Mehrspr_Vielf.
Now what I would like to know is, how many "Kombi" are in category "1", how many "Paral" are in category "1" and so on, and then to print this number in the plot, so that in every box of the plot, I can see the corresponding number of observations. R must know these numbers, otherwise it could not vary the height of the different boxes according to the number of observations. So it cannot be that hard to get these numbers into the plot, can it?
With the command table(), I can get these numbers, but I would have to have 5 table()-commands to get all the numbers. Example for category = 1:
> table(subset(datProjektMehr, Mehrspr_Vielf=="1")$ArtMehrspr)
einspr Kombi Paral Versc Wechs
0 1 9 2 1
Apparently, you can achieve what I am looking for by adding the command labels = TRUE. But it does not work:
par(mar=c(4.5,4.5,9.5,4), xpd=TRUE, labels = TRUE)
plot(factor(ArtMehrspr)~Mehrspr_Vielf, data=datProjektMehr, col=terrain.colors(4),
bty='L', main="Vielfalt nutzen")
legend("topright", inset=c(0,-.225), title="Art der Mehrsprachigkeit", levels(factor(datProjektMehr$ArtMehrspr)),
fill=terrain.colors(4), horiz=TRUE)
par(mar=c(5,4,4,2)+0.1)
R gives me the following warning message:
Warning message:
In par(mar = c(4.5, 4.5, 9.5, 4), xpd = TRUE, labels = TRUE) :
"labels" is not a graphical parameter
Is this not the right command? Does anyone know how to do this?
First of all, the warning informs that there is not a labels argument you can use inside par.
Regarding the plotting of the table output, I'm not aware if there is an easy way of doing this, but I managed a pretty UNreliable and, maybe, inefficient code. In my machine, though, it works every time I run it.
The concept I had in mind is to text all values from your table inside the plot. To do so, coordinates in xx' and yy' had to be estimated. I prefer the term "estimated" instead of "calculated" because I didn't find a way to compute absolute values for the coordinates, due to the fact that the plot method was plot.factor.
So:
#random data. DF = datProjektMehr, artmehr = ArtMehrspr, mehrviel = Mehrspr_Vielf
DF <- data.frame(artmehr = sample(letters[1:4], 20, T), mehrviel = as.factor(sample(1:5, 20, T)))
#your code of plotting
par(mar = c(4.5,4.5,9.5,4), xpd = TRUE)
plot(factor(artmehr) ~ mehrviel, data = DF, col = terrain.colors(4),
bty = 'L', main = "Vielfalt nutzen")
legend("topright", inset=c(0,-.225), title="Art der Mehrsprachigkeit", levels(factor(DF$artmehr)),
fill=terrain.colors(4), horiz=TRUE)
#no need to "table()" many times
tab = table(DF$artmehr, DF$mehrviel)
#maximum value of x axis (at least in my machine)
#I found -through trial and error- that for a factor of n levels, x.max = 1 + (n-1)*0.02
x.max = 1 + (length(levels(DF$mehrviel)) - 1) * 0.02
#coordinates of "mehrviel" (as I named it)
mehrviel.coords = ((cumsum(apply(tab, 2, sum)) / sum(tab)) * x.max) - ((apply(tab, 2, sum) / sum(tab)) / 2)
#coordinates of "artmehr" (as I named it)
artmehr.coords <- apply(tab, 2, function(x) { cumsum(x / sum(x)) })
artmehr.coords <- apply(artmehr.coords, 2, function(x) { x - c(x[1]/2, diff(x)/2) })
#"text" the values in your table
#don't plot "0"s
for(i in 1:ncol(artmehr.coords))
{
text(x = mehrviel.coords[i], y = artmehr.coords[,i], labels = ifelse(tab[,i] != 0, tab[,i], ""), cex = 2)
}
The values of table:
tab
1 2 3 4 5
a 1 1 0 1 0
b 0 0 2 1 2
c 1 1 2 1 0
d 2 0 0 3 2
The plot:
EDIT: 1) "Tidied" the answer. 2) Aadded an extra level to the factor ploted in xx' axis to match your data exactly. 3)texted the frequencies in the middle of each box.

using R.zoo to plot multiple series with error bars

I have data that looks like this:
> head(data)
groupname ob_time dist.mean dist.sd dur.mean dur.sd ct.mean ct.sd
1 rowA 0.3 61.67500 39.76515 43.67500 26.35027 8.666667 11.29226
2 rowA 60.0 45.49167 38.30301 37.58333 27.98207 8.750000 12.46176
3 rowA 120.0 50.22500 35.89708 40.40000 24.93399 8.000000 10.23363
4 rowA 180.0 54.05000 41.43919 37.98333 28.03562 8.750000 11.97061
5 rowA 240.0 51.97500 41.75498 35.60000 25.68243 28.583333 46.14692
6 rowA 300.0 45.50833 43.10160 32.20833 27.37990 12.833333 14.21800
Each groupname is a data series. Since I want to plot each series separately, I've separated them like this:
> A <- zoo(data[which(groupname=='rowA'),3:8],data[which(groupname=='rowA'),2])
> B <- zoo(data[which(groupname=='rowB'),3:8],data[which(groupname=='rowB'),2])
> C <- zoo(data[which(groupname=='rowC'),3:8],data[which(groupname=='rowC'),2])
ETA:
Thanks to gd047: Now I'm using this:
z <- dlply(data,.(groupname),function(x) zoo(x[,3:8],x[,2]))
The resulting zoo objects look like this:
> head(z$rowA)
dist.mean dist.sd dur.mean dur.sd ct.mean ct.sd
0.3 61.67500 39.76515 43.67500 26.35027 8.666667 11.29226
60 45.49167 38.30301 37.58333 27.98207 8.750000 12.46176
120 50.22500 35.89708 40.40000 24.93399 8.000000 10.23363
180 54.05000 41.43919 37.98333 28.03562 8.750000 11.97061
240 51.97500 41.75498 35.60000 25.68243 28.583333 46.14692
300 45.50833 43.10160 32.20833 27.37990 12.833333 14.21800
So if I want to plot dist.mean against time and include error bars equal to +/- dist.sd for each series:
how do I combine A,B,C dist.mean and dist.sd?
how do I make a bar plot, or perhaps better, a line graph of the resulting object?
I don't see the point of breaking up the data into three pieces only to have to combine it together for a plot. Here is a plot using the ggplot2 library:
library(ggplot2)
qplot(ob_time, dist.mean, data=data, colour=groupname, geom=c("line","point")) +
geom_errorbar(aes(ymin=dist.mean-dist.sd, ymax=dist.mean+dist.sd))
This spaces the time values along the natural scale, you can use scale_x_continuous to define the tickmarks at the actual time values. Having them equally spaced is trickier: you can convert ob_time to a factor, but then qplot refuses to connect the points with a line.
Solution 1 - bar graph:
qplot(factor(ob_time), dist.mean, data=data, geom=c("bar"), fill=groupname,
colour=groupname, position="dodge") +
geom_errorbar(aes(ymin=dist.mean-dist.sd, ymax=dist.mean+dist.sd), position="dodge")
Solution 2 - add lines manually using the 1,2,... recoding of the factor:
qplot(factor(ob_time), dist.mean, data=data, geom=c("line","point"), colour=groupname) +
geom_errorbar(aes(ymin=dist.mean-dist.sd, ymax=dist.mean+dist.sd)) +
geom_line(aes(x=as.numeric(factor(ob_time))))
This is a hint of the way I would try to do it. I have ignored grouping, so you'll have to modify it to include more than one series. Also I haven't used zoo cause I don't know much.
g <- (nrow(data)-1)/(3*nrow(data))
plot(data[,"dist.mean"],col=2, type='o',lwd=2,cex=1.5, main="This is the title of the graph",
xlab="x-Label", ylab="y-Label", xaxt="n",
ylim=c(0,max(data[,"dist.mean"])+max(data[,"dist.sd"])),
xlim=c(1-g,nrow(data)+g))
axis(side=1,at=c(1:nrow(data)),labels=data[,"ob_time"])
for (i in 1:nrow(data)) {
lines(c(i,i),c(data[i,"dist.mean"]+data[i,"dist.sd"],data[i,"dist.mean"]-data[i,"dist.sd"]))
lines(c(i-g,i+g),c(data[i,"dist.mean"]+data[i,"dist.sd"], data[i,"dist.mean"]+data[i,"dist.sd"]))
lines(c(i-g,i+g),c(data[i,"dist.mean"]-data[i,"dist.sd"], data[i,"dist.mean"]-data[i,"dist.sd"]))
}
Read the data in using read.zoo with the split= argument to split it by groupname. Then bind together the dist, lower and upper lines. Finally plot them.
Lines <- "groupname ob_time dist.mean dist.sd dur.mean dur.sd ct.mean ct.sd
rowA 0.3 61.67500 39.76515 43.67500 26.35027 8.666667 11.29226
rowA 60.0 45.49167 38.30301 37.58333 27.98207 8.750000 12.46176
rowA 120.0 50.22500 35.89708 40.40000 24.93399 8.000000 10.23363
rowA 180.0 54.05000 41.43919 37.98333 28.03562 8.750000 11.97061
rowB 240.0 51.97500 41.75498 35.60000 25.68243 28.583333 46.14692
rowB 300.0 45.50833 43.10160 32.20833 27.37990 12.833333 14.21800"
library(zoo)
# next line is only needed until next version of zoo is released
source("http://r-forge.r-project.org/scm/viewvc.php/*checkout*/pkg/zoo/R/read.zoo.R?revision=719&root=zoo")
z <- read.zoo(textConnection(Lines), header = TRUE, split = 1, index = 2)
# pick out the dist and sd columns binding dist with lower & upper
z.dist <- z[, grep("dist.mean", colnames(z))]
z.sd <- z[, grep("dist.sd", colnames(z))]
zz <- cbind(z = z.dist, lower = z.dist - z.sd, upper = z.dist + z.sd)
# plot using N panels
N <- ncol(z.dist)
ylab <- sub("dist.mean.", "", colnames(z.dist))
plot(zz, screen = 1:N, type = "l", lty = rep(1:2, N*1:2), ylab = ylab)
I don't think you need to create zoo objects for this type of plot, I would do it directly from the data frame. Of course, there may be other reasons to use zoo objects, such a smart merging, aggregation, etc.
One option is the segplot function from latticeExtra
library(latticeExtra)
segplot(ob_time ~ (dist.mean + dist.sd) + (dist.mean - dist.sd) | groupname,
data = data, centers = dist.mean, horizontal = FALSE)
## and with the latest version of latticeExtra (from R-forge):
trellis.last.object(segments.fun = panel.arrows, ends = "both", angle = 90, length = .1) +
xyplot(dist.mean ~ ob_time | groupname, data, col = "black", type = "l")
Using Gabor's nicely-reproducible dataset this produces:

Resources