user10072460
user10072460

Reputation:

Calculating several regression analysis with specific columns in lapply

This is my data:

df1<-read.table(text=" Time1    Time2   Time3   MNR1    MNR2    MNR3

36  36  43  5   4   5
40  41  51  4   6   4
38  36  50  7   8   3
35  51  43  8   3   2
52  55  57  3   2   4
",header=TRUE)

I want to have a loop using lapply ( preferably) to analyse Time1 with MNR1, Time2 with MNR2 and Time 3 with MRN3 using regression model and ....

I have tried the following function, but I failed to get the results:

R <- lapply(1:ncol(df1), function(x) lm(Time[,x] ~ MNR[,x]))

But it does not give me the results for each group. Can we do it using lapply?

Upvotes: 2

Views: 351

Answers (3)

G. Grothendieck
G. Grothendieck

Reputation: 270298

reshape to a 15x4 long form data.frame long having column names No, Time, MNR and id. The No column contains values 1, 2 and 3 and the Time and MNR columns contain the respective data from the original data frame. The id column is not used. It is automatically generated by reshape and contains the row number that the data in that row of long came from. This long data frame is not only useful in producing the result asked for in the question but can be usefully used in producing graphics as shown later below.

Then we use lmList in nlme (which comes with R, no need to install it) to perform the regressions all at once. Depending on what you want you could set pool = TRUE to pool the errors (instead of pool = FALSE). Note that out[[1]], out[[2]] and out[[3]] are the 3 lm objects if you want them separately.

library(nlme)

v <- list(Time = 1:3, MNR = 4:6)
long <- reshape(df1, dir = "long", varying = v, v.names = names(v), timevar = "No")
out <- lmList(Time ~ MNR | No, long, pool = FALSE)
out

giving:

Call:
  Model: Time ~ MNR | No 
   Data: long 

Coefficients:
  (Intercept)        MNR
1    53.82558 -2.5232558
2    56.96552 -2.8620690
3    45.61538  0.8846154

Graphics

library(ggplot2)
ggplot(long, aes(MNR, Time)) +
  geom_point() +
  geom_smooth(method = "lm") +
  facet_wrap(~ No)

screenshot

or using classic graphics:

old.par <- par(mfrow = c(2,2))
for(nm in names(out)) { 
  fm <- out[[nm]]
  fo <- formula(fm)
  plot(fo, long, type = "n", main = nm)
  points(fo, model.frame(fm))
  abline(fm)
}
par(old.par)

screenshot

Upvotes: 1

akrun
akrun

Reputation: 887951

We can use Map to paste the corresponding column names or create formula with reformulate by passing the 'Times' and 'MNR' column names separately in Map

Map(function(x, y) lm(reformulate(y, x), data = df1),
        names(df1)[1:3], names(df1)[4:6])

Or with paste

Map(function(x, y) lm(paste(x, y, sep="~"), data = df1),
        names(df1)[1:3], names(df1)[4:6])

Or using lapply

lapply(paste(names(df1)[1:3], "~", names(df1)[4:6]), function(x) lm(x, data = df1))

Or with map2 from purrr

library(purrr)
map2(names(df1)[1:3], names(df1)[4:6], ~ lm(reformulate(.y, .x), data = df1)

Upvotes: 4

AlexB
AlexB

Reputation: 3269

lapply(1:3, function(i) lm(as.formula(paste0('Time', i, ' ~ ', 'MNR', i)), data = df1))

Upvotes: 3

Related Questions