https://github.com/cran/RandomFields
Tip revision: 4877e49dad8ee6b04e79289f69ff7f2186f11506 authored by Martin Schlather on 20 January 2012, 00:00:00 UTC
version 2.0.54
version 2.0.54
Tip revision: 4877e49
x.R
model <- list("a", list("y", 6, 7, c(0, NA, NA)), list(5, 6, NA,8 ))
getNApos <- function(l, n=0) {
# print(l)
if (is.list(l)) {
ret <- NULL
for (i in 1:length(l)) {
nas <- getNApos(l[[i]], n)
n <- nas[[2]]
ret <- c(ret, nas[[1]])
}
# str(list("r", list(ret, n)))
return(list(ret, n))
} else {
x <- which(is.na(l))
# print(c(length(l), n))
# str(list("x", list(x + n, length(l) + n)))
return(list(x + n, length(l) + n))
}
}
putpos <- function(l, pos, what, n=0) {
# print("neu")
# str(l)
if (is.list(l)) {
for (i in 1:length(l)) {
# print(i)
# str(l)
lneu <- putpos(l[[i]], pos, what, n)
l[[i]] <- lneu[[1]]
n <- lneu[[2]]
}
# str(list("r", list(l, n)))
return(list(l, n))
} else {
x <- n + 1:length(l)
idx <- x %in% pos
widx <- pos %in% x
if (any(idx)) {
l[idx] <- what[widx]
}
# str(list("x", list(l, n + length(l))))
return(list(l, n + length(l)))
}
}
getpos <- function(l, pos, n=0) {
# print("neu")
# str(l)
if (is.list(l)) {
ret <- NULL
for (i in 1:length(l)) {
# print(i)
# str(l)
lneu <- getpos(l[[i]], pos, n)
ret <- c(ret, lneu[[1]])
n <- lneu[[2]]
}
# str(list("r", list(l, n)))
return(list(ret, n))
} else {
x <- n + 1:length(l)
idx <- x %in% pos
ret <- l[idx]
# str(list("x", list(l, n + length(l))))
return(list(ret, n + length(l)))
}
}
if (FALSE) {
cat(rep("\n", 15))
(p <- getNApos(model)[[1]])
str(pp <- putpos(model, p, c(23, 24, 25)))
(pp2 <- getpos(pp[[1]], p))
}