I am trying to add a tangent to my plot at the point x = 30 and I want to calculate the x-intersection of the tangent at y = 0.08.
I already found a very useful example, which I tried to use, but for some reason it is not working for y = 0.08.
I don't understand the meaning of deriv in the predict() function nor the actual difference in between pred0 and pred1. Can someone please explain?
x <- seq(0,40)
y <- dnorm(seq(0,40), mean=25, sd=5)
plot(x, y)
spl <- smooth.spline(y ~ x)
lines(spl, col="green")
newx <- 30
pred0 <- predict(spl, x=newx, deriv=0)
pred1 <- predict(spl, x=newx, deriv=1)
yint <- pred0$y - (pred1$y*newx)
xint <- -yint/pred1$y
xint
plot(x, y)
abline(h=0, col="red")
lines(spl, col="red")
points(pred0,col="red", pch=19)
lines(x, yint + pred1$y*x)
points(xint, 0, col="red", pch=19)
It seems like you have no problem calculating the tangent line and the intersect, but rather need some help in finding the x value for a given y value. This method will work for any smooth curve, but mark Gregors warning. There might not be a corresponding x value, or there might be several.
x <- seq(0, 40, by=0.01)
y <- dnorm(x, mean=25, sd=5)
spl <- smooth.spline(y ~ x)
plot(spl, type="l")
yval <- 0.08
ad <- abs(yval - spl$y)
if (min(ad) > max(diff(spl$y))*10) {
warning("The supplied y value is out of bounds")
}
xval <- x[which(diff(sign(diff(ad))) > 1) + 1]
points(xval, rep(yval, length(xval)))
With that xval you can calculate the tangent as you've already done.
Related
I have this simple code that plots two intersecting lines:
x <- c(1,2,3,4,5,6)
y2 <- c(6,5,4,3,2,1)
y1 <- c(1,2,3,4,5,6)
plot(x, y1)
plot(x, y1, type="o", col="blue", pch="o", lty=1)
points(x, y2, col="red", pch="*")
lines(x, y2, col="red", lty=1)
I then use the locator() function to manually find the position of the intersection of the two lines, using the coordinates of the intersection to plot a label at the intersection with the text() function, and draw a vertical line at the intersection position with the abline() function.
p <- locator()
text(p$x, p$y+0.4, labels="S")
abline(v=p$x, lty=3)
However, here I have run into a problem as I want thart the vertical line at the intersection position would stop at the intersection (instead of going along the entire y axis).
Can someone give me a hint on how to do this?
You can use segments to draw a line segment between two x, y points, so you can do:
p <- locator()
text(p$x, p$y + 0.4, labels = "S")
segments(p$x, 0, p$x, p$y, lty = 3)
Note also that if your lines are always straight like this you can find the intersection algrebaically, which is more accurate and reproducible than using locator():
dx <- tail(x, 1) - head(x, 1)
dy1 <- tail(y1, 1) - head(y1, 1)
dy2 <- tail(y2, 1) - head(y2, 1)
grad1 <- dy1/dx
grad2 <- dy2/dx
c1 <- y1[1] - grad1 * x[1]
c2 <- y2[1] - grad2 * x[1]
xi <- (c2 - c1)/(grad1 - grad2)
yi <- grad1 * xi + c1
segments(xi, 0, xi, yi, lty = 3)
text(xi, yi + 0.4, labels = "S")
I would like to plot the likelihood function of a size 1000 weibull sample with a sequence of shape parameter theta. I have used standardised weibull so the scale lambda is 1. However the output is a horizontal straight line.
n<-1000
lik <- function(theta, x){
K<- length(theta)
n<- length(x)
out<- rep(0,K)
for(k in 1:K){
out[k] <- prod(dweibull(x, shape= theta[k], scale=1))
}
return(out)
}
theta<-seq(0.01, 10, by = 0.01)
x <- rweibull(n, shape= 0.5, scale= 1)
plot(theta, lik(theta, x), type="l", lwd=2)
There is nothing really wrong about what you have done but computers struggle to calculate the product of many small numbers and so can end up as zero (even 0.99^1000 = 4^-5). And so it is easier to log transform and then sum. (As the log transform is a monotonic increasing function maximising the log-likelihood is the same as maximising the likelihood).Thus change
prod(dweibull(x, shape= theta[k], scale=1))
to
sum(dweibull(x, shape= theta[k], scale=1, log=TRUE))
The other minor change is to plot the likelihood witihin a reasonable range of theta so that
you can see the curve.
Working code:
set.seed(1)
n<-1000
lik <- function(theta, x){
K <- length(theta)
n <- length(x)
out <- rep(0,K)
for(k in 1:K){
out[k] <- sum(dweibull(x, shape= theta[k], scale=1, log=TRUE))
}
return(out)
}
popTheta = 0.5
theta = seq(0.01, 1.5, by = 0.01)
x = rweibull(n, shape=popTheta, scale= 1)
plot(theta, lik(theta, x), type="l", lwd=2)
abline(v=popTheta)
theta[which.max( lik(theta, x))]
(Please note: I'm using R for only two days now.)
I have a dataset data that looks like this:
plot(data, pch=20, xlim=c(-2,3), ylim=c(-1,2))
I'm using the mixsmsn package to fit a mixture of bivariate skew-normal distributions:
sn2 <- smsn.mmix(data, nu=3, g=2, get.init=TRUE, criteria=TRUE, group=TRUE, family="Skew.normal", error=1e-08, iter.max=10000)
I can plot it like this (why pch=20 doesn't work?):
mix.contour(data, sn2, pch=20, xlim=c(-2,3), ylim=c(-1,2), levels=c(0.1,0.25,0.5))
How can I achieve the following?
I'd want to draw a contour separately for each component at half its height. That is, say it's a mixture distribution of the form p f_1(x,y) + (1-p) f_2(x,y) (f_i being the pdf of the _i_th skew-normal component); I'd want to draw (on a scatter plot) a contour of the f_1 component at half its height, and a second contour related to f_2 at half its height; I'd like the result to look like this:
Using the fMultivar package, I came up with this:
X <- data
sn2 <- smsn.mmix(X, nu=3, g=2, get.init=TRUE, criteria=TRUE, group=TRUE, family="Skew.normal", error=1e-08, iter.max=10000)
mu1 <- sn2$mu[[1]]
sigma1 <- sn2$Sigma[[1]]
alpha1 <- c(sn2$shape[[1]][1], sn2$shape[[1]][2])
p1 <- sn2$pii[[1]]
mu2 <- sn2$mu[[2]]
sigma2 <- sn2$Sigma[[2]]
alpha2 <- c(sn2$shape[[2]][1], sn2$shape[[2]][2])
p2 <- sn2$pii[[2]]
N <- 101
x <- seq(min(X[, 1]), max(X[, 1]), l=N)
y <- seq(min(X[, 2]), max(X[, 2]), l=N)
u <- grid2d(x, y)$x
v <- grid2d(x, y)$y
XY <- cbind(u, v)
Z1 <- matrix(p1*dmsn(XY, mu1, sigma1, alpha1), ncol=N)
Z2 <- matrix(p2*dmsn(XY, mu2, sigma2, alpha2), ncol=N)
c1 <- 0.5*max(Z1)
c2 <- 0.5*max(Z2)
plot(X, pch=20, xlim=c(-2,3), ylim=c(-1,2))
contour(x, y, Z1, add=TRUE, col="red", lwd=3, levels=c(c1), labels="")
contour(x, y, Z2, add=TRUE, col="green", lwd=3, levels=c(c2), labels="")
I am trying to plot the plane determined by the equation y = x between 0 and 2 superimposed on a 3D surface described by z = 1/2 * x * y.
I "hacked" code from another question to get a minimally satisfactory representation of the surface (wouldn't mind a fresh start on that), but I have no idea how to superimposed the 2D plane.
Here is the idea:
And this is what I got so far:
with the borrow code:
my_surface <- function(f, n=10, ...) {
ranges <- rgl:::.getRanges()
x <- seq(ranges$xlim[1], ranges$xlim[2], length=n)
y <- seq(ranges$ylim[1], ranges$ylim[2], length=n)
z <- outer(x,y,f)
surface3d(x, y, z, ...)
}
library(rgl)
f <- function(x, y) 1/2 * x * y
g <- function(x, y) x = y
x <- seq(0, 2, by=0.001)
y <- seq(0,2, by=0.001)
z <- 1/2 * x * y
plot3d(x, y, z, xlab="X", ylab="y", zlab="z", site=5, type = "n")
my_surface(f, alpha=.5, col="red")
my_second_surface <- function(f, n=10, ...) {
ranges <- rgl:::.getRanges()
x <- seq(ranges$xlim[1], ranges$xlim[2], length=n)
y <- seq(ranges$ylim[1], ranges$ylim[2], length=n)
z <- outer(x,y,g)
surface3d(x, y, z, ...)
}
my_second_surface(g, alpha=.5, col="blue")
Notice that the main problem (or difference with the sketch on the first graph) is that I can't make the greenish triangle appear. Instead, I get an oblique plane in blue.
I would like to create a waterfall plot in R (XYYY) from my data.
So far, I use this code:
load("myData.RData")
ls()
dim(data)
##matrix to xyz coords
library(reshape2)
newData <- melt(data, id="Group.1")
dim(newData)
head(newData)
tail(newData)
newDataO <- newData[c(2,1,3)]
head(newDataO)
##color scale for z axis
myColorRamp <- function(colors, values) {
v <- (values - min(values))/diff(range(values))
x <- colorRamp(colors)(v)
rgb(x[,1], x[,2], x[,3], maxColorValue = 255)
}
cols <- myColorRamp(c("darkblue","yellow","darkorange","red","darkred"),newDataO$value)
##3D scatter
library(rgl)
plot3d(newDataO$variable, newDataO$Group.1, newDataO$value, xlab="", ylab="", zlab="", type="p", col=cols, box=FALSE, axes=FALSE)
rgl.postscript("persptrial_060514.eps","eps")
to get this plot:
https://dl.dropboxusercontent.com/u/14906265/persptrial_060514.jpg
I have also use this option in 2d with polygon but the result does not properly show the differential effect between both plots (left vs right).
I do not know whether something like persp3d could do the job but I am not familiar enough with writing code to achieve it. Any help will be very much appreciated.
It seems to me that the simplest way of doing a waterfall plot in R is to add all the lines manually in a loop.
library(rgl)
# Function to plot
f <- function(x, y) sin(10 * x * y) * cos(4 * y^3) + x
nx <- 30
ny <- 100
x <- seq(0, 1, length = nx)
y <- seq(0, 1, length = ny)
z <- outer(x, y, FUN = f)
# Plot function and add lines manually
surface3d(x, y, z, alpha = 0.4)
axes3d()
for (i in 1:nx) lines3d(x[i], y, z[i, ], col = 'white', lwd = 2)