ggplot中的多个最小二乘二次拟合

Posted 2023-03-12

【中文标题】ggplot中的多个最小二乘二次拟合

【英文标题】：Multiple least squares quadratic fit in ggplot

【发布时间】：2019-07-31 00:14:12

【问题描述】：

请注意，根据问题 4 构建的图形显示了一个二次 log_wages 与 exp 之间的关系或曲线关系。下一个 任务是为每个种族级别“黑色”绘制三个二次函数， “白色”和“其他”。要估计二次拟合，您可以使用 以下函数quad_fit：

```r
quad_fit <- function(data_sub) 
  return(lm(log_wage~exp+I(exp^2),data=data_sub)$coefficients)

quad_fit(salary_data)
```

上述函数计算最小二乘二次拟合和 返回系数 a1、a2、a3，其中

Y(帽子) = a1 + a2x + a3x^2

其中 Y(hat) = log(wage) 和 x = exp

使用 ggplot 完成此任务或使用基本 R 图形 部分分数。确保包含图例和适当的标签。

我的尝试

blackfit <- quad_fit(salary_data[salary_data$race == "black",])
whitefit <- quad_fit(salary_data[salary_data$race == "white",])
otherfit <- quad_fit(salary_data[salary_data$race == "other",])

yblack <- blackfit[1] + blackfit[2]*salary_data$exp + blackfit[3]*(salary_data$exp)^2
ywhite <- whitefit[1] + whitefit[2]*salary_data$exp + whitefit[3]*(salary_data$exp)^2
yother <- otherfit[1] + otherfit[2]*salary_data$exp + otherfit[3]*(salary_data$exp)^2

soloblack <- salary_data[salary_data$race == "black",]
solowhite <- salary_data[salary_data$race == "white",]
soloother <- salary_data[salary_data$race == "other",]

ggplot(data = soloblack) +
  geom_point(aes(x = exp, y = log_wage)) +
  stat_smooth(aes(y = log_wage, x = exp), formula = y ~ yblack)

这只是使用 for race == "black" 过滤的数据的第一次尝试。 我不清楚公式应该是什么样子，因为通过 quad_fit 函数，它似乎已经为您完成了计算。

【问题讨论】：

你的图形是从问题 4 中构造的在哪里？只需将子集传递给该进程即可。

library(ggplot2) ggplot(data = Salary_data) + geom_point(aes(x = exp, y = log_wage, alpha = exp)) + labs(x = "工作经验", y = "Log of Wage", title = "Salary Dataset") 这是图表的代码，但我觉得我在 geom_smooth 中的论点是错误的。

【参考方案1】：

考虑使用quad_fit 的输出（如@StefanK here 所示）绘制拟合值，并使用by 绘制race 的所有不同值：

reg_plot <- function(sub) 
   # PREDICTED DATA FOR LINE PLOT
   q_fit <- quad_fit(sub)
   predicted_df <- data.frame(wage_pred = predict(q_fit, sub), exp = sub$exp)

   # ORIGINAL SCATTER PLOT WITH PREDICTED LINE
   ggplot(data = sub) + 
     geom_point(aes(x = exp, y = log_wage, alpha = exp)) +
     labs(x = "Job Experience", y = "Log of Wage", 
          title = paste("Wage and Job Experience Plot for",    
                        sub$race[[1]], "in Salary Dataset") 
     geom_line(color='red', data = predicted_df, aes(x = exp, y = wage_pred))


# RUN GRAPHS FOR EACH RACE
by(salary_data, salary_data$race, reg_plot)