# \donttest{
library(sf)
if (!require(ggplot2)) print("Plotting of results will not work
without installation of ggplot2")
if (!require(viridis)) print("Some of the plots will not work
without installation of viridis package")
if (!require(patchwork)) print("Some of the plots will not work
without installation of patchwork")
if (require(giscoR)) {
useBorder = TRUE
} else {
useBorder = FALSE
print("You need to install giscoR for plotting borders and clipping the gridded maps")
}
# These are SYNTHETIC agricultural FSS data
data(ifs_dk) # Census data
ifs_weight = ifs_dk %>% dplyr::filter(Sample == 1) # Extract weighted subsample
# Create spatial data
ifg = fssgeo(ifs_dk, locAdj = "LL")
fsg = fssgeo(ifs_weight, locAdj = "LL")
if (useBorder) {
# Read country borders, only used for plotting
borders = gisco_get_nuts(nuts_level = 0)
dkb = borders[borders$CNTR_CODE == "DK",] %>% st_transform(crs = 3035)
}
ress = c(1,5,10,20,40, 80, 160)*1000
# Gridding Utilized agricultural area (UAA)
ifl = gridData(ifg, "UAA",res = ress)
# Gridding organic utilized agricultural area
ifl2 = gridData(ifg, vars = "UAAXK0000_ORG", res = ress)
# Gridding UAA and organic UAA together
ifl3 = gridData(ifg, vars = c("UAA", "UAAXK0000_ORG"), res = ress)
# Gridding the UAA from the survey - the survey weights are in the column EXT_MODULE
fsl = gridData(fsg, vars = c("UAA"), weights = "EXT_MODULE", res = ress)
# Create a multi-resolution grid only with farm number as confidentiality rule, then plot results
himg0 = multiResGrid(ifl, checkReliability = FALSE, suppresslim = 0)
ggplot(himg0) + geom_sf(aes(fill = count))
# Create a multi-resolution grid of UAA, also based on the dominance rule (default)
himg1 = multiResGrid(ifl, vars = "UAA", ifg = ifg)
p1 = ggplot(himg1) + geom_sf(aes(fill = UAA))
p1
# Create a multi-resolution grid of UAA, also based on the p-percent rule
himg101 = multiResGrid(ifl, vars = "UAA", ifg = ifg, checkPpercent = TRUE)
p11 = ggplot(himg101) + geom_sf(aes(fill = UAA))
p11
# Create multi-resolution grid of organic UAA
himg2 = multiResGrid(ifl2, vars = "UAAXK0000_ORG", ifg = ifg)
himg21 = multiResGrid(ifl2, vars = "UAAXK0000_ORG", ifg = ifg, postProcess = FALSE)
ggplot(himg2) + geom_sf(aes(fill = UAAXK0000_ORG))
# Create joint multi-resolution grid of organic UAA and total UAA
himg3 = multiResGrid(ifl3, vars = c("UAA", "UAAXK0000_ORG"), ifg = ifg,
checkReliability = FALSE, suppresslim = 0)
# Create multi-resolution grid of organic UAA, based on the UAA grid
# The large number of missing values indicates that this feature should
# mainly be used for data that have similar or higher resolution as the
# original data set.
himg33 = multiResGrid(himg1, vars = c("UAAXK0000_ORG"), ifg = ifg,
checkReliability = FALSE, suppresslim = 0)
p31 = ggplot(himg3) + geom_sf(aes(fill = UAA))
p32 = ggplot(himg3) + geom_sf(aes(fill = UAAXK0000_ORG))
p33 = ggplot(himg33) + geom_sf(aes(fill = UAAXK0000_ORG))
if (require(patchwork)) p31 + p32 + p33
# Create multi-resolution grid of UAA, based on survey data,
# with and without applying reliability check
# This is a relatively slow functionality
# rounding is set to FALSE, to be better able to visualize the few records
# (Not recommended for data to be published)
himg4 = multiResGrid(fsl, vars = c("UAA"), weights = "EXT_MODULE", ifg = fsg,
strat = "STRA_ID_CORE", checkReliability = FALSE, rounding = FALSE)
# The parameter reliabilitySplit = 15 will divide the data set in 15 groups for the
# reliabilityCheck.
# A lower value would be recommended, but a high value speeds up the computation for this example
himg5 = multiResGrid(fsl, vars = c("UAA"), weights = "EXT_MODULE", ifg = fsg,
strat = "STRA_ID_CORE", checkReliability = TRUE,
reliabilitySplit = TRUE, rounding = FALSE, pseudoreg = "REGIONS")
# Apply suppreslim to suppress insignificant grid cells
# Show intermediate maps of confidential cells (wait 5 seconds)
pint = ifelse(interactive(), 5, FALSE)
#himg11 = multiResGrid(ifl, vars = "UAA", ifg = ifg,
# suppresslim = 0, plotIntermediate = pint)
himg11 = himg1
himg12 = multiResGrid(ifl, vars = "UAA", ifg = ifg,
suppresslim = 0.02, plotIntermediate = pint)
himg13 = multiResGrid(ifl, vars = "UAA", ifg = ifg,
suppresslim = 0.05, plotIntermediate = pint)
himg14 = multiResGrid(ifl, vars = "UAA", ifg = ifg,
suppresslim = 0.1, plotIntermediate = pint)
# This is an example of a userfun that can be used for alternative restrictions
# for a grid cell. This particular toy example assures that there are at least
# \code{nabove} records with a value (UAA in this case) above a certain "limit".
ufun = function(df, nabove, limit) {
sum(df$gridvar > limit) < nabove
}
himg6 = multiResGrid(ifl, vars = "UAA", ifg = ifg,
suppresslim = 0.2, plotIntermediate = pint, userfun = ufun, nabove = 5, limit = 10)
if (useBorder) himg00 = st_intersection(dkb, himg0) else himg00 = himg0
p00 = ggplot() + geom_sf(data = himg00, aes(fill = count, color = count)) +
scale_fill_viridis( name = "number of farms", trans = "log10") +
scale_color_viridis( name = "number of farms", trans = "log10") +
coord_sf(crs = 3035) +
ggtitle("Number of farms for variable grid cell size, only frequency confidentiality") +
theme_bw()
if (useBorder) p00 = p00 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
p00
if (useBorder) himg01 = st_intersection(dkb, himg1) else himg01 = himg1
p01 = ggplot() + geom_sf(data = himg01, aes(fill = count, color = count)) +
scale_fill_viridis( name = "number of farms", trans = "log10") +
scale_color_viridis( name = "number of farms", trans = "log10") +
coord_sf(crs = 3035) +
ggtitle("Number of farms for variable grid cell size, frequency and dominance confidentiality") +
theme_bw()
if (useBorder) p01 = p01 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
p01
# Plot the density of organic agriculture, as hectares per square km
if (useBorder)himg02 = st_intersection(dkb, himg2) else himg02 = himg2
himg02$orgarea = himg02$UAAXK0000_ORG/units::set_units(st_area(himg02), "km^2")
units(himg02$orgarea) = NULL
p02 = ggplot() + geom_sf(data = himg02, aes(fill = orgarea), lwd = 0) +
scale_fill_viridis( name = "ha / km2") +
coord_sf(crs = 3035) +
ggtitle("Organic UAA density") +
theme_bw()
if (useBorder) p02 = p02 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
p02
# Plot the relative abundance of organic UAA relative to total UAA
if (useBorder) himg03 = st_intersection(dkb, himg3) else himg03 = himg3
himg03$ouaashare = himg03$UAAXK0000_ORG/himg03$UAA*100
p03 = ggplot() + geom_sf(data = himg03, aes(fill = ouaashare), lwd = 0) +
scale_fill_viridis( name = "% Organic") +
coord_sf(crs = 3035) +
ggtitle("Organic share") +
theme_bw()
if (useBorder) p03 = p03 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
p03
# Plot maps from survey data before and after adding the reliability constraint
# The percentage of UAA can be above 100% due to farm area being registered at the location
# of the administration building, but the map without reliability check has too high values
# for too many cells
if (useBorder) himg04 = st_intersection(dkb, himg4) else himg04 = himg4
himg04$area = st_area(himg04)/1e6
units(himg04$area) = NULL
himg04$uaashare = himg04$UAA/himg04$area
himg04$uaashare[himg04$uaashare > 1000] = 1000
p04 = ggplot() + geom_sf(data = himg04, aes(fill = uaashare), lwd = 0) +
scale_fill_viridis( name = "% UAA", trans = "log10", limits = c(1,1000)) +
coord_sf(crs = 3035) +
ggtitle("UAA share (sample without reliability check)") +
theme_bw()
if (useBorder) p04 = p04 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
p04
if (useBorder) himg05 = st_intersection(dkb, himg5) else himg05 = himg5
himg05$area = st_area(himg05)/1e6
units(himg05$area) = NULL
himg05$uaashare = himg05$UAA/himg05$area
himg05$uaashare[himg05$uaashare > 1000] = 1000
p05 = ggplot() + geom_sf(data = himg05, aes(fill = uaashare), lwd = 0) +
scale_fill_viridis( name = "% UAA", trans = "log10", limits = c(1,1000)) +
coord_sf(crs = 3035) +
ggtitle("UAA share (sample with reliability check)") +
theme_bw()
if (useBorder) p05 = p05 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
if (require(patchwork)) p04 + p05 + plot_layout(guides = "collect")
if (useBorder) himg06 = st_intersection(dkb, himg6) else himg06 = himg6
p06 = ggplot() + geom_sf(data = himg06, aes(fill = UAA), lwd = 0) +
scale_fill_viridis( name = "ha") +
coord_sf(crs = 3035) +
ggtitle("UAA, with additional user defined function") +
theme_bw()
if (useBorder) p06 = p06 + geom_sf(data = dkb, fill = NA, colour='black', lwd = 1)
p06
# Plot the different maps from using different suppreslim values
himgs = list(himg11, himg12, himg13, himg14)
slims = c(0, 0.02, 0.05, 0.1, 0.2)
plots = list()
uaas = c(himg11$UAA, himg12$UAA, himg13$UAA, himg14$UAA)
lims = range(uaas[uaas > 0], na.rm = TRUE)
for (ii in 1:4) {
if (useBorder) himg = st_intersection(dkb, himgs[[ii]]) else himg = himgs[[ii]]
plots[[ii]] =
ggplot() + geom_sf(data = himg, aes(fill = UAA), lwd = 0) +
scale_fill_viridis( name = "UAA (ha)", trans = "log10", limits = lims, na.value="red") +
ggtitle(paste("Suppresslim = ", slims[[ii]])) +
xlab("") + ylab("") +
theme_bw()
if (useBorder) plots[[ii]] = plots[[ii]] +
geom_sf(data = dkb, fill = NA, colour='black', lwd = 0.5)
}
if (require(patchwork)) plots[[1]] + plots[[2]] + plots[[3]] + plots[[4]] +
plot_layout(guides = "collect")
# }
#' @rdname multiResGrid
Run the code above in your browser using DataLab