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.
Related
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]))
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 have written a function to calculate the BMI and have the code to create a corresponding graphical output. My goal is to include the graphical output into the function so that I get the plot by just using the function.
My current code:
BMI <- function(meter, kg){
BMI <- kg/(meter^2)
return(BMI)
}
BMI(1.8,70)
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
z <- outer(x, y, FUN = function(x, y) {BMI(x, y)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = 70, v=1.8, col="darkgrey")
points(1.8,70, col="red", cex=2, pch=16, bg="red")
By just modifying the meter & kg in the function I would like to get a diagram with the correct line and point positioning. I started with the code below - however it does not work, yet.
graphicalBMI <- function(meter, kg){
BMI <- kg/(meter^2)
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
z <- outer(x, y, FUN = function(x, y) {graphicalBMI(x, y)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = kg, v= meter, col="darkgrey")
points(meter, kg, col="red", cex=2, pch=16, bg="red")
return(graphicalBMI)
}
The problem of your second function is that it produces an infinite-recursion.
If you change it like this you'll get what you want:
graphicalBMI <- function(meter, kg, showPlot=TRUE){
BMI <- kg/(meter^2)
if(showPlot){
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
# here we call graphicalBMI by setting showPlot=F to avoid infinite recursion
z <- outer(x, y, FUN = function(x, y) {graphicalBMI(x, y, FALSE)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = kg, v= meter, col="darkgrey")
points(meter, kg, col="red", cex=2, pch=16, bg="red")
}
return(BMI)
}
# usage example:
graphicalBMI(1.8,70) # plot produced
graphicalBMI(1.8,70,FALSE) # no plot produced
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)) })