Intro

Elaborazioni su spunti da “Introduzione al rilevamento campionario delle risorse forestali” (Corona, 2000)

Premesse

Il dimensionamento è un processo iterativo (vedi esempi 5.7 ed altri)

\(n_0 =\) stima della dimensione minima per ottenere un campione che conduca a valutazioni affette da un errore campionario non superiore ad \(ecp_0\), con un livello di confidenza pari a \(p_0\) (consuetudinariamente si adottano valori di 90%, 95% o 99%).

Il livello di confidenza è quantificato nella stima tramite il valore del \(t\) di Student che dipende da \(p_0\) e da \(df=\) ‘gradi di ibertà’: \(t(p_0, df)\). La stima è per sua natura iterativa in quanto occorre modificare progressivamente \(df\) per adattarlo al valore di \(n_0\) generato al passo precedente.

Gli stimatori di \(n_0\) sono tendenzialemte specifici e rispondono allo schema campionario adottato, al parametro statistico oggetto di indagine ed alle caratteristiche del popolamento.

Campionamento casuale semplice (SRS)

Stima della media

Popolazione infinita

(o, equivalentemente, ‘campionamento con reinserimento’)

NOTA: il campionamento casuale su popolazione infinita è una contraddizione in termini. Infatti, per applicare SRS occorre disporre della lista degli elementi della popolazione!

\[ n_0 = \left( {\frac{t(p_0, df) * CV%}{epc_0}} \right)^2\]

  1. In prima approssimazione si può assumere per \(t\) un valore centrale: \(t(95\%, 60)=2\).
library(tidyverse)
p_0 <- 95/100        # 1-P_0 = P(X<x) test 'ad una coda'
p_01<- 1-(1-p_0)/2   # 1-P_0 = P(abs(X-x)) test 'a 2 code'
df <- 60
t <- qt(p_01, df)

df <- crossing(CV = seq(.1,.7,.01), 
               ecp_0 = seq(.1,.4,.05)) %>% 
  mutate(n_0 = (t*CV/ecp_0)^2)

df %>% 
  filter(n_0 > 1) %>% 
  ggplot(aes(x = CV*100, y = n_0, 
             colour = as.factor(ecp_0*100))) +
  ggtitle("Nomogramma dimesionamento - prima approssimazione",
          "(SRS, media, Pop.infinita)")+
  labs(x = bquote(~ CV ~ "%"),
       y = bquote(~ n[0] ~ ""),
       colour = bquote(~ ec[0] ~ "%")) +
#  labs(colour = "ec_0%") +
  geom_line() +
  scale_y_log10()

  1. Nel tentativo di tenere conto del processo iterativo che, in fase applicativa, è necessario adottare, si ottiene un andamento irregolare. Per semplificare la presentazione le singole spezzate vengono smorzate in curve.
n_0i <- function(p, n_0, CVp, ecp){
  n_01 <- (n_0)
  n_02 <- ((qt(p_01, n_01-1)*CVp/ecp)^2)
  d1 <- abs(n_01 - n_02)
  repeat{
    n_03 <- ((qt(p_01, n_02-1)*CVp/ecp)^2)
    d2 <- abs(n_02 - n_03) 
    if(d1 < 2 ) break()
    n_01 <- n_02
    d1 <- d2
    n_02 <- n_03
  }
  return(n_02)
}

df0 <- df
df <- df[df$n_0>3,]
df$n_0j <- NA
for(j in 1:nrow(df)){
  if(df$n_0[j]>2) df$n_0j[j] <- 
      with(df[j,], n_0i(p_01,n_0,CV,ecp_0))
}

df %>% 
  filter(n_0 > 1) %>% 
  ggplot(aes(x = CV*100, y = n_0j, 
             colour = as.factor(ecp_0*100))) +
  ggtitle("Nomogramma dimesionamento - con approssimazione iterativa",
          "(SRS, media, Pop.infinita)")+
  labs(x = bquote(~ CV ~ "%"),
       y = bquote(~ n[0] ~ ""),
       colour = bquote(~ ec[0] ~ "%")) +
#  labs(colour = "ec_0%") +
#  geom_line(aes(y = n_0)) +
  scale_y_log10() +
  geom_smooth(se = F)
`geom_smooth()` using method = 'loess' and formula 'y ~ x'

