correction of Scenario B

2-SMLFilltableJRCTests.R

@@ -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 ----------
 

PrepareData/BuildSiteHTML.R

@@ -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"
+)
+
+

PrepareData/plotResultsFillTable.Rmd

+---
+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)
+
+
+

functionssML.R

@@ -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 ,