I am trying to made a kind of xyplot with a line from the bottom till the value. The problem is that I don't know how to adjust the color of the line.
time <- rnorm(50, 5, 2)
death.count <- rnorm(50, -0.25, 0.25)
Inoc.size <-rep(c("A", "B"), times=25)
data <- data.frame(time, death.count, Inoc.size)
xyplot(death.count ~ time, data,
groups=Inoc.size, ylim=c(0, -0.5),
xlab=list("Time - h", cex=1.5),
ylab=list(expression("Death cells - ln N"[i]), cex=1.5),
par.settings=list(
alpha=0.5,
superpose.symbol=list(pch=c(15, 16, 17, 18),
col=c(myColours[3], myColours[6], myColours[4], myColours[7]))),
auto.key=T,
panel=panel.superpose,
panel.groups=function(x, y, col, group.number, groups, ...) {
xj <- jitter(as.numeric(x), factor=0.5)
panel.xyplot(xj, y, ...)
panel.segments(x0=xj, x1=xj, y0=0, y1=y, groups, lwd=2)
}
)
I don't quite see how your plot matches with your code.
But this may work for you. Define col within panel.groups and reference that indexed by group.number in panel.segments.
library(lattice)
myColours=1:7
time<- rnorm(50,5,2)
death.count<- rnorm(50,-0.25,0.25)
Inoc.size<-rep(c("A","B"),times=25)
data<-data.frame( time,death.count, Inoc.size)
xyplot(death.count~time, data,
groups=Inoc.size,#ylim=c(0,-0.5),
xlab = list("Time - h", cex=1.5),
ylab = list(expression("Death cells - ln N"[i]), cex=1.5),
par.settings= list(
alpha = 0.5,superpose.symbol=list(
pch=c(15,16,17,18),
col=c(myColours[3],myColours[6],myColours[4],myColours[7])),
pch=c(15,16,17,18),
col=c(myColours[3],myColours[6],myColours[4],myColours[7])),
auto.key=T,
panel = panel.superpose,
panel.groups = function(x, y, col,group.number,groups, ...) {
xj=jitter(as.numeric(x), factor=0.5)
col=c(myColours[3],myColours[6],myColours[4],myColours[7])
panel.xyplot(xj,y,...)
panel.segments(x0=xj,x1=xj, y0=0, y1=y,col=col[group.number],groups,
lwd = 2)
}
)
I think you need col=c(myColours[3],myColours[6],myColours[4],myColours[7]) to the panel.segments.
panel.segments(x0=xj,x1=xj, y0=0, y1=y,groups,lwd = 2, col=c(myColours[3],myColours[6],myColours[4],myColours[7]))
Related
I'd like to plot multiple data sets on this graph but I can't figure out how.
I need to put t, u, v, w on the already functioning xyplot.
library(lattice)
x <- rnorm(250, 5, .5)
y <- rnorm(250, 5, .4)
t <- rnorm(200, 6, .7)
u <- rnorm(200, 6, .6)
v <- rnorm(150, 7, .9)
w <- rnorm(150, 7, .8)
xyplot(y ~ x, xlab="", ylab="",
par.settings = list(axis.line = list(col="transparent")),
panel = function(x, y,t,u,...) {
panel.xyplot(x, y, col=3, pch=16)
panel.rug(x, y, col=8, x.units = rep("snpc", 2), y.units = rep("snpc",
2), ...)})
If you're looking to make a scatter plot of points whose coordinates are defined by (x, y), (t, u), & (v, w), the following should work for you:
df <- data.frame(V1 = c(x, t, v),
V2 = c(y, u, w),
V3 = c(rep("xy", length(x)), rep("tu", length(t)), rep("vw", length(v))))
xyplot(V1 ~ V2, group = V3, data = df,
xlab="", ylab="",
par.settings = list(axis.line = list(col="transparent")),
panel = function(x, y, groups...) {
panel.xyplot(x, y,
col = c("red", "blue", "green"), # change this if you want other colours
pch=16)
panel.rug(x, y, col = 8, x.units = rep("snpc", 2), y.units = rep("snpc", 2))
})
If you're looking to plot them into the chart in some other way, please clarify in your question.
I would like to add text labels (e.g. a, b, c, d) to different panels in a lattice multi panel plot. I would like the text to appear at the same point (i.e. in the top left corner) in each plot, however I can't seem to do this when the scales are not constant.
library(lattice)
X <- rnorm(100)
Y <- rnorm(100)
n <- c(rep("control", 5), rep("low", 5), rep("medium", 5),
rep("high", 5), rep("v.high", 5))
Z <- c(rep("a", 25), rep("b", 25), rep("c", 25), rep("d", 25))
df1 <- data.frame(X, Y, n, Z)
MyText <- c("(c)", "(d)", "(a)", "(b)")
xyplot(X ~ Y|Z, data=df1,
groups=n,
panel=function(x, y,...){
panel.xyplot(x, y,...)
panel.text(-1, 1.5, labels=MyText[panel.number()])
},
ylab = expression(paste(delta, ""^"15", "N")),
xlab = expression(paste(delta, ""^"13", "C")),
scales=list(relation="free"),
strip = F,
auto.key=list(columns= 5, title="Treatments", cex.title=1))
If anybody has any advice on this your help would be much appreciated.
One way is with grid.text, referring to the desired location with npc coordinates, where the lower left corner is (0, 0), and the upper right is (1, 1).
library(grid)
xyplot(X~Y|Z, data=df1,
groups=n,
panel=function(x, y,...) {
panel.xyplot(x,y,...)
grid.text(MyText[panel.number()], unit(0.05, 'npc'), unit(0.95, 'npc'))
},
ylab = expression(paste(delta, ""^"15","N")),
xlab = expression(paste(delta, ""^"13","C")),
scales=list(relation="free"),
strip = F,
auto.key=list(columns= 5, title="Treatments", cex.title=1))
I'm trying to achieve a similar plot to this one, using R's native plot command.
I was able to get something similar with the code below, however, I'd like the density polygons to overlap. Can anyone suggest a way to do this?
data = lapply(1:5, function(x) density(rnorm(100, mean = x)))
par(mfrow=c(5,1))
for(i in 1:length(data)){
plot(data[[i]], xaxt='n', yaxt='n', main='', xlim=c(-2, 8), xlab='', ylab='', bty='n', lwd=1)
polygon(data[[i]], col=rgb(0,0,0,.4), border=NA)
abline(h=0, lwd=0.5)
}
Outputs:
I would do it something like the following. I plot the densities in the same plot but add an integer to the y values. To make them overlapping i multiply by a constant factor fac.
# Create your toy data
data <- lapply(1:5, function(x) density(rnorm(100, mean = x)))
fac <- 5 # A factor to make the densities overlap
# We make a empty plot
plot(1, type = "n", xlim = c(-3, 10), ylim = c(1, length(data) + 2),
axes = FALSE, xlab = "", ylab = "")
# Add each density, shifted by i and scaled by fac
for(i in 1:length(data)){
lines( data[[i]]$x, fac*data[[i]]$y + i)
polygon(data[[i]]$x, fac*data[[i]]$y + i, col = rgb(0, 0, 0, 0.4), border = NA)
abline(h = i, lwd = 0.5)
}
(Note: This content was previously edited into the Question and was written by #by0.)
Thanks to #AEBilgrau, I quickly put together this function which works really nicely. Note: you need to play around with the factor fac depending on your data.
stacked.density <- function(data, fac = 3, xlim, col = 'black',
alpha = 0.4, show.xaxis = T,
xlab = '', ylab = ''){
xvals = unlist(lapply(data, function(d) d$x))
if(missing(xlim)) xlim=c(min(xvals), max(xvals))
col = sapply(col, col2alpha, alpha)
if(length(col) == 1) col = rep(col, length(data))
plot(1, type = "n", xlim = xlim, ylim = c(1,length(data) + 2),
yaxt='n', bty='n', xaxt=ifelse(show.xaxis, 'l', 'n'), xlab = xlab, ylab = ylab)
z = length(data):1
for(i in 1:length(data)){
d = data[[ z[i] ]]
lines(d$x, fac*d$y + i, lwd=1)
polygon(d$x, fac*d$y+ i, col=col[i], border=NA)
abline(h = i, lwd=0.5)
}
}
data <- lapply(1:5, function(x) density(rnorm(100, mean = x)))
stacked.density(data, col=c('red', 'purple', 'blue', 'green', 'yellow'), alpha=0.3, show.xaxis=T)
outputs:
I have a scatterplot and wish to color the points by a z value assigned to each point. Then I want to get the legend on the right hand side of the plot to show what colors correspond to what z values using a nice smooth color spectrum.
Here are some x,y,z values you can use so that this is a reproducible example.
x = runif(50)
y = runif(50)
z = runif(50) #determines color of the (x,y) point
I suppose the best answer would be one that is generalized for any color function, but I do anticipate using rainbow()
Translated from this previous question:
library(ggplot2)
d = data.frame(x=runif(50),y=runif(50),z=runif(50))
ggplot(data = d, mapping = aes(x = x, y = y)) + geom_point(aes(colour = z), shape = 19)
If you don't want to use ggplot2 I modified a solution to this provided by someone else, I don't remember who.
scatter_fill <- function (x, y, z,xlim=c(min(x),max(x)),ylim=c(min(y),max(y)),zlim=c(min(z),max(z)),
nlevels = 20, plot.title, plot.axes,
key.title, key.axes, asp = NA, xaxs = "i",
yaxs = "i", las = 1,
axes = TRUE, frame.plot = axes, ...)
{
mar.orig <- (par.orig <- par(c("mar", "las", "mfrow")))$mar
on.exit(par(par.orig))
w <- (3 + mar.orig[2L]) * par("csi") * 2.54
layout(matrix(c(2, 1), ncol = 2L), widths = c(1, lcm(w)))
par(las = las)
mar <- mar.orig
mar[4L] <- mar[2L]
mar[2L] <- 1
par(mar = mar)
# choose colors to interpolate
levels <- seq(zlim[1],zlim[2],length.out = nlevels)
col <- colorRampPalette(c("red","yellow","dark green"))(nlevels)
colz <- col[cut(z,nlevels)]
#
plot.new()
plot.window(xlim = c(0, 1), ylim = range(levels), xaxs = "i", yaxs = "i")
rect(0, levels[-length(levels)], 1, levels[-1L],col=col,border=col)
if (missing(key.axes)) {if (axes){axis(4)}}
else key.axes
box()
if (!missing(key.title))
key.title
mar <- mar.orig
mar[4L] <- 1
par(mar = mar)
# points
plot(x,y,type = "n",xaxt='n',yaxt='n',xlab="",ylab="",xlim=xlim,ylim=ylim,bty="n")
points(x,y,col = colz,xaxt='n',yaxt='n',xlab="",ylab="",bty="n",...)
## options to make mapping more customizable
if (missing(plot.axes)) {
if (axes) {
title(main = "", xlab = "", ylab = "")
Axis(x, side = 1)
Axis(y, side = 2)
}
}
else plot.axes
if (frame.plot)
box()
if (missing(plot.title))
title(...)
else plot.title
invisible()
}
Just run the function first and it is ready to be used. It is quite handy.
# random vectors
vx <- rnorm(40,0,1)
vy <- rnorm(40,0,1)
vz <- rnorm(40,10,10)
scatter_fill(vx,vy,vz,nlevels=15,xlim=c(-1,1),ylim=c(-1,5),zlim=c(-10,10),main="TEST",pch=".",cex=8)
As you can notice, it inherits the usual plot function capabilities.
Another alternative using levelplot in package latticeExtra, with three different colour palettes.
library(latticeExtra)
levelplot(z ~ x + y, panel = panel.levelplot.points, col.regions = heat.colors(50))
levelplot(z ~ x + y, panel = panel.levelplot.points,
col.regions =colorRampPalette(brewer.pal(11,"RdYlGn"))(50))
levelplot(z ~ x + y, panel = panel.levelplot.points, col.regions = rainbow(50))
I came across this interesting website, with an idea of a way to visualize a clustering algorithm called "Clustergram":
(source: schonlau.net)
I am not sure how useful this really is, but in order to play with it I would like to reproduce it with R, but am not sure how to go about doing it.
How would you create a line for each item so it would stay consistent throughout the different number of clusters?
Here is an example code/data to play with for potential answer:
hc <- hclust(dist(USArrests), "ave")
plot(hc)
Update: I posted a solution with a lengthy example and discussion here. (it is based on the code I gave bellow). Also, Hadley was very kind and offered a ggplot2 implementation of the code.
Here is a basic solution (for a better one, look at the "update" above):
set.seed(100)
Data <- rbind(matrix(rnorm(100, sd = 0.3), ncol = 2),
matrix(rnorm(100, mean = 1, sd = 0.3), ncol = 2))
colnames(Data) <- c("x", "y")
# noise <- runif(100,0,.05)
line.width <- rep(.004, dim(Data)[1])
Y <- NULL
X <- NULL
k.range <- 2:10
plot(0, 0, col = "white", xlim = c(1,10), ylim = c(-.5,1.6),
xlab = "Number of clusters", ylab = "Clusters means",
main = "(Basic) Clustergram")
axis(side =1, at = k.range)
abline(v = k.range, col = "grey")
centers.points <- list()
for(k in k.range){
cl <- kmeans(Data, k)
clusters.vec <- cl$cluster
the.centers <- apply(cl$centers,1, mean)
noise <- unlist(tapply(line.width, clusters.vec,
cumsum))[order(seq_along(clusters.vec)[order(clusters.vec)])]
noise <- noise - mean(range(noise))
y <- the.centers[clusters.vec] + noise
Y <- cbind(Y, y)
x <- rep(k, length(y))
X <- cbind(X, x)
centers.points[[k]] <- data.frame(y = the.centers , x = rep(k , k))
# points(the.centers ~ rep(k , k), pch = 19, col = "red", cex = 1.5)
}
require(colorspace)
COL <- rainbow_hcl(100)
matlines(t(X), t(Y), pch = 19, col = COL, lty = 1, lwd = 1.5)
# add points
lapply(centers.points,
function(xx){ with(xx,points(y~x, pch = 19, col = "red", cex = 1.3)) })