[英]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.