Related
I'm trying to produce a dotchart with a secondary axis on top. However once I plot the second dotchart (with a par(new=T)), I can't figure out how not to display the axis ticks over the previous ones in axis side=1. Here's my code with mock data:
y1_i <- c(2,8,2,14,2)
y2_i <- c(15,17,28,22,30)
y1_f <- c(4,9,11,16,7)
y2_f <- c(13,11,16,11,21)
y=c(y1_i,y2_i,y1_f,y2_f)
x <- c("AAEG","AALO","AGAM","ACHR","AALB")
y1=c(y1_i,y1_f)
y2=c(y2_i,y2_f)
dotchart(y1_i,labels=x,xlab="N50 length",xlim = c(0,max(y1)))
par(new=T)
dotchart(y2_i,labels=x,xlim = c(0,max(y2)))
axis(side=3)
Also, if possible, I would like to add a second data set which would be slightly pushed vertically above the first dataset (to not overlap it), but still corresponding to the same y-axis categories.
Thank you for any suggestion :)
Found it, by using dotchart2 from the Hmisc package
library(Hmisc)
y1_i <- c(2,8,2,14,2)
y2_i <- c(15,17,28,22,30)
y1_f <- c(4,9,11,16,7)
y2_f <- c(13,11,16,11,21)
y=c(y1_i,y2_i,y1_f,y2_f)
x <- c("AAEG","AALO","AGAM","ACHR","AALB")
y1=c(y1_i,y1_f)
y2=c(y2_i,y2_f)
y1_i <- c(2,8,2,14,2)
y2_i <- c(15,17,28,22,30)
y1_f <- c(4,9,11,16,7)
y2_f <- c(13,11,16,11,21)
y=c(y1_i,y2_i,y1_f,y2_f)
x <- c("AAEG","AALO","AGAM","ACHR","AALB")
y1=c(y1_i,y1_f)
y2=c(y2_i,y2_f)
dotchart2(y1_i,labels=x,xlab="N50 length",xlim = c(0,max(y1)))
par(new=T)
dotchart2(y2_i,labels=x,xlim = c(0,max(y2)),xlab="Scaffold number",lines=F,xaxis=F)
axis(side=3,xlab="Scaffold number")
I have a matrix called ht2. I use persp function to generate a 3D view.
ht2 <- matrix(1, 29, 36)
ht2[4:26,4:33] <- 0
ht2[6:10,6:31] <- 3
ht2[13:17,6:31] <- 3
ht2[20:24,6:31] <- 3
persp(ht2, expand=0.03, theta=25, phi=25, shade=0.75, col=terrain.colors(999,alpha=1))
This gives me:
As you can see, the color from green to yellow to brown changes along y-axis. However, I'd rather want to change it along z-axis.
I'm looking for any simple way to do that.
I found a possible solution in this site:
https://stat.ethz.ch/pipermail/r-help/2003-July/036151.html
levelpersp <- function(x, y, z, colors=topo.colors, ...) {
## getting the value of the midpoint
zz <- (z[-1,-1] + z[-1,-ncol(z)] + z[-nrow(z),-1] + z[-nrow(z),-ncol(z)])/4
## calculating the breaks
breaks <- hist(zz, plot=FALSE)$breaks
## cutting up zz
cols <- colors(length(breaks)-1)
zzz <- cut(zz, breaks=breaks, labels=cols)
## plotting
persp(x, y, z, col=as.character(zzz), ...)
## return breaks and colors for the legend
list(breaks=breaks, colors=cols)
}
## Example
x <- seq(-10, 10, length=60)
y <- x
f <- function(x,y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
z <- outer(x, y, f)
levelpersp(x, y, z, theta = 30, phi = 30, expand = 0.5)
Someone may suggest a way to implement this in original question.
In principle you just have to give col= a matrix with your colours you want to fill the squares with, as simple example:
col=terrain.colors(max(ht2)+1)[ht2[-1,-1]+1]
(this simple version works since ht2 contains integers, otherwise it wouldn't)
This creates all the colours needed: terrain.colours(max(ht2)+1)
and then selects them for each position based on one corner: [ht2[-1,-1]+1]
What Anuj Sharma's answer does is basically a nicer version of this, it assumes you have decimal numbers, so it bins them (breaks & cutting up) and instead of taking one corner it uses the height of the middle point (averaging of the four shifted matrices in getting the midpoint )
My problem is that I generate a time series from normal distribution and I plot my time series but I want to color in red the positive area between the time series and the axe X, the same for the negative area below the axe X and my time series.
This is the code I use but it does not work :
x1<-rnorm(250,0.4,0.9)
x <- as.matrix(x1)
t <- ts(x[,1], start=c(1,1), frequency=30)
plot(t,main="Daily closing price of Walterenergie",ylab="Adjusted close Returns",xlab="Times",col="blue")
plot(t,xlim=c(2,4),main="Daily closing price of Walterenergie",ylab="Adjusted close Returns",xlab="Times",col="blue")
abline(0,0)
z1<-seq(2,4,0.001)
cord.x <- c(2,z1,4)
cord.y <- c(0,t(z1),0)
polygon(cord.x,cord.y,col='red')
Edit: In response to OP's additional query.
library(ggplot2)
df <- data.frame(t=1:nrow(x),y=x)
df$fill <- ifelse(x>0,"Above","Below")
ggplot(df)+geom_line(aes(t,y),color="grey")+
geom_ribbon(aes(x=t,ymin=0,ymax=ifelse(y>0,y,0)),fill="red")+
geom_ribbon(aes(x=t,ymin=0,ymax=ifelse(y<0,y,0)),fill="blue")+
labs(title="Daily closing price of Walterenergie",
y="Adjusted close Returns",
x="Times")
Original response:
Is this what you had in mind?
library(ggplot2)
df <- data.frame(t=1:nrow(x),y=x)
ggplot(df)+geom_line(aes(t,y),color="grey")+
geom_ribbon(aes(x=t,ymin=0,ymax=y),fill="red")+
labs(title="Daily closing price of Walterenergie",
y="Adjusted close Returns",
x="Times")
This is some code I had written a while ago for someone. In this case two different colors are used for positive and negative. Although this is not exactly what you're after, I thought I'll share this.
# Set a seed to get a reproducible example
set.seed(12345)
num.points <- 100
# Create some data
x.vals <- 1:num.points
values <- rnorm(n=num.points, mean=0, sd=10)
# Plot the graph
plot(x.vals, values, t="o", pch=20, xlab="", ylab="", las=1)
abline(h=0, col="darkgray", lwd=2)
# We need to find the intersections of the curve with the x axis
# Those lie between positive and negative points
# When the sign changes the product between subsequent elements
# will be negative
crossings <- values[-length(values)] * values[-1]
crossings <- which(crossings < 0)
# You can draw the points to check (uncomment following line)
# points(x.vals[crossings], values[crossings], col="red", pch="X")
# We now find the exact intersections using a proportion
# See? Those high school geometry problems finally come in handy
intersections <- NULL
for (cr in crossings)
{
new.int <- cr + abs(values[cr])/(abs(values[cr])+abs(values[cr+1]))
intersections <- c(intersections, new.int)
}
# Again, let's check the intersections
# points(intersections, rep(0, length(intersections)), pch=20, col="red", cex=0.7)
last.intersection <- 0
for (i in intersections)
{
ids <- which(x.vals<=i & x.vals>last.intersection)
poly.x <- c(last.intersection, x.vals[ids], i)
poly.y <- c(0, values[ids], 0)
if (max(poly.y) > 0)
{
col="green"
}
else
{
col="red"
}
polygon(x=poly.x, y=poly.y, col=col)
last.intersection <- i
}
And here's the result!
Base plotting solution:
x1<-rnorm(250,0.4,0.9)
x <- as.matrix(x1)
# t <- ts(x[,1], start=c(1,1), frequency=30)
plot(x1,main="Daily closing price of Walterenergie",ylab="Adjusted close Returns",xlab="Times",col="blue", type="l")
polygon( c(0,1:250,251), c(0, x1, 0) , col="red")
Note this doesn't deal with the time-series plotting method which is rather difficult to understand because of differences in scaling by the frequency value and a starting x value of 1. The solution to that is below:
plot(t,main="Daily closing price of Walterenergie",
ylab="Adjusted close Returns",xlab="Times",col="blue", type="l")
polygon( c(1,1+(0:250)/30), c(0, t, 0) , col="red")
I need to use black and white color for my boxplots in R. I would like to colorfill the boxplot with lines and dots. For an example:
I imagine ggplot2 could do that but I can't find any way to do it.
Thank you in advance for your help!
I thought this was a great question and pondered if it was possible to do this in base R and to obtain the checkered look. So I put together some code that relies on boxplot.stats and polygon (which can draw angled lines). Here's the solution, which is really not ready for primetime, but is a solution that could be tinkered with to make more general.
boxpattern <-
function(y, xcenter, boxwidth, angle=NULL, angle.density=10, ...) {
# draw an individual box
bstats <- boxplot.stats(y)
bxmin <- bstats$stats[1]
bxq2 <- bstats$stats[2]
bxmedian <- bstats$stats[3]
bxq4 <- bstats$stats[4]
bxmax <- bstats$stats[5]
bleft <- xcenter-(boxwidth/2)
bright <- xcenter+(boxwidth/2)
# boxplot
polygon(c(bleft,bright,bright,bleft,bleft),
c(bxq2,bxq2,bxq4,bxq4,bxq2), angle=angle[1], density=angle.density)
polygon(c(bleft,bright,bright,bleft,bleft),
c(bxq2,bxq2,bxq4,bxq4,bxq2), angle=angle[2], density=angle.density)
# lines
segments(bleft,bxmedian,bright,bxmedian,lwd=3) # median
segments(bleft,bxmin,bright,bxmin,lwd=1) # min
segments(xcenter,bxmin,xcenter,bxq2,lwd=1)
segments(bleft,bxmax,bright,bxmax,lwd=1) # max
segments(xcenter,bxq4,xcenter,bxmax,lwd=1)
# outliers
if(length(bstats$out)>0){
for(i in 1:length(bstats$out))
points(xcenter,bstats$out[i])
}
}
drawboxplots <- function(y, x, boxwidth=1, angle=NULL, ...){
# figure out all the boxes and start the plot
groups <- split(y,as.factor(x))
len <- length(groups)
bxylim <- c((min(y)-0.04*abs(min(y))),(max(y)+0.04*max(y)))
xcenters <- seq(1,max(2,(len*(1.4))),length.out=len)
if(is.null(angle)){
angle <- seq(-90,75,length.out=len)
angle <- lapply(angle,function(x) c(x,x))
}
else if(!length(angle)==len)
stop("angle must be a vector or list of two-element vectors")
else if(!is.list(angle))
angle <- lapply(angle,function(x) c(x,x))
# draw plot area
plot(0, xlim=c(.97*(min(xcenters)-1), 1.04*(max(xcenters)+1)),
ylim=bxylim,
xlab="", xaxt="n",
ylab=names(y),
col="white", las=1)
axis(1, at=xcenters, labels=names(groups))
# draw boxplots
plots <- mapply(boxpattern, y=groups, xcenter=xcenters,
boxwidth=boxwidth, angle=angle, ...)
}
Some examples in action:
mydat <- data.frame(y=c(rnorm(200,1,4),rnorm(200,2,2)),
x=sort(rep(1:2,200)))
drawboxplots(mydat$y, mydat$x)
mydat <- data.frame(y=c(rnorm(200,1,4),rnorm(200,2,2),
rnorm(200,3,3),rnorm(400,-2,8)),
x=sort(rep(1:5,200)))
drawboxplots(mydat$y, mydat$x)
drawboxplots(mydat$y, mydat$x, boxwidth=.5, angle.density=30)
drawboxplots(mydat$y, mydat$x, # specify list of two-element angle parameters
angle=list(c(0,0),c(90,90),c(45,45),c(45,-45),c(0,90)))
EDIT: I wanted to add that one could also obtain dots as a fill by basically drawing a pattern of dots, then covering them a "donut"-shaped polygon, like so:
x <- rep(1:10,10)
y <- sort(x)
plot(y~x, xlim=c(0,11), ylim=c(0,11), pch=20)
outerbox.x <- c(2.5,0.5,10.5,10.5,0.5,0.5,2.5,7.5,7.5,2.5)
outerbox.y <- c(2.5,0.5,0.5,10.5,10.5,0.5,2.5,2.5,7.5,7.5)
polygon(outerbox.x,outerbox.y, col="white", border="white") # donut
polygon(c(2.5,2.5,7.5,7.5,2.5),c(2.5,2.5,2.5,7.5,7.5)) # inner box
But mixing that with angled lines in a single plotting function would be a bit difficult, and is generally a bit more challenging, but it starts to get you there.
I think it is hard to do this with ggplot2 since it dont use shading polygon(gris limitatipn). But you can use shading line feature in base plot, paramtered by density and angle arguments in some plot functions ( ploygon, barplot,..).
The problem that boxplot don't use this feature. So I hack it , or rather I hack bxp internally used by boxplot. The hack consist in adding 2 arguments (angle and density) to bxp function and add them internally in the call of xypolygon function ( This occurs in 2 lines).
my.bxp <- function (all.bxp.argument,angle,density, ...) {
.....#### bxp code
xypolygon(xx, yy, lty = boxlty[i], lwd = boxlwd[i],
border = boxcol[i],angle[i],density[i])
.......## bxp code after
xypolygon(xx, yy, lty = "blank", col = boxfill[i],angle[i],density[i])
......
}
Here an example. It should be noted that it is entirely the responsibility of the user to ensure
that the legend corresponds to the plot. So I add some code to rearrange the legend an the boxplot code.
require(stats)
set.seed(753)
(bx.p <- boxplot(split(rt(100, 4), gl(5, 20))))
layout(matrix(c(1,2),nrow=1),
width=c(4,1))
angles=c(60,30,40,50,60)
densities=c(50,30,40,50,30)
par(mar=c(5,4,4,0)) #Get rid of the margin on the right side
my.bxp(bx.p,angle=angles,density=densities)
par(mar=c(5,0,4,2)) #No margin on the left side
plot(c(0,1),type="n", axes=F, xlab="", ylab="")
legend("top", paste("region", 1:5),
angle=angles,density=densities)
I am looking to label data points with indices -- to identify the index number easily by visual examination.
So for instance,
x<-ts.plot(rnorm(10,0,1)) # would like to visually identify the data point indices easily through arrow labelling
Of course, if there's a better way of achieving this, please suggest
You can use arrows function:
set.seed(1); ts.plot(x <-rnorm(10,0,1), ylim=c(-1.6,1.6)) # some random data
arrows(x0=1:length(x), y0=0, y1=x, code=2, col=2, length=.1) # adding arrows
text(x=1:10, y=x+.1, 0, labels=round(x,2), cex=0.65) # adding text
abline(h=0) # adding a horizontal line at y=0
Use my.symbols from package TeachingDemos to get arrows pointing to the locations you want:
require(TeachingDemos)
d <- rnorm(10,0,1)
plot(d, type="l", ylim=c(min(d)-1, max(d)+1))
my.symbols(x=1:10, y=d, ms.arrows, angle=pi/2, add=T, symb.plots=TRUE, adj=1.5)
You can use text() for this
n <- 10
d <- rnorm(n)
plot(d, type="l", ylim=c(min(d)-1, max(d)+1))
text(1:n, d+par("cxy")[2]/2,col=2) # Upside
text(1:n, d-par("cxy")[2]/2,col=3) # Downside
Here a lattice version, to see the analogous of some base function.
set.seed(1234)
dat = data.frame(x=1:10, y = rnorm(10,0,1))
xyplot(y~x,data=dat, type =c('l','p'),
panel = function(x,y,...){
panel.fill(col=rgb(1,1,0,0.5))
panel.xyplot(x,y,...)
panel.arrows(x, y0=0,x1=x, y1=y, code=2, col=2, length=.1)
panel.text(x,y,label=round(y,2),adj=1.2,cex=1.5)
panel.abline(a=0)
})