Jestem w trakcie wypróbowywania przepływu pracy opartego na dplyr (zamiast używania głównie data.table, do czego jestem przyzwyczajony) i napotkałem problem, do którego nie mogę znaleźć równoważnego rozwiązania dplyr . Często spotykam się ze scenariuszem, w którym muszę warunkowo zaktualizować / wymienić kilka kolumn na podstawie jednego warunku. Oto przykładowy kod z moim rozwiązaniem data.table:

library(data.table)

# Create some sample data
set.seed(1)
dt <- data.table(site = sample(1:6, 50, replace=T),
                 space = sample(1:4, 50, replace=T),
                 measure = sample(c('cfl', 'led', 'linear', 'exit'), 50, 
                               replace=T),
                 qty = round(runif(50) * 30),
                 qty.exit = 0,
                 delta.watts = sample(10.5:100.5, 50, replace=T),
                 cf = runif(50))

# Replace the values of several columns for rows where measure is "exit"
dt <- dt[measure == 'exit', 
         `:=`(qty.exit = qty,
              cf = 0,
              delta.watts = 13)]

Czy istnieje proste rozwiązanie tego samego problemu za pomocą programu dplyr? Chciałbym uniknąć używania ifelse, ponieważ nie chcę wielokrotnie wpisywać warunku - to jest uproszczony przykład, ale czasami jest wiele przypisań opartych na jednym warunku.

Z góry dziękuję za pomoc!

Te rozwiązania (1) utrzymują potok, (2) nie nadpisują danych wejściowych i (3) wymagają tylko jednorazowego określenia warunku:

1a) mutate_cond Utwórz prostą funkcję dla ramek danych lub tabel danych, które można włączyć do potoków. Ta funkcja jest podobna, mutateale działa tylko na wierszach spełniających warunek:

mutate_cond <- function(.data, condition, ..., envir = parent.frame()) {
  condition <- eval(substitute(condition), .data, envir)
  .data[condition, ] <- .data[condition, ] %>% mutate(...)
  .data
}

DF %>% mutate_cond(measure == 'exit', qty.exit = qty, cf = 0, delta.watts = 13)

1b) mutate_last Jest to alternatywna funkcja dla ramek danych lub tabel danych, która również jest podobna, mutateale jest używana tylko w obrębie group_by(jak w poniższym przykładzie) i działa tylko na ostatniej grupie, a nie na każdej grupie. Zauważ, że TRUE> FALSE, więc jeśli group_byokreśli warunek, mutate_lastbędzie działać tylko na wierszach spełniających ten warunek.

mutate_last <- function(.data, ...) {
  n <- n_groups(.data)
  indices <- attr(.data, "indices")[[n]] + 1
  .data[indices, ] <- .data[indices, ] %>% mutate(...)
  .data
}


DF %>% 
   group_by(is.exit = measure == 'exit') %>%
   mutate_last(qty.exit = qty, cf = 0, delta.watts = 13) %>%
   ungroup() %>%
   select(-is.exit)

2) Uwzględnij warunek Uwzględnij warunek, tworząc dodatkową kolumnę, która jest później usuwana. Następnie za pomocą ifelse, replacelub arytmetyczne logicals jak pokazano na rysunku. Działa to również w przypadku tabel danych.

library(dplyr)

DF %>% mutate(is.exit = measure == 'exit',
              qty.exit = ifelse(is.exit, qty, qty.exit),
              cf = (!is.exit) * cf,
              delta.watts = replace(delta.watts, is.exit, 13)) %>%
       select(-is.exit)

3) sqldf Moglibyśmy użyć SQL updateza pośrednictwem pakietu sqldf w potoku dla ramek danych (ale nie tabel danych, chyba że je przekonwertujemy - może to oznaczać błąd w dplyr. Zobacz dplyr wydanie 1579 ). Może się wydawać, że niepożądanie modyfikujemy dane wejściowe w tym kodzie ze względu na istnienie, updateale w rzeczywistości updatedziała na kopii danych wejściowych w tymczasowo wygenerowanej bazie danych, a nie na faktycznych danych wejściowych.

library(sqldf)

