landIneq: Lading Ineq (concept function for now)

In RJauslin/Sampling: SamplingC

Description

Lading Ineq (concept function for now)

Usage

landIneq(X, pikstar, pik, B, r, comment = TRUE)

Arguments

X	matrix of auxiliary variables
pikstar	vector of inclusion probabilities
pik	vector of inclusion probabilities
B	matrix
r	vector
comment	bool, should comment be written.

Value

sample (vector of 0 or 1)

Examples

## Not run: 
rm(list = ls())
EPS=0.0000001
N=1000
n=300
p=1
q=7
z=runif(N)
#z=rep(1,N)
pik=inclusionprobabilities(z,n)
X=cbind(pik,matrix(rnorm(N*p),c(N,p)))
A=X/pik
Z=cbind(matrix(rbinom(N*q,1,1/2),c(N,q)))
B=cbind(Z,-Z)
r=c(ceiling(pik%*%B))
r[abs(pik%*%B-round(pik%*%B))<EPS]=round(pik%*%B)[abs(pik%*%B-round(pik%*%B))<EPS]
# s=as.vector(ineq(X,pik,B,r,EPS=0.000001))

t(B)%*%pik <= r
t(B)%*%s <= r
colSums(X)
c(t(X)%*%(s/pik))


# ON COMMENCE PAR EQUILIBRER TOUTEs
# LES VARIABLES (Y COMPRIS LES INEGALITE)
# A la fin de la phase de vol on a donc au maxium p+q+1 unités non égal 0 ou 1

piks <- as.vector(flightphase_arma2(cbind(X,B*pik),pik))
p+q+1 # + 1 pour la colonne 1
length(which(piks > EPS & piks <(1-EPS)))
# check
t(B)%*%piks <= r
t(X/pik)%*%piks
t(X/pik)%*%pik

# ON RELACHE LES CONTRAINTES D'INEGALITE
# il reste au maxium p+1 unités non égal à 0 ou 1
pikstar <- ineq(X/pik*piks,piks,B,r)
p+1 # + 1 pour la colonne 1
length(which(pikstar > EPS & pikstar <(1-EPS)))
# check
t(B)%*%pikstar <= r
t(X/pik)%*%pikstar
t(X/pik)%*%pik

s <- landIneq(X,pikstar,pik,B,r)
t(B)%*%s <= r
t(X/pik)%*%s
t(X/pik)%*%pik

## End(Not run)

RJauslin/Sampling documentation built on Aug. 29, 2020, 7:27 a.m.