zplot <- function(x,y,z,DrawTopView = TRUE,NrOfContourLines = 20, TwoDplotter = 'native', xlim, ylim){
# plotobject = zplot(x,y,z)
# plotobject = zplot(x,y,z,DrawTopView,NrOfContourLines,TwoDplotter)
# plots z above xy plane as mountain
# INPUT
# x,y,z the three coordinates to plot may also be given as 3D array XYZ
# OPTIONAL
# DrawTopView ==1 means contur is drawn, otherwise a 3D plot is drawn (default:DrawTopView==0);
# NrOfContourLines number of contour lines to be drawn
# TwoDplotter if DrawTopView==1: use the following engine to plot.
# legal values: "ggplot", "native", "plotly"
#
# OUTPUT
# plotobject as returned by plotting routines
# taken from matlabs 2005 version of ALU
# Implemented in R: FP 3/2016
isnumber=function(x) return(is.numeric(x)&length(x)==1)
if(!isnumber(NrOfContourLines))
stop('"NrOfContourLines" is not a numeric number of length 1. Please change Input.')
if(!is.vector(x)){
x=as.vector(x)
warning('x is not a vector. Calling as.vector()')
}
if(!is.numeric(x)){
x=as.numeric(x)
warning('x is not a numeric. Calling as.numeric()')
}
if(!is.vector(y)){
y=as.vector(y)
warning('y is not a vector. Calling as.vector()')
}
if(!is.numeric(y)){
y=as.numeric(y)
warning('y is not a numeric. Calling as.numeric()')
}
if(!is.vector(z)){
z=as.vector(z)
warning('z is not a vector. Calling as.vector()')
}
if(!is.numeric(z)){
z=as.numeric(z)
warning('z is not a numeric. Calling as.numeric()')
}
if(missing(xlim))
xlim = c(min(x), max(x))
if(missing(ylim))
ylim = c(min(y), max(y))
requireNamespace('plyr')
if(missing(y) && missing(z)){
# All Dataparameters given as single matrix.
data = as.matrix(x)
} else {
data = cbind(x,y,z)
}
nrofbins = 100 # Magic number taken from matlabcode
minx = min(data[,1])
maxx = max(data[,1])
xbins = seq(minx, maxx, length.out = nrofbins)
miny = min(data[,2])
maxy = max(data[,2])
ybins = seq(miny, maxy, length.out = nrofbins)
# Jetzt: Interpolation mit akima
# requireRpackage('akima')
# Aequivaltent zu Griddata in Matlab. Arbeitet nur leider linear.
# Ergebnis trotzdem sehr nah an Matlab.
#this is faster but acm license
# requireNamespace('akima')
# fld <- akima::interp(x=data[,1],
# y=data[,2],
# z=data[,3],
# xo=xbins,
# yo=ybins,
# linear=T,
# duplicate = 'mean')
#
#this slower but better license
# requireNamespace('interp')
# fld <- interp::interp(x=data[,1],
# y=data[,2],
# z=data[,3],
# xo=xbins,
# yo=ybins,
# linear=T,
# duplicate = 'mean')
if (!requireNamespace('MBA',quietly = TRUE)){
message('Subordinate package (MBA) is missing. No computations are performed.
Please install the package which is defined in "Suggests".')
return('Subordinate package (MBA) is missing. No computations are performed.
Please install the package which is defined in "Suggests".')
}
requireNamespace('MBA')
fld<- MBA::mba.surf(xyz = data,no.X = nrofbins,no.Y=nrofbins)$xyz.est
if(!isTRUE(DrawTopView)){
#### Option 1: Plotly. Plotly ist ein im Backend auf Javascript basierendes Plotingframework
xaxis = list(title = "X")
yaxis = list(title = "Y")
zaxis = list(title = "Z")
# requireRpackage("plotly")
requireNamespace('plotly')
# Aus Gruenden erwartet plotly die Matrix transponiert zur R implementation
p<-plotly::plot_ly(x = fld$x, y = fld$y, z = t(fld$z), type="surface", colors = DataVisualizations::PmatrixColormap)
#p<-plotly::plot_ly(x = fld[,1], y = fld[,2], z = fld[,3], type="surface", colors = DataVisualizations::PmatrixColormap)
p <-plotly::layout(p,scene =list(xaxis = xaxis, yaxis = yaxis, zaxis = zaxis),dragmode="turntable")
return(p)
####
#### Option 2: rgl. Kann GAR keine colormaps?
# requireRpackage("rgl")
# requireRpackage("evd")
# persp3d(x = fld$x, y = fld$y, z = fld$z)
} else {
switch(TwoDplotter,'ggplot'={
kernels <- as.matrix(expand.grid(x = xbins, y = ybins))
naz = which(is.na(fld$z))
fld$z[naz] = 0
df = data.frame(x = kernels[,1], y = kernels[,2], z = as.vector(fld$z))
# Aufbau des Plots
plt <- ggplot() +
geom_raster(data = df, aes(x = x, y = y, fill=z))+ # Fuer den hintergrund
geom_contour(data = df, aes(x = x, y = y, z = z), bins = NrOfContourLines,colour="grey",alpha=0.5) +
scale_fill_gradientn(colors = DataVisualizations::PmatrixColormap) +
coord_cartesian(xlim = xlim, ylim = ylim)
# if(PlotPoints){
# df2 <- data.frame(cbind(x,y))
# plt <- plt + geom_point(data = df2, aes(x,y), colour = 'blue')
# }
return(plt)
}, 'native'={
# R eigener Contourplot
colormapWrapper <- function(n){
tmp <- as.numeric(cut(1:length(DataVisualizations::PmatrixColormap),n))
fun <- function(x){median(which(tmp == x))}
return(DataVisualizations::PmatrixColormap[as.integer(apply(t(t(unique(tmp))), 1, fun))])
}
filled.contour(x = fld$x,
y = fld$y,
z = fld$z,
nlevels = NrOfContourLines,
color.palette = colormapWrapper,
xlim = xlim,
ylim = ylim)
}, 'plotly'={
### Plotly Contourplot. leider schlechter dokumentiert und keine NrOfContourLines
return(plotly::plot_ly(x = fld$y, y =fld$x, z = t(fld$z), type = "contour", colors = DataVisualizations::PmatrixColormap))
})
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.