mutate data list column in purrr block and get a static min by grouping numeric variable

user_14328853 0
Viewed 56

Using diamonds as an example, I'd like to group by cut then add a row number for each grouping and then shuffle. Then I'd like to apply a transformation to price, in this case just price + 1 and then I'd like to find the price corresponding to row 1 and make that the value for the entire feature.

Tried:

mydiamonds <- diamonds %>%
  group_by(cut) %>% 
  mutate(rownum = row_number()) %>% 
  nest %>% 
  mutate(data = map(data, ~ .x %>% sample_n(nrow(.x)))) %>% 
  mutate(data = map(data, ~ .x %>% mutate(InitialPrice = price + rownum)))

This gets me close:

mydiamonds$data[[1]] %>% head
# A tibble: 6 x 11
  carat color clarity depth table price     x     y     z rownum InitialPrice
  <dbl> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>  <int>        <int>
1  0.4  E     VS1      62.4  54     951  4.73  4.75  2.96  13792        14743
2  0.71 H     VS2      60.9  55    2450  5.76  5.74  3.5   20808        23258
3  1.01 F     VVS2     61    57    8688  6.52  6.46  3.96   6567        15255
4  0.62 G     VS2      61.6  55    2321  5.51  5.53  3.4   20438        22759
5  0.77 F     VS1      60.9  58    3655  5.91  5.95  3.61   1717         5372
6  1.37 G     VVS2     62.3  55.5 12207  7.05  7.14  4.43   8013        20220

What I'd like to do from here is to find the value of InitialPrice corresponding to rownum == 1 and then overwrite InitialPrice to be that single value all the way down for each data frame in mydiamonds$data.

I tried mutating and mutating again in my last line like so:

mutate(data = map(data, ~ .x %>% mutate(InitialPrice = price + rownum) %>% mutate(InitialPrice = . %>% filter(rownum ==1) %>% pull(InitialPrice))))

However got error:

Error: Problem with mutate() input data. x Problem with mutate() input InitialPrice. x Input InitialPrice must be a vector, not a fseq/function object. ℹ Input InitialPrice is . %>% filter(rownum == 1) %>% pull(InitialPrice). ℹ Input data is map(...).

How could I do that?

purrr dplyr r
2 Answers

We could wrap the . within braces

library(dplyr)
library(ggplot2)
library(purrr)
mydiamonds %>% 
   mutate(data = map(data, ~ .x %>% 
       mutate(InitialPrice = price + rownum ) %>%
       mutate(InitialPrice = {.} %>% 
                 filter(rownum ==1) %>% 
                 pull(InitialPrice))))
# A tibble: 5 x 2
# Groups:   cut [5]
#  cut       data                  
#  <ord>     <list>                
#1 Ideal     <tibble [21,551 × 11]>
#2 Premium   <tibble [13,791 × 11]>
#3 Good      <tibble [4,906 × 11]> 
#4 Very Good <tibble [12,082 × 11]>
#5 Fair      <tibble [1,610 × 11]>
user_37322710

You can do :

library(tidyverse)

result <- mydiamonds %>%
              mutate(data = map(data, ~.x %>% 
                            mutate(InitialPrice = InitialPrice[rownum == 1])))

result$data[[1]]

# A tibble: 21,551 x 11
#   carat color clarity depth table price     x     y     z rownum InitialPrice
#   <dbl> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>  <int>        <int>
# 1  0.7  I     VVS1     61.8  56    2492  5.72  5.74  3.54  20897          327
# 2  0.51 G     VS1      61.8  60    1757  5.08  5.12  3.15  18405          327
# 3  0.32 G     VVS1     61.4  57     814  4.39  4.41  2.7   11820          327
# 4  0.33 H     VVS1     62.5  56     901  4.44  4.42  2.77  13130          327
# 5  0.72 G     SI2      62.1  54    2079  5.77  5.82  3.6   19769          327
# 6  1.31 G     VVS2     59.2  59   11459  7.12  7.18  4.23   7807          327
# 7  0.32 F     VVS2     61.6  55     945  4.41  4.42  2.72  13714          327
# 8  0.39 G     VVS1     62.1  54.7  1008  4.64  4.72  2.91  14462          327
# 9  0.7  E     VVS2     62.3  53.7  3990  5.67  5.72  3.55   2138          327
#10  0.71 D     SI2      62.7  55    2551  5.67  5.71  3.57  21042          327
# … with 21,541 more rows
user_39629140
Related