LS0tDQp0aXRsZTogIkd1aWRhIGFsIGRpbWVuc2lvbmFtZW50byINCmF1dGhvcjoNCi0gYWZmaWxpYXRpb246IE51b3JvRm9yZXN0cnlTY2hvb2wNCiAgbmFtZTogIlJvYmVydG8gU2NvdHRpIg0KZGF0ZTogImByIGZvcm1hdChTeXMudGltZSgpLCAnJWQgJUIgICVZJylgIg0Kb3V0cHV0Og0KIyAgaHRtbF9kb2N1bWVudDogZGVmYXVsdA0KICBodG1sX25vdGVib29rOiBkZWZhdWx0DQojICBwZGZfZG9jdW1lbnQ6IGRlZmF1bHQNCmtleXdvcmRzOiBkYXRhIHdyYW5nbGluZw0KIyBzdWJ0aXRsZTogcHJpbWEgYm96emEgZGkgdW4gZG9jdW1lbnRvIGV2ZW50dWFsbWVudGUgZXN0ZW5kaWJpbGUiDQphYnN0cmFjdDogVE8gQkUgQ09NUExFVEVEDQotLS0NCiMgSW50cm8NCkVsYWJvcmF6aW9uaSBzdSBzcHVudGkgZGEgIkludHJvZHV6aW9uZSBhbCByaWxldmFtZW50byBjYW1waW9uYXJpbyBkZWxsZSByaXNvcnNlIGZvcmVzdGFsaSIgKENvcm9uYSwgMjAwMCkNCg0KIyBQcmVtZXNzZQ0KSWwgZGltZW5zaW9uYW1lbnRvIOggdW4gcHJvY2Vzc28gaXRlcmF0aXZvICh2ZWRpIGVzZW1waSA1LjcgZWQgYWx0cmkpDQoNCiRuXzAgPSQgc3RpbWEgZGVsbGEgZGltZW5zaW9uZSBtaW5pbWEgcGVyIG90dGVuZXJlIHVuIGNhbXBpb25lIGNoZSBjb25kdWNhIGEgdmFsdXRhemlvbmkgYWZmZXR0ZSBkYSB1biBlcnJvcmUgY2FtcGlvbmFyaW8gbm9uIHN1cGVyaW9yZSBhZCAkZWNwXzAkLCBjb24gdW4gbGl2ZWxsbyBkaSBjb25maWRlbnphIHBhcmkgYSAkcF8wJCAoY29uc3VldHVkaW5hcmlhbWVudGUgc2kgYWRvdHRhbm8gdmFsb3JpIGRpIDkwJSwgOTUlIG8gOTklKS4NCg0KSWwgbGl2ZWxsbyBkaSBjb25maWRlbnphIOggcXVhbnRpZmljYXRvIG5lbGxhIHN0aW1hIHRyYW1pdGUgaWwgdmFsb3JlIGRlbCAkdCQgZGkgU3R1ZGVudCBjaGUgZGlwZW5kZSBkYSAkcF8wJCBlIGRhICRkZj0kICdncmFkaSBkaSBpYmVydOAnOiAkdChwXzAsIGRmKSQuIExhIHN0aW1hIOggcGVyIHN1YSBuYXR1cmEgaXRlcmF0aXZhIGluIHF1YW50byBvY2NvcnJlIG1vZGlmaWNhcmUgcHJvZ3Jlc3NpdmFtZW50ZSAkZGYkIHBlciBhZGF0dGFybG8gYWwgdmFsb3JlIGRpICRuXzAkIGdlbmVyYXRvIGFsIHBhc3NvIHByZWNlZGVudGUuDQoNCkdsaSBzdGltYXRvcmkgZGkgJG5fMCQgc29ubyB0ZW5kZW56aWFsZW10ZSBzcGVjaWZpY2kgZSByaXNwb25kb25vIGFsbG8gc2NoZW1hIGNhbXBpb25hcmlvIGFkb3R0YXRvLCBhbCBwYXJhbWV0cm8gc3RhdGlzdGljbyBvZ2dldHRvIGRpIGluZGFnaW5lIGVkIGFsbGUgY2FyYXR0ZXJpc3RpY2hlIGRlbCBwb3BvbGFtZW50by4NCg0KIyBDYW1waW9uYW1lbnRvIGNhc3VhbGUgc2VtcGxpY2UgKFNSUykNCiMjIFN0aW1hIGRlbGxhIG1lZGlhDQojIyMgUG9wb2xhemlvbmUgaW5maW5pdGENCihvLCBlcXVpdmFsZW50ZW1lbnRlLCAnY2FtcGlvbmFtZW50byBjb24gcmVpbnNlcmltZW50bycpDQoNCk5PVEE6IGlsIGNhbXBpb25hbWVudG8gY2FzdWFsZSBzdSBwb3BvbGF6aW9uZSBpbmZpbml0YSDoIHVuYSBjb250cmFkZGl6aW9uZSBpbiB0ZXJtaW5pLiBJbmZhdHRpLCBwZXIgYXBwbGljYXJlIFNSUyBvY2NvcnJlIGRpc3BvcnJlIGRlbGxhIGxpc3RhIGRlZ2xpIGVsZW1lbnRpIGRlbGxhIHBvcG9sYXppb25lIQ0KDQoNCiQkIG5fMCA9IFxsZWZ0KCB7XGZyYWN7dChwXzAsIGRmKSAqIENWJX17ZXBjXzB9fSBccmlnaHQpXjIkJA0KDQpBKSBJbiAqKnByaW1hIGFwcHJvc3NpbWF6aW9uZSoqIHNpIHB18iBhc3N1bWVyZSBwZXIgJHQkIHVuIHZhbG9yZSBjZW50cmFsZTogICR0KDk1XCUsIDYwKT0yJC4NCg0KYGBge3J9DQpsaWJyYXJ5KHRpZHl2ZXJzZSkNCnBfMCA8LSA5NS8xMDAgICAgICAgICMgMS1QXzAgPSBQKFg8eCkgdGVzdCAnYWQgdW5hIGNvZGEnDQpwXzAxPC0gMS0oMS1wXzApLzIgICAjIDEtUF8wID0gUChhYnMoWC14KSkgdGVzdCAnYSAyIGNvZGUnDQpkZiA8LSA2MA0KdCA8LSBxdChwXzAxLCBkZikNCg0KZGYgPC0gY3Jvc3NpbmcoQ1YgPSBzZXEoLjEsLjcsLjAxKSwgDQogICAgICAgICAgICAgICBlY3BfMCA9IHNlcSguMSwuNCwuMDUpKSAlPiUgDQogIG11dGF0ZShuXzAgPSAodCpDVi9lY3BfMCleMikNCg0KZGYgJT4lIA0KICBmaWx0ZXIobl8wID4gMSkgJT4lIA0KICBnZ3Bsb3QoYWVzKHggPSBDVioxMDAsIHkgPSBuXzAsIA0KICAgICAgICAgICAgIGNvbG91ciA9IGFzLmZhY3RvcihlY3BfMCoxMDApKSkgKw0KICBnZ3RpdGxlKCJOb21vZ3JhbW1hIGRpbWVzaW9uYW1lbnRvIC0gcHJpbWEgYXBwcm9zc2ltYXppb25lIiwNCiAgICAgICAgICAiKFNSUywgbWVkaWEsIFBvcC5pbmZpbml0YSkiKSsNCiAgbGFicyh4ID0gYnF1b3RlKH4gQ1YgfiAiJSIpLA0KICAgICAgIHkgPSBicXVvdGUofiBuWzBdIH4gIiIpLA0KICAgICAgIGNvbG91ciA9IGJxdW90ZSh+IGVjWzBdIH4gIiUiKSkgKw0KIyAgbGFicyhjb2xvdXIgPSAiZWNfMCUiKSArDQogIGdlb21fbGluZSgpICsNCiAgc2NhbGVfeV9sb2cxMCgpDQoNCmBgYA0KDQpCKSBOZWwgdGVudGF0aXZvIGRpICoqdGVuZXJlIGNvbnRvIGRlbCBwcm9jZXNzbyBpdGVyYXRpdm8qKiBjaGUsIGluIGZhc2UgYXBwbGljYXRpdmEsIOggbmVjZXNzYXJpbyBhZG90dGFyZSwgc2kgb3R0aWVuZSB1biBhbmRhbWVudG8gaXJyZWdvbGFyZS4gUGVyIHNlbXBsaWZpY2FyZSBsYSBwcmVzZW50YXppb25lIGxlIHNpbmdvbGUgc3BlenphdGUgdmVuZ29ubyBzbW9yemF0ZSBpbiBjdXJ2ZS4NCg0KYGBge3J9DQoNCm5fMGkgPC0gZnVuY3Rpb24ocCwgbl8wLCBDVnAsIGVjcCl7DQogIG5fMDEgPC0gKG5fMCkNCiAgbl8wMiA8LSAoKHF0KHBfMDEsIG5fMDEtMSkqQ1ZwL2VjcCleMikNCiAgZDEgPC0gYWJzKG5fMDEgLSBuXzAyKQ0KICByZXBlYXR7DQogICAgbl8wMyA8LSAoKHF0KHBfMDEsIG5fMDItMSkqQ1ZwL2VjcCleMikNCiAgICBkMiA8LSBhYnMobl8wMiAtIG5fMDMpIA0KICAgIGlmKGQxIDwgMiApIGJyZWFrKCkNCiAgICBuXzAxIDwtIG5fMDINCiAgICBkMSA8LSBkMg0KICAgIG5fMDIgPC0gbl8wMw0KICB9DQogIHJldHVybihuXzAyKQ0KfQ0KDQpkZjAgPC0gZGYNCmRmIDwtIGRmW2RmJG5fMD4zLF0NCmRmJG5fMGogPC0gTkENCmZvcihqIGluIDE6bnJvdyhkZikpew0KICBpZihkZiRuXzBbal0+MikgZGYkbl8waltqXSA8LSANCiAgICAgIHdpdGgoZGZbaixdLCBuXzBpKHBfMDEsbl8wLENWLGVjcF8wKSkNCn0NCg0KZGYgJT4lIA0KICBmaWx0ZXIobl8wID4gMSkgJT4lIA0KICBnZ3Bsb3QoYWVzKHggPSBDVioxMDAsIHkgPSBuXzBqLCANCiAgICAgICAgICAgICBjb2xvdXIgPSBhcy5mYWN0b3IoZWNwXzAqMTAwKSkpICsNCiAgZ2d0aXRsZSgiTm9tb2dyYW1tYSBkaW1lc2lvbmFtZW50byAtIGNvbiBhcHByb3NzaW1hemlvbmUgaXRlcmF0aXZhIiwNCiAgICAgICAgICAiKFNSUywgbWVkaWEsIFBvcC5pbmZpbml0YSkiKSsNCiAgbGFicyh4ID0gYnF1b3RlKH4gQ1YgfiAiJSIpLA0KICAgICAgIHkgPSBicXVvdGUofiBuWzBdIH4gIiIpLA0KICAgICAgIGNvbG91ciA9IGJxdW90ZSh+IGVjWzBdIH4gIiUiKSkgKw0KIyAgbGFicyhjb2xvdXIgPSAiZWNfMCUiKSArDQojICBnZW9tX2xpbmUoYWVzKHkgPSBuXzApKSArDQogIHNjYWxlX3lfbG9nMTAoKSArDQogIGdlb21fc21vb3RoKHNlID0gRikNCg0KDQpgYGANCg0KDQoNCmBgYHtyIGV2YWw9RkFMU0UsIGVjaG89RkFMU0V9DQpSbWRfZmlsZV9uYW1lIDwtICJHdWlkYUFsRGltZW5zaW9uYW1lbnRvIg0Kcm1hcmtkb3duOjpyZW5kZXIocGFzdGUwKFJtZF9maWxlX25hbWUsICIuUm1kIiksICJhbGwiKQ0KIyBybWFya2Rvd246OnJlbmRlcihwYXN0ZTAoUm1kX2ZpbGVfbmFtZSwgIi5SbWQiKSwgImFsbCIsIGVuY29kaW5nPSJVVEYtOCIpDQptYXJrZG93bjo6cnB1YnNVcGxvYWQoIkd1aWRhIGFsaW1lbnNpb25hbWVudG8gZGkgdW4gY2FtcGlvbmUiLCBwYXN0ZTAoUm1kX2ZpbGVfbmFtZSMsICIuaHRtbCIpLCBpZCA9ICJodHRwczovL2FwaS5ycHVicy5jb20vYXBpL3YxL2RvY3VtZW50LzxpZCBZT1UgR0VUIFRIRSBGSVJTVCBUSU1FIikNCg0KIyAkY29udGludWVVcmwgImh0dHA6Ly9ycHVicy5jb20vc2NvdHRpLzQ1Nzg0MyINCg==