Loading the libraries and the dataset

# initialisation
graphics.off()
rm(list = ls())

# global parameters
flag.verbose = FALSE
opers = EStatOption_fromKeys(c("NUM", "MINI", "MAXI", "MEAN", "STDV"))
set.seed(25854)

Initial data set

# grid
nx  = c(100, 100)
dx  = 1/nx
x0  = c(0., 0.)
grd = DbGrid_create(nx = nx, dx = dx, x0 = x0)

# neighborhood
neigh = NeighMoving_create(nmaxi = 50, nmini = 10, radius = 1.0)

# model
rho = 0.7
c0  = matrix(c(1.0, rho, rho, 1), nrow = 2, ncol = 2)
mod = Model_createFromParam(type = ECov_EXPONENTIAL(), range = 0.1, sills = c0)
err = mod$setMeans(c(100, 0))
# Initial simulation
err = simtub(dbin = NULL, dbout = grd, model = mod, nbsimu = 1, 
             namconv = NamingConvention("Y"))

err = grd$setName("Y.1", "Z1")
err = grd$setName("Y.2", "Z2")

knitr::kable(dbStatisticsMono(grd, names = "Z*", opers = opers, flagIso = FALSE)$toTL(),
             digits = 3, 
             caption = "Statistics on the initial simulations")
Statistics on the initial simulations
Number Minimum Maximum Mean St. Dev.
Z1 10000 96.240 103.796 100.056 1.035
Z2 10000 -3.893 4.364 -0.080 0.994 
print(paste0("Correlation = ", round(cor(grd["Z1"], grd["Z2"]), 3)))
## [1] "Correlation = -0.692"

Deriving a heterotopic data base

np = 200

dat = Db_createSamplingDb(db = grd, number = np, names = c("x1", "x2", "Z1", "Z2"), 
                          seed = 123)

# discarding 1/4 of the initial data on Z1
sel = sort(sample(1:np, np/4, replace = FALSE))
Z1 <- dat["Z1"]
Z1[sel] <- NaN
dat["Z1.heterotopic"] <- Z1

# discarding 1/5 of the initial data on Z2
sel = sort(sample(1:np, np/5, replace = FALSE))
Z2 <- dat["Z2"]
Z2[sel] <- NaN
dat["Z2.heterotopic"] <- Z2

knitr::kable(dbStatisticsMono(dat, names = "Z*.heterotopic", opers = opers, 
                              flagIso = FALSE)$toTL(), digits = 3, 
             caption = "Statistics on the heterotopic data set")
Statistics on the heterotopic data set
Number Minimum Maximum Mean St. Dev.
Z1.heterotopic 150 97.698 102.954 100.087 1.021
Z2.heterotopic 160 -2.599 2.103 -0.044 0.992 
knitr::kable(dbStatisticsMono(dat, names = "Z*.heterotopic", opers = opers, 
                              flagIso = TRUE)$toTL(), digits = 3, 
             caption = "Statistics on the homotopic sub set")
Statistics on the homotopic sub set
Number Minimum Maximum Mean St. Dev.
Z1.heterotopic 125 97.698 102.954 100.129 1.028
Z2.heterotopic 125 -2.599 2.103 -0.054 1.021

Conditional simulations

- with homotopic data set

err = dat$setLocators(names = paste(c("Z1", "Z2"), sep = "."), 
                      locatorType = ELoc_Z(), cleanSameLocator = TRUE)
err = simtub(dbin = dat, dbout = grd, model = mod, neigh = neigh, nbsimu = 1, 
             seed = 2597,
             namconv = NamingConvention("homotopic"))

# statistics
knitr::kable(
  rbind(
    dbStatisticsMono(grd, names = paste0("homotopic*"), opers = opers, 
                     flagIso = FALSE)$toTL()
  ), digits = 4, caption = "Statistics on simulated data"
)
Statistics on simulated data
Number Minimum Maximum Mean St. Dev.
homotopic.Z1 10000 95.8723 103.4425 100.0238 1.0003
homotopic.Z2 10000 -3.2258 3.6165 0.0544 0.9683 
# histogram and base map
p1 = ggDefault() + plot.hist(grd, name = "homotopic.Z1")
p2 = ggDefault() + plot.hist(grd, name = "homotopic.Z2")
p3 = ggDefault() + plot.grid(grd, nameRaster = "homotopic.Z1", palette = "Spectral", 
                             flagLegendRaster = TRUE, legendNameRaster = "Z1")
p4 = ggDefault() + plot.grid(grd, nameRaster = "homotopic.Z2", palette = "Spectral", 
                             flagLegendRaster = TRUE, legendNameRaster = "Z2")
ggarrange(p1, p2, p3, p4, nrow = 2, ncol = 2)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

- with heterotopic data set

err = dat$setLocators(names = paste(c("Z1", "Z2"), "heterotopic", sep = "."), 
                      locatorType = ELoc_Z(), cleanSameLocator = TRUE)
err = simtub(dbin = dat, dbout = grd, model = mod, neigh = neigh, nbsimu = 1, 
             seed = 2597,
             namconv = NamingConvention("heterotopic"))

# statistics
knitr::kable(
  rbind(
    dbStatisticsMono(grd, names = paste0("heterotopic*"), opers = opers, 
                     flagIso = FALSE)$toTL()
  ), digits = 4, caption = "Statistics on simulated data"
)
Statistics on simulated data
Number Minimum Maximum Mean St. Dev.
heterotopic.Z1.heterotopic 10000 96.0081 103.5257 99.9908 1.0449
heterotopic.Z2.heterotopic 10000 -3.3506 3.6063 0.0156 0.9861 
# histogram and base map
p1 = ggDefault() + plot.hist(grd, name = "heterotopic.Z1.heterotopic")
p2 = ggDefault() + plot.hist(grd, name = "heterotopic.Z2.heterotopic")
p3 = ggDefault() + plot.grid(grd, nameRaster = "heterotopic.Z1.heterotopic", 
                             palette = "Spectral", 
                             flagLegendRaster = TRUE, legendNameRaster = "Z1")
p4 = ggDefault() + plot.grid(grd, nameRaster = "heterotopic.Z2.heterotopic", 
                             palette = "Spectral", 
                             flagLegendRaster = TRUE, legendNameRaster = "Z2")
ggarrange(p1, p2, p3, p4, nrow = 2, ncol = 2)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.