Skip to content
Snippets Groups Projects
Commit 63092cce authored by Nicolas Saby's avatar Nicolas Saby :bicyclist_tone1:
Browse files

correction of Scenario B

parent 67e01dd4
No related branches found
No related tags found
No related merge requests found
Pipeline #172014 passed
......@@ -295,7 +295,7 @@ sample1500Fr$FR_NUTS1 <- as.factor(sample1500Fr$FR_NUTS1)
rnd.lhsFr = clhs::clhs(sample1Fr[ , X ],
size=clhsNb,
iter=20000,
iter=2000,
progress=T,
simple=F
......@@ -303,7 +303,7 @@ rnd.lhsFr = clhs::clhs(sample1Fr[ , X ],
rnd.lhs500Fr = clhs::clhs(sample1500Fr[ , X ],
size=clhsNb,
iter=20000,
iter=2000,
progress=T,
simple=F
......@@ -314,7 +314,7 @@ rnd.lhs500Fr = clhs::clhs(sample1500Fr[ , X ],
# A JRC scenario with default layers (A)
sample2 <- sample1500Fr[rnd.lhs500Fr$index_samples,]
sample2 <- sample1Fr[rnd.lhsFr$index_samples,]
# simplified LU if necessary, not here
sample2$FR_CLC_S = sample2$FR_CLC # occuprecode(sample2$FR_CLC)
......@@ -326,7 +326,7 @@ sample3$domains <- as.factor(as.character(sample3$domains))
sample3$id <- c(1:nrow(sample3))
ndom <- length(unique(sample2$domains))
ndom <- length(unique(sample3$domains))
cv <- as.data.frame(list(DOM=rep("DOM1",ndom),
CV1=rep(0.05,ndom),
......@@ -369,7 +369,7 @@ sample3$domains <- as.factor(as.character(sample3$domains))
sample3$id <- c(1:nrow(sample3))
ndom <- length(unique(sample2$domains))
ndom <- length(unique(sample3$domains))
cv <- as.data.frame(list(DOM=rep("DOM1",ndom),
CV1=rep(0.05,ndom),
......@@ -452,7 +452,7 @@ sample3$domains <- as.factor(as.character(sample3$domains))
sample3$id <- c(1:nrow(sample3))
ndom <- length(unique(sample2$domains))
ndom <- length(unique(sample3$domains))
cv <- as.data.frame(list(DOM=rep("DOM1",ndom),
CV1=rep(0.05,ndom),
......@@ -483,6 +483,7 @@ plotResu(testB3,
stack500 = stack500Fr
)
save.image("output/FillJRCTableResults.RData")
## test B3.1 ----------
......
......@@ -17,3 +17,20 @@ rmarkdown::render("PrepareData/plotResults.Rmd",
encoding="UTF-8"
)
rmarkdown::render("PrepareData/plotResultsFillTable.Rmd",
readthedown(highlight = "kate",
gallery = TRUE,
fig_width = 12,
fig_height = 12,
# toc = TRUE,
# toc_float = TRUE,
code_folding = c("hide")),
params = list(MySite = site ),
output_dir = 'public/',
output_file = 'index.html',
# output_format = c("html_document"),
encoding="UTF-8"
)
---
title: "First results SML sampling exercise"
author: "Nicolas Saby"
output: html_document
date: "2024-02-08"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
load("../output/first_test.RData")
stac500a = rast("~/serena/data/sml/europe/stack500.tiff")
```
# To fill the JRC table
Here is the results of the different scenarios
```{r}
load("../output/FillJRCTableResults.RData")
```
```{r}
cbind.data.frame(
scenario = c("A1","A2","A4","B1","B2","B3"),
nSites = c(testA1$NbSample,testA2$NbSample,testA4$NbSample,testB1$NbSample,testB2$NbSample,testB3$NbSample)
)
```
![A1](../output/testA1.jpeg)
![B1](../output/B1.jpeg)
# comparison with 3 different sets of starting samples
Here we compare the computed required sample sizes using NUTS1 only as Domain and with different starting samples:
1) A 5k sample selected by clhs based on 80k SI sample as proposed by JRC.
2) A 80k SI sample
3) A 20k SY sample
SI = random sampling
SY = systematic sampling
The SY sample gave a larger required sample size.
There is a very large differences in computed required sample sizes.
```{r}
# Results for 1
print(c( "CLHS 5k sample", resNUTS1Sallprop$NbSample))
# Results for 2
print(c( "A 80k SI sample", resNUTS1allpropLargeSample$NbSample) )
# Results for 3
print(c( "A 20k SY sample", resGRid10k$NbSample))
```
Here are the maps
For the 5K starting sample
![Sample5K](../output/NUTS1allclhs.jpeg)
For the 80K starting sample
![test](../output/NUTS1allLarge.jpeg)
For a grid as starting sample
![Sample5K](../output/Nuts1AllGRid10k.jpeg)
......@@ -44,11 +44,14 @@ optimisesampleSML <-function(
print(" Include points from existing surveys (forcing to keep existing points) ")
tab1 <- table(framesamp[,domainvalue])
framesamp <- sample2[framesamp[,domainvalue] %in% names(tab1[tab1 >= 10]),]
framesamp <- framesamp[framesamp[,domainvalue] %in% names(tab1[tab1 >= 10]),]
tab1 <- table(framecens[,domainvalue])
framecens <- framecens[framecens[,domainvalue] %in% names(tab1[tab1 >= 10]),]
print(dim(framecens))
sample2 <- rbind(framesamp,
framecens)
......@@ -90,6 +93,9 @@ optimisesampleSML <-function(
frame1samp <- frame1[ ind_framecens , ]
frame1cens <- frame1[ !ind_framecens , ]
print(dim(frame1cens))
solution3 <- optimStrata(method = "continuous",
errors = cv,
framesamp = frame1samp ,
......
This diff is collapsed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment