Question

我希望获得有关R中以下问题的帮助。

我有近4,000家公司的4个变量，firm ID，sales，size，date。

我要运行此回归：

lm(size~sales)，同时一次从4000家增加了100家公司。

因此，第一个回归将拥有100个公司，第二个将拥有200个公司，第三个将拥有300个公司，直到达到包括所有公司（4000）的最后一个回归。

第二个任务是，我想保存每个回归的贝塔系数（即，我添加额外的100个公司后的每个回归），然后在Y上绘制贝塔，在x上绘制公司数（从100到4000）以观察添加公司时Beta会如何变化。

我需要某种用于回归的循环，用于保存beta的循环以及用于绘图的循环吗？谢谢您阅读

Answer 1

这是使用mtcars数据集的最小示例。我建立了一个回归，每次添加一行。我在右边预先分配了一个结果向量，然后遍历各行并存储系数结果。

results <- vector(length = nrow(mtcars))
for (j in 1:nrow(mtcars)){
  results[j] <- coef(lm(mpg ~ hp, data = mtcars[1:j, ]))[2]
}

plot(x = 1:nrow(mtcars), y = results, type = "p")

^{由reprex package（v0.2.1）于2019-04-07创建}

Answer 2

考虑按公司划分数据集，然后使用序列lm迭代运行seq(1, 4000, by=100)来划分数据帧列表的子集：

# BUILD A LIST OF DATA FRAMES (SIZE = 4,000)
firms_df_list <- split(df, df$firm_id)

# FUNCTION TO CALL lm() AND EXTRACT RESULTS
lm_results <- function(n, df) {

  model <- lm(sales ~ size, data = df)
  res <- summary(model)

  p <- res$fstatistic
  c(num_of_firms = n,
    sales = res$coefficients[2,1],
    std_err = res$coefficients[2,2],
    t_stat = res$coefficients[2,3],
    t_pvalue = res$coefficients[2,4],
    r_sq = res$r.squared,
    adj_r_sq = res$adj.r.squared,
    f_stat = p[['value']],
    f_pvalue = unname(pf(p[1], p[2], p[3], lower.tail=FALSE))
  )
}

# BUILD MATRIX RESULTS WHERE ROWS ARE MODEL RUNS AND COLS ARE RESULT ESTIMATES
mat_results <- t(sapply(seq(1, 4000, by=100), function(i) {
     # COMBINE FIRM SUBSETS BY RANGE
     curr_df <- do.call(rbind, firms_df_list[1:i])

     # CALL MODEL AND RETRIEVE RESULTS
     lm_results(i, curr_df)
}))

# PLOT ALL SALES BETAS AND NUMBER OF FIRMS
plot(mat_results[,"num_of_firms"], mat_results[,"sales"], type="b", 
     col="blue", lwd=1, pch=16, xlab="Number of Firms", ylab="Sales Estimate")

要考虑年份和月份的细分，请考虑by（类似于split + lapply），然后按年划分子集，然后使用内部split进行月份划分（类似于上面的内容）流程），其中每个迭代运行所需的模型。然后，在每个月和年级别绑定矩阵以生成最终的大型矩阵。注意：lm_results现在为指标月份和年份矩阵列又增加了两个参数。

# FUNCTION TO CALL lm() AND EXTRACT RESULTS
lm_results <- function(n, df, yy, mm) {

  model <- lm(sales ~ size, data = df)
  res <- summary(model)

  p <- res$fstatistic
  c(year = yy,
    month = mm,
    num_of_firms = n,
    sales = res$coefficients[2,1],
    std_err = res$coefficients[2,2],
    t_stat = res$coefficients[2,3],
    t_pvalue = res$coefficients[2,4],
    r_sq = res$r.squared,
    adj_r_sq = res$adj.r.squared,
    f_stat = p[['value']],
    f_pvalue = unname(pf(p[1], p[2], p[3], lower.tail=FALSE))
  )
}    

# BUILD A LIST OF MONTHLY MATRICES BY YEAR
firms_mat_list <- by(df, df$yy, function(sub_year){

  # BUILD A LIST OF FIRM MATRICES BY MONTH
  month_mat_list <- by(sub_year, sub_year$mm, function(sub_month){

    firms_df_list <- split(sub_month, sub_month$firm)

    # BUILD MATRIX RESULTS WHERE ROWS ARE MODEL RUNS AND COLS ARE RESULT ESTIMATES
    mat_results <- t(sapply(seq(1, 4000, by=100), function(i) {
      # COMBINE FIRM SUBSETS BY RANGE
      curr_df <- do.call(rbind, firms_df_list[1:i])

      # CALL MODEL AND RETRIEVE RESULTS
      lm_results(i, curr_df, curr_df$yy[1], curr_df$mm[1])
    }))

  })

  do.call(rbind, month_mat_list)
})

firms_matrix <- do.call(rbind, firms_mat_list)

firms_matrix

Answer 3

第二个任务是，我想保存每个回归的贝塔系数（即，我添加额外的100个公司后的每个回归），然后在Y上绘制贝塔，在x上绘制公司数（从100到4000）以观察添加公司时Beta会如何变化。

您可以使用我的rollRegres软件包。这与this vignette中的示例几乎相同：

set.seed(65731482)
ngrp <- 40L
n_per_g <- 100L
# create group variable
grp <- c(sapply(1:ngrp, rep, times = n_per_g))
n <- n_per_g * ngrp
p <- 1L
X <- matrix(rnorm(p * n), n, p)
y <- drop(X %*% 1.5) + rnorm(n)

library(rollRegres)
out <- roll_regres(y ~ X, do_downdates = FALSE, width = 100L)
beta <- out$coefs

# check result
tail(out$coefs, 2)
#R      (Intercept)    X
#R 3999    -0.00552 1.51
#R 4000    -0.00571 1.51
coef(lm(y ~ X))
#R (Intercept)           X 
#R    -0.00571     1.51405 

# plot 
plot(out$coefs[, 2], xlab = "Time", ylab = "slope", type = "l")

它为您提供所有40000-99的值，但它很快完成，因此您可能不会在意额外的计算

microbenchmark::microbenchmark(
  roll_regres(y ~ X, do_downdates = FALSE, width = 100L))
#R Unit: microseconds
#R                                                   expr min  lq mean median  uq  max neval
#R roll_regres(y ~ X, do_downdates = FALSE, width = 100L) 740 750  771    763 772 1090   100

，然后您可以将beta子集化。

如何在R中运行多元回归，同时每次添加100行

3 个答案: