Mam następujący kod, w którym muszę chwycić nazwy kolumn z zmiennej, a następnie wykonaj operację selektywnie na wierszach, używając określonej kolumny w tej operacji. Oto mój prosty przykład, tworząc kolumnę res, aby dopasować kolumnę targe t:

library(tidyverse)

tst <- tibble(grp = c("a","a","b","b","c","c"), a = rep(2,6), b = rep(4,6), 
              c = rep(8,6), target = c(2,2,4,4,8,8), res = rep(0,6))

# create list of columns to iterate over
lst <-  unique(tst$grp)

# loop over each column, creating a dummy column with 
# the copied value in the matching rows, zeroes elsewhere
for(g in lst) {

  tst <- tst %>% 
    mutate(!!paste("res", g, sep="_") := ifelse(grp == g, !!rlang::sym(g),0)) %>% 
    select(!!paste("res", g, sep="_")) %>% 
    cbind(tst)
}

# combine the dummy columns by rowSum
res <- tst %>% select(starts_with("res_")) %>% mutate(res = rowSums(.)) %>% 
select(res)

# tidy up the output, result matches the target
tst <- tst %>% select(grp, a, b, c, target) %>% cbind(res)

tst

  grp a b c target res
1   a 2 4 8      2   2
2   a 2 4 8      2   2
3   b 2 4 8      4   4
4   b 2 4 8      4   4
5   c 2 4 8      8   8
6   c 2 4 8      8   8

Podjęłam podejście iteracyjne podejście, zapętląc się przez unikalne zmienne w kolumnie grp, tworząc tymczasowe kolumny, a następnie rowSum() ING, aby uzyskać ostateczny wynik. Crazy, ale w końcu dotarł.

Jestem pewien, że jest bardziej elegancki sposób na zrobienie jednego z rodziny {x0}} z purrr. Czy ktoś może mi pokazać, jak mogę to zrobić bez pętli za pomocą purrr? Naprawdę walczyłem, aby dostać bit Dynamic Kolumn Name Pracując przy użyciu tego podejścia. Z góry dziękuję.

2
Scott Simpson 5 czerwiec 2018, 12:08

4 odpowiedzi

Najlepsza odpowiedź

Możesz użyć imap, który iteruje o wartości kolumnowych i ich nazwy. Wartości kolumn to wartości grp, nazwy są tylko sekwencją 1,...,6.

Ponadto, musisz dostarczyć samą ramę danych jako dodatkowy argument ({x0}} do imap, który do przodu jest do jego argumentu funkcji. W sumie:

tst %>% 
  mutate(res = purrr::imap_dbl(grp, df = ., 
    .f = function(g, i, df) df[i,g][[1]] # [[1]] turns the result from tibble into a double
  )) 

Edytuj: Czas ten rozwiązanie z większym stołem:

tst <- tst[sample(nrow(tst), 50000, TRUE),]

I zajmuje około 50 lat.

0
akraf 5 czerwiec 2018, 11:24

Coś, co nie wymaga napisania pętli

library(tidyverse)

tst <- tibble(grp = c("a","a","b","b","c","c"), a = rep(2,6), b = rep(4,6), 
              c = rep(8,6), target = c(2,2,4,4,8,8), res = rep(0,6))

tst %>% 
  mutate(res = 
           case_when(
             grp == "a" ~ a,
             grp == "b" ~ b,
             grp == "c" ~ c
           ))

# A tibble: 6 x 6
  grp       a     b     c target   res
  <chr> <dbl> <dbl> <dbl>  <dbl> <dbl>
1 a         2     4     8      2     2
2 a         2     4     8      2     2
3 b         2     4     8      4     4
4 b         2     4     8      4     4
5 c         2     4     8      8     8
6 c         2     4     8      8     8

Uwaga: zamiast ~ a Możesz użyć własnej formuły w razie potrzeby.
Aby uzyskać więcej pomocy, zobacz ?case_when

1
Vasim 5 czerwiec 2018, 09:38

Jest to rozwiązanie podstawowe R, które również nie ma już:

# Save all source columns in a matrix. This enables indexing by another matrix
x <- as.matrix(tst[, unique(tst$grp)])
# Matrix of (row, column) pairs to extract from x
i <- cbind(seq_len(nrow(tst)), match(tst$grp, colnames(x)))
tst$res <- x[i]

Edytuj: Upłynął czas na większą tabelę:

tst <- tst[sample(nrow(tst), 50000, TRUE), ]

0,008s - 0,015s.

0
akraf 5 czerwiec 2018, 11:23

Być może:

tst %>% 
  mutate(res = sapply(seq(nrow(tst)), function(x) tst[x,as.character(tst$grp[x])]))


# A tibble: 6 x 6
    grp     a     b     c target   res
  <chr> <dbl> <dbl> <dbl>  <dbl> <dbl>
1     a     2     4     8      2     2
2     a     2     4     8      2     2
3     b     2     4     8      4     4
4     b     2     4     8      4     4
5     c     2     4     8      8     8
6     c     2     4     8      8     8
0
Lennyy 6 czerwiec 2018, 06:00