knitr::opts_chunk$set(echo = TRUE)

Introduction

This file contains some ongoing work and testing of approaches to use in the package. Do not expect to understand what is going on or me to explain it.

rDir<-paste0(getwd(), "/R/")
for(fname in list.files(rDir, full.names = TRUE)){source(fname)}

Simple Random Sampling (SRS)

Without Replacment (SRSWOR)

## SRSWOR
# Sample the data using single stage simple random sampling without replacement (srswor)
numberOfSamples <- 50
y_srswor <- myTestData[sample(nrow(myTestData),numberOfSamples, replace = FALSE),]
y_srswor$SAselectionMethod <- 'SRSWOR'
y_srswor$SAnumberSampled <- numberOfSamples
y_srswor$SAnumberTotal <- nrow(myTestData)
# Get correctly named fields in our sample data
y_srswor$studyVariable <- y_srswor$discardedWeight
y_srswor$numberSampled <- y_srswor$SAnumberSampled
y_srswor$numberTotal <- y_srswor$SAnumberTotal

# Use our functions to make a univariate estimate of the total discards
# Estimte the total discards
mcPopulationEstimator(y_srswor)

# What are the actual total discards of the population?
sum(myTestData$discardedWeight)

# Calculate the variance of our estimate - 0 if I sample everything
var <- mcVarianceEstimator(y_srswor)
var
sqrt(var)
var/(100*100)
N<-nrow(myTestData)
y<-y_srswor$studyVariable
pk <- y_srswor$numberSampled/y_srswor$SAnumberTotal
PI<-matrix(y_srswor$numberSampled/y_srswor$SAnumberTotal*(y_srswor$numberSampled-1)/(y_srswor$SAnumberTotal-1),
               nrow = length(pk),
               ncol = length(pk))
diag(PI)<-pk
htestimate(y,N,pk=pk, PI=PI, method = "ht")
e<-estimMC(y_srswor$studyVariable, y_srswor$numberSampled,y_srswor$SAnumberTotal )
e
sqrt(e$var)

With Replacment (SRSWR)

## SRSWR
# Sample the data using single stage simple random sampling with replacement (SRSWR)
numberOfSamples <- 50
y_srswr <- myTestData[sample(nrow(myTestData),numberOfSamples, replace = TRUE),]
y_srswr$SAselectionMethod <- 'SRSWR'
y_srswr$SAnumberSampled <- numberOfSamples
y_srswr$SAnumberTotal <- nrow(myTestData)
# Get correctly named fields in our sample data
y_srswr$studyVariable <- y_srswr$discardedWeight
y_srswr$numberSampled <- y_srswr$SAnumberSampled
y_srswr$numberTotal <- y_srswr$SAnumberTotal
# Estimte the total discards
mcPopulationEstimator(y_srswr)

# What are the actual total discards of the population?
sum(myTestData$discardedWeight)

# Calculate the variance of our estimate
mcVarianceEstimator(y_srswr)
N<-nrow(myTestData)
y<-y_srswr$studyVariable
pk <- y_srswr$numberSampled/y_srswr$SAnumberTotal
PI<-matrix(y_srswr$numberSampled/y_srswr$SAnumberTotal*(y_srswr$numberSampled-1)/(y_srswr$SAnumberTotal-1),
               nrow = length(pk),
               ncol = length(pk))
diag(PI)<-pk
htestimate(y,N,pk=pk, PI=PI, method = "ht")
htestimate(y,N,pk=pk, PI=PI, method = "hh")
e<-estimMC(y_srswr$studyVariable, y_srswr$numberSampled,y_srswr$SAnumberTotal, method = "SRSWR")
e
sqrt(e$var.total)
tot <- 4
  items <- c(3, 4, 4, 5)
  elems <- length(items)
  x <- estimMC(items, rep(elems, elems), rep(tot, elems), "SRSWR")
  x
x<-estimMC(c(1,1,1,1),c(4,4,4,4),c(4,4,4,4))
x
sum(1/diag(x$PI))
x<-estimMC(c(3,4,4,5),c(4,4,4,4),c(4,4,4,4))
x
sum(1/diag(x$PI))
tot<-8
items <- c(3,4,4,5)
elems <- length(items)
x<-estimMC(c(3,4,4,5),rep(elems, elems),rep(tot, elems))
x
sum(1/diag(x$PI))


ices-tools-dev/icesRDBES documentation built on April 17, 2025, 1:58 p.m.