2 
# Packages
library(dplyr)
library(recipes)

# toy dataset, with A being multicolored
df <- tibble(name = c("A", "A", "A", "B", "C"), color = c("green", "yellow", "purple", "green", "blue"))


    #> # A tibble: 5 x 2
    #>   name  color 
    #>   <chr> <chr> 
    #> 1 A     green 
    #> 2 A     yellow
    #> 3 A     purple
    #> 4 B     green 
    #> 5 C     blue

食谱步骤效果很好

dummified_df <- recipe(. ~ ., data = df) %>%
        step_dummy(color, one_hot = TRUE) %>%
        prep(training = df) %>%
        juice()


    #> # A tibble: 5 x 5
    #>   name  color_blue color_green color_purple color_yellow
    #>   <fct>      <dbl>       <dbl>        <dbl>        <dbl>
    #> 1 A              0           1            0            0
    #> 2 A              0           0            0            1
    #> 3 A              0           0            1            0
    #> 4 B              0           1            0            0
    #> 5 C              1           0            0            0

但我真正想要获得的结果是下面的结果，每行有一个观察结果，因为多色项目不再需要几行。

summarized_dummified_df <- dummified_df %>% 
     group_by(name) %>% 
     summarise_all(~ifelse(max(.) > 0, 1, 0)) %>% 
     ungroup()


    #> # A tibble: 3 x 5
    #>   name  color_blue color_green color_purple color_yellow
    #>   <fct>      <dbl>       <dbl>        <dbl>        <dbl>
    #> 1 A              0           1            1            1
    #> 2 B              0           1            0            0
    #> 3 C              1           0            0            0

显然，我可以这样做。但是为了将我的配方步骤完全集成到tidymodels生态系统中，例如使用工作流，如果我可以将不再需要重复的行分组，这要好得多，这要归功于配方中直接存在的虚拟变量。

是否有任何tidymodels 认可的方法来获得此结果？

我也尝试过这样做mlr3，但无济于事，因为我找不到任何适合PipeOp聚合行的方法。

library("mlr3")
library("mlr3pipelines")


task = TaskClassif$new("task",
                       data.table::data.table(
                           name = c("A", "A", "A", "B", "C"),
                           color = as.factor(c("green", "yellow", "purple", "green", "blue")),
                           price = as.factor(c("low", "low", "low", "high", "low"))),
                           "price"
                       )
                       
poe = po("encode")

poe$train(list(task))[[1]]$data()

#>    price name color.blue color.green color.purple color.yellow
#> 1:   low    A          0           1            0            0
#> 2:   low    A          0           0            0            1
#> 3:   low    A          0           0            1            0
#> 4:  high    B          0           1            0            0
#> 5:   low    C          1           0            0            0

我正在研究自定义step_函数或自定义PipeOp的创建，但我仍然觉得我缺少一些东西，因为我的数据类型对我来说并不罕见。

4

2 回答 2

2

在我所见过的任何地方，虚拟变量或指标变量在概念上都被映射为一对一，而不是一对多，我认为这就是你遇到这种情况的原因。不过，像你一样，我想在现实世界中的某个时候将它们一对多地映射。我通常在开始我的模型预处理工作流之前的数据整理步骤中执行此操作，如下所示：

library(tidyverse)

# toy dataset, with A being multicolored
df <- tibble(name = c("A", "A", "A", "B", "C"), color = c("green", "yellow", "purple", "green", "blue"))

df %>%
  mutate(value = 1) %>%
  pivot_wider(names_from = "color", names_prefix = "color_", values_from = "value", values_fill = 0)
#> # A tibble: 3 x 5
#>   name  color_green color_yellow color_purple color_blue
#>   <chr>       <dbl>        <dbl>        <dbl>      <dbl>
#> 1 A               1            1            1          0
#> 2 B               1            0            0          0
#> 3 C               0            0            0          1

由reprex 包于 2020-08-18 创建(v0.3.0.9001)

于 2020-08-18T18:30:15.077 回答
1

我为食谱包编写了以下自定义步骤。

step_summarize <- function(
    recipe, 
    ..., 
    role = NA, 
    trained = FALSE, 
    col_names = NULL,
    skip = FALSE,
    id = rand_id("summarize")
){
    terms <- ellipse_check(...) 
    
    add_step(
        recipe, 
        step_summarize_new(
            terms = terms, 
            role = role, 
            trained = trained,
            col_names = col_names,
            skip = skip,
            id = id
        )
    )
    
    
}


step_summarize_new <- 
    function(terms, role, trained, col_names, skip, id) {
        step(
            subclass = "summarize", 
            terms = terms,
            role = role,
            trained = trained,
            col_names = col_names,
            skip = skip,
            id = id
        )
    }

prep.step_summarize <- function(x, training, info = NULL, ...) {
    col_names <- terms_select(terms = x$terms, info = info)
    
    step_summarize_new(
        terms = x$terms, 
        trained = TRUE,
        role = x$role, 
        col_names = col_names,
        skip = x$skip,
        id = x$id
    )
}


bake.step_summarize <- function(object, new_data, ...) {
    vars <- object$col_names
    
    new_data <- new_data %>% 
        group_by(across(- any_of(vars))) %>% 
        summarise(across(any_of(vars), ~ifelse(max(.) > 0, 1, 0)))
    
    ## Always convert to tibbles on the way out
    tibble::as_tibble(new_data)
}

它可以作为我真实数据集的预处理步骤正常工作，但在使用时会进一步中断tune。这可能与此问题有关

于 2020-08-17T08:23:19.753 回答