I have a data set like the following one:
data<-data.frame(x=c(50,100,250,400),y1=c(0.74,0.75,0.82,0.79),y2=c(0.81,0.83,0.87,0.88))
I generate the plot like this:
plot(data$x,data$y1,type='l',col="red",xaxs='i',yaxs='i',ylim=c(0.4,1),xlim=c(50,500))
lines(data$x, data$y2, type='l',col="blue")
The generated figure is:
How could I make the following modifications on this plot?
1) The current X axis starts with 50. But it does not mark 50 explicitly.
2) The current X axis is marked as 100, 200, 300, 400, 500, Can I mark it as 50,100, 250,500?
3) The current Y axis is marked as 0.5, 0.6,0.7.0.8,0.9,1.0. Can I mark it as 0.5, 0.55, 0.6, 0.65, 0.7,0.75, 0.8, 0.85, 0.9, 0.95, 1?
4) I would like to add some grid line parallel to X axis. These lines should start at points of 0.5, 0.55, 0.6, 0.65, 0.7,0.75, 0.8, 0.85, 0.9, 0.95, 1 along the Y-axis.
data<-data.frame(x=c(50,100,250,400),y1=c(0.74,0.75,0.82,0.79),y2=c(0.81,0.83,0.87,0.88))
windows()
plot(data$x,data$y1,type="l",col="red", ylim=c(0.5,1),xlim= c(50,500),col.axis = "white")
axis(1, xaxp=c(50,500,9))
axis(2, yaxp=c(0.5,1,10))
lines(data$x, data$y2, type='l',col="blue")
for(i in c(0.55,0.6,0.65,0.7,0.75,0.8,0.85,0.9,0.95)) {
lines(c(50,500),c(i,i),type="l",lty=2,lwd=0.5, col="black")
rm(i)
}
Related
I am trying to fit a model that linearly relates two variables using R. I need to fit a Orthogonal Linear Regression (total least squares). So I'm trying to use the odregress() function of the pracma package which performs an Orthogonal Linear Regression via PCA.
Here an example data:
x <- c(1.0, 0.6, 1.2, 1.4, 0.2, 0.7, 1.0, 1.1, 0.8, 0.5, 0.6, 0.8, 1.1, 1.3, 0.9)
y <- c(0.5, 0.3, 0.7, 1.0, 0.2, 0.7, 0.7, 0.9, 1.2, 1.1, 0.8, 0.7, 0.6, 0.5, 0.8)
I'm able to fit the model and get the coefficient using:
odr <- odregress(y, x)
c <- odr$coeff
So, the model is defined by the following equation:
print(c)
[1] 0.65145762 -0.03328271
Y = 0.65145762*X - 0.03328271
Now I need to plot the line fit, compute the RMSE and the R-squared. How can I do that?
plot(x, y)
Here are two functions to compute the MSE and RMSE.
library(pracma)
x <- c(1.0, 0.6, 1.2, 1.4, 0.2, 0.7, 1.0, 1.1, 0.8, 0.5, 0.6, 0.8, 1.1, 1.3, 0.9)
y <- c(0.5, 0.3, 0.7, 1.0, 0.2, 0.7, 0.7, 0.9, 1.2, 1.1, 0.8, 0.7, 0.6, 0.5, 0.8)
odr <- odregress(y, x)
mse_odreg <- function(object) mean(object$resid^2)
rmse_odreg <- function(object) sqrt(mse_odreg(object))
rmse_odreg(odr)
#> [1] 0.5307982
Created on 2023-01-10 with reprex v2.0.2
Edit
The R^2 can be computed with the following function. Note that odr$ssq is not the sum of the squared residuals, odr$resid, it is the sum of the squared errors, odr$err.
r_squared_odreg <- function(object, y) {
denom <- sum((y - mean(y))^2)
1 - object$ssq/denom
}
r_squared_odreg(odr, y)
#> [1] 0.1494818
Created on 2023-01-10 with reprex v2.0.2
Here is another alternative to solve an Orthogonal Linear Regression (total least squares) via PCA according to what is explained in this post. It actually does the same as pracma::odregress.
x <- c(1.0, 0.6, 1.2, 1.4, 0.2, 0.7, 1.0, 1.1, 0.8, 0.5, 0.6, 0.8, 1.1, 1.3, 0.9)
y <- c(0.5, 0.3, 0.7, 1.0, 0.2, 0.7, 0.7, 0.9, 1.2, 1.1, 0.8, 0.7, 0.6, 0.5, 0.8)
In this case we perform a Principal Component Analysis using the prcomp() function.
v <- prcomp(cbind(x,y))$rotation
Then we calculate the slope (m) from the firs principal component and the intercept (n):
# Y = mX + n
m <- v[2,1]/v[1,1]
n <- mean(y) - (m*mean(x))
Our model is defined by: f <- function(x){(m*x) + n}
We can plot it using:
plot(x, y)
abline(n, m, col="blue")
Finally we plot the Total Least Squares fit versus the Ordinary Least Squares fit.
plot(x, y)
abline(n, m, col="blue")
abline(lm(y~x), col="red")
legend("topleft", legend=c("TLS", "OLS"), col=c("blue", "red"), lty=1, bty="n")
As you can see we obtain the same results as in pracma::odregress:
odr <- odregress(y, x)
print(odr$coeff)
print(paste(round(m, digits=7), round(n, digits=7)))
[1] 0.5199081 0.2558142
[1] 0.5199081 0.2558142
I need make meteorological maps with package lattice. But i found a problem in comand levelplot(). I can make maps with the comand using a regular label. E.g: Correlation maps with label 0, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35 0.4... In this example the label skip five by five (Fig.1).
h1<- levelplot(var~x*y,data = idw.msk.dfr,contour=F,at=seq(0,0.5,0.05),
par.settings = paleta1,main = "correlation map",
xlab = NULL, ylab = NULL, ylim = c(-60,15), xlim = c(-90,-30))
Figure 1:
But, i need make maps with non-regular values. E.g: 0, 0.1, 0.15, 0.2, 0.22, 0.25, 0.40... When put this values in code, i get this result (Fig.2):
h1<- levelplot(var~x*y,data = idw.msk.dfr,contour=F,at=c(0,0.1,0.15,0.2,0.22,0.25,0.4,0.5),
par.settings = paleta1,main = "correlation map",
xlab = NULL, ylab = NULL, ylim = c(-60,15), xlim = c(-90,-30))
Figure 2
Note that the label of map is very strange and inrregular.
So. How do i solve this problem? I will apreciate your help.
You need to specify a custom colorkey. Add colorkey to the levelplot function.
x <- seq(pi/4, 5 * pi, length = 100)
y <- seq(pi/4, 5 * pi, length = 100)
r <- as.vector(sqrt(outer(x^2, y^2, "+")))
grid <- expand.grid(x=x, y=y)
grid$z <- cos(r^2) * exp(-r/(pi^3))
breaks <- c(0, 0.1, 0.15, 0.2, 0.22, 0.25, 0.4, 0.5)
levelplot(z~x*y, grid, at=breaks)
myColorkey=list(at=breaks, labels=list(at=breaks, labels=breaks))
levelplot(z~x*y, grid, colorkey=myColorkey)
To have the same size for the intervals change the at argument:
ats=seq(0, 0.5, by=0.07)
myColorkey=list(at=ats, labels=list(at=ats, labels=breaks))
levelplot(z~x*y, grid, colorkey=myColorkey)
I have a curve, derived from empirical data, and I can obtain a reasonable model of it. I need to identify a point (x, y) where the curve intersects a circle of known center and radius. The following code illustrates the question.
x <- c(0.05, 0.20, 0.35, 0.50, 0.65, 0.80, 0.95,
1.10, 1.25, 1.40, 1.55, 1.70, 1.85, 2.00,
2.15, 2.30, 2.45, 2.60, 2.75, 2.90, 3.05)
y <- c(1.52, 1.44, 1.38, 1.31, 1.23, 1.15, 1.06,
0.96, 0.86, 0.76, 0.68, 0.61, 0.54, 0.47,
0.41, 0.36, 0.32, 0.29, 0.27, 0.26, 0.26)
fit <- loess(y ~ x, control = loess.control(surface = "direct"))
newx <- data.frame(x = seq(0, 3, 0.01))
fitline <- predict(fit, newdata = newx)
est <- data.frame(newx, fitline)
plot(x, y, type = "o",lwd = 2)
lines(est, col = "blue", lwd = 2)
library(plotrix)
draw.circle(x = 3, y = 0, radius = 2, nv = 1000, lty = 1, lwd = 1)
To obtain the point of intersection we can use the optim function in r to do so:
circle=function(x){
if(4<(x-3)^2) return(NA)# Ensure it is limited within the radius
sqrt(4-(x-3)^2)
}
fun=function(x)predict(fit,data.frame(x=x))
g=function(x)(circle(x)-fun(x))# We need to set this to zero. Ie solve this
sol1=optimise(function(x)abs(g(x)),c(1,5))$min
[1] 1.208466
Thus the two functions should evaluate to the same value at x=1.208466..
To make it even more precise, you can use the optim function:
sol2= optim(1,function(x)abs(g(x)),g,method="Brent",upper=5,lower=1)$par
[1] 1.208473
Now you can evaluate:
circle(sol1)
[1] 0.889047
fun(sol1)
1
0.8890654
circle(sol2)
[1] 0.889061
fun(sol2)
1
0.889061
From the above, you can tell that solution 2 is very close..
Plotting this point on the graph will be challenging since the draw.circle function draws circles in proportionality with the zxes.. Thus changing everytime depending on how big the plot region is.
If you were to write your own circle function:
circleplot=function(x,y,r){
theta=seq(0,2*pi,length.out = 150)
cbind(x+r*cos(theta),y+r*sin(theta))
}
Then you can do:
plot(x, y, type = "o",lwd = 2)
lines(est, col = "blue", lwd = 2)
lines(circleplot(3,0,2))
abline(v=sol2,col=2)
points(sol2,fun(sol2),col=2,pch=16)
It's straightforward to find the intersection using functions from the sf package.
Calculate the circle values (inspired by this answer and as done by #Onyambu)
circ <- function(xc = 0, yc = 0, r = 1, n = 100){
v <- seq(0, 2 * pi, len = n)
cbind(x = xc + r * cos(v),
y = yc + r * sin(v))
}
m <- circ(xc = 3, yc = 0, r = 2)
Convert the predicted values and the circle values to "simple features" (LINESTRING), and find their intersection (a POINT):
library(sf)
int <- st_intersection(st_linestring(as.matrix(est)),
st_linestring(m))
int
# POINT (1.2091 0.8886608)
Add the intersection to your plot:
plot(x, y, type = "o", lwd = 2)
lines(est, col = "blue", lwd = 2)
lines(m)
points(int[1], int[2], col = "red", pch = 19)
I want to figure out how to build complex curved lines/polygons in R. We can easily draw a simple bezier line, e.g.
require(grid)
x <- c(0.25, 0.25, 0.75, 0.75)
y <- c(0.25, 0.75, 0.75, 0.25)
grid.newpage()
grid.bezier(x, y)
This method seems scale-constrained to 0-1 in both axes, and I'm not sure how to build beziers in a custom scale. I'm also unclear how R can bind these bezier objects together into polylines and ultimately polygons. If anyone can provide a minimal example I'd be very grateful. But alternatively a point in the right direction of documentation would greatly help, as I've not found a workflow so far. Thanks in advance.
As far as I understand grid.bezier you will have to chain individuals segments. This can be done via the id argument, but see also ?grig.bezier.
You can adjust the scale through viewports and the xscale and yscale.
library(grid)
x <- c(0.2, 0.2, 0.7, 0.4, 0.2, 0.2, 0.4, 0.4)
y <- c(0.2, 0.4, 0.7, 0.2, 0.2, 0, 0, 0.2)
grid.newpage()
grid.bezier(x, y, id=rep(1:2, each=4))
grid.newpage()
pushViewport(plotViewport(xscale=c(0, 10), yscale=c(0, 100)))
grid.xaxis()
grid.yaxis()
x <- x * 10
y <- y * 50
grid.bezier(x, y, id=rep(1:2, each=4), default.units="native")
Note that I used dataViewport which is just a convenience function wrapping viewport.
If you have the parametrization 'Y' of the curve you want to draw, you could just
t <- c(1:1000)*0.001
plot(t,Y(t))
or something like that.
I have two plots that I would like to overlay in a particular way. Instead of side by side like when using par(), I would like one to sit inside the other, but be about a quarter the size.
More details: one of my plots is a map, another is a scatterplot with colored quadrants. The colored quadrants represent the colors plotted onto the map, so I would like to inset it nicely in the same plot as the map so that it serves as a legend.
Thanks in advance
Here's an example, although the links in comments point to similar approaches.
Grab a shapefile:
download.file(file.path('http://www.naturalearthdata.com/http/',
'www.naturalearthdata.com/download/50m',
'cultural/ne_50m_admin_1_states_provinces_lakes.zip'),
{f <- tempfile()})
unzip(f, exdir=tempdir())
Plotting:
library(rgdal)
shp <- readOGR(tempdir(), 'ne_50m_admin_1_states_provinces_lakes')
plot(subset(shp, admin=='Australia'),
col=sample(c('#7fc97f', '#beaed4', '#fdc086', '#ffff99'),
9, repl=TRUE))
opar <- par(plt=c(0.75, 0.95, 0.75, 0.95), new=TRUE)
plot.new()
plot.window(xlim=c(0, 1), ylim=c(0, 1), xaxs='i', yaxs='i')
rect(0, 0, 0.5, 0.5, border=NA, col='#7fc97f')
rect(0.5, 0, 1, 0.5, border=NA, col='#beaed4')
rect(0, 0.5, 0.5, 1, border=NA, col='#fdc086')
rect(0.5, 0.5, 1, 1, border=NA, col='#ffff99')
points(runif(100), runif(100), pch=20, cex=0.8)
box(lwd=2)
par(opar)
See plt under ?par for clarification.
This is how I did it in the past
grid.newpage()
vp <- viewport(width = 1, height = 1)
submain <- viewport(width = 0.9, height = 0.9, x = 0.5, y = 1,just=c("center","top"))
print(p, vp = submain)
subvp2 <- viewport(width = 0.2, height = 0.2, x = 0.39, y = 0.35,just=c("right","top"))
print(hi, vp = subvp2)
subvp1 <- viewport(width = 0.28, height = 0.28, x = 0.0, y = 0.1,just=c("left","bottom"))
print(ak, vp = subvp1)
in my case p, ak and hi were gg objects (maps created with ggplot) and I was inserting a small version of each near the main use map (p) - as it is typically done