Related
I need this type of figure:
I need x on x axis, y on y axis and fx and fy in ploy area. Could you please help me in R i.e. both curves intersect to each other. My code is
gx <- expand.grid(x=seq(1,5,length=50))
fx <- function(x) { exp(-x) }
gx$fx <- apply(gx,1,fx)
plot(gx, type="l",col="red")
gy <- expand.grid(y=seq(1,5,length=50))
fy <- function(y) { y*exp(-y) }
gy$fy <- apply(gy, 1, fy)
par(new=TRUE)
plot(gy, type="l", col="green")
Not 100% sure I understand what this question means, but if you are looking to label your axes you can use the xlab and ylab graphical parameters:
ie:
plot(gx, type="l",col="red", xlab="label for x axis", ylab="label for y axis")
Here's the plot with base:
plot(gx, type="n", xlab="", ylab="")
for(i in 1:2) lines(get(c("gx", "gy")[i]), col=c("red", "green")[i])
title(xlab="x", ylab="y")
I personally prefer to do a little bit more data-manipulation to combine both data (gx and gy) into a single data.frame in long-form using "dplyr" and "tidyr" packages :
dat <- data.frame(gx, gy)
dat <- dat %>%
gather(xvar, x, x,y) %>%
gather(yvar, y, fx, fy)
head(dat)
# xvar x yvar y
# 1 x 1.000000 fx 0.3678794
# 2 x 1.081633 fx 0.3390415
# 3 x 1.163265 fx 0.3124642
# 4 x 1.244898 fx 0.2879703
# 5 x 1.326531 fx 0.2653964
# 6 x 1.408163 fx 0.2445921
This will make it easy to visualise with ggplot:
ggplot(dat, aes(x,y, col=yvar)) + geom_line()
Use of legend and lines functions along with plot would give the following figure.
plot(gx,type="l",col="red", xlab ="x", ylab="y")
lines(gy,col="green")
legend("topright", inset=.05, cex = 1, c("f(x)","f(y)"), horiz=TRUE, lty=c(1,1), lwd=c(2,2), col=c("red","green"), text.font=3)
It doesn't seem anyone so far has answered about putting f(x) and f(y) in the plot area. You can do this with text(), though it's not the most elegant solution because you have to manually give the coordinates of where to place the text.
The data you gave:
gx <- expand.grid(x=seq(1,5,length=50))
fx <- function(x) { exp(-x) }
gx$fx <- apply(gx,1,fx)
gy <- expand.grid(y=seq(1,5,length=50))
fy <- function(y) { y*exp(-y) }
gy$fy <- apply(gy, 1, fy)
Creating the plot:
plot(gx,type="l",col="red", xlab ="x", ylab="y")
lines(gy,col="green")
text(x=c(3,2),y=c(0.18,0.1), labels=c("f(y)","f(x)"))
Gives this:
I hope this helps! The part that is confusing about your question is when you say that you need the lines to intersect. That's an issue with your data and/or the functions you are applying, and not one we can answer without some clarity.
I have an R plot where I use the values as symbols. The points also have error bars:
The problem is, obviously, that the error bars (I use arrows for that) cross through the numbers and that just looks ugly and makes them hard to read.
This is my code, any ideas?
x = c(45.58333, 89.83333, 114.03333,138.65000,161.50000,185.15000,191.50000)
y_mean = c(3.350000,6.450000,7.200000,7.033333,8.400000,7.083333,6.750000)
y_sd = c(0.1802776,0.1732051,0.2500000,0.2020726,0.3500000,0.2020726,0.1000000)
values = data.frame(x, y_mean, y_sd)
plot(values$x, values$y_mean, type="n")
arrows(values$x, values$y_mean - values$y_sd,
values$x, values$y_mean + values$y_sd,
length=0.05, angle=90,
code=3, col="red")
lines(values$x, values$y_mean, type="b",
pch=" ",
col="red", bg="white")
text(values$x, values$y_mean, label=round(values$y_mean), col="red")
EDIT:
I executed the exact code shown above as asked:
I would play with the horizontal justification and add small points to keep track of the original position
points(values$x, values$y_mean, pch=19, col="red", cex=0.5)
text(values$x, values$y_mean, label=round(values$y_mean), col="red", adj = -0.2)
One idea is to white out the plot content where the text will be drawn, before drawing the text. This can be done with rect(). Although you risk whiting out the error bars entirely with this approach.
We can use strwidth() and strheight() to get the appropriate sizes for the whiteout rectangles.
x <- c(45.58333, 89.83333, 114.03333,138.65000,161.50000,185.15000,191.50000);
y_mean <- c(3.350000,6.450000,7.200000,7.033333,8.400000,7.083333,6.750000);
y_sd <- c(0.1802776,0.1732051,0.2500000,0.2020726,0.3500000,0.2020726,0.1000000);
xlim <- range(x);
ylim <- c(min(y_mean-y_sd),max(y_mean+y_sd));
plot(NA,xlim=xlim,ylim=ylim,xlab='x',ylab='y');
arrows(x,y_mean-y_sd,x,y_mean+y_sd,length=0.05,angle=90,code=3,col='red');
lines(x,y_mean,type='b',pch=' ',col='red',bg='white');
ls <- as.character(round(y_mean));
ex <- 0.4; ## whiteout expansion factor
lsw <- strwidth(ls); w <- lsw/2*(1+ex);
lsh <- strheight(ls); h <- lsh/2*(1+ex);
rect(x-w,y_mean-h,x+w,y_mean+h,col='white',border=NA);
text(x,y_mean,ls,col='red');
Just apply these changes:
plot(values$x, values$y_mean, type="n",
xlim = c(min(values$x), max(values$x) + 20),
ylim = c(min(values$y_mean)-1, max(values$y_mean)+1))
text(values$x, values$y_mean, label=round(values$y_mean), col="blue", pos = 3)
I would like to draw the external outer envelope (contour) of a distribution graph which includes multiple density graphs and extract its value.
X <- c(1,2,1,4,3,1,2,8,9,0,5,4,2,2,5,5,7,8,8,9,5,6,5,6,3,4,5,3,4,5,4)
Y <- c(0,3,1,1,3,2,7,1,2,1,9,2,1,3,6,1,9,5,2,9,1,1,2,1,3,4,6,9,4,5,2)
Z <- c(1,4,9,5,7,8,2,8,9,0,5,4,2,2,5,5,7,8,8,9,5,6,5,6,9,9,9,2,6,7,1)
W <- c(1,8,9,7,8,9,12,3,11,21,5,4,8,8,2,3,2,1,2,3,4,5,6,3,1,9,2,1,8,4,1)
Q <- c(1,8,9,7,8,9,12,3,16,30,2,3,4,4,4,3,7,7,2,3,2,5,9,3,2,1,1,1,1,1,0)
n <- data.frame(X,Y,Z,W,Q)
plot((density(X)))
fun <- function(x)lines((density(n[[x]])))
t <- seq(1:length(n))
lapply(t,fun)
Have searched on web and I could find the contour but it can not be applied to a distribution graph generated as above.
I suspect you are asking for what might be called the "outer envelope". My first effort had a couple of problems as you can see:
lines( x= density(X)$x,
y=apply( do.call( cbind,
lapply(n, function(x){ density(x)$y})), 1, max), col="red", lwd=3)
And I think that also highlights problems with your efforts as well, since it illustrates the problems with not establishing a common grid on which to hang your density estimates.
So establish limits and re-do:
from=min(X,Y,Z,W,Q); to = max(X,Y,Z,W,Q)
png()
plot( Xd <- density(X, from=from, to=to))
fun <- function(x) lines(density(n[[x]],from=from, to = to ) )
t <- seq(1:length(n))
lapply(t,fun)
lines( x= density(X, from=from, to=to )$x,
y=apply( do.call( cbind, lapply(n,
function(x){ density(x, from=from, to = to)$y})), 1, max), col="red", lwd=3)
dev.off()
Here's an answer very similar to BondedDust's (and based on his from/to approach) that I think is easier to read and possibly faster if the dataset is very large, because it doesn't calculate the densities twice.
from <- min(n)
to <- max(n)
t <- seq(1:length(n))
ds <- lapply(t, function(i) density(n[[i]], from=from, to=to)) #Densities
maxd <- apply(sapply(ds, "[[", "y"), 1, max) #Max y of each x
plot(density(X), type="n", ylim=c(0, max(maxd)), xlim=c(0, 15))
for (i in t) lines(ds[[i]])
lines(seq(from, to, length.out = length(maxd)), maxd, col="red", lwd=3)
I manually set the plot xlim for better visualization.
I need a nice plot for my thesis on the different distributions of different factors. Only the standard approach seemed with the package(ineq) was flexible enough.
However, it doesn't let me to put dots (see comment below) at the classes. It is important to see them, ideally to name them individually. Is this possible?
Distr1 <- c( A=137, B=499, C=311, D=173, E=219, F=81)
Distr2 <- c( G=123, H=400, I=250, J=16)
Distr3 <- c( K=145, L=600, M=120)
library(ineq)
Distr1 <- Lc(Distr1, n = rep(1,length(Distr1)), plot =F)
Distr2 <- Lc(Distr2, n = rep(1,length(Distr2)), plot =F)
Distr3 <- Lc(Distr3, n = rep(1,length(Distr3)), plot =F)
plot(Distr1,
col="black",
#type="b", # !is not working
lty=1,
lwd=3,
main="Lorenz Curve for My Distributions"
)
lines(Distr2, lty=2, lwd=3)
lines(Distr3, lty=3, lwd=3)
legend("topleft",
c("Distr1", "Distr2", "Distr3"),
lty=c(1,2,3),
lwd=3)
This is how it looks now
In case you really want to use ggplot, here is a simple solution
# Compute the Lorenz curve Lc{ineq}
library(ineq)
Distr1 <- c( A=100, B=900, C=230, D=160, E=190, F=40, G=5,H=30,J=60, K=500)
Distr1 <- Lc(Distr1, n = rep(1,length(Distr1)), plot =F)
# create data.frame from LC
p <- Distr1[1]
L <- Distr1[2]
Distr1_df <- data.frame(p,L)
# plot
ggplot(data=Distr1_df) +
geom_point(aes(x=p, y=L)) +
geom_line(aes(x=p, y=L), color="#990000") +
scale_x_continuous(name="Cumulative share of X", limits=c(0,1)) +
scale_y_continuous(name="Cumulative share of Y", limits=c(0,1)) +
geom_abline()
To show the problem, only Distr1 is needed; it' good to strip down before posting.
library(ineq)
Distr1 <- c( A=137, B=499, C=311, D=173, E=219, F=81)
Distr1 <- Lc(Distr1, n = rep(1,length(Distr1)), plot =F)
plot(Distr1$p,Distr1$L,
col="black",
type="b", # it should be "b"
lty=1,
lwd=3,
main="Lorenz Curve for My Distributions"
)
As there is a package (gglorenz) handling Lorenz Curves automatically for ggplot, I add this:
library(ggplot2)
library(gglorenz)
Distr1 <- c( A=137, B=499, C=311, D=173, E=219, F=81)
x <- data.frame(Distr1)
ggplot(x, aes(Distr1)) +
stat_lorenz() +
geom_abline(color = "grey")
I am trying to control how many z labels should be written in my contour plot plotted with contourplot() from the lattice library.
I have 30 contour lines but I only want the first 5 to be labelled. I tried a bunch of things like
contourplot(z ~ z+y, data=d3, cuts=30, font=3, xlab="x axis", ylab="y axis", scales=list(at=seq(2,10,by=2)))
contourplot(z ~ z+y, data=d3, cuts=30, font=3, xlab="x axis", ylab="y axis", at=seq(2,10,by=2))
but nothing works.
Also, is it possible to plot two contourplot() on the same graph? I tried
contourplot(z ~ z+y, data=d3, cuts=30)
par(new=T)
contourplot(z ~ z+y, data=d3, cuts=20)
but it's not working.
Thanks!
Here is my take:
library(lattice)
x <- rep(seq(-1.5,1.5,length=50),50)
y <- rep(seq(-1.5,1.5,length=50),rep(50,50))
z <- exp(-(x^2+y^2+x*y))
# here is default plot
lp1 <- contourplot(z~x*y)
# here is an enhanced one
my.panel <- function(at, labels, ...) {
# draw odd and even contour lines with or without labels
panel.contourplot(..., at=at[seq(1, length(at), 2)], col="blue", lty=2)
panel.contourplot(..., at=at[seq(2, length(at), 2)], col="red",
labels=as.character(at[seq(2, length(at), 2)]))
}
lp2 <- contourplot(z~x*y, panel=my.panel, at=seq(0.2, 0.8, by=0.2))
lp3 <- update(lp2, at=seq(0.2,0.8,by=0.1))
lp4 <- update(lp3, lwd=2, label.style="align")
library(gridExtra)
grid.arrange(lp1, lp2, lp3, lp4)
You can adapt the custom panel function to best suit your needs (e.g. other scale for leveling the z-axis, color, etc.).
You can specify the labels as a character vector argument and set the last values with rep("", 5), so perhaps for the example you offered on an earlier question about contour
x = seq(0, 10, by = 0.5)
y = seq(0, 10, by = 0.5)
z <- outer(x, y)
d3 <- expand.grid(x=x,y=y); d3$z <- as.vector(z)
contourplot(z~x+y, data=d3)
# labeled '5'-'90'
contourplot(z~x+y, data=d3,
at=seq(5,90, by=5),
labels=c(seq(5,25, by=5),rep("", 16) ),
main="Labels only at the first 5 contour lines")
# contourplot seems to ignore 'extra' labels
# c() will coerce the 'numeric' elements to 'character' if any others are 'character'
?contourplot # and follow the link in the info about labels to ?panel.levelplot