DF %>% 
   do(sqldf(c("update '.' 
                 set 'qty.exit' = qty, cf = 0, 'delta.watts' = 13 
                 where measure = 'exit'", 
              "select * from '.'")))

4) row_case_when Sprawdź również row_case_whenzdefiniowane w sekcji Zwracanie tibble: jak wektoryzować za pomocą case_when? . Używa składni podobnej case_whendo wierszy, ale ma zastosowanie do.

library(dplyr)

DF %>%
  row_case_when(
    measure == "exit" ~ data.frame(qty.exit = qty, cf = 0, delta.watts = 13),
    TRUE ~ data.frame(qty.exit, cf, delta.watts)
  )

Uwaga 1: Użyliśmy tego jakoDF

set.seed(1)
DF <- data.frame(site = sample(1:6, 50, replace=T),
                 space = sample(1:4, 50, replace=T),
                 measure = sample(c('cfl', 'led', 'linear', 'exit'), 50, 
                               replace=T),
                 qty = round(runif(50) * 30),
                 qty.exit = 0,
                 delta.watts = sample(10.5:100.5, 50, replace=T),
                 cf = runif(50))

Uwaga 2: Problem łatwego określania aktualizacji podzbioru wierszy jest również omawiany w wydaniach dplyr 134 , 631 , 1518 i 1573, gdzie 631 jest głównym tematem , a 1573 jest przeglądem odpowiedzi tutaj.

Możesz to zrobić za magrittrpomocą potoku dwukierunkowego %<>%:

library(dplyr)
library(magrittr)

dt[dt$measure=="exit",] %<>% mutate(qty.exit = qty,
                                    cf = 0,  
                                    delta.watts = 13)

Zmniejsza to ilość wpisywania, ale nadal jest znacznie wolniejsze niż data.table.

Oto rozwiązanie, które lubię:

mutate_when <- function(data, ...) {
  dots <- eval(substitute(alist(...)))
  for (i in seq(1, length(dots), by = 2)) {
    condition <- eval(dots[[i]], envir = data)
    mutations <- eval(dots[[i + 1]], envir = data[condition, , drop = FALSE])
    data[condition, names(mutations)] <- mutations
  }
  data
}

Pozwala pisać np

mtcars %>% mutate_when(
  mpg > 22,    list(cyl = 100),
  disp == 160, list(cyl = 200)
)

co jest całkiem czytelne - chociaż może nie być tak wydajne, jak mogłoby być.

Jak pokazano powyżej w eipi10, nie ma prostego sposobu na zastąpienie podzbioru w dplyr, ponieważ DT używa semantyki przekazywania przez referencję w porównaniu z dplyr przy użyciu przekazywania przez wartość. dplyr wymaga użycia of ifelse()na całym wektorze, podczas gdy DT zrobi podzbiór i zaktualizuje przez odniesienie (zwróci cały ID). Tak więc w tym ćwiczeniu DT będzie znacznie szybszy.

Możesz alternatywnie najpierw podzielić podzbiór, następnie zaktualizować, a na koniec ponownie połączyć:

dt.sub <- dt[dt$measure == "exit",] %>%
  mutate(qty.exit= qty, cf= 0, delta.watts= 13)

dt.new <- rbind(dt.sub, dt[dt$measure != "exit",])

Ale DT będzie znacznie szybszy: (zmodyfikowany tak, aby używał nowej odpowiedzi eipi10)

library(data.table)
library(dplyr)
library(microbenchmark)
microbenchmark(dt= {dt <- dt[measure == 'exit', 
                            `:=`(qty.exit = qty,
                                 cf = 0,
                                 delta.watts = 13)]},
               eipi10= {dt[dt$measure=="exit",] %<>% mutate(qty.exit = qty,
                                cf = 0,  
                                delta.watts = 13)},
               alex= {dt.sub <- dt[dt$measure == "exit",] %>%
                 mutate(qty.exit= qty, cf= 0, delta.watts= 13)

               dt.new <- rbind(dt.sub, dt[dt$measure != "exit",])})


Unit: microseconds
expr      min        lq      mean   median       uq      max neval cld
     dt  591.480  672.2565  747.0771  743.341  780.973 1837.539   100  a 
 eipi10 3481.212 3677.1685 4008.0314 3796.909 3936.796 6857.509   100   b
   alex 3412.029 3637.6350 3867.0649 3726.204 3936.985 5424.427   100   b

Właśnie się na to natknąłem i naprawdę polubiłem mutate_cond()@G. Grothendieck, ale pomyślał, że może się przydać również obsługa nowych zmiennych. Więc poniżej ma dwa dodatki:

Niepowiązane: Druga ostatnia linia zrobiona trochę więcej dplyrdzięki użyciufilter()

Trzy nowe wiersze na początku pobierają nazwy zmiennych do użycia w programie mutate()i inicjują wszystkie nowe zmienne w ramce danych przed mutate()wystąpieniem. Nowe zmienne są inicjalizowane przez pozostałą część czasu data.frameusing new_init, który jest NAdomyślnie ustawiony na missing ( ).

mutate_cond <- function(.data, condition, ..., new_init = NA, envir = parent.frame()) {
  # Initialize any new variables as new_init
  new_vars <- substitute(list(...))[-1]
  new_vars %<>% sapply(deparse) %>% names %>% setdiff(names(.data))
  .data[, new_vars] <- new_init

  condition <- eval(substitute(condition), .data, envir)
  .data[condition, ] <- .data %>% filter(condition) %>% mutate(...)
  .data
}

Oto kilka przykładów wykorzystujących dane tęczówki:

Zmień Petal.Lengthna 88, gdzie Species == "setosa". Będzie to działać zarówno w oryginalnej funkcji, jak iw nowej wersji.

iris %>% mutate_cond(Species == "setosa", Petal.Length = 88)

Tak samo jak powyżej, ale także utwórz nową zmienną x( NAw wierszach nieuwzględnionych w warunku). Wcześniej niemożliwe.

iris %>% mutate_cond(Species == "setosa", Petal.Length = 88, x = TRUE)

Tak samo jak powyżej, ale wiersze nieuwzględnione w warunku dla xmają ustawioną wartość FALSE.

iris %>% mutate_cond(Species == "setosa", Petal.Length = 88, x = TRUE, new_init = FALSE)

Ten przykład pokazuje, jak new_initmożna ustawić a, listaby zainicjować wiele nowych zmiennych z różnymi wartościami. W tym miejscu tworzone są dwie nowe zmienne z wykluczonymi wierszami inicjowanymi przy użyciu różnych wartości ( xinicjalizowane jako FALSE, yas NA)

iris %>% mutate_cond(Species == "setosa" & Sepal.Length < 5,
                  x = TRUE, y = Sepal.Length ^ 2,
                  new_init = list(FALSE, NA))

mutate_cond to świetna funkcja, ale daje błąd, jeśli w kolumnach użytych do utworzenia warunku znajduje się NA. Uważam, że warunkowa mutacja powinna po prostu zostawić takie rzędy w spokoju. Jest to zgodne z zachowaniem funkcji filter (), która zwraca wiersze, gdy warunek ma wartość TRUE, ale pomija oba wiersze z wartościami FALSE i NA.

Dzięki tej niewielkiej zmianie funkcja działa jak urok:

mutate_cond <- function(.data, condition, ..., envir = parent.frame()) {
    condition <- eval(substitute(condition), .data, envir)
    condition[is.na(condition)] = FALSE
    .data[condition, ] <- .data[condition, ] %>% mutate(...)
    .data
}

Właściwie nie widzę żadnych zmian dplyr, które to znacznie ułatwiłyby. case_whenświetnie sprawdza się, gdy istnieje wiele różnych warunków i wyników dla jednej kolumny, ale nie pomaga w tym przypadku, gdy chcesz zmienić wiele kolumn na podstawie jednego warunku. Podobnie, recodezapisuje wpisywanie, jeśli zastępujesz wiele różnych wartości w jednej kolumnie, ale nie pomaga to robić w wielu kolumnach jednocześnie. Na koniec mutate_atitd. Stosuj warunki tylko do nazw kolumn, a nie do wierszy w ramce danych. Mógłbyś potencjalnie napisać funkcję dla mutate_at, która by to zrobiła, ale nie mogę dowiedzieć się, jak byś zachowywał się inaczej dla różnych kolumn.

