CODEWITHSUNDEEP
rfor-looplm
tattila23
tattila23

Reputation: 41

Exclude single-level factors/change lm formula in a for loop

I've imported one large table from a SQL database with similar structure to this example table

testData <- data.frame(
  BatchNo = c(1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,3,3),
  Y = c(1,1.247011378,1.340630851,1.319026357,1.41264583,1.093619473,1.38023909,1.473858563,1,1.093619473,1.038888089,1.081833061,1,1.215913383,1.278861891,1.297746443,1.360694952,1.332368123,1.414201183,1,1.081833061,1,1.063661202),
  Categorical1 = c("A9","B5513","B5513","B5514","B5514","A9","B5514","B5514","A9","A9","B1723","A9","A9","B5513","B5514","B5513","B5514","B5514","B5514","A9","A9","A486","B1701"),
  Categorical2 = c("A2793","B5512","B5512","B5512","B5512","B5508","B6623","B6623","B5508","B5508","B5508","A127","A127","B5515","B5515","B5515","B5515","B6623","B6623","A127","A127","A2727","A2727"),
  Categorical3 = c("A5510","B5511","B5511","B5511","B5511","A5510","B5511","B5511","B5511","B5511","B5511","A5518","A5518","B5517","B5517","B5517","B5517","B5517","B5517","B5517","B5517","A2","A2"),
  Categorical4 = c("A5","A5","B649","A5","B649","B649","A5","B649","A5","B649","A5","B649","A5","A5","A5","B649","B649","A5","B649","A5","B649","A649","A649"),
  Binary1 = c(rep(0,times=23)),
  Binary2 = c(rep(0,times=23)),
  Binary3 = c(rep(0,times=23)),
  Binary4 = c(rep(0,times=23))
  )

What I'd like to do in a for loop is to:

1.Create subset data frames based on the BatchNo column (1 to 2500)
2.Fit linear models using each subset data frame
3.Export the list of coefficient estimates back to a SQL table

I've got the following so far for steps 1 & 2:

n<-max(testData[,1])
for (i in 1:n) {
assign(paste("dat"),droplevels(subset(testData,BatchNo == i, select = 1:10)))
assign(paste("lm.", i, sep =
""),lm(Y~Categorical1+Categorical2+Categorical3+Categorical4+Binary1+Binary2+Binary3+Binary4,data=dat))}

The problem is that there will be subsets created where at least one of the 4 Categorical variables (or maybe all of them) will have a single level (like BatchNo = 3 in this example) and R cannot use those in regression. It is not a problem for the binary predictors as it only results in a N/A coefficient estimate, and I'll do a step(backward) to remove any of those after the models have been fitted.

At first I tried to use step(forward) to select only meaningful predictors in each loop, but that didn't work as I had to list all potential predictors for selection.

I can think of 2 possible solutions:

I've only got to the point of creating these 2 vectors:

factors<-dat[,3:6]
f<-names(factors)
levels<-c(length(levels(factors[,1])),length(levels(factors[,2])),length(levels(factors[,3])),length(levels(factors[,4])))

So now I just had to drop the nth element from "f" where the nth element of "levels" equals 1.

Upvotes: 1

Views: 562

Answers (2)

zx8754
zx8754

Reputation: 56219

Try this:

do.call(rbind,
        lapply(split(testData, testData$BatchNo), function(i){
          #check if factor columns have more than 1 level
          cats <- colnames(i)[c(3:6)[sapply(i[, c(3:6)], function(j){length(unique(j))}) > 1]]
          cats <- paste(cats, collapse = "+")
          fit <- lm(as.formula(paste0("Y~", cats, "+Binary2+Binary3+Binary4")), data = i)
          #return coef as df
          as.data.frame(coef(fit))
          })
        )

Output

#                         coef(fit)
# 1.(Intercept)        1.000000e+00
# 1.Categorical1B1723  3.888809e-02
# 1.Categorical1B5513  3.082241e-01
# 1.Categorical1B5514  3.802391e-01
# 1.Categorical2B5508  5.611389e-16
# 1.Categorical2B5512 -6.121273e-02
# 1.Categorical2B6623            NA
# 1.Categorical3B5511  1.699675e-17
# 1.Categorical4B649   9.361947e-02
# 1.Binary2                      NA
# 1.Binary3                      NA
# 1.Binary4                      NA
# 2.(Intercept)        1.000000e+00
# 2.Categorical1B5513  2.694196e-01
# 2.Categorical1B5514  3.323681e-01
# 2.Categorical2B5515 -5.350623e-02
# 2.Categorical2B6623            NA
# 2.Categorical3B5517  3.289161e-18
# 2.Categorical4B649   8.183306e-02
# 2.Binary2                      NA
# 2.Binary3                      NA
# 2.Binary4                      NA
# 3.(Intercept)        1.000000e+00
# 3.Categorical1B1701  6.366120e-02
# 3.Binary2                      NA
# 3.Binary3                      NA
# 3.Binary4                      NA

Upvotes: 1

tattila23
tattila23

Reputation: 41

Eventually I've been able to find a way to do what I intended to. There might be a simpler/more elegant way, but I've used: 

  l<-nrow(dat)
  a<-length(levels(dat[,3]))
  b<-length(levels(dat[,4]))
  c<-length(levels(dat[,5]))
  d<-length(levels(dat[,6]))
  zeros<-c(rep(0,times=l))
  if (a<2) dat[,2]<-zeros
  if (b<2) dat[,3]<-zeros
  if (c<2) dat[,4]<-zeros
  if (d<2) dat[,5]<-zeros

The single-level factors are replaced with an appropriate length of vectors containing zeros each loop, hence the regressions can be run without getting an error.

Upvotes: 1

Related Questions