如何使用 R`tidymodels` 复制 plot.lda()

Question

我想使用ggplot2 和tidymodels 复制 plot.lda 打印方法。有没有优雅的方式来获取情节？

我想我可以通过使用predict() 来伪造没有lda 方法的augment() 函数并将其绑定到原始数​​据上。

这是一个带有基本 R 和 tidymodels 代码的示例：

library(ISLR2)
library(MASS)

# First base R
train <- Smarket$Year < 2005

lda.fit <-
  lda(
    Direction ~ Lag1 + Lag2,
    data = Smarket,
    subset = train
  )

plot(lda.fit)


# Next tidymodels

library(tidyverse)
library(tidymodels)
library(discrim)

lda_spec <- discrim_linear() %>%
  set_mode("classification") %>%
  set_engine("MASS")

the_rec <- recipe(
  Direction ~ Lag1 + Lag2, 
  data = Smarket
)

the_workflow<- workflow() %>% 
  add_recipe(the_rec) %>% 
  add_model(lda_spec)

Smarket_train <- Smarket %>%
  filter(Year != 2005)

the_workflow_fit_lda_fit <- 
  fit(the_workflow, data = Smarket_train) %>% 
  extract_fit_parsnip()

# now my attempt to do the plot

predictions <- predict(the_workflow_fit_lda_fit, 
                 new_data = Smarket_train, 
                 type = "raw"
         )[[3]] %>% 
  as.vector()

bind_cols(Smarket_train, .fitted = predictions) %>% 
  ggplot(aes(x=.fitted)) +
  geom_histogram(aes(y = stat(density)),binwidth = .5) + 
  scale_x_continuous(breaks = seq(-4, 4, by = 2))+
  facet_grid(vars(Direction)) +
  xlab("") + 
  ylab("Density")

必须有更好的方法来做到这一点......想法？

Answer 1

您可以通过使用extract_fit_*() 和parsnip:::repair_call() 的组合来做到这一点。 plot.lda() 方法使用 LDA 拟合中的 $call 对象，我们需要调整它，因为使用 tidymodels 的调用对象将与直接使用 lda() 不同。

library(ISLR2)
library(MASS)

# First base R
train <- Smarket$Year < 2005

lda.fit <-
  lda(
    Direction ~ Lag1 + Lag2,
    data = Smarket,
    subset = train
  )

# Next tidymodels

library(tidyverse)
library(tidymodels)
library(discrim)

lda_spec <- discrim_linear() %>%
  set_mode("classification") %>%
  set_engine("MASS")

the_rec <- recipe(
  Direction ~ Lag1 + Lag2, 
  data = Smarket
)

the_workflow <- workflow() %>% 
  add_recipe(the_rec) %>% 
  add_model(lda_spec)

Smarket_train <- Smarket %>%
  filter(Year != 2005)

the_workflow_fit_lda_fit <- 
  fit(the_workflow, data = Smarket_train)

在拟合两个模型后，我们可以检查$call 对象，我们发现它们是不同的。

lda.fit$call
#> lda(formula = Direction ~ Lag1 + Lag2, data = Smarket, subset = train)

extract_fit_engine(the_workflow_fit_lda_fit)$call
#> lda(formula = ..y ~ ., data = data)

parsnip::repair_call() 函数会将data 替换为我们传入的数据。此外，我们会将数据的响应重命名为..y 以匹配调用。

the_workflow_fit_lda_fit %>%
  extract_fit_parsnip() %>%
  parsnip::repair_call(rename(Smarket_train, ..y = Direction)) %>%
  extract_fit_engine() %>%
  plot()

^{由reprex package (v2.0.1) 于 2021 年 11 月 12 日创建}