Операции от элемента к элементу над несколькими столбцами в группах - PullRequest
3 голосов
/ 03 мая 2020

У нас есть набор данных mtcars, и мы хотим вычислить функцию между различными автомобилями в группах, используя в качестве входных данных несколько столбцов.

Более конкретно:

  1. Группировать по передаче am и шестерни gear
  2. Сравните все автомобили в одной группе друг с другом (автомобиль1 с автомобилем2, автомобиль1 с автомобилем3, автомобиль2 с автомобилем3 ...)
  3. Есть ли у первого автомобиля больше смещение, чем вторая машина? disp1>disp2
  4. И у первой машины больше лошадиных сил, чем у второй? hp1>hp2

Результат должен выглядеть следующим образом:

# Car1           Car2           result
# Mazda RX4      Mazda RX4 Wag  false
# Mazda RX4      Datsun 710     false 
# Mazda RX4 Wag  Datsun 710     true

В этот вопрос является внешней операцией для группы, но только один столбец используемый. Можно ли расширить это до нескольких столбцов? Если возможно, было бы неплохо иметь disp1, disp2 et c. столбцы в таблице результатов.

Ответы [ 2 ]

4 голосов
/ 03 мая 2020

Это немного грязно, но вы можете сделать следующее:

library(dplyr)
library(tidyr)

dat <- mtcars %>%
    tibble::rownames_to_column(var = "Car1") %>%
    mutate(Car2 = Car1) %>%
    group_by(am, gear) %>%
    expand(Car1, Car2) %>%
    left_join(tibble::rownames_to_column(mtcars, var = "Car1"), by = "Car1") %>%
    left_join(tibble::rownames_to_column(mtcars, var = "Car2"), by = "Car2") %>%
    ungroup() %>%
    mutate(result = disp.x > disp.y & hp.x > hp.y) %>%
    select(Car1, Car2, result)

Тогда мы получим ожидаемые результаты:

dat

# A tibble: 330 x 3
   Car1        Car2                result
   <chr>       <chr>               <lgl> 
 1 AMC Javelin AMC Javelin         FALSE 
 2 AMC Javelin Cadillac Fleetwood  FALSE 
 3 AMC Javelin Camaro Z28          FALSE 
 4 AMC Javelin Chrysler Imperial   FALSE 
 5 AMC Javelin Dodge Challenger    FALSE 
 6 AMC Javelin Duster 360          FALSE 
 7 AMC Javelin Hornet 4 Drive      TRUE  
 8 AMC Javelin Hornet Sportabout   FALSE 
 9 AMC Javelin Lincoln Continental FALSE 
10 AMC Javelin Merc 450SE          FALSE 
# … with 320 more rows

dat %>% filter(Car1 == "Mazda RX4")

# A tibble: 8 x 3
  Car1      Car2           result
  <chr>     <chr>          <lgl> 
1 Mazda RX4 Datsun 710     TRUE  
2 Mazda RX4 Fiat 128       TRUE  
3 Mazda RX4 Fiat X1-9      TRUE  
4 Mazda RX4 Honda Civic    TRUE  
5 Mazda RX4 Mazda RX4      FALSE 
6 Mazda RX4 Mazda RX4 Wag  FALSE 
7 Mazda RX4 Toyota Corolla TRUE  
8 Mazda RX4 Volvo 142E     TRUE

(В то время как сравнение Mazda RX4 с Datsun 710 отличается от заявленных вами ожидаемых результатов, это на самом деле правильно:)

mtcars %>%
    tibble::rownames_to_column(var = "Car1") %>%
    filter(Car1 %in% c("Mazda RX4", "Datsun 710"))
        Car1  mpg cyl disp  hp drat   wt  qsec vs am gear carb
1  Mazda RX4 21.0   6  160 110 3.90 2.62 16.46  0  1    4    4
2 Datsun 710 22.8   4  108  93 3.85 2.32 18.61  1  1    4    1
2 голосов
/ 03 мая 2020

Вот немного более краткий (если не менее грязный) метод, использующий outer, как требуется, и показывающий сравнительную ценность hp и disp. Он также использует reshape2::melt:

library(dplyr)

f <- function(x) {
  y <- reshape2::melt(outer(x$disp, x$disp, `>`) & outer(x$hp, x$hp, `>`))
  y <- y[y[[1]] != y[[2]],]
  tibble(Car1 = rownames(x)[y[[1]]], Car2 = rownames(x)[y[[2]]],
         disp1 = x$disp[y[[1]]], disp2 = x$disp[y[[2]]],
         hp1 = x$hp[y[[1]]], hp2 = x$hp[y[[2]]], result = y[[3]])
}

result_list <- mtcars %>% split(paste(.$gear, .$am)) %>% lapply(f)

В результирующем списке есть один фрейм данных для каждой комбинации передач / утра. Я только что показал второй здесь для краткости:

result_list[2]
$`4 0`
# A tibble: 12 x 7
   Car1      Car2      disp1 disp2   hp1   hp2 result
   <chr>     <chr>     <dbl> <dbl> <dbl> <dbl> <lgl> 
 1 Merc 230  Merc 240D  141.  147.    95    62 FALSE 
 2 Merc 280  Merc 240D  168.  147.   123    62 TRUE  
 3 Merc 280C Merc 240D  168.  147.   123    62 TRUE  
 4 Merc 240D Merc 230   147.  141.    62    95 FALSE 
 5 Merc 280  Merc 230   168.  141.   123    95 TRUE  
 6 Merc 280C Merc 230   168.  141.   123    95 TRUE  
 7 Merc 240D Merc 280   147.  168.    62   123 FALSE 
 8 Merc 230  Merc 280   141.  168.    95   123 FALSE 
 9 Merc 280C Merc 280   168.  168.   123   123 FALSE 
10 Merc 240D Merc 280C  147.  168.    62   123 FALSE 
11 Merc 230  Merc 280C  141.  168.    95   123 FALSE 
12 Merc 280  Merc 280C  168.  168.   123   123 FALSE 
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...