Commit 6875d810 authored by alge's avatar alge

plot fuer bias term

hat plot.krige.map fehler bei nicht quadratischem gitter !?
immer noch (wieder) sefaults, aber nur beim R beenden!
parent 4f890057
......@@ -210,92 +210,13 @@ bk.grid <- function(point.obj,
typpr<-prior$info
typpr[prior$type=="subjective"]<-typpr[prior$type=="subjective"]*(-1)
#browser()
if(FALSE)
snbbit<-rep(0,1+n*nz)
snbbit[1]<-1
ans<-.C("bk_grid",
# xsw = as.double(xsw),
xsw = as.double(1),
# ysw = as.double(ysw),
ysw = as.double(1),
# xne = as.double(xne),
xne = as.double(1),
# yne = as.double(yne),
yne = as.double(1),
# angle = as.double(angle),
angle = as.double(1),
# nx = as.integer(nx),
nx = as.integer(1),
# ny = as.integer(ny),
ny = as.integer(1),
# dx = as.double(dx),
dx = as.double(1),
# dy = as.double(dy),
dy = as.double(1),
# xg = double(nx),
xg = double(1),
# yg = double(ny),
yg = double(1),
# zg = double(nz),
zg = double(1),
# varg = double(nz),
varg = double(1),
# dog = as.integer(dog),
dog = as.integer(1),
# lon = as.double(point.obj$x),
lon = as.double(1),
# lat = as.double(point.obj$y),
lat = as.double(1),
# z = as.double(point.obj[[match(at, names(point.obj))]]),
z = as.double(1),
# extrap = as.integer(extrap),
extrap = as.integer(1),
# n = as.integer(n),
n = as.integer(1),
# covtype = as.integer(covtype),
covtype = as.integer(1),
# covpar = as.double(var.mod.obj$parameters),
covpar = as.double(1),
# trend = as.integer(trend),
trend = as.integer(1),
# ntrend = as.integer(ntrend),
ntrend = as.integer(1),
# mupr = as.double(matlist.cbind(prior$mu)),
mupr = as.double(1),
# ldmpr = as.integer(ntrend),
ldmpr = as.integer(1),
# phipr = as.double(matlist.cbind(prior$phi)),
phipr = as.double(1),
# ldphpr = as.integer(ntrend),
ldphpr = as.integer(1),
# lonpr = as.double(prior$lon),
lonpr = as.double(1),
# latpr = as.double(prior$lat),
latpr = as.double(1),
# npr = as.integer(npr),
npr = as.integer(1),
# typpr = as.integer(typpr),
typpr = as.integer(1),
# rsearch = as.double(rsearch),
rsearch = as.double(1),
# nsearch = as.integer(nsearch),
nsearch = as.integer(1),
# nsmin = as.integer(nsmin),
nsmin = as.integer(1),
# nsmax = as.integer(nsmax),
nsmax = as.integer(1),
# lwork = as.integer(lwork),
lwork = as.integer(1),
# mode = as.integer(mode),
mode = as.integer(1),
# searchnb= integer(n*nz),
searchnb= integer(1),
# ierr = integer(1),
ierr = integer(1),
# glsmth = as.integer(method),
glsmth = as.integer(1)
# ,.Package= "baykrig"
)
if(TRUE) ans<-.C("bk_grid",
xsw = as.double(xsw),
ysw = as.double(ysw),
xne = as.double(xne),
......@@ -333,7 +254,9 @@ if(TRUE) ans<-.C("bk_grid",
nsmax = as.integer(nsmax),
lwork = as.integer(lwork),
mode = as.integer(mode),
searchnb= integer(n*nz),
lambda = double(n*nz),
lambd0 = double(nz),
bits = as.integer(c(integer(nz),snbbit)),
ierr = integer(1),
glsmth = as.integer(method),
# ,.Package= "baykrig"
......@@ -344,9 +267,13 @@ if(TRUE) ans<-.C("bk_grid",
z=matrix(ans$zg,nx,ny),
var=matrix(ans$varg,nx,ny),
done=matrix(ans$dog, nx, ny),
snb=matrix(ans$searchnb,nrow=n,ncol=nz,byrow=F))
snb=matrix(ans$bits[(nz+2):(nz+n*nz+1)],nrow=n,ncol=nz,byrow=F),
lambda=matrix(ans$lambda,nrow=n,ncol=nz,byrow=FALSE),
lambda0=matrix(ans$lambd0,nx,ny)
)
retval$z[retval$done<=0] <- NA
retval$var[retval$done<=0] <- NA
retval$lambda0[retval$done<=0] <- NA
retval$data<-point.obj
retval$at<-at
class(retval)<-"krige.map"
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment