Início / coding / Perguntas / 78828772
Accepted
Alireza Sadeghi
Asked: 2024-08-03 21:20:33 +0800 CST

Como posso usar uma função e `across()` para transformar uma coluna condicional em um `tibble`?

  • 772

Para fins demonstrativos, utilizo um tidytuesdayconjunto de dados chamado animal_outcomes.

Meu problema: tenho várias colunas numéricas em um arquivo tibble. Quero mutateuma nova coluna que some todas as colunas (exceto a última) e se a soma for igual à última a nova coluna é 1 senão 0 . Vou explicar melhor:

# Adding the example dataset
data <- tidytuesdayR::tt_load(x = "2020-07-21")
data <- data$animal_outcomes

Agora os dados estão assim:

> data$animal_outcomes

# A tibble: 664 × 12
    year animal_type outcome      ACT   NSW    NT   QLD    SA   TAS   VIC    WA Total
   <dbl> <chr>       <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
 1  1999 Dogs        Reclaimed    610  3140   205  1392  2329   516  7130     1 15323
 2  1999 Dogs        Rehomed     1245  7525   526  5489  1105   480  4908   137 21415
 3  1999 Dogs        Other         12   745   955   860   380   168  1001     6  4127
 4  1999 Dogs        Euthanized   360  9221     9  9214  1701   599  5217    18 26339
 5  1999 Cats        Reclaimed    111   201    22   206   157    31   884     0  1612
 6  1999 Cats        Rehomed     1442  3913   269  3901  1055   752  3768    62 15162
 7  1999 Cats        Other          0   447     0   386    46   124  1501     5  2509
 8  1999 Cats        Euthanized  1007  8205   847 10554  3415  1056  6113     5 31202
 9  1999 Horses      Reclaimed      0     0     1     0     2     1    87     0    91
10  1999 Horses      Rehomed        1    12     3     3    10     0    19     0    48
# ℹ 654 more rows
# ℹ Use `print(n = ...)` to see more rows

Quero adicionar uma coluna que verifique se a Totalcoluna é realmente uma soma de todas as colunas. Aqui está o resultado em minha mente:

# A tibble: 664 × 13
    year animal_type outcome      ACT   NSW    NT   QLD    SA   TAS   VIC    WA Total condition # notice this last column
   <dbl> <chr>       <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>
 1  1999 Dogs        Reclaimed    610  3140   205  1392  2329   516  7130     1 15323         1
 2  1999 Dogs        Rehomed     1245  7525   526  5489  1105   480  4908   137 21415         1
 3  1999 Dogs        Other         12   745   955   860   380   168  1001     6  4127         1
 4  1999 Dogs        Euthanized   360  9221     9  9214  1701   599  5217    18 26339         1
 5  1999 Cats        Reclaimed    111   201    22   206   157    31   884     0  1612         1
 6  1999 Cats        Rehomed     1442  3913   269  3901  1055   752  3768    62 15162         1
 7  1999 Cats        Other          0   447     0   386    46   124  1501     5  2509         1
 8  1999 Cats        Euthanized  1007  8205   847 10554  3415  1056  6113     5 31202         1
 9  1999 Horses      Reclaimed      0     0     1     0     2     1    87     0    91         1
10  1999 Horses      Rehomed        1    12     3     3    10     0    19     0    48         1
# ℹ 654 more rows
# ℹ Use `print(n = ...)` to see more rows

Eu tentei o seguinte código. Funciona, mas requer muitas teclas digitadas; portanto, não funcionará muito bem se você tiver muitas colunas:

> data$animal_outcomes %>% 
    mutate(condition = if_else((ACT + NSW + NT + QLD + SA + TAS + VIC + WA) == Total, 1, 0))

# A tibble: 664 × 13
    year animal_type outcome      ACT   NSW    NT   QLD    SA   TAS   VIC    WA Total condition
   <dbl> <chr>       <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>
 1  1999 Dogs        Reclaimed    610  3140   205  1392  2329   516  7130     1 15323         1
 2  1999 Dogs        Rehomed     1245  7525   526  5489  1105   480  4908   137 21415         1
 3  1999 Dogs        Other         12   745   955   860   380   168  1001     6  4127         1
 4  1999 Dogs        Euthanized   360  9221     9  9214  1701   599  5217    18 26339         1
 5  1999 Cats        Reclaimed    111   201    22   206   157    31   884     0  1612         1
 6  1999 Cats        Rehomed     1442  3913   269  3901  1055   752  3768    62 15162         1
 7  1999 Cats        Other          0   447     0   386    46   124  1501     5  2509         1
 8  1999 Cats        Euthanized  1007  8205   847 10554  3415  1056  6113     5 31202         1
 9  1999 Horses      Reclaimed      0     0     1     0     2     1    87     0    91         1
