# R/normalize.R In prefmod: Utilities to Fit Paired Comparison Models for Preferences

```# calculates normalizing constant for all Y,R patterns

normalize<-function(lambda,X,nobj,ENV){

nrm<-function(r,eta,Bstar,alpha,betas,Xundec,XIthet,ENV){   # 7.12.09  Xundec added

#####    nonresponse models alpha_i+alpha_j/alpha_i-alpha_j
if (ENV\$MISmod=="obj"){    # 6.9.2010

if(ENV\$MISalpha){
rBstar<-r %*% Bstar                  # one row of RBstar, identical for all rows within block
eta<-eta + as.vector(rBstar[,ENV\$Malph]%*%alpha) # scalar, based on one row of RBstar,
# identical for all rows within block
}
if (ENV\$MISbeta){
YrBstar<-do.call(cbind,lapply(1:nobj,function(x)ENV\$Y[,x]*rBstar[x])) # design matrix for betas for current block
eta<-eta+YrBstar[,ENV\$Mbeta,drop=FALSE]%*%betas # 27.6.2010
}
}

#####    nonresponse model alpha_ij  # 6.9.2010
if (ENV\$MISmod=="comp"){
if(ENV\$MISalpha)
eta <- eta + as.vector(r[ENV\$Malph]%*%alpha)
if (ENV\$MISbeta){
Yr<-ENV\$Y[,ENV\$Mbeta,drop=FALSE] * r[ENV\$Mbeta]
####Yr<-do.call(cbind,lapply((1:nobj,function(x)ENV\$Y[,x]*r[x])) # design matrix for betas for current block
eta <- eta + Yr%*%betas
}
}

if(ENV\$undec){                 # 7.12.09
eta<-eta+Xundec
}
if(ENV\$ia){
eta<-eta+XIthet
}

if(ENV\$MIScommon){
eta<-eta+as.vector(r)*alpha
}

nrm.bl<-sum(exp(eta))
nrm.bl
}# end nrm()

#alpha<-betas<-theta<-NULL
# lam(bda)s, alphas, betas from parametervector lambda
lam<-lambda[1:(nobj-1)]
if(ENV\$MISalpha)
alpha<-lambda[ENV\$paridx==2]
if(ENV\$MISbeta)
betas<-lambda[ENV\$paridx==3]
if(ENV\$MIScommon){
alpha<-lambda[ENV\$paridx==4]
}
if(ENV\$undec){                       # 7.12.09
undecU<-lambda[ENV\$paridx==6]
Xundec<-ENV\$U * undecU
}
if(ENV\$ia){
theta<-lambda[ENV\$paridx==5]
XIthet<-ENV\$XI%*%theta
}

eta<-X%*%lam # YBlambda

R<-patternmat2(nobj)
if(ENV\$MIScommon)
R<-matrix(rowSums(R),ncol=1)

Bstar<-abs(pcdesign(nobj))  # alpha_i + alpha_j
nrm.bl.vec<-apply(R,1,nrm,eta,Bstar,alpha,betas,Xundec,XIthet,ENV)        # 7.12.09  Xundec added
nrm.all<-sum(nrm.bl.vec)
nrm.all
}
```

## Try the prefmod package in your browser

Any scripts or data that you put into this service are public.

prefmod documentation built on May 2, 2019, 4:59 p.m.