Smoothing 3d plot in R - r

I made 3d plot in rgl.persp3d but I don't know how to smooth that to see trend. Or maybe next solution is to implement wireframe in rgl.persp3d (because I need this plot to be interactive). Please, help.
library(mgcv)
x<- rnorm(200)
y<- rnorm(200)
z<-rnorm(200)
tab<-data.frame(x,y,z)
tab
#surface wireframe:
mod <- gam(z ~ te(x, y), data = tab)
wyk <- matrix(fitted(mod), ncol = 20) #8 i 10 też ok
wireframe(wyk, drape=TRUE, colorkey=TRUE)
#surface persp3d
library(rgl)
library(akima)
z_interpolation <- 200
tabint <- interp(x, y, z)
x.si <- tabint$x
y.si <- tabint$y
z.si <- tabint$z
nbcol <- 200
vertcol <- cut(t, nbcol)
color = rev(rainbow(nbcol, start = 0/6, end = 4/6))
persp3d(x.si, y.si, z.si, col = color[vertcol], smooth=T)
So wireframe is neither smoothed nor interactive
...and rgl.persp3d is interactive but no smoothed. And I can't have both smoothed and interactive.

rgl just draws what you give it. You need to use mgcv as in your first example to do the smoothing, but you don't get a matrix of fitted values back at the end, so you'll want to use deldir to turn the results into a surface. For example,
library(mgcv)
x<- rnorm(200)
y<- rnorm(200)
z<-rnorm(200)
tab<-data.frame(x,y,z)
tab
#surface wireframe:
mod <- gam(z ~ te(x, y), data = tab)
library(rgl)
library(deldir)
zfit <- fitted(mod)
col <- cm.colors(20)[1 +
round(19*(zfit - min(zfit))/diff(range(zfit)))]
persp3d(deldir(x, y, z = zfit), col = col)
aspect3d(1, 2, 1)
This gives a nice smooth surface, for example

A simpler way, without the delaunay stuff:
library(mgcv)
x <- rnorm(200)
y <- rnorm(200)
z <- rnorm(200)
tab <- data.frame(x,y,z)
mod <- mgcv::gam(z ~ te(x, y), data = tab)
grid <- -5:5
zfit <- predict(mod, expand.grid(x = grid, y = grid))
persp3d(grid, grid, zfit)

Related

Directly Plotting Mathematical Functions in R

