I have a chart of financial activity and a couple running sums. Things are getting a little busy and I'm having trouble distinguishing fiscal (ends June 30th) vs calendar year. Is there a way to set the background to different colors based on date?
In other words could I set background to lite green where 2009-06-30 < date < 2010-07-01?
Apply a piece of both suggestions by #G-Grothendieck and #vincent - use rect within zoo package. zoo is excellent for any visualization of time series.
library(zoo)
#random data combined with time series that starts in 2009-01
v <- zooreg(rnorm(37), start = as.yearmon("2009-1"), freq=12)
plot(v, type = "n",xlab="",xaxt="n")
#this will catch some min and max values for y-axis points in rect
u <- par("usr")
#plot green rect - notice that x-coordinates are defined by date points
rect(as.yearmon("2009-6-30"), u[3], as.yearmon("2010-7-1"), u[4],
border = 0, col = "lightgreen")
lines(v)
axis(1, floor(time(v)))
#customized x-axis labels based on dates values
axis(1,at=c(2009.4, 2010.5),padj=-2,lty=0,labels=c("start","end"),cex.axis=0.8)
Check out xblocks.zoo in the zoo package. e.g., example(xblocks.zoo)
You can plot grey rectangles, with rect, before plotting the curves.
You will also need the dimensions of the plotting area: they are in par("usr").
library(quantmod)
getSymbols("A")
plot( index(A), coredata(Ad(A)), type="n" )
# This example uses calendar years: adapt as needed
dates <- c(
ISOdate( year(min(index(A))), 1, 1 ),
ISOdate( year(max(index(A))) + 1, 1, 1 )
)
dates <- as.Date(dates)
dates <- seq.Date(dates[1], dates[2], by="2 year")
rect(
dates,
par("usr")[3],
as.Date( ISOdate( year(dates) + 1, 1, 1 ) ),
par("usr")[4],
col="grey",
border=NA
)
lines(index(A), coredata(Ad(A)), lwd=3)
Related
I am plotting a very large time series (200.000 observations).
But I want to look at every day in detail and scroll through it day by day.
That is why I am exporting it as .pdf with width=500.
Here is the code ( x is a multivariate zoo time series)
pdf(file= "myPlot.pdf", width=500, height = 20 )
plot(x,plot.type = "multiple", nc = 1, col =c("green"),
ylim = list(c(0,25), c(0.05,1),c(4,10), c(700,1000),
c(100,500),c(0,2), c(0,3600)))
dev.off()
This works good so far. I can zoom into the pdf and then scroll through the series.
Problem is now, I have no accurate x-axis ticks / labels.
I would like to have at least daily labels. But I get one label per month.
I tried now the following:
pdf(file= "myPlot.pdf", width=500, height = 20 )
plot(x,plot.type = "multiple", nc = 1, col =c("green"), xaxt="n",
ylim = list(c(0,25), c(0.05,1),c(4,10), c(700,1000),
c(100,500),c(0,2), c(0,3600)))
axis(1,time(x))
dev.off()
But now no x axis appears in the pdf at all.
I would like to color X-axis intervals of a plot line with different colours between these points:
52660, 106784, 151429, 192098, 233666, 273857, 307933, 343048, 373099, 408960, 441545, 472813, 497822, 518561, 537471, 556747, 571683, 591232, 599519, 616567, 625727, 633745
The intervals represent SNP positions along 22 chromosomes.
The problem is that the intervals are unequal (e.g. 52660 - 106784, 106784 - 151429, ... 472813 - 497822, ...). Y-axis values represent ancestry frequencies. X-axis name is SNP_position
The closest I have found is using "ifelse", but for some reason it doesn't work well for me.
For instance, for the first interval (0 - 52660) I included the "col" variable for "plot" and I tried:
col = ifelse(SNP_position < 52660,'blue', 'green')
or
col=ifelse(SNP_position < 52660 & SNP_position > 106784,"blue","green")
but when I do this the whole line becomes green.
Here is the plot I want to colour
Any help would be highly appreciated.
Here's a proof of concept on how to do it with segments. First step is to create a vector of alternating segments. I'm using even and odds to do this. You will have to plug in the correct y-axis data in your code.
x <-1:700000
segments <-c(52660, 106784, 151429, 192098, 233666, 273857, 307933, 343048, 373099, 408960, 441545, 472813, 497822, 518561, 537471, 556747, 571683, 591232, 599519, 616567, 625727, 633745)
stOdds <- segments[1:length(segments) %% 2 == 1]
stEvens <- segments[1:length(segments) %% 2 == 0]
plot(x, type="l", col="green", lwd=2)
segments(stOdds,stOdds,stEvens,stEvens,col="blue", lwd=2)
UPDATE
With the additional info, here's how to do it with cut, and lines.
#create data
x <-1:700*1000
y <-runif(700)
z <-data.frame(x,y)
#cut in segments
my_segments <-c(52660, 106784, 151429, 192098, 233666, 273857, 307933, 343048, 373099, 408960, 441545, 472813, 497822, 518561, 537471, 556747, 571683, 591232, 599519, 616567, 625727, 633745)
my_cuts <-cut(x,my_segments, labels = FALSE)
my_cuts[is.na(my_cuts)] <-0
#create subset of of segments
z_alt <-z
z_alt[my_cuts %% 2 == 0,] <-NA
#plot green, then alternating segments in blue
plot(z, type="l", col="green", lwd=2)
lines(z_alt,col="blue", lwd=2)
please help: I want to shade a time-series figure in R's plot for all values where an indicator variable, z == 1.
Here follows a code which generates a similar scenario that I am looking at:
x <-runif(100, 5.0, 7.5)
y <-runif(100, 1, 10)
z = as.numeric(y >= 5)
date = seq(as.Date("1910/1/1"), as.Date("2009/1/1"), "years")
data = data.frame(cbind(x,y,z))
color <- rgb(190, 190, 190, alpha=80, maxColorValue=255)
plot(date,x, type='l')
rect(xleft=date[10], xright=date[40], ybottom=5, ytop=7.5, col = color,density=100)
From the code, I can only specify dates one by one. But suppose I want to shade all the areas where z==1? I.e. all the dates where z == 1. Any ideas how this could be done?
Manythanks, Nic
Just feed an entire vector of dates into the xleft and xright parameters, as indexed by z==1. Don't do line shading, it will run a long time, just change the color to grey. Afterwards, plot the time series again over the rectangles:
plot(date,x, type='l')
rect(xleft=date[z==1]-180,xright=date[z==1]+180,
ybottom=5, ytop=7.5, col="grey",border=NA)
lines(date,x)
I have 20 subjects and each subject has 2 durations with different (staggered) start time point and end time point. I would like to make a line chart in R which would look like the lift table in suruvival analysis with staggered entry. To be specific, say the Y-axis is the ID and X-axis is the duration, the plot would be ideally to show the 2 durations stacked for the same ID.
Any help would be greatly appreciated.
You can make a blank plot and draw the lines yourself. Here's my attempt at an example based on your description.
set.seed(500)
df <- data.frame(
id = 1:20,
time_start1 = sample(1:25, 20),
time_end1 = sample(51:75, 20),
time_start2 = sample(26:50, 20),
time_end2 = sample(76:100, 20)
)
plot(NULL, NULL, xlim=c(0,100), ylim=c(1,20),
xlab="Time", ylab="Identifier")
segments(
x0=df$time_start1,
y0=df$id,
x1=df$time_end1,
y1=df$id
)
segments(
x0=df$time_start2,
y0=df$id - 0.25,
x1=df$time_end2,
y1=df$id - 0.25,
lty=2
)
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")