R: Contour plot for each component of a fitted bivariate mixture - r

(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="")

Related

How to get the correct output when using batch forecasting for the monthly time series with the Mcomp package?

I'm trying to do batch forecasting for the monthly time series with the Mcomp package. I've prepared a code but I am not getting any output.
library(forecast)
library(Mcomp)
Using the seq function, as I need to select the particular time series which ends with 7.
tsset <- (seq(1507, 2797, 10))
tsset
horizon <- 18
fit1<-array(0,130)
for (tsi in 1:130){
y <- tsset[[tsi]]$x
yt <- head(y, length(y) - horizon)
yv <- tail(y, horizon)
for(i in 1:130){
fit1 <-c(ets(yt))
}
print(fit1)
}
Here is how you get the prediction for the last 18 points, given the first 112 points in the time series (you don't need loops):
tsset<- seq(1507, 2797, 10) + 10*runif(130) # add noise
horizon <- 18
y <- tsset
n <- length(y)
yt <- head(y, n - horizon)
#yv <- tail(y, horizon)
fit1 <- ets(yt)
yv1 <- forecast(fit1, h=horizon)
start <- n - horizon + 1
plot(start:n, yv, type='l', col='red', lty=1, xlab='t', ylab='y(t)')
lines(start:n, yv1$mean, col='blue', lty=2)
lines(start:n, yv1$upper[,2], col='green', lty=2)
lines(start:n, yv1$lower[,2], col='green', lty=2)
legend("topleft", legend=c("original", "forecast", "95% CI"),
col=c("red", "blue", "green"), lty=c(1,2,2), cex=0.8)

Calculating a tangent intersection with R

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.

Interpolation on a Curve in R

I have a dataset called dataframe (a 2d table) and a best fit curve as:
scatter.smooth(dataframe, xlab="", ylab="")
What code would I need to realize and evaluate (get numerical value of) a Y value on that best fit curve at a single x value?
Try
set.seed(1)
dataframe <- data.frame(x=runif(100), y=runif(100))
scatter.smooth(dataframe, xlab="", ylab="")
res <- with(dataframe, loess.smooth(x, y, evaluation = 200))
lengths(res)
# x y
# 200 200
x <- 0.5
y <- res$y[res$x>=x][1]
points(x, y, col="blue", pch = 19, cex=2)

Hacking the plot data.frame method in R to include histograms on the diagonals and lowess fits in the scatterplots

Dummy example:
N=1000
x1 = rgamma(N,5,10)
x2 = rnorm(N)+x1
x3 = (x1+x2)/(runif(N)+1)
d = data.frame(x1,x2,x3)
plot(d,col=rgb(1,0,0,.5),pch=19,cex=.5)
I'd like to take the plot data frame method and augment it to include histograms on the diagonals and lowess fits on each of the scatterplots. Is it possible to do without completely re-writing the function? Where do I even find the source code for methods?
When you plot data.frames like this, you are basically calling the pairs() function. See ?pairs for more information. There is an example if a histogram there. Here's an example that also plots a loess line
panel.hist <- function(x, ...)
{
usr <- par("usr"); on.exit(par(usr))
par(usr = c(usr[1:2], 0, 1.5) )
h <- hist(x, plot = FALSE)
breaks <- h$breaks; nB <- length(breaks)
y <- h$counts; y <- y/max(y)
rect(breaks[-nB], 0, breaks[-1], y, ...)
}
panel.loess<-function(x, y, ...) {
ll <- loess(y~x)
points(x,y, ...)
nx<-seq(min(x), max(x), length.out=100)
lines(nx, predict(ll, nx), col="black")
}
pairs(d,col=rgb(1,0,0,.5),pch=19,cex=.5,
diag.panel=panel.hist,
lower.panel=panel.loess)
which gives

How to make 3D line plot in R (waterfall plot)

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)

Resources