# R/find.factors.R In nonrandom: Stratification and matching by the propensity score

#### Defines functions find.factors

```find.factors <- function(regr,
name.regr,
data,
lr.form,
name.sep.var,
name.resp.var)
{
## ######################
## check regr for factors
regr.fac <- vector(length=dim(regr)[2])

for (i in 1: dim(regr)[2]){
regr.fac[i] <- ifelse(class(regr[,i])=="factor", 1, 0)
}
non.fac.matrix <- as.data.frame(regr[,which(regr.fac==0)])
names(non.fac.matrix) <- names(regr)[which(regr.fac==0)]

## ##################################
## create dummy variables for factors
fac         <- as.data.frame(regr[,regr.fac == 1])
name.fac    <- name.regr[regr.fac == 1]
nlevels.fac <- as.numeric(apply(as.data.frame(fac), 2,
function(x) nlevels(as.factor(x))))
levels.fac  <- list(apply(as.data.frame(fac), 2,
function(x) as.numeric(levels(as.factor(x)))))

dummy.list <- list(); fac.matrix <- c()
all.fac.names <- vector(length=sum(nlevels.fac)-length(nlevels.fac))

for (i in 1:dim(fac)[2]){
dummy.list[[i]] <- matrix(NA, nrow=dim(data)[1], ncol=(nlevels.fac[i]-1))

for (j in 2:nlevels.fac[i]){ ## Kat.1 ist Referenzkat.
dummy.list[[i]][apply(as.data.frame(fac[,i]), 1,
function(x) x==levels.fac[[1]][j]) == TRUE, j-1] <- 1
dummy.list[[i]][,j-1] <- ifelse(is.na(dummy.list[[i]][,j-1]),0,1)
dummy.list[[i]][,j-1] <- ifelse(is.na(fac[,i]),fac[,i],dummy.list[[i]][,j-1])

if (i==1)
all.fac.names[j-1] <- paste(name.fac[i],j-1, sep="")
else
all.fac.names[(nlevels.fac[i-1]-1)+(j-1)] <- paste(name.fac[i],j-1, sep="")
}
fac.matrix <- cbind(fac.matrix, dummy.list[[i]])
}

colnames(fac.matrix) <- all.fac.names
regr1 <- cbind(fac.matrix, non.fac.matrix)

lr.form1 <- formula(paste(name.resp.var,
paste(c(name.sep.var,names(regr1)),
collapse="+"),
sep="~"))
data1 <- cbind(data, fac.matrix)

out <- list(regr1,
data1,
lr.form1)

return(out)
}
```

## Try the nonrandom package in your browser

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

nonrandom documentation built on May 29, 2017, 11:41 p.m.