To powiedziawszy tutaj, jest to, jak podszedłbym do tego za pomocą nestformularza tidyri mapz purrr.

library(data.table)
library(dplyr)
library(tidyr)
library(purrr)

# Create some sample data
set.seed(1)
dt <- data.table(site = sample(1:6, 50, replace=T),
                 space = sample(1:4, 50, replace=T),
                 measure = sample(c('cfl', 'led', 'linear', 'exit'), 50, 
                                  replace=T),
                 qty = round(runif(50) * 30),
                 qty.exit = 0,
                 delta.watts = sample(10.5:100.5, 50, replace=T),
                 cf = runif(50))

dt2 <- dt %>% 
  nest(-measure) %>% 
  mutate(data = if_else(
    measure == "exit", 
    map(data, function(x) mutate(x, qty.exit = qty, cf = 0, delta.watts = 13)),
    data
  )) %>%
  unnest()

Jednym zwięzłym rozwiązaniem byłoby dokonanie mutacji na przefiltrowanym podzbiorze, a następnie dodanie z powrotem nie-wyjściowych wierszy tabeli:

library(dplyr)

dt %>% 
    filter(measure == 'exit') %>%
    mutate(qty.exit = qty, cf = 0, delta.watts = 13) %>%
    rbind(dt %>% filter(measure != 'exit'))

Dzięki stworzeniu rlang, możliwa jest nieco zmodyfikowana wersja przykładu 1a Grothendiecka, eliminująca potrzebę envirargumentacji, ponieważ enquo()oddaje środowisko, które .pjest tworzone automatycznie.

mutate_rows <- function(.data, .p, ...) {
  .p <- rlang::enquo(.p)
  .p_lgl <- rlang::eval_tidy(.p, .data)
  .data[.p_lgl, ] <- .data[.p_lgl, ] %>% mutate(...)
  .data
}

dt %>% mutate_rows(measure == "exit", qty.exit = qty, cf = 0, delta.watts = 13)

Możesz podzielić zbiór danych i wykonać zwykłe wywołanie mutacji na TRUEczęści.

dplyr 0.8 zawiera funkcję, group_splitktóra dzieli na grupy (i grupy można zdefiniować bezpośrednio w wywołaniu), więc użyjemy jej tutaj, ale base::splitdziała również.

library(tidyverse)
df1 %>%
  group_split(measure == "exit", keep=FALSE) %>% # or `split(.$measure == "exit")`
  modify_at(2,~mutate(.,qty.exit = qty, cf = 0, delta.watts = 13)) %>%
  bind_rows()

