Polynomial regression (second order) plot in R - r

I am doing a polynomial regression in R for the following data but I cannot display the correct graph of the polynomial of 2rd degree. I got the equation of polynomial of degree 2 right, however I did something wrong in the last part of the script. Could anyone help? Thanks
Here is my script:
Vegetation_Cover <- c(5,0,10,40,100,30,80,2,70,2,0)
NDVI <- c(0.35,0.32,0.36,0.68,0.75,0.48,0.75,0.35,0.70,0.34,0.28)
plot(Vegetation_Cover,NDVI, main=list
("Vegetation Cover and NDVI",cex=1.5),pch=20,cex=1.4,col="gray0")
sample1 <- data.frame(Vegetation_Cover, NDVI)
sample1
fit2 <- lm(sample1$NDVI ~ sample1$Vegetation_Cover + I(sample1$Vegetation_Cover^2))
summary(fit2)
lm(formula = sample1$NDVI ~ sample1$Vegetation_Cover + I(sample1$Vegetation_Cover^2))
anova(fit2)
pol2 <- function(x) fit2$coefficient[3]*x^2 + fit2$coefficient[2]*x + fit2$coefficient[1]
plot(sample1$Vegetation_Cover, sample1$NDVI, type="p", lwd=3)
pol2 <- function(x) fit2$coefficient[3]*x^2 + fit2$coefficient[2]*x + fit2$coefficient[1]
curve(pol2, col="red", lwd=2)
points(sample1$Vegetation_Cover, sample1$NDVI, type="p", lwd=3)

It looks like you're just missing add=TRUE for your call to curve. This seems to plot what you're looking for:
pol2 <- function(x) fit2$coefficient[3]*x^2 + fit2$coefficient[2]*x + fit2$coefficient[1]
plot(sample1$Vegetation_Cover, sample1$NDVI, type="p", lwd=3)
curve(pol2, col="red", lwd=2, add=T)

Related

Plot residuals in R [duplicate]

Given two variables, x and y, I run a dynlm regression on the variables and would like to plot the fitted model against one of the variables and the residual on the bottom showing how the actual data line differs from the predicting line. I've seen it done before and I've done it before, but for the life of me I can't remember how to do it or find anything that explains it.
This gets me into the ballpark where I have a model and two variables, but I can't get the type of graph I want.
library(dynlm)
x <- rnorm(100)
y <- rnorm(100)
model <- dynlm(x ~ y)
plot(x, type="l", col="red")
lines(y, type="l", col="blue")
I want to generate a graph that looks like this where you see the model and the real data overlaying each other and the residual plotted as a separate graph on the bottom showing how the real data and the model deviate.
This should do the trick:
library(dynlm)
set.seed(771104)
x <- 5 + seq(1, 10, len=100) + rnorm(100)
y <- x + rnorm(100)
model <- dynlm(x ~ y)
par(oma=c(1,1,1,2))
plotModel(x, model) # works with models which accept 'predict' and 'residuals'
and this is the code for plotModel,
plotModel = function(x, model) {
ymodel1 = range(x, fitted(model), na.rm=TRUE)
ymodel2 = c(2*ymodel1[1]-ymodel1[2], ymodel1[2])
yres1 = range(residuals(model), na.rm=TRUE)
yres2 = c(yres1[1], 2*yres1[2]-yres1[1])
plot(x, type="l", col="red", lwd=2, ylim=ymodel2, axes=FALSE,
ylab="", xlab="")
axis(1)
mtext("residuals", 1, adj=0.5, line=2.5)
axis(2, at=pretty(ymodel1))
mtext("observed/modeled", 2, adj=0.75, line=2.5)
lines(fitted(model), col="green", lwd=2)
par(new=TRUE)
plot(residuals(model), col="blue", type="l", ylim=yres2, axes=FALSE,
ylab="", xlab="")
axis(4, at=pretty(yres1))
mtext("residuals", 4, adj=0.25, line=2.5)
abline(h=quantile(residuals(model), probs=c(0.1,0.9)), lty=2, col="gray")
abline(h=0)
box()
}
what you're looking for is resid(model). Try this:
library(dynlm)
x <- 10+rnorm(100)
y <- 10+rnorm(100)
model <- dynlm(x ~ y)
plot(x, type="l", col="red", ylim=c(min(c(x,y,resid(model))), max(c(x,y,resid(model)))))
lines(y, type="l", col="green")
lines(resid(model), type="l", col="blue")

Kernel density scatter plot in R

I saw a beautiful plot and I'd like to recreate it. Here's an example showing what I've got so far:
# kernel density scatterplot
library(RColorBrewer)
library(MASS)
greyscale <- rev(brewer.pal(4, "Greys"))
x <- rnorm(20000, mean=5, sd=4.5); x <- x[x>0]
y <- x + rnorm(length(x), mean=.2, sd=.4)
z <- kde2d(x, y, n=100)
plot(x, y, pch=".", col="hotpink")
contour(z, drawlabels=FALSE, nlevels=4, col=greyscale, add=T)
abline(c(0,1), lty=1, lwd=2)
abline(lm(y~x), lty=2, lwd=2)
I'm struggling to fill the contours with colour. Is this a job for smoothScatter or another package? I suspect it might be down to my use of kde2d and, if so, can someone please explain this function or link me to a good tutorial?
Many thanks!
P.S. the final image should be greyscale
Seems like you want a filled contour rather than jus a contour. Perhaps
library(RColorBrewer)
library(MASS)
greyscale <-brewer.pal(5, "Greys")
x <- rnorm(20000, mean=5, sd=4.5); x <- x[x>0]
y <- x + rnorm(length(x), mean=.2, sd=.4)
z <- kde2d(x, y, n=100)
filled.contour(z, nlevels=4, col=greyscale, plot.axes = {
axis(1); axis(2)
#points(x, y, pch=".", col="hotpink")
abline(c(0,1), lty=1, lwd=2)
abline(lm(y~x), lty=2, lwd=2)
})
which gives