10  1999 Horses      Rehomed        1    12     3     3    10     0    19     0    48         1
# ℹ 654 more rows
# ℹ Use `print(n = ...)` to see more rows

Eu também usei o seguinte, mas retornou um erro:

data$animal_outcomes %>% 
    mutate(condition = if_else((ACT + NSW + NT + QLD + SA + TAS + VIC + WA) == Total, 1, 0))

Além disso, este (que obviamente está errado porque soma os números reais 4:11):

data$animal_outcomes %>% 
    mutate(condition = if_else(sum(4:11) == Total, 1,0))

E ESTE: Não sei por que sum(ACT:WA)não retorna erro! E se não retornar erro, o que na verdade está somando!!

data$animal_outcomes %>% 
    mutate(condition = if_else(sum(ACT:WA) == Total, 1,0))

# A tibble: 664 × 13
    year animal_type outcome      ACT   NSW    NT   QLD    SA   TAS   VIC    WA Total condition
   <dbl> <chr>       <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <dbl>
 1  1999 Dogs        Reclaimed    610  3140   205  1392  2329   516  7130     1 15323         0
 2  1999 Dogs        Rehomed     1245  7525   526  5489  1105   480  4908   137 21415         0
 3  1999 Dogs        Other         12   745   955   860   380   168  1001     6  4127         0
 4  1999 Dogs        Euthanized   360  9221     9  9214  1701   599  5217    18 26339         0
 5  1999 Cats        Reclaimed    111   201    22   206   157    31   884     0  1612         0
 6  1999 Cats        Rehomed     1442  3913   269  3901  1055   752  3768    62 15162         0
 7  1999 Cats        Other          0   447     0   386    46   124  1501     5  2509         0
 8  1999 Cats        Euthanized  1007  8205   847 10554  3415  1056  6113     5 31202         0
 9  1999 Horses      Reclaimed      0     0     1     0     2     1    87     0    91         0
10  1999 Horses      Rehomed        1    12     3     3    10     0    19     0    48         0

3 respostas

  1. Best Answer

    Você pode tentar isso:

    data %>% rowwise() %>% mutate(check = 1*(Total ==  sum(c_across(ACT:WA))))

    Saída:

        year animal_type outcome      ACT   NSW    NT   QLD    SA   TAS   VIC    WA Total check
   <dbl> <chr>       <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
 1  1999 Dogs        Reclaimed    610  3140   205  1392  2329   516  7130     1 15323     1
 2  1999 Dogs        Rehomed     1245  7525   526  5489  1105   480  4908   137 21415     1
 3  1999 Dogs        Other         12   745   955   860   380   168  1001     6  4127     1
 4  1999 Dogs        Euthanized   360  9221     9  9214  1701   599  5217    18 26339     1
 5  1999 Cats        Reclaimed    111   201    22   206   157    31   884     0  1612     1
 6  1999 Cats        Rehomed     1442  3913   269  3901  1055   752  3768    62 15162     1
 7  1999 Cats        Other          0   447     0   386    46   124  1501     5  2509     1
 8  1999 Cats        Euthanized  1007  8205   847 10554  3415  1056  6113     5 31202     1
 9  1999 Horses      Reclaimed      0     0     1     0     2     1    87     0    91     1
10  1999 Horses      Rehomed        1    12     3     3    10     0    19     0    48     1
# ℹ 654 more rows
# ℹ Use `print(n = ...)` to see more rows
    • 1

  2. No seu último exemplo, se você agrupar esse intervalo de colunas para pick()transformá-lo em um quadro e substituí-lo sum()por rowSums(), isso funciona:

    library(dplyr)
mutate(data, condition = if_else(rowSums(pick(ACT:WA)) == Total, 1, 0))

    Pode ser uma seleção um pouco infeliz de dados de exemplo, mas o problema aqui é testar a igualdade de duplas com ==. Para evitar o Círculo 1 de R Inferno - Caindo na Armadilha de Ponto Flutuante , você pode querer usar algo assim:

    mutate(data, condition = +near(rowSums(pick(ACT:WA)), Total))

    dplyr::near()é uma escolha mais segura, pois usa tolerância integrada ao comparar vetores de entrada, +transforma o vetor booleano em numérico ( TRUEto 1)

    Resultado:

    mutate(data, condition = +near(rowSums(pick(ACT:WA)), Total))
