繁体   English   中英

R函数用于循环数据帧

[英]R Function For Loop Data Frame

对于这是重复的还是有点令人困惑的事情,我深表歉意-我已经搜索了所有内容,但似乎无法应用来查找我要完成的任务。 我没有广泛使用函数/循环,尤其是从头开始编写,因此我不确定错误是来自函数(可能)还是来自数据构造。 基本流程如下:

虚拟数据集-分组,类型,费率,年,月

我通过将此位分组对数据集运行lm公式:

coef_models <- test_coef %>% group_by(Grouping) %>% do(model = lm(rate ~ years + months, data = .))

上面的结果为我提供了变量的截距和系数-接下来我要完成的操作(也是失败的)是针对所有估计值为负的系数,将其从方程式中删除,然后使用只是正系数。 因此,例如一组国家,如果年系数为负,则我想在公式中运行lm(rate〜months,data =。)。

为了到达那里,请使用plyr /扫帚,将结果放入一个数据框中:

#removed lines with negative coefficients
library(dplyr)
library(broom)
coef_output_test <- as.data.frame(coef_models %>% tidy(model))
coef_output_test$Grouping <- as.character(coef_output_test$Grouping)
#drop these coefficients and rerun
coef_output_test_rerun <- coef_output_test[!(coef_output_test$estimate >= 0),]

从这里开始,我试图重新运行出现问题的分组,而初始运行中没有负变量。 由于变量会有所不同,因此某些实例将需要数年,有些则将需要数月,我需要通过正确的列来使用。 我认为这是我要挂断的地方:

lm_test_rerun_out <- data.frame(grouping=character()
                            , '(intercept)'=double()
                            , term=character()
                            , estimate=double()
                            , stringsAsFactors=FALSE)    
lm_test_rerun <- function(r) {    
y = coef_output_test_rerun$Grouping
x = coef_output_test_rerun$term
for (i in 2:nrow(coef_output_test_rerun)){
    lm_test_rerun_out <- test_coef %>% group_by(Grouping["y"]) %>% do(model = lm(rate ~ x, data = .))
  }
}
lm_test_rerun(coef_output_test_rerun)

我收到此错误:

variable lengths differ (found for 'x')

函数的输出应类似于以下虚拟输出:

Grouping, Term, (intercept), Estimate
Sports, Years, 0.56, 0.0430
States, Months, 0.67, 0.340

我当然不太会R,而且我确信上面所做的工作可以更有效地完成,但是函数的输出应该是所使用的分组和x变量,以及每个函数的截距和估计值。 最终,我将获得该输出并将其附加回原始的'coef_models'-但现在我无法绕过这部分。

编辑:示例test_coef设置

        Grouping    Drilldown   Years   Months  Rate
    Sports  Basketball  10  23  0.42
    Sports  Soccer  13  18  0.75
    Sports  Football    9   5   0.83
    Sports  Golf    13  17  0.59
    States  CA  13  20  0.85
    States  TX  14  9   0.43
    States  AK  14  10  0.63
    States  AR  10  5   0.60
    States  ID  18  2   0.22
Countries   US  8   19  0.89
Countries   CA  9   19  0.86
Countries   UK  2   15  0.64
Countries   MX  21  15  0.19
Countries   AR  8   11  0.62

考虑一种基本的R解决方案,该解决方案可以by一个或多个因子对数据帧进行切片, by使扩展方法可以在每个分组子集上运行。 具体来说,以下将通过检查系数矩阵有条件地重新运行lm模型,并最终返回具有所需值的数据帧:

数据

txt <- '        Grouping    Drilldown   Years   Months  Rate
    Sports  Basketball  10  23  0.42
    Sports  Soccer  13  18  0.75
    Sports  Football    9   5   0.83
    Sports  Golf    13  17  0.59
    States  CA  13  20  0.85
    States  TX  14  9   0.43
    States  AK  14  10  0.63
    States  AR  10  5   0.60
    States  ID  18  2   0.22
Countries   US  8   19  0.89
Countries   CA  9   19  0.86
Countries   UK  2   15  0.64
Countries   MX  21  15  0.19
Countries   AR  8   11  0.62'

test_coef <- read.table(text=txt, header=TRUE)

df_list <- by(test_coef, test_coef$Grouping, function(df){
  # FIRST MODEL
  res <- summary(lm(Rate ~ Years + Months, data = df))$coefficients

  # CONDITIONALLY DEFINE FORMULA
  f <- NULL
  if ((res["Years",1]) < 0 & (res["Months",1]) > 0) f <- Rate ~ Months
  if ((res["Years",1]) > 0 & (res["Months",1]) < 0) f <- Rate ~ Years 

  # CONDITIONALLY RERUN MODEL
  if (!is.null(f)) res <- summary(lm(f, data = df))$coefficients

  # ITERATE THROUGH LENGTH OF res MATRIX SKIPPING FIRST ROW
  tmp_list <- lapply(seq(length(res[-1,1])), function(i)
    data.frame(Group = as.character(df$Grouping[[1]]), 
               Term = row.names(res)[i+1],
               Intercept = res[1,1],
               Estimate = res[i+1,1])
  )

  # RETURN DATAFRAME OF 1 OR MORE ROWS
  return(do.call(rbind, tmp_list))
})

final_df <- do.call(rbind, unname(df_list))
final_df

#       Group   Term  Intercept    Estimate
# 1 Countries Months -0.0512500  0.04375000
# 2    Sports  Years  0.6894118 -0.00372549
# 3    States Months  0.2754176  0.02941113

请注意:删除第一个模型的负系数并重新运行新模型可能会使另一个组件在以前为负数时变为负数。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM