Issue with when plotting `density` objects

Question

I have an issue when trying to plot density objects. Consider for example

require(grDevices)

set.seed(43)
d0 = density(rexp(1e5,rate=1))
d1 = density(rexp(1e5,rate=1.8))


plot(d1, col="white", xlab = "x", ylab="Density", main = "")
polygon(d1, col=adjustcolor("blue", alpha.f=0.2))
lines(d0, col="white")
polygon(d0, col=adjustcolor("red", alpha.f=0.2))

For the moment, it looks as I expected. The problem arises when zooming on low values of the Y-axis. Consider for example

plot(d1, col="white", xlim=c(2.5,3), xlab = "x", ylab="Density", main = "", 
ylim=c(0,0.02))
polygon(d1, col=adjustcolor("blue", alpha.f=0.2))
lines(d0, col="white", xlim=c(2.5,3), ylim=c(0,0.02))
polygon(d0, col=adjustcolor("red", alpha.f=0.2))

Strangely, the lower part of the polygons do not reach Density = 0. Also, one polygon ends lower than the other one. The problem persists when setting yaxs="i" and xaxs="i".

What is going on and how to solve this issue?

---

With some personal data, I get things like

Answer 1

Another option is to extend the x-range of the density estimate a bit beyond the range of the data so that the density estimate really will be effectively zero at both ends. This avoids the need to artificially change any values in the density estimate. For example:

set.seed(43)
d0 = density(rexp(1e5,rate=1))
d1 = density(rexp(1e5,rate=1.8))

d1$y[c(1, length(d1$y))]

[1] 2.987316e-03 1.235864e-06

set.seed(43)
d1 = rexp(1e5,rate=1.8)
d1 = density(d1, from=min(d1) - 0.05*diff(range(d1)), to=max(d1) + 0.05*diff(range(d1)))

d1$y[c(1, length(d1$y))]

[1] 6.334144e-17 3.797333e-17

Answer 2

Can you cheat by just anchoring the y values to zero at both ends?

set.seed(43)
d0 = density(rexp(150,rate=1))
d1 = density(rexp(150,rate=1.8))

d0$y[c(1, length(d0$y))] <- 0
d1$y[c(1, length(d1$y))] <- 0

plot(d1, col="white", xlim=c(2.5,3), xlab = "x", ylab="Density", main = "", 
ylim=c(0,0.02))
polygon(d1, col=adjustcolor("blue", alpha.f=0.2))
lines(d0, col="white", xlim=c(2.5,3), ylim=c(0,0.02))
polygon(d0, col=adjustcolor("red", alpha.f=0.2))

A slight improvement would be to lower the whole polygon so that one of the ends touches the base line, and then set the next one to zero:

set.seed(43)
d0 = density(rexp(150,rate=1))
d1 = density(rexp(150,rate=1.8))

ends0 <- d0$y[c(1, length(d0$y))]
ends1 <- d1$y[c(1, length(d1$y))]

d0$y <- d0$y - min(ends0)
d1$y <- d1$y - min(ends1)

d0$y[c(1, length(d0$y))] <- 0
d1$y[c(1, length(d1$y))] <- 0


plot(d1, col="white", xlim=c(2.5,3), xlab = "x", ylab="Density", main = "", 
ylim=c(0,0.02))
polygon(d1, col=adjustcolor("blue", alpha.f=0.2))
lines(d0, col="white", xlim=c(2.5,3), ylim=c(0,0.02))
polygon(d0, col=adjustcolor("red", alpha.f=0.2))

Here's one without correction, for comparison.