#    site space measure qty qty.exit delta.watts          cf
# 1     1     4     led   1        0        73.5 0.246240409
# 2     2     3     cfl  25        0        56.5 0.360315879
# 3     5     4     cfl   3        0        38.5 0.279966850
# 4     5     3  linear  19        0        40.5 0.281439486
# 5     2     3  linear  18        0        82.5 0.007898384
# 6     5     1  linear  29        0        33.5 0.392412729
# 7     5     3  linear   6        0        46.5 0.970848817
# 8     4     1     led  10        0        89.5 0.404447182
# 9     4     1     led  18        0        96.5 0.115594622
# 10    6     3  linear  18        0        15.5 0.017919745
# 11    4     3     led  22        0        54.5 0.901829577
# 12    3     3     led  17        0        79.5 0.063949974
# 13    1     3     led  16        0        86.5 0.551321441
# 14    6     4     cfl   5        0        65.5 0.256845013
# 15    4     2     led  12        0        29.5 0.340603733
# 16    5     3  linear  27        0        63.5 0.895166931
# 17    1     4     led   0        0        47.5 0.173088800
# 18    5     3  linear  20        0        89.5 0.438504370
# 19    2     4     cfl  18        0        45.5 0.031725246
# 20    2     3     led  24        0        94.5 0.456653397
# 21    3     3     cfl  24        0        73.5 0.161274319
# 22    5     3     led   9        0        62.5 0.252212124
# 23    5     1     led  15        0        40.5 0.115608182
# 24    3     3     cfl   3        0        89.5 0.066147321
# 25    6     4     cfl   2        0        35.5 0.007888337
# 26    5     1  linear   7        0        51.5 0.835458916
# 27    2     3  linear  28        0        36.5 0.691483644
# 28    5     4     led   6        0        43.5 0.604847889
# 29    6     1  linear  12        0        59.5 0.918838163
# 30    3     3  linear   7        0        73.5 0.471644760
# 31    4     2     led   5        0        34.5 0.972078100
# 32    1     3     cfl  17        0        80.5 0.457241602
# 33    5     4  linear   3        0        16.5 0.492500255
# 34    3     2     cfl  12        0        44.5 0.804236607
# 35    2     2     cfl  21        0        50.5 0.845094268
# 36    3     2  linear  10        0        23.5 0.637194873
# 37    4     3     led   6        0        69.5 0.161431896
# 38    3     2    exit  19       19        13.0 0.000000000
# 39    6     3    exit   7        7        13.0 0.000000000
# 40    6     2    exit  20       20        13.0 0.000000000
# 41    3     2    exit   1        1        13.0 0.000000000
# 42    2     4    exit  19       19        13.0 0.000000000
# 43    3     1    exit  24       24        13.0 0.000000000
# 44    3     3    exit  16       16        13.0 0.000000000
# 45    5     3    exit   9        9        13.0 0.000000000
# 46    2     3    exit   6        6        13.0 0.000000000
# 47    4     1    exit   1        1        13.0 0.000000000
# 48    1     1    exit  14       14        13.0 0.000000000
# 49    6     3    exit   7        7        13.0 0.000000000
# 50    2     4    exit   3        3        13.0 0.000000000

Jeśli kolejność wierszy ma znaczenie, użyj tibble::rowid_to_columnnajpierw, potem dplyr::arrangewłącz rowidi wybierz ją na końcu.

dane

df1 <- data.frame(site = sample(1:6, 50, replace=T),
                 space = sample(1:4, 50, replace=T),
                 measure = sample(c('cfl', 'led', 'linear', 'exit'), 50, 
                                  replace=T),
                 qty = round(runif(50) * 30),
                 qty.exit = 0,
                 delta.watts = sample(10.5:100.5, 50, replace=T),
                 cf = runif(50),
                 stringsAsFactors = F)

Myślę, że ta odpowiedź nie została wcześniej wspomniana. Działa prawie tak szybko, jak „domyślne” data.tablerozwiązanie.

Posługiwać się base::replace()

df %>% mutate( qty.exit = replace( qty.exit, measure == 'exit', qty[ measure == 'exit'] ),
                          cf = replace( cf, measure == 'exit', 0 ),
                          delta.watts = replace( delta.watts, measure == 'exit', 13 ) )

replace odzyskuje wartość zastępczą, więc jeśli chcesz, aby wartości kolumn zostały qtywprowadzone do kolumn qty.exit, musisz również dokonać podzbioru qty ... stąd qty[ measure == 'exit']w pierwszej zamianie ...

teraz prawdopodobnie nie będziesz chciał ciągle wpisywać ponownie measure == 'exit'... więc możesz stworzyć wektor indeksu zawierający ten wybór i użyć go w powyższych funkcjach.

#build an index-vector matching the condition
index.v <- which( df$measure == 'exit' )

df %>% mutate( qty.exit = replace( qty.exit, index.v, qty[ index.v] ),
               cf = replace( cf, index.v, 0 ),
               delta.watts = replace( delta.watts, index.v, 13 ) )

wzorce

# Unit: milliseconds
#         expr      min       lq     mean   median       uq      max neval
# data.table   1.005018 1.053370 1.137456 1.112871 1.186228 1.690996   100
# wimpel       1.061052 1.079128 1.218183 1.105037 1.137272 7.390613   100
# wimpel.index 1.043881 1.064818 1.131675 1.085304 1.108502 4.192995   100

Kosztem zerwania ze zwykłą składnią dplyr można użyć withinz bazy:

dt %>% within(qty.exit[measure == 'exit'] <- qty[measure == 'exit'],
              delta.watts[measure == 'exit'] <- 13)

Wydaje się, że dobrze integruje się z rurą i możesz zrobić w niej prawie wszystko, co chcesz.