#> # A tibble: 10 × 13
#>     year animal_type outcome      ACT   NSW    NT   QLD    SA   TAS   VIC    WA Total condition
#>    <dbl> <chr>       <chr>      <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>     <int>
#>  1  1999 Dogs        Reclaimed    610  3140   205  1392  2329   516  7130     1 15323         1
#>  2  1999 Dogs        Rehomed     1245  7525   526  5489  1105   480  4908   137 21415         1
#>  3  1999 Dogs        Other         12   745   955   860   380   168  1001     6  4127         1
#>  4  1999 Dogs        Euthanized   360  9221     9  9214  1701   599  5217    18 26339         1
#>  5  1999 Cats        Reclaimed    111   201    22   206   157    31   884     0  1612         1
#>  6  1999 Cats        Rehomed     1442  3913   269  3901  1055   752  3768    62 15162         1
#>  7  1999 Cats        Other          0   447     0   386    46   124  1501     5  2509         1
#>  8  1999 Cats        Euthanized  1007  8205   847 10554  3415  1056  6113     5 31202         1
#>  9  1999 Horses      Reclaimed      0     0     1     0     2     1    87     0    91         1
#> 10  1999 Horses      Rehomed        1    12     3     3    10     0    19     0    48         1

    Dados de exemplo:

    data <- structure(list(year = c(1999, 1999, 1999, 1999, 1999, 1999, 1999, 
1999, 1999, 1999), animal_type = c("Dogs", "Dogs", "Dogs", "Dogs", 
"Cats", "Cats", "Cats", "Cats", "Horses", "Horses"), outcome = c("Reclaimed", 
"Rehomed", "Other", "Euthanized", "Reclaimed", "Rehomed", "Other", 
"Euthanized", "Reclaimed", "Rehomed"), ACT = c(610, 1245, 12, 
360, 111, 1442, 0, 1007, 0, 1), NSW = c(3140, 7525, 745, 9221, 
201, 3913, 447, 8205, 0, 12), NT = c(205, 526, 955, 9, 22, 269, 
0, 847, 1, 3), QLD = c(1392, 5489, 860, 9214, 206, 3901, 386, 
10554, 0, 3), SA = c(2329, 1105, 380, 1701, 157, 1055, 46, 3415, 
2, 10), TAS = c(516, 480, 168, 599, 31, 752, 124, 1056, 1, 0), 
    VIC = c(7130, 4908, 1001, 5217, 884, 3768, 1501, 6113, 87, 
    19), WA = c(1, 137, 6, 18, 0, 62, 5, 5, 0, 0), Total = c(15323, 
    21415, 4127, 26339, 1612, 15162, 2509, 31202, 91, 48)), row.names = c(NA, 
-10L), class = c("tbl_df", "tbl", "data.frame"))

    bench::mark()for rowSums()e sum()in rowwise()com conjunto de dados completo (664 × 12 tibble):

    library(dplyr)
data <- tidytuesdayR::tt_load(x = "2020-07-21")$animal_outcomes 
bm <- bench::mark(
  rowsums_ = mutate(data, check = +near(rowSums(pick(ACT:WA)), Total)),
  rowwise_ = rowwise(data) |>  mutate(check = if_else(near(Total, sum(pick(4:11))), 1L,0L)) |> ungroup(),
  min_iterations = 100,
)
#> Warning: Some expressions had a GC in every iteration; so filtering is
#> disabled.
bm
#> # A tibble: 2 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 rowsums_     1.17ms   1.36ms    646.      2.27MB     7.98
#> 2 rowwise_   106.83ms 114.95ms      8.49    1.34MB    12.1
ggplot2::autoplot(bm)
#> Loading required namespace: tidyr

    Criado em 03/08/2024 com reprex v2.1.0

    • 1

  3. Obrigado a todos por suas soluções perspicazes.

    Acho que o código a seguir, inspirado nas respostas anteriores, se adapta melhor à minha pergunta:

    data$animal_outcomes %>% 
    rowwise() %>%  
    mutate(check = if_else(near(Total, sum(pick(4:11))), 1,0))
    • 1

relate perguntas