BERENZ

<sondaz>
<section name="frekwencja" active="1">
<subsection name="wojewodztwa" active="1" label="Województwa" frekwencja="51">
<wojewodztwo frekwencja="48.8" name="dolnoslaskie" label="Dolnoślaskie"/>
<wojewodztwo frekwencja="46.6" name="kujawsko-pomorskie" label="Kujawsko - pomorskie"/>
<wojewodztwo frekwencja="48.8" name="lubelskie" label="Lubelskie"/>
<wojewodztwo frekwencja="45.6" name="lubuskie" label="Lubuskie"/>
<wojewodztwo frekwencja="52.6" name="lodzkie" label="Łódzkie"/>
<wojewodztwo frekwencja="56.1" name="malopolskie" label="Małopolskie"/>
<wojewodztwo frekwencja="58.3" name="mazowieckie" label="Mazowieckie"/>

BERENZ

calib_asinh <- function(X,
                        d,
                        totals,
                        bounds = c(0.9,1.1),
                        alpha = 1,
                        eps = .Machine$double.eps,
                        maxit = 50,
                        tol = 1e-06,
                        verbose = F,
                        details = F) {

BERENZ

# indicators - vector of indicators

eurostat_GaL <- function(indicators) {
  inds <- lapply(indicators,get_eurostat)
  inds <- lapply(inds, label_eurostat)
  inds <- bind_rows(inds)
  inds <- tbl_df(inds)
  return(inds)
}

BERENZ

# source: http://statweb.stanford.edu/~owen/empirical/scel.R
# Self-concordant empirical likelihood for a vector mean,
# as described in:
#
# @article{owen:2013,
#  title={Self-concordance for empirical likelihood},
#  author={Owen, A. B.},
#  journal={Canadian Journal of Statistics},
#  volume={41},
#  number={3},

BERENZ

### Source : A. J. Lee, G.A.F Seber, Jennifer K. Holden and John T. Huakau (2001) Capture-recapture, Epidemiology and List Mismatches: Several Lists. Biometrics, 57, 707-713 (S-Plus functions to implement the methods discussed in this paper are in file PL2functions.s. Code for the example is in the file example.)

###############################################################
#
#  Functions for paper "Capture-recapture, Epidemiology and 
#  List mismatches: several lists
#
##############################################################
 generate.names<-function(n, nchar)
{

BERENZ

## Source: A. J. Lee (2002) Effect of list errors on the estimation of population size. Biometrics, 58, 185-191. (S-Plus functions to implement the methods discussed in this paper are in file functions.s. Code for the examples is in Example1 and Example2. )


#############################################################
#
# Functions for Example 2 of paper "Effect of list errors on the
#  estimate of population size"
#
##############################
binmat<-function(i, n){

BERENZ

### source: http://www.statisphere.govt.nz/~/media/Statistics/about-us/statisphere/Files/official-statistics-research-series/osr-series-v4-2009-regression-analysis-probability-linked-data.pdf


# Note: The following code assumes
#(1) 1-1 linkingofregisters
#(2) Nomeasurementerroronthe(categorical)blockingvariable 
# (3) Exchangeablelinkageerrorswithinblocks

LinEstPlus <- function(lambda,m,X,Ystar,Block,alpha=0.05,nits=5) {
# Calculates the naive (b_ST), ratio type (R), predictive (B), modified OLS (A) and Eb_CUE (C) estimates of beta, along with

BERENZ

Vfun3 <- function(f, lambda) {
  # Function to calculate diagonal approximation to linkage error component (Vq matrix) of variance of Ystar under exchangeable linkage errors
  
  M <- length(f)
  fbar1 <- mean(f)
  fbar2 <- mean(f^2)
  return((1 - lambda) * (lambda * (f - fbar1)^2 + fbar2 - fbar1^ 2))
}

BERENZ

require(foreach)
require(itertools)

# block matrix multiplication
bmm <- function(x, y, chunkSize=max(1, floor(nrow(x)/6)), verbose=FALSE,
  writeBlock=FALSE, returnResult=TRUE, filePrefix="block.", writeDir="",
  projectionBlocks=FALSE) {
  if (ncol(x) != nrow(y))
    stop("Non-conformable matrices")
  if (verbose) {

BERENZ

### where model is lmer/glmer object

cAIC_vb <- function(model) {
  if (!isLMM(model) & !isGLMM(model)) {
    stop('Currently supports only lmer/glmer objects', call. = FALSE)
  }
  
  rho <- sum(hatvalues(model))
  p <- getME(model, 'p')
  n <- getME(model, 'n')