I am working with the R programming language.
In a previous question that I asked (Understanding 3D traces in Plotly and R: Evaluating and Plotting Functions Over a Grid), I learned how to plot mathematical functions by first evaluating the mathematical function at different points, then by plotting these points on a 3D grid, and finally "interpolating" a 3D surface over these points:
# set seed for reproducibility
#load libraries
set.seed(123)
library(dplyr)
library(plotly)
#create more data
n <- 50
my_grid <- expand.grid(i1 = 1:n, i2 = 1:n)
my_grid$final_value = with(my_grid, sin(i1) + cos(i2) )
#make plot
plot_ly(data = my_grid, x=~i1, y=~i2, z=~final_value, type='mesh3d', intensity = ~final_value, colors = colorRamp(c("blue", "grey", "red")))
I am trying to use this same approach to plot the following function (https://en.wikipedia.org/w/index.php?title=Test_functions_for_optimization&oldid=1030693803, https://en.wikipedia.org/w/index.php?title=Test_functions_for_optimization&oldid=1030693803#/media/File:ConstrTestFunc03.png) :
I first defined the function:
my_function <- function(x,y) {
final_value = (1 - x)^2 + 100*((y - x^2)^2)
}
Then, I defined the "grid":
input_1 <- seq(-1.5, 1.5,0.1)
input_2 <- seq(-1.5, 1.5,0.1)
my_grid <- data.frame(input_1, input_2)
my_grid$final_value = (1 - input_1)^2 + 100*((input_2 - input_1^2)^2)
Then, I tried to plot this function:
x <- my_grid$input_1
y <- my_grid$input_2
z <- matrix(my_grid$final_value, nrow = length(x), ncol = length(y)) # proper matrix & dimensions
plot_ly(x = x, y = y, z = z) %>% add_surface()
My Problem: The final result does not look similar to the result from the Wikipedia page:
Can someone please show me what I am doing wrong? Is there an easier way to do this?
Thanks!
Your problem is that you are not actually creating a grid, you are creating a single vector of equal x, y points and running your formula on that, so your matrix is wrong (every column will be the same due to it being repeated). The easiest fix is to run outer on your function to evaluate it at every pair of input 1 and input 2:
z <- outer(input_1, input_2, my_function)
plot_ly(x = input_1, y = input_2, z = z) %>% add_surface()

Plotting Contours with x, y, z values

I am trying to create a contour plot of 1000 data points. I have the matrix with all of the values in it. Here is my code.
mu1 <- rbind(2, 2)
mu2 <- rbind(-2, -2)
sigma1 <- rbind(c(.6, 0), c(0, .6))
simga2 <- sigma1
det1 <- det(sigma1)
det2 <- det1
inv1 <- solve(sigma1)
inv2 <- inv1
x <- runif(1000, -5, 5)
y <- runif(1000, -5, 5)
w <- rbind(x, y)
ratio <- function(v){
quotient <- (exp((-1/2)*t(v-mu1)%*%inv1%*%(v-mu1)))/(exp((-1/2)*t(v-mu2)%*%inv2%*%(v-mu2)))
return(quotient)
}
z <- apply(w, 2, ratio)
round.z <- round(z, digits=0)
df <- cbind(x, y, z, round.z)
df <- as.data.frame(df)
I want to plot the contours of x and y by the round.z values including where round.z=1. I know that the contour where round.z=1 should be the line y=-x, but I don't know how to get it to show up. Thanks for the help.
The contour and related functions in R want to have the data on a grid, not a random sample like yours. The akima::interp function can convert your data to this format. For example, after running your code,
library(akima)
grid <- with(df, interp(x, y, round.z))
contour(grid, levels = 10^(0:10))
which produces this image:

Error occuring in plotting thin plate spline model

library(mgcv)
#Input dataset
vo2max<-read.csv('C:/Users/Dell/Desktop/Paper(2009)/vo2max.csv')
model1 <- gam(VO2max ~ s(Load, Speed, m=4, bs=c("tp", data = vo2max)
x <- range(vo2max$Load)
x <- seq(x[1], x[2], length.out=14)
y <- range(vo2max$Speed)
y <- seq(y[1], y[2], length.out=14)
z <- outer(x,y,
function(Load,Speed)
predict(model1, data.frame(Load,Speed)))
p <- persp(x,y,z, theta=30, phi=30,
col="yellow",expand = 0.5,shade = 0.2, ticktype = "detailed",
xlab="Load", ylab="Speed", zlab="VO2max")
obs<- trans3d(vo2max$Load, vo2max$Speed,vo2max$VO2max,p)
pred<- trans3d(vo2max$Load, vo2max$Speed,fitted(model1),p)`enter code here`
points(obs, col="red",pch=16)
segments(obs$x, obs$y, pred$x, pred$y)
predict(model1)
The dataset contains 14 values. I need to plot a thin plate spline and predict the model,but I'm getting error in smooth construct. Whether I have to use any other library package. Help me in providing the appropriate code.

`scatterplot3d`: can not add a regression plane to 3D scatter plot

I have created a 3d Scatterplot in R and want to add a regression plane. I have looked at code from the statmethods.net website, which can be very useful, and it worked. I then tried it with my own data and the plane did not show up.
library(scatterplot3d)
s3d <- scatterplot3d(Try$Visits, Try$Net.Spend, Try$Radio, pch=16, highlight.3d = TRUE, type = "h", main = "3D Scatterplot")
fit <- lm(Try$Visits ~ Try$Net.Spend +Try$Radio)
s3d$plane3d(fit)
I can not reproduce the issue with the following reproducible example:
set.seed(0)
x <- runif(20)
y <- runif(20)
z <- 0.1 + 0.3 * x + 0.5 * y + rnorm(20, sd = 0.1)
dat <- data.frame(x, y, z)
rm(x,y,z)
fit <- lm(z ~ x + y, data = dat)
library(scatterplot3d)
s3d <- scatterplot3d(dat$x, dat$y, dat$z, pch=16, highlight.3d = TRUE, type = "h", main = "3D Scatterplot")
s3d$plane3d(fit)
You should avoid $ in model formula. Use data argument instead:
fit <- lm(Visits ~ Net.Spend + Radio, data = Try)
Your z-variable(dependent variable) in the scatter plot is Try$Radio whereas in the regression model, the dependent variable is Try$Visits and this is causing confusion. The 3rd variable in the scatter plot argument is treated as the dependent variable R.

How to show matrix values on Levelplot

I have a matrix data here, and I visualized it with levelplot. The Plot is placed below. But I just couldn't put the values into the plot, I mean I read this question, but still couldn't figure it out.
How can I do that ? Thanks.
The problem with the code in the answer you linked to is that it only works when the objects in the levelplot's formula are named x, y, and z.
Here is an example that uses a more standard idiom for processing the arguments passed in to the custom panel function and so becomes more generally applicable:
library("lattice")
## Example data
x <- seq(pi/4, 5*pi, length.out=10)
y <- seq(pi/4, 5*pi, length.out=10)
grid <- expand.grid(X=x, Y=y)
grid$Z <- runif(100, -1, 1)
## Write a panel function (after examining 'args(panel.levelplot) to see what
## will be being passed on to the panel function by levelplot())
myPanel <- function(x, y, z, ...) {
panel.levelplot(x,y,z,...)
panel.text(x, y, round(z,1))
}
## Try it out
levelplot(Z ~ X*Y, grid, panel = myPanel)
mat <- read.csv("J_H2S1T6_PassTraffic.csv", header=F)
y <- as.numeric(mat[1,-1])
mat <- mat[-1,-1]
n <- dim(mat)[1]
Here a modification, I generate a new scale
x <- seq(min(y), max(y), length.out=n)
grid <- expand.grid(x=x, y=x)
mat <- as.matrix(mat)
dim(mat) <- c(n*n,1)
grid$z <- mat
Here the modification. I change the dimension of the matrix to a vector to put it in the grid .
mat <- as.matrix(mat)
dim(mat) <- c(n*n,1)
grid$z <- mat
p <- levelplot(z~x*y, grid,
panel=function(...) {
arg <- list(...)
panel.levelplot(...)
panel.text(arg$x, arg$y,arg$z)},
scales = list(y = list(at=y,labels=y),
x = list(at=y,labels=y)))
print(p)
Another option is to use layer() from latticeExtra. It allows you to overlay one plot on top of another, using the + operator familiar to ggplot2 enthusiasts:
library(latticeExtra)
## Applied to the example data in my other answer, this will produce
## an identical plot
levelplot(Z ~ X*Y, data = grid) +
layer(panel.text(X, Y, round(Z, 1)), data = grid)

Resources