How to plot a nice Lorenz Curve for factors in R (ggplot ?)

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

Plot margins for support vector machine

i just set up a SVM in R with e1071.
Unfortunately the plot of the margin and die hyperplane does not look as desired. I wanted the margin to pass through the support vectors. Shouldnt this be the case?
Can anybody spot my mistake?
Here is my code:
rm(list=ls(all=TRUE))
x1s <- c(.5,1,1,2,3,3.5, 1,3.5,4,5,5.5,6)
x2s <- c(3.5,1,2.5,2,1,1.2, 5.8,3,4,5,4,1)
ys <- c(rep(+1,6), rep(-1,6))
my.data <- data.frame(x1=x1s, x2=x2s, type=as.factor(ys))
my.data
library('e1071')
svm.model <- svm(type ~ ., data=my.data, type='C-classification', kernel='linear',scale=FALSE)
plot(my.data[,-3],col=(ys+3)/2, pch=19, xlim=c(-1,6), ylim=c(-1,6))
points(my.data[svm.model$index,c(1,2)],col="blue",cex=2)
w <- t(svm.model$coefs) %*% svm.model$SV
b <- -svm.model$rho
p <- svm.model$SV
abline(a=-b/w[1,2], b=-w[1,1]/w[1,2], col="black", lty=1)
abline(a=--b/p[1,2], b=-w[1,1]/w[1,2], col="orange", lty=3)
abline(a=--b/p[3,2], b=-w[1,1]/w[1,2], col="orange", lty=3)
Your last 2 commands should be
abline(a=(-b-1)/w[1,2], b=-w[1,1]/w[1,2], col="orange", lty=3)
abline(a=(-b+1)/w[1,2], b=-w[1,1]/w[1,2], col="orange", lty=3)
Another way
plot(my.data[,-3],col=(ys+3)/2, pch=19, xlim=c(-1,6), ylim=c(-1,6))
points(my.data[svm.model$index,c(1,2)],col="blue",cex=2)
x1min = min(x1s); x1max = max(x1s);
x2min = min(x2s); x2max = max(x2s);
coef1 = sum(svm.model$coefs*x1s[svm.model$index]);
coef2 = sum(svm.model$coefs*x2s[svm.model$index]);
lines(c(x1min,x1max), (svm.model$rho-coef1*c(x1min, x1max))/coef2)
lines(c(x1min,x1max), (svm.model$rho+1-coef1*c(x1min, x1max))/coef2, lty=2)
lines(c(x1min,x1max), (svm.model$rho-1-coef1*c(x1min, x1max))/coef2, lty=2)

How to plot a regression plane with an interaction in rgl

I want to plot the regression surface from a model with an interaction term using rgl's interactive plotting system. It is easy to plot a regression plane for a model without an interaction term using:
plot3d(x=x1, y=x2, z=y1, type="s", col="yellow", size=1)
planes3d(a=coef(mod1)[2], b=coef(mod1)[3], c=-1, d=coef(mod1)[1], alpha=.5)
However, when the plane twists, this seems to be more difficult. Following on this question: 3D equivalent of the curve function in r, I am trying:
f2 <- function(x, y) as.vector(coef(mod2)%*%c(1, x, y, x*y))
curve_3d <- function(f2, x_range=c(0, 40), y_range=c(0, 40)){
if (!require(rgl) ) {stop("load rgl")}
xvec <- seq(x_range[1], x_range[2], by=1)
yvec <- seq(y_range[1], y_range[2], by=1)
fz <- outer(xvec, yvec, FUN=f2)
persp3d(xvec, yvec, fz, alpha=.5)
}
open3d()
plot3d(x=x1, y=x2, z=y2, type="s", col="yellow", size=1)
curve_3d(f2)
But, it's not working. (I've tried some other things as well, but I'm keeping this short.) My main problem so far seems to be with f2; however, I will also want this to look like planes3d, and I'm not sure if this is going to give me a wireframe.
Here's an example:
set.seed(897)
x1 = rep(c(0, 10, 20, 30, 40), times=25)
x2 = rep(c(0, 10, 20, 30, 40), each=25)
y2 = 37 + 0.7*x1 + 1.2*x2 - 0.05*x1*x2 + rnorm(125, mean=0, sd=5)
mod2 = lm(y2~x1*x2)
open3d()
plot3d(x=x1, y=x2, z=y2, type="s", col="yellow", size=1)
curve_3d(f2)
grd <- expand.grid(x1=unique(x1), x2=unique(x2) )
grd$pred <-predict(mod2, newdata=grd)
persp3d(x=unique(grd[[1]]), y=unique(grd[[2]]),
z=matrix(grd[[3]],5,5), add=TRUE)

Resources