I am trying to create a plot with dual y-axes using the xyplot and doubleYscale functions of latticeExtra. How do I change the axis label colors of the left and right y-axis as well as legend line colors to the same as the line colors in the plot? These now plot in blue and pink, but should be same as the lines in the plot below. Please see reproducible code example and plot below:
library(lattice)
library(latticeExtra)
# Create the data frame.
My_DataFrame <- data.frame(
emp_id = c (1:5),
salary = c(623.3,515.2,611.0,729.0,843.25),
weight = c(80,90,92,93,91),
start_date = as.Date(c("2012-01-01", "2013-09-23", "2014-05-11", "2014-11-15","2015-03-27")),
stringsAsFactors = FALSE
)
# Print the data frame.
print(My_DataFrame)
obj1 <- xyplot(salary ~ start_date, My_DataFrame, type = "l", lwd = 2, col = "#6F99ADFF", col.lab = "black", ylim = seq(0,1000,100), scales = list(x=list(cex=1.2), y=list(cex=1.2)), xlab = list("", fontsize = 22), ylab = list("Hello", fontsize = 18), ylab.right = list("There", fontsize = 18))
obj2 <- xyplot(weight ~ start_date, My_DataFrame, type = "l", lwd = 2, col = "#E18727FF")
doubleYScale(obj1, obj2, col = c("#6F99ADFF","#E18727FF"), text = c("salary", "weight"), add.ylab2 = FALSE)
Add
par.settings = list(superpose.line = list(col=c("#6F99ADFF", "#E18727FF"))),
in your code:
obj1 <- xyplot(salary ~ start_date, My_DataFrame, type = "l", lwd = 2,
col = "#6F99ADFF", col.lab = "black",
par.settings = list(superpose.line = list(col=c("#6F99ADFF", "#E18727FF"))),
ylim = seq(0,1000,100),
scales = list(x=list(cex=1.2),
y=list(cex=1.2)),
xlab = list("", fontsize = 22),
ylab = list("Hello", fontsize = 18, col="#6F99ADFF"), ylab.right = list("There", fontsize = 18, col="#E18727FF"))
obj2 <- xyplot(weight ~ start_date, My_DataFrame, type = "l", lwd = 2, col = "#E18727FF")
doubleYScale(obj1, obj2, col = c("#6F99ADFF","#E18727FF"), text = c("salary", "weight"), add.ylab2 = F)
I have found multiple ways to create a secondary y-axis in plot but I couldn't find a way to create a secondary y-axis in histogram.
Here is a sample code:
a <- sample(90:110, 50, replace=TRUE)
b <- runif(50, min=0, max=1)
hist(a)
lines(b)
b is too small to show in hist(a) so is there any way that I can see both in the histogram?
Technically a solution may be quite an identical to the approach proposed for the plots in this answer. The idea is to use overlapping of two plots as proposed by #r2evans.
It makes sense to use color coding:
# set color rules
col_a <- "red"
col_b <- "darkblue"
col_common <- "black"
Then let's draw the histogram and the plot:
# draw a histogram first
par(mar = c(5, 5, 5, 5) + 0.3)
hist(a, col = col_a, axes = FALSE, xlab = "", ylab = "", main = "")
# add both axes with the labels
axis(side = 1, xlim = seq(along.with = b), col = col_a, col.axis = col_a)
mtext(side = 1, text = "a_value", col = col_a, line = 2.5)
axis(side = 2, col = col_a, col.axis = col_a, ylab = "")
mtext(side = 2, text = "a_Frequency", col = col_a, line = 2.5)
# ... and add an overlaying plot
par(new=TRUE)
plot(b, ylim = c(0, 1), axes = FALSE, col = col_b, type = "l", xlab = "", ylab = "")
points(b, col = col_b, pch = 20, xlab = "", ylab = "")
axis(side = 3, xlim = seq(along.with = b), col = col_b, col.axis = col_b)
mtext(side = 3, text = "b_index", col = col_b, line = 2.5)
axis(side = 4, ylim = c(0, 1), col = col_b, col.axis = col_b)
mtext(side = 4, text = "b_value", col = col_b, line = 2.5)
box(col = col_common)
Any tips to remove the zero labels in between the histogram bars?
hist(links$Survey_Duration, breaks = seq(0,50,5), main = "Survey Duration",
labels = TRUE, border = "black",
xlab = "Survey", ylim = c(0, 15), col = "gray", las = 1, xaxt='n')
axis(side=1, at=seq(0,50,5), labels=seq(0,50,5))
abline(v = mean(links$Survey_Duration), col = "royalblue", lwd = 1.5)
abline(v = median(links$Survey_Duration), col = "red", lwd = 1.5)
legend(x = "topright", c("Mean", "Median"), col = c("royalblue","red"),
lwd = c(1.5,1.5))
How about this?
# modify data so there's zero in one of the bins
mtcars$mpg <- ifelse(mtcars$mpg >= 25 & mtcars$mpg <= 30, NA, mtcars$mpg)
# save plot parameters
h <- hist(mtcars$mpg, plot = FALSE)
# produce plot
plot(h, ylim = c(0, 14))
# add labels manually, recoding zeros to nothing
text(h$mids, h$counts + 1, ifelse(h$counts == 0, "", h$counts))
A slightly different answer using the labeling in hist instead of adding text afterwards.
You do not provide your data, so I will use some data that is handy to illustrate.
The labels argument can specify the individual labels
H1 = hist(iris$Sepal.Length, breaks = 3:8, plot=FALSE)
BarLabels = H1$counts
BarLabels[BarLabels == 0] = ""
hist(iris$Sepal.Length, breaks = 3:8, labels = BarLabels)
Thanks #Daniel Anderson, it Ok now (Thumbs Up)
links$Survey_Duration <- ifelse(links$Survey_Duration > 15 &
links$Survey_Duration <= 25,
NA,
links$Survey_Duration)
h <- hist(links$Survey_Duration, breaks = seq(0,50,5), plot = FALSE)
plot(h, ylim = c(0, 14), main = "Survey Duration", xlab = "Time", col = "gray", las = 1)
text(h$mids, h$counts + 1, ifelse(h$counts == 0, "", h$counts))
axis(side=1, at=seq(0,50,5), labels=seq(0,50,5))
abline(v = mean(links$Survey_Duration), col = "royalblue", lwd = 1.5)
abline(v = median(links$Survey_Duration), col = "red", lwd = 1.5)
legend(x = "topright",
c("Mean", "Median"),
col = c("royalblue","red"),
lwd = c(1.5,1.5))
Here is a simplified plot to work with:
env <- data.frame(site = c('BLK','DUC','WHP','BLK','DUC','WHP','BLK','DUC','WHP'),
sal = c(5,6,3,2,4,5,6,8,4),
date = c(2013,2013,2013,2015,2015,2015,2017,2017,2017))
sitelist <- c('BLK','DUC','WHP')
par(mar=c(3,5,3,6), xpd = T)
plot(sal~date, data = env, type = 'n', ylim = c(0,10), ylab = 'Salinity',
bty = 'n', xlab = '')
abline(v=2016, col = 'khaki', lwd = 20)
abline(mean(env$sal), 0, lty = 3)
for (ii in seq_along(sitelist)) {
i <- sitelist[ii]; lines(sal[site==i] ~ date[site==i], data = env,
col = c(4,2,5)[ii], lwd = 2,
lty = c(1,2,3)[ii]);
points(sal[site==i] ~ date[site==i], data = env,
pch = c(0,1,2)[ii], col = c(4,2,5)[ii])}
legend('topright', title = 'sites', inset=c(-0.2,0), lty = c(1,2,3),
col = c(4,2,5), lwd = 2, sitelist,
pch = c(0,1,2))
As written, this code yields a plot where the abline functions create lines that go outside of the boundaries of the plot, thanks to xpd=T. However, I don't want to set xpd=F, because I won't be able to plot my legend outside of the boundaries. The solution must either be a way to plot a legend outside of the boundaries with xpd=F or a way to plot lines that stop at the boundaries. Ideally, the solution would use the base program and be fairly standard, so I could drop it into each of my ~20 plots without too much customization.
I tried using segments but was not happy with the rounded edges of the segment, as my vertical line is supposed to be a sort of shaded area to indicate a certain time period.
You can either set xpd to FALSE in the par call and insert xpd = TRUE in the legend call like this:
env <- data.frame(site = c('BLK','DUC','WHP','BLK','DUC','WHP','BLK','DUC','WHP'),
sal = c(5,6,3,2,4,5,6,8,4),
date = c(2013,2013,2013,2015,2015,2015,2017,2017,2017))
sitelist <- c('BLK','DUC','WHP')
par(mar=c(3,5,3,6), xpd = F)
plot(sal~date, data = env, type = 'n', ylim = c(0,10), ylab = 'Salinity',
bty = 'n', xlab = '')
abline(v=2016, col = 'khaki', lwd = 20)
abline(mean(env$sal), 0, lty = 3)
for (ii in seq_along(sitelist)) {
i <- sitelist[ii]; lines(sal[site==i] ~ date[site==i], data = env,
col = c(4,2,5)[ii], lwd = 2,
lty = c(1,2,3)[ii]);
points(sal[site==i] ~ date[site==i], data = env,
pch = c(0,1,2)[ii], col = c(4,2,5)[ii])}
legend('topright', title = 'sites', inset=c(-0.2,0), lty = c(1,2,3),
col = c(4,2,5), lwd = 2, sitelist,
pch = c(0,1,2),
xpd = T)
Or keep xpd = TRUE in the par call and set xpd to FALSE in the abline calls like this:
env <- data.frame(site = c('BLK','DUC','WHP','BLK','DUC','WHP','BLK','DUC','WHP'),
sal = c(5,6,3,2,4,5,6,8,4),
date = c(2013,2013,2013,2015,2015,2015,2017,2017,2017))
sitelist <- c('BLK','DUC','WHP')
par(mar=c(3,5,3,6), xpd = T)
plot(sal~date, data = env, type = 'n', ylim = c(0,10), ylab = 'Salinity',
bty = 'n', xlab = '')
abline(v=2016, col = 'khaki', lwd = 20,xpd=F)
abline(mean(env$sal), 0, lty = 3,xpd=F)
for (ii in seq_along(sitelist)) {
i <- sitelist[ii]; lines(sal[site==i] ~ date[site==i], data = env,
col = c(4,2,5)[ii], lwd = 2,
lty = c(1,2,3)[ii]);
points(sal[site==i] ~ date[site==i], data = env,
pch = c(0,1,2)[ii], col = c(4,2,5)[ii])}
legend('topright', title = 'sites', inset=c(-0.2,0), lty = c(1,2,3),
col = c(4,2,5), lwd = 2, sitelist,
pch = c(0,1,2))
This should solve your issue.
Replace
abline(v=2016, col = 'khaki', lwd = 20)
abline(mean(env$sal), 0, lty = 3)
with
lines(c(2013, 2017), rep(mean(env$sal), 2), col="black", lwd = 2, lty = 2)
lines(rep(2016, 2), c(0, 10), col="khaki", lwd = 20)
Source: https://stackoverflow.com/a/24741885/5874001
par(mar=c(3,5,3,6), xpd = T)
plot(sal~date, data = env, type = 'n', ylim = c(0,10), ylab = 'Salinity', bty = 'n', xlab = '')
lines(c(2013, 2017), rep(mean(env$sal), 2), col="black", lwd = 2, lty = 2)
lines(rep(2016, 2), c(0, 10), col="khaki", lwd = 20)
for (ii in seq_along(sitelist)) {
i <- sitelist[ii]; lines(sal[site==i] ~ date[site==i],
data = env,
col = c(4,2,5)[ii],
lwd = 2,
lty = c(1,2,3)[ii]);
points(sal[site==i] ~ date[site==i], data = env,
pch = c(0,1,2)[ii], col = c(4,2,5)[ii])}
legend('topright', title = 'sites', inset=c(-0.2,0),
lty = c(1,2,3), col = c(4,2,5), lwd = 2,
sitelist, pch = c(0,1,2))
If you have 20+ plots, I'd look to see if you can write a loop to perform that task.
Hi can anyone see what is the problem with the code below?
output$zscore_chart <- renderPlot({
xvals <- 2:186
req(input$countrySelectZScore)
idx_country = which(input$countrySelectZScore == esiCountries)
max_comp_z <- max(esiData_DF[idx_country, 2:186], na.rm = TRUE)
overall_max_z <- max(max_comp_z, na.rm = TRUE)
foo = ts(esiData_DF[idx_country, 2:186], frequency = 12, start = 2001)
dates = seq(as.Date("2001-01-01"), by = "month", along = foo)
plot(x = 2:186, y = esiData_DF[idx_country, 2:186], type = "l",
xlab = "", ylab = "", col = "grey20", ylim = c(-2, overall_max_z),
lwd=3,las=2)
mtext("Quarterly percentage changes", side = 3, adj = 0, line = 0.1,
cex = 1, font = 0.5)
axis(1, at = xvals, label = dates, cex.axis = 1, las = 2)
mtext("Economic Sentiment Indicators", side = 3, adj = 0,
line = 1.2, cex = 2, font = 2)
legend(
"bottom",
lty = c(1,1),
lwd = c(3,3),
col = c("grey20", "green2"),
legend = c("Economic Sentiment Indicator", "GDP growth"),
bty = "n",
xjust = 0.5,
yjust = 0.5,
horiz = TRUE
)
}, height = 525)
esiData_DF is the DF used to index and plot the correct data. The dataframe has the country names down the left hand side with the dates, monthly across the top. I need the plot to render but it wont when I run the app. Any ideas?
The data continues to the right, up to May 2017 monthly.