Hi Guys,
I could need some help here. I have a set of 3d points (x,y,v). These
points are not randomly scattered but lie on a surface. This surface can be
taken as a calibration plane for x and y -values. My goal is to quantify
this surface and than predict the v-values for given pairs of x- and
y-coordinates.
This iscode shows how I started to solve this problem. First, I generate
more points between existing points using 3d-splines. That way I
"pre-smooth" my data set. After that I use interp to create even more
points and I end up with an object called "sp" (class
"list"). sp is
visualized using surface3d. The surface looks like I wish it to be.
Now, how can I predict a x/y-pair of, say -2, 2 ??
Can somebody help?
Thanks a lot!
library(rgl)
library(akima)
v <- read.table(text="5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 6 6 6 6 6 6 6
6 6
6 6 6 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 9 9 9 9
9 9 9 9 9 9 9 9 9 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 11 11 11
11 11 11 11 11 11 11 11 11 11 11 11 12 12 12 12 12 12 12 12 12 12 12 12 12
12 12 13 13 13 13 13 13 13 13 13 13 13 13 13 13 13 14 14 14 14 14 14 14 14
14 14 14 14 14 14 14", sep=" ")
v <- as.numeric(v)
x <- read.table(text="3.4 3.3 3.4 3.4 3.4 3.4 3.6 3.5 3.5 3.4 3.4 3.4
3.4
3.5 3.5 2.6 2.6 2.6 2.7 2.6 2.7 2.9 2.9 2.8 2.7 2.7 2.7 2.7 2.7 2.8 1.8 1.7
1.7 1.7 1.8 1.9 2.1 2.2 2.0 1.9 1.9 1.9 1.9 1.9 2.0 0.8 0.8 0.8 0.8 0.9 1.1
1.3 1.4 1.2 1.1 1.0 1.0 1.0 1.1 1.1 -0.2 -0.2 -0.2 -0.2 0.0 0.2 0.4 0.6 0.3
0.1 0.1 0.1 0.1 0.1 0.2 -1.2 -1.3 -1.3 -1.3 -1.1 -0.8 -0.5 -0.3 -0.6 -0.9
-0.9 -0.9 -0.9 -1.0 -0.9 -2.4 -2.6 -2.6 -2.5 -2.3 -2.0 -1.1 -1.2 -1.6 -2.0
-2.0 -2.0 -2.1 -2.2 -2.1 -3.9 -4.2 -4.3 -4.2 -3.9 -3.6 -2.5 -2.7 -3.3 -3.7
-3.7 -3.8 -3.8 -4.0 -3.9 -5.8 -6.1 -6.2 -6.1 -5.7 -5.3 -3.9 -4.1 -4.8 -5.3
-5.3 -5.3 -5.4 -5.5 -5.4 -7.5 -7.8 -8.0 -7.8 -7.4 -6.8 -5.1 -5.3 -6.1 -6.6
-6.7 -6.8 -6.9 -6.9 -6.9", sep=" ")
y <- read.table(text="0.5 0.6 0.6 0.7 0.7 0.8 0.8 0.9 0.9 1.0 1.0 1.1
1.1
1.2 1.2 0.5 0.5 0.6 0.7 0.8 0.9 0.9 1.0 1.1 1.1 1.2 1.3 1.4 1.4 1.5 0.4 0.5
0.6 0.7 0.8 0.9 1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 0.4 0.5 0.7 0.8 0.9 1.0
1.1 1.2 1.3 1.5 1.6 1.7 1.9 2.0 2.1 0.4 0.5 0.7 0.8 1.0 1.1 1.2 1.3 1.5 1.7
1.8 2.0 2.1 2.3 2.4 0.3 0.5 0.7 0.9 1.0 1.2 1.4 1.5 1.7 1.9 2.1 2.3 2.5 2.7
2.8 0.2 0.4 0.7 0.9 1.1 1.3 1.4 1.6 1.9 2.2 2.4 2.6 2.8 3.1 3.3 0.2 0.4 0.7
1.0 1.3 1.5 1.6 1.8 2.2 2.5 2.7 3.0 3.3 3.6 3.8 0.2 0.5 0.8 1.1 1.4 1.7 1.8
2.0 2.4 2.8 3.1 3.4 3.7 4.1 4.3 0.1 0.4 0.8 1.2 1.5 1.8 1.9 2.2 2.7 3.1 3.5
3.8 4.2 4.5 4.9", sep=" ")
x <- as.numeric(x)
y <- as.numeric(y)
z <- read.table(text="-35 -30 -25 -20 -15 -10 -5 0 5 10 15 20 25 30 35
-35
-30 -25 -20 -15 -10 -5 0 5 10 15 20 25 30 35 -35 -30 -25 -20 -15 -10 -5 0 5
10 15 20 25 30 35 -35 -30 -25 -20 -15 -10 -5 0 5 10 15 20 25 30 35 -35 -30
-25 -20 -15 -10 -5 0 5 10 15 20 25 30 35 -35 -30 -25 -20 -15 -10 -5 0 5 10
15 20 25 30 35 -35 -30 -25 -20 -15 -10 -5 0 5 10 15 20 25 30 35 -35 -30 -25
-20 -15 -10 -5 0 5 10 15 20 25 30 35 -35 -30 -25 -20 -15 -10 -5 0 5 10 15
20 25 30 35 -35 -30 -25 -20 -15 -10 -5 0 5 10 15 20 25 30 35", sep="
")
z <- as.numeric(z)
df <- data.frame(x,y,z,v) #hier ist df die originale kali
plot3d(x,y,v)
all_dat <- c()
for (n in seq(min(z), max(z),5))
{
blubb <- (which(df$z == n)) #hier werden gleiche winkel gesucht
gleicheWink <- df[(blubb),]
red_df <- data.frame(t=seq(1,length(gleicheWink[,1]),1), x gleicheWink$x,
y= gleicheWink$y, v=gleicheWink$v )
ts <- seq( from = min(red_df$t), max(red_df$t), length=50 )
d2 <- apply( red_df[,-1], 2, function(u) spline(red_df$t, u, xout = ts
)$y )
all_dat <- rbind(all_dat, d2)
}
x <- all_dat[,1]
y <- all_dat[,2]
z <- all_dat[,3]
sp <- interp(x,y,z,linear=TRUE, xo=seq(min(x),max(x), length=50),
yo=seq(min(y),max(y), length=50), duplicate="mean")
open3d(scale=c(1/diff(range(x)),1/diff(range(y)),1/diff(range(z))))
zlen=5
cols <- heat.colors(zlen)
with(sp,surface3d(x,y,z, color=cols)) #,alpha=.2))
points3d(x,y,z)
title3d(xlab="x",ylab="y",zlab="v")
axes3d()
[[alternative HTML version deleted]]