I am trying to make a 3D surface plot in R. In this the values for the z and x axes should be within a given range, and the value of y should depend on both x and z as described in the function.
z <- maxGiraffeNumber <- c(100:2400)
x <- Tourism <- c(1:100)
y <- Rain <- 100/(17/((z/365)*0.3))*(100-y)
surface3d(x,y,z, col=colors)
running this code gives me the following error
Error in rgl.surface(x = 1:100, y = 100:2400, z = c(14.7789550384904, :
'y' length != 'x' rows * 'z' cols
Thank you for your help
The problem is stated fairly well in the error. To produce a surface plot you need a vector of x co-ordinates of any length and a vector of y co-ordinates of any length. However, your z vector needs to have a value at every (x, y) co-ordinate, which means you need to be sure that length(z) == length(x) * length(y). However, what you have is x of length 100, y of length 2301 and z of length 2301.
If you have a function you want to apply to every possible combination of x and y, you can use outer.
I'll give an example of producing a surface with something similar to the code you have created here, but it's probably not exactly what you were looking for, since it's not clear exactly what you are trying to do.
library(rgl)
f <- function(x, y) 100 / (17/((x / 365) * 0.3)) * (100 - y)
y <- Rain <- c(1:100)
x <- Tourism <- c(1:100)
z <- maxGiraffeNumber <- outer(Rain, Tourism, f)
surface3d(Tourism, Rain, maxGiraffeNumber, col = "red")
Which makes the following rotatable 3D surface pop-up:
Related
I am trying to create a 3D mesh of a specific building from points that I extracted from a lidar point cloud. I then created a matrix from the x, y and z values to feed into the as.mesh3d function from the rlg package and since its from a lidar survey, I have 27,000+ points for this one building. I run into an error when I try to create the mesh. I've copied in a sample of 20 points from the point cloud:
X <- c(1566328,1566328,1566328,1566328,1566328,1566327,1566327,1566327,
1566327,1566327,1566327,1566327,1566327,1566327,1566327,1566327,
1566326,1566326,1566326,1566326)
Y <- c(5180937,5180937,5180936,5180935,5180936,5180937,5180937,5180936,
5180936,5180935,5180935,5180935,5180936,5180936,5180937,5180938,
5180938,5180937,5180936,5180936)
Z <- c(19.92300028,19.98300046,19.93700046,19.88099962,19.93500046,19.99500046,
20.00400046,20.00600046,19.97199962,19.92499962,19.95400046,
19.99099991,20.01199991,19.97600020,19.95800008,19.93200008,
19.95300008,19.94800008,19.94300020,19.98399991)
#created a matrix
xyz <- matrix(c(X, Y, Z), byrow = TRUE, ncol = 3)
The problem arises when I try to create the mesh using as.mesh3d():
mesh <- as.mesh3d(xyz, y = NULL, Z = NULL, type = "triangle", col = "red")
This is what I get: Error in as.mesh3d.default(xyz, y = NULL, Z = NULL, type = "triangle", : Wrong number of vertices
The same error happens for the original dataset of 27000+ points despite all being of the same length.
I'm really not advanced in R and was hoping I could get some advice or solutions on how to get past this.
Thankyou
The as.mesh3d function assumes the points are already organized as triangles. Since you're giving it 20 points, that's not possible: it needs a multiple of 3 points.
There's a problem with your calculation of xyz: you say byrow = TRUE, but you're specifying values by column. Using
xyz <- cbind(X, Y, Z)
would work.
If I plot all of your points using text3d(xyz, text=1:20), it looks as though there are a lot of repeats.
There are several ways to triangulate those points, but they depend on assumptions about the surface. For example, if you know there is only one Z value for each (X, Y) pair, you could use as.mesh3d.deldir (see the help page) to triangulate. Here's the code and output for your sample:
dxyz <- deldir::deldir(X - mean(X), Y - mean(Y), z = Z)
# Warning message:
# In deldir::deldir(X - mean(X), Y - mean(Y), z = Z) :
# There were different z "weights" corresponding to
# duplicated points.
persp3d(dxyz, col = "red")
I had to subtract the means from X and Y because rounding errors caused it to look very bad without that: rgl does a lot of things in single precision, which only gives 7 or 8 decimal place accuracy.
I want to see how three variables x, y, and z respond to a function f using R.
I've searched for R solutions (e.g. rgl using 4d plots) but none seem to allow the input of a function as the fourth variable while allowing manipulation of x, y, and z across their full range of values.
# First I create three variables that each have a domain 0 to 4
x
y
z
# Then I create a function from those three variables
f <- sqrt(x^2 + y^2 + z^2)
EDIT: I originally stated that I wanted x, y, and z to be seq(0, 4, 0.01) but in fact I only want them to range from 0 to 4, and do so independently of other variables. In other words, I want to plot the function across a range of values letting x move independently of y and z and so forth, rather than plotting a 3-D line. The result should be a 3-D surface.
I want to:
a) see how the function f responds to all possible combinations of x, y, and z across a range of x, y, and z values 0 to 4, and
b) find what maxima/minima exist especially when holding one variable constant.
This is rather a mathematical questions. Unfortunately, our computer screens are not really made fro 4D, neither our brains. So what you ask wont be possible as if. Indeed, you want to show a dense set of data (a cube between 0 and 4), and we can not display what is "inside" the cube.
To come back to R, you can always display a slice of it, for example fixing z and plot sqrt(x^2 + y^2 + z^2) for x and y. Here you have two examples:
# Points where the function should be evaluated
x <- seq(0, 4, 0.01)
y <- seq(0, 4, 0.01)
z <- seq(0, 4, 0.01)
# Compute the distance from origin
distance <- function(x,y,z) {
sqrt(x^2 + y^2 + z^2)
}
# Matrix to store the results
slice=matrix(0, nrow=length(x),ncol=length(y))
# Fill the matrix with a slice at z=3
i=1
for (y_val in y)
{
slice[,i]=distance(x,y_val,3)
i=i+1
}
# PLot with plot3D library
require(plot3D)
persp3D(z = slice, theta = 100,phi=50)
# PLot with raster library
library(raster)
plot(raster(slice,xmn=min(x), xmx=max(x), ymn=min(y), ymx=max(y)))
If you change your z values, you will not really change the shape (just making it "flatter" for bigger z). Note that the function being symmetric in x, y and z, the same plots are produced if you keep xor y constant.
For your last question about the maximum, you can re-use the slice matrix and do:
max_ind=which(slice==max(slice),arr.ind = TRUE)
x[max_ind[,1]]
y[max_ind[,2]]
(see Get the row and column name of the minimum element of a matrix)
But again with math we can see from your equation that the maximum will always be obtained by maxing x, y and z. Indeed, the function simply measure the distance from the origin.
I have a 2-dimensional data set.
I use the R's smooth.spline function to smooth my points graph following an example in this article:
https://stat.ethz.ch/R-manual/R-devel/library/stats/html/predict.smooth.spline.html
So that I get the spline graph similar to the green line on this picture
I'd like to know the X values, where the first derivative of the smoothing spline equals zero (to determine exact minimum or maximum).
My problem is that my initial dataset (or a dataset that I could auto-generate) to feed into the predict() function does not contain such exact X values that correspond to the smoothing spline extrema.
How can I find such X values?
Here is the picture of the first derivative of the green spline line above
But exact X coordinate of extremums are still not exact.
My approximate R script to generate the pictures looks like the following
sp1 <- smooth.spline(df)
pred.prime <- predict(sp1, deriv=1)
pred.second <- predict(sp1, deriv=2)
d1 <- data.frame(pred.prime)
d2 <- data.frame(pred.second)
dfMinimums <- d1[abs(d1$y) < 1e-4, c('x','y')]
I think that there are two problems here.
You are using the original x-values and they are spaced too far apart AND
Because of the wide spacing of the x's, your threshold for where you consider the derivative "close enough" to zero is too high.
Here is basically your code but with many more x values and requiring smaller derivatives. Since you do not provide any data, I made a coarse approximation to it that should suffice for illustration.
## Coarse approximation of your data
x = runif(300, 0,45000)
y = sin(x/5000) + sin(x/950)/4 + rnorm(300, 0,0.05)
df = data.frame(x,y)
sp1 <- smooth.spline(df)
Spline code
Sx = seq(0,45000,10)
pred.spline <- predict(sp1, Sx)
d0 <- data.frame(pred.spline)
pred.prime <- predict(sp1, Sx, deriv=1)
d1 <- data.frame(pred.prime)
Mins = which(abs(d1$y) < mean(abs(d1$y))/150)
plot(df, pch=20, col="navy")
lines(sp1, col="darkgreen")
points(d0[Mins,], pch=20, col="red")
The extrema look pretty good.
plot(d1, type="l")
points(d1[Mins,], pch=20, col="red")
The points identified look like zeros of the derivative.
You can use my R package SplinesUtils: https://github.com/ZheyuanLi/SplinesUtils, which can be installed by
devtools::install_github("ZheyuanLi/SplinesUtils")
The function to be used are SmoothSplinesAsPiecePoly and solve. I will just use the example under the documentation.
library(SplinesUtils)
## a toy dataset
set.seed(0)
x <- 1:100 + runif(100, -0.1, 0.1)
y <- poly(x, 9) %*% rnorm(9)
y <- y + rnorm(length(y), 0, 0.2 * sd(y))
## fit a smoothing spline
sm <- smooth.spline(x, y)
## coerce "smooth.spline" object to "PiecePoly" object
oo <- SmoothSplineAsPiecePoly(sm)
## plot the spline
plot(oo)
## find all stationary / saddle points
xs <- solve(oo, deriv = 1)
#[1] 3.791103 15.957159 21.918534 23.034192 25.958486 39.799999 58.627431
#[8] 74.583000 87.049227 96.544430
## predict the "PiecePoly" at stationary / saddle points
ys <- predict(oo, xs)
#[1] -0.92224176 0.38751847 0.09951236 0.10764884 0.05960727 0.52068566
#[7] -0.51029209 0.15989592 -0.36464409 0.63471723
points(xs, ys, pch = 19)
One caveat in the #G5W implementation that I found is that it sometimes returns multiple records close around extrema instead of a single one. On the diagram they cannot be seen, since they all fall into one point effectively.
The following snippet from here filters out single extrema points with the minimum value of the first derivative:
library(tidyverse)
df2 <- df %>%
group_by(round(y, 4)) %>%
filter(abs(d1) == min(abs(d1))) %>%
ungroup() %>%
select(-5)
I have a scatterplot of x versus y. I have drawn an abline down the middle of the plot. I want to calculate the variance of the points on the left of the abline and I want to calculate the variance of the points on the right of the abline. This is most likely a relatively simple problem, but I'm struggling to find a solution. Any advice is appreciated. Thanks in advance.
x = rnorm(100,mean=12,sd=2)
y = rnorm(100,mean=20,sd=5)
data = as.data.frame(cbind(x,y))
plot(x=x,y=y,type="p")
abline(v=12,col="red")
In your sample code you have a vertical line v = 12. Your data points (x, y) are split into two groups as x < 12 and x >= 12. It is straightforward to do something like:
var(y[x < 12])
var(y[x >= 12])
But we can also use a single call to tapply:
tapply(y, x < 12, FUN = var)
More generally if you have a line y = a * x + b, where a is slope and b is intercept, your data points (x, y) will be split into two groups: y < a * x + b (below the line) and y >= a * x + b (above the line), so that you may use
tapply(y, y < a * x + b, FUN = var)
I'm trying to make a 3D scatterplot with boudaries or zones based on combinations of 3 variables that return certain values. The variables each range between 0:1, and combine to make an index that ranges from -1:1 as follows:
f(x,y,z) = (x*y)-z
I'd like to create a visual representation that will highlight all combinations of variables that return a certain index value. As an example, I can easily show those variables where index > 0 using scatterplot3d (rgl would also work):
# Create imaginary dataset of 50 observations for each variable
x<-runif(50,0,1)
y<-runif(50,0,1)
z<-runif(50,0,1)
# Create subset where f(x,y,z) > 0
x1<-y1<-z1<-1
for (i in 1:length(x)){ if ((x[i]*y[i])-z[i] > 0) {
x1<-rbind(x1, x[i])
y1<-rbind(y1, y[i])
z1<-rbind(z1, z[i])}
}
s3d<-scatterplot3d(x,y,z) # Plot entire dataset
s3d$points3d(x1,y1,z1,pch=19, col="red") # Highlight subset where f(x,y,z) > 0
This gives me the following graph:
It seems fairly intuitive that there should be an easy way to plot either the surface (extending from top/right/back to bottom/left/front) separating the subset from the rest of the data, or else a volume/3D area within which these plots lie. E.g. my first instinct was to use something like surface3d, persp3d or planes3d. However, all attempts so far have only yielded error messages. Most solutions seem to use some form of z<-lm(y~x) but I obviously need something like q<-func((x*y)-z) for all values of x, y and z that yield q > 0.
I know I could calculate extreme points and use them as vertices for a 3D polygon, but that seems too "manual". It feels like I'm overlooking something fairly simple and obvious. I've looked at many similar questions on Stack but can't seem to find one that fits my particular problem. If I've missed any and this question has been answered already, please do point me in the right direction!
Here is a suggestion for an interactive 3D plot that is based on an example from the "R Graphics Cookbook" by Winston Chang.
set.seed(4321)
library(rgl)
interleave <- function(v1,v2) as.vector(rbind(v1,v2))
x <- runif(50)
y <- runif(50)
z <- runif(50)
plot3d(x, y, z, type="s", size=0.6, col=(2+(x*y<z)))
x0 <- y0 <- seq(0, 1, 0.1)
surface3d(x0, y0, outer(x0, y0), alpha=0.4) #plot the surface f(x,y)=x*y
x1 <- x[x * y > z] #select subset that is below the separating surface
y1 <- y[x * y > z]
z1 <- z[x * y > z]
segments3d(interleave(x1, x1), #highlight the distance of the points below the surface
interleave(y1, y1),
interleave(x1 * y1, z1), col="red", alpha=0.4)
If you don't like the red lines and only want the surface and the colored points, this will be sufficient:
plot3d(x,y,z,type="s",size=0.6,col=(2+(x*y<z)))
x0 <- y0 <- seq(0,1,0.1)
surface3d(x0,y0,outer(x0,y0),alpha=0.4)
Does this representation provide the information that you wanted to highlight?
The first thought was to see if the existing functions within scatterplot3d could handle the problem but I think not:
my.lm <- lm(z ~ I(x) * I(y)+0)
s3d$plane3d(my.lm, lty.box = "solid", col="red")
pkg:scatterplot3d doesn't really have a surface3d function so you will need to choose a package that provides that capability; say 'rgl', 'lattice', or 'plot3d'. Any of them should provide the needed facilities.