library(mgcv)
model1 <- gam(EE ~ te(Load, Gradient, k=4, bs=c("tp", "tp")), data = dipasEE)
x <- range(dipasEE$Load)
x <- seq(x[1], x[2], length.out=20)
y <- range(dipasEE$Gradient)
y <- seq(y[1], y[2], length.out=20)
z <- outer(x,y,
function(Load,Gradient)
predict(model1, data.frame(Load,Gradient)))
p <- persp(x,y,z, theta=30, phi=30,
col="yellow",expand = 0.5,shade = 0.2, ticktype = "detailed",
xlab="Load", ylab="Gradient", zlab="EE")
obs<- trans3d(dipasEE$Load, dipasEE$Gradient,dipasEE$EE,p)
pred<- trans3d(dipasEE$Load, dipasEE$Gradient,fitted(model1),p)
points(obs, col="red",pch=16)
segments(obs$x, obs$y, pred$x, pred$y)
predict(model1)
pd <- data.frame(Load = seq(0, 21.5, by = 0.5), Gradient = 15)
predict(model1,newdata=pd)
Output:
[enter image description here][1]
# How to plot the points for newdata=pd in the 3d plot? Below is the Output for above code with Plots. Need to Point more plots for newdata=pd.
# 3 D Plot Graph
[1]: https://i.stack.imgur.com/bIMoY.png
Related
I generate 4 parts of big data: cluster1(10000 points), cluster2(15000 points), cluster3(15000 points) and throws(500 points). Here is the code:
library('MASS')
library('fpc')
#library("dbscan")
library("factoextra")
library("clustertend")
library("boot")
library("stream")
set.seed(123)
mu1<-c(-5,-7)
mu1
sigma1<-matrix(c(4,-2,-2,2), nrow=2, ncol=2, byrow = TRUE)
sigma1
n<-10000
cluster1<-mvrnorm(n,mu1,sigma1)
cluster1
#cluster1<-as.data.frame(cluster1)
#cluster1
#c<-runif(10000,1,1000)
#c
phi <- runif(15000, max = 2*pi)
rho <- sqrt(runif(15000))
x <- sqrt(5)*rho*cos(phi) + 6
y <- sqrt(10/3)*rho*sin(phi) + 4
range(2*(x - 6)^2 + 3*(y - 4)^2)
#[1] 0.001536582 9.999425234
plot(x, y)
cluster2<-cbind(x,y)
cluster2
u <- runif(15000, max = 3)
v <- runif(15000, max = 2)
x <- u + v - 10
y <- v - u + 8
range(x + y)
#[1] -1.999774 1.999826
range(x - y + 15)
#[1] -2.999646 2.999692
plot(x, y)
cluster3<-cbind(x,y)
cluster3
#cluster3<-as.data.frame(cluster1)
#cluster3
x <- runif(500, -20, 20)
y <- runif(500, -20, 20)
#u <- runif(500, max = 20)
#v <- runif(500, max = 20)
#x <- u + v - 20
#y <- v - u
range(x)
range(y)
plot(x,y)
throws<-cbind(x,y)
throws
data<-rbind(cluster1,cluster2,cluster3,throws)
data<-as.data.frame(data)
data
plot(data)
Then I try by using the bootstrap method, construct a distribution of H statistics for some
fixed m, which is from 7% of the total number of generated points(m=2835). Here is th code where I do this:
B<-10#number of iterations
H<-NULL#value of Hopkins statistic
for(i in 1:B){
N<-dim(data)[1]
s<-sample(N,0.8*N)
stat<-hopkins(data[s,], n=2835, byrow = TRUE)$H
H[i]<-stat
#print(c(i, stat))
}
It takes very to generate. Then I should to compare this result with beta distribution - B(m,m). Here is the code:
hist(H)
#(density(H), col="red")
#hist(distB)
X<-seq(min(H), max(H), 0.001)
X
lines(X, dbeta(X,2835,2835), type="l", col="red")
The problem is that lined doesn't draw on hist. Can anybody say what is the problem? Here is the image, I see red line, but it's not exactly right.
Your y-axis values plotted by dbeta() are way too low to register on the supplied y-axis (<0.0000001). You need to overlay the second plot:
# sample data
H <- sample(seq(0.455,0.475,0.001), 1000, replace = TRUE)
#plot histogram
hist(H)
# prepare graphics to add second plot
par(new = TRUE)
# sample data for second plot
X <- seq(0.455,0.475, 0.001)
Y <- dbeta(X,2835,2835)
# plot second plot, remove axes
plot(X, dbeta(X,2835,2835), type="l", col="red", axes = FALSE)
axis(4, Y) # add axis on right side
Can anybody help me how to plot an image or 3D plot for this function that the output is in array class?
mu <- function(x,y,t,par){
return(par[1]+ par[2]*(x-t)+par[3]*x*t)
}
x <- seq(0,1,0.1)
y <- seq(0,1,0.1)
t <- seq(0,1,0.1)
mu.values <- array(NA, dim=c(length(x),length(y),length(t)))
for(i in 1:length(x)){
for(j in 1:length(y)){
for(k in 1:length(t)){
mu.values[i,j,k] <- mu(x[i], y[j], t[k], par=c(0.25,0.25,0))
}
}
}
Try this, now including slices:
library(reshape2)
library(plot3D)
m = melt(mu.values)
par(mfrow = c(1,2))
scatter3D(x = m$Var1, y = m$Var2, z = m$Var3, colvar = m$value, pch = 16, cex = 0.1)
# contour slices
x <- y <- z <- 1:11
slicecont3D (x, y, z, ys = 1:11, colvar = mu.values,
theta = 60, border = "gray")
Created on 2020-07-08 by the reprex package (v0.3.0)
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.
I try to plot cube and ball around it in 3D using plotly in R, type = "mesh3D". I was successful to get the plots right, however, can't get the coordinate lines to go through the origin, point (0,0,0). Any suggestions on how to do that? Code example:
library(misc3d)
library(plotly)
grid <- 100
f.1 <- function(x, y, z){
(x^2+y^2+z^2)
}
f.2 <- function(x, y, z){
abs(x)+abs(y)+abs(z)
}
x <- seq(-1, 1, length=grid)
y <- seq(-1, 1, length=grid)
z <- seq(-1, 1, length=grid)
g <- expand.grid(x=x, y=y, z=z)
voxel.1 <- array(with(g, f.1(x,y,z)), c(grid,grid,grid))
voxel.2 <- array(with(g, f.2(x,y,z)), c(grid,grid,grid))
cont.1 <- computeContour3d(voxel.1, level=1, x=x, y=y, z=z)
idx.1 <- matrix(0:(nrow(cont.1)-1), ncol=3, byrow=TRUE)
cont.2 <- computeContour3d(voxel.2, level=1, x=x, y=y, z=z)
idx.2 <- matrix(0:(nrow(cont.2)-1), ncol=3, byrow=TRUE)
axx <- list(gridcolor="rgb(255,255,255)",zerolinecolor="rgb(0,0,0)")
axy <- list(gridcolor="rgb(255,255,255)",zerolinecolor="rgb(0,0,0)")
axz <- list(gridcolor="rgb(255,255,255)",zerolinecolor="rgb(0,0,0)")
plot.1 <- plot_ly(x = cont.1[,1], y = cont.1[,2], z = cont.1[,3],
i = idx.1[,1], j = idx.1[,2], k = idx.1[,3],
type = "mesh3d",opacity = 0.1,intensity=seq(0,1,length=4),showscale = FALSE,colors="red") %>%
add_trace(x = cont.2[,1], y = cont.2[,2], z = cont.2[,3],
i = idx.2[,1], j = idx.2[,2], k = idx.2[,3],color="blue",
type="mesh3d",opacity=0.7,intensity=seq(0,1,length=4),
showscale=FALSE,inherit=FALSE) %>%
layout(scene = list(xaxis=axx,yaxis=axy,zaxis=axz))
plot.1
It plots zerolines through (1,0,0), (0,1,0) and (0,0,1), but cant get it to plot through (0,0,0).
I want to build a 3D PCA bi-plot using plotly package because the graph is nice and interactive in html format (something that I need).
My difficulty is to add the loading. I want the loading to be presented as straight lines from the point (0,0,0) (i.e. the equivalent to 2D biplots)
So all in all I don't know how to add straight lines starting from the centre of the 3D graph.
I have calculated the scores and loading using the PCA function;
pca1 <- PCA (dat1, graph = F)
for scores:
ind1 <- pca1$ind$coord[,1:3]
x <- ind1[,1] ; y <- ind1[,2] ; z <- ind1[,3]
for loadings:
var1 <- pca1$var$coord[,1:3]
xl <- var1[,1] ; yl <- var1[,2] ; zl <- var1[,3]
and using the code bellow the 3D score plot is generated;
p <- plot_ly( x=x, y=y, z=z,
marker = list(opacity = 0.7, color=y , colorscale = c('#FFE1A1', '#683531'), showscale = F)) %>%
layout(title = "3D Prefmap",
scene = list(
xaxis = list(title = "PC 1"),
yaxis = list(title = "PC 2"),
zaxis = list(title = "PC 3")))
Here are some ideas that could be useful for the development of a 3D biplot.
# Data generating process
library(MASS)
set.seed(6543)
n <- 500
mu <- c(1,-2,3,-1,3,4)
Sigma <- diag(rep(1,length(mu)))
Sigma[3,1] <- Sigma[1,3] <- 0.1
Sigma[4,6] <- Sigma[6,4] <- 0.1
X <- as.data.frame(mvrnorm(n, mu=mu, Sigma=Sigma))
# PCA
pca <- princomp(X, scores=T, cor=T)
# Scores
scores <- pca$scores
x <- scores[,1]
y <- scores[,2]
z <- scores[,3]
# Loadings
loads <- pca$loadings
# Scale factor for loadings
scale.loads <- 5
# 3D plot
library(plotly)
p <- plot_ly() %>%
add_trace(x=x, y=y, z=z,
type="scatter3d", mode="markers",
marker = list(color=y,
colorscale = c("#FFE1A1", "#683531"),
opacity = 0.7))
for (k in 1:nrow(loads)) {
x <- c(0, loads[k,1])*scale.loads
y <- c(0, loads[k,2])*scale.loads
z <- c(0, loads[k,3])*scale.loads
p <- p %>% add_trace(x=x, y=y, z=z,
type="scatter3d", mode="lines",
line = list(width=8),
opacity = 1)
}
print(p)