In R create new column with name of column closest in value to target

user_10226848 0
Viewed 64

I'm analyzing donor data from an appeal. Let's say we have this data frame, which has an ID, the amount given, and the ask amounts from an appeal card:

dfgive <- data.frame(id = c(1, 2, 3, 4, 5),
   gift = c(20, 1000, 1500, 300, 500),
   ask1 = c(50, 5000, 5000, 100, 2500),
   ask2 = c(100, 3750, 3750, 250, 5000),
   ask3 = c(250, 2500, 2500, 500, 10000),
   gift_diff_1 = c(-30, -4000, -3500, 200, -2000),
   gift_diff_2 = c(-80, -2750, -2250, 50, -4500),
   gift_diff_3 = c(-230, -1500, -1000, -200, -9500),
   mindiff = c(-230, -4000, -3500, -200, -9500))

The gift difference from each ask amount and the minimum difference were created with the code below.

mutate(gift_diff_1 = gift - ask1) %>%
   mutate(gift_diff_2 = gift - ask2) %>%
   mutate(gift_diff_3 = gift - ask3) %>%
   mutate(mindiff=min(gift_diff_1, gift_diff_2, gift_diff_3))

What I'm hoping to do next is create a new column called gift_closest that would identify which of the ask amounts (ask1, ask2, or ask3) is closest in absolute value to the gift. We could use either the derived gift_diff columns or do it wholly within the equation. I can't get my head around how to best do it.

The value of the new column would be one of "ask1", "ask2", or "ask3". Ideally in a dplyr chain as that's where I'm creating the entire data set which will include a bunch of demographic fields.

thanks...

dplyr r
4 Answers

You might consider reshaping the data if you have many different ask columns, to reduce duplication of code. The result below can be joined back onto the original dfgive if you want to keep other columns in that dataframe.

library(tidyverse)
dfgive <- data.frame(
  id = c(1, 2, 3, 4, 5),
  gift = c(20, 1000, 1500, 300, 500),
  ask1 = c(50, 5000, 5000, 100, 2500),
  ask2 = c(100, 3750, 3750, 250, 5000),
  ask3 = c(250, 2500, 2500, 500, 10000)
)

dfgive %>%
  pivot_longer(
    cols = starts_with("ask"),
    names_to = "ask_num",
    values_to = "ask"
  ) %>%
  mutate(gift_diff = gift - ask) %>%
  group_by(id) %>%
  summarise(
    mindiff = min(gift_diff),
    gift_closest = ask_num[which.min(abs(gift_diff))]
  )
#> # A tibble: 5 x 3
#>      id mindiff gift_closest
#>   <dbl>   <dbl> <chr>       
#> 1     1    -230 ask1        
#> 2     2   -4000 ask3        
#> 3     3   -3500 ask3        
#> 4     4    -200 ask2        
#> 5     5   -9500 ask1
user_70284590

First of all: I guess your mindiff-part won't do what you expect it to do. Replace min with pmin.

library(dplyr)

dfgive %>%
  mutate(abs = pmin(abs(gift - ask1), abs(gift - ask2), abs(gift - ask3)),
         gift_close = case_when(abs(gift - ask1) == abs ~ "ask1",
                                abs(gift - ask2) == abs ~ "ask2",
                                abs(gift - ask3) == abs ~ "ask3",
                                TRUE ~ NA_character_))

returns

  id gift ask1 ask2  ask3 gift_diff_1 gift_diff_2 gift_diff_3 mindiff  abs gift_close
1  1   20   50  100   250         -30         -80        -230    -230   30       ask1
2  2 1000 5000 3750  2500       -4000       -2750       -1500   -4000 1500       ask3
3  3 1500 5000 3750  2500       -3500       -2250       -1000   -3500 1000       ask3
4  4  300  100  250   500         200          50        -200    -200   50       ask2
5  5  500 2500 5000 10000       -2000       -4500       -9500   -9500 2000       ask1
user_125052510

You can also use the following solution which is predominantly based on purrr package functions beside the very good answers you received:

library(dplyr)
library(purrr)

dfgive %>% 
  select(2) %>%
  map2_dfc(., dfgive %>% select(starts_with("gift_diff")), 
     ~ .x - abs(.y)) %>%
  set_names(~ paste("ask", 1:3, sep = "_")) %>%
  rowwise() %>% 
  mutate(gift_close = colnames(.)[max.col(cur_data())]) %>%
  select(gift_close) %>%
  bind_cols(dfgive) %>%
  relocate(gift_close, .after = last_col())


# A tibble: 5 x 10
# Rowwise: 
     id  gift  ask1  ask2  ask3 gift_diff_1 gift_diff_2 gift_diff_3 mindiff gift_close
  <dbl> <dbl> <dbl> <dbl> <dbl>       <dbl>       <dbl>       <dbl>   <dbl> <chr>     
1     1    20    50   100   250         -30         -80        -230    -230 ask_1     
2     2  1000  5000  3750  2500       -4000       -2750       -1500   -4000 ask_3     
3     3  1500  5000  3750  2500       -3500       -2250       -1000   -3500 ask_3     
4     4   300   100   250   500         200          50        -200    -200 ask_2     
5     5   500  2500  5000 10000       -2000       -4500       -9500   -9500 ask_1
user_143145200

This you mutate directly using cur_data

dfgive %>% 
  mutate(gift_closest = {tmp <- str_detect(names(.), 'ask'); names(.[tmp])[max.col(-1 * abs(gift - cur_data()[tmp]))]})

  id gift ask1 ask2  ask3 gift_diff_1 gift_diff_2 gift_diff_3 mindiff gift_closest
1  1   20   50  100   250         -30         -80        -230    -230         ask1
2  2 1000 5000 3750  2500       -4000       -2750       -1500   -4000         ask3
3  3 1500 5000 3750  2500       -3500       -2250       -1000   -3500         ask3
4  4  300  100  250   500         200          50        -200    -200         ask2
5  5  500 2500 5000 10000       -2000       -4500       -9500   -9500         ask1

even you can proceed with generation of all new columns without the need of repeating it for every ask value

dfgive <- structure(list(id = c(1, 2, 3, 4, 5), gift = c(20, 1000, 1500, 
                                                         300, 500), ask1 = c(50, 5000, 5000, 100, 2500), ask2 = c(100, 
                                                                                                                  3750, 3750, 250, 5000), ask3 = c(250, 2500, 2500, 500, 10000)), class = "data.frame", row.names = c(NA, 
                                                                                                                                                                                                                      -5L))
dfgive
#>   id gift ask1 ask2  ask3
#> 1  1   20   50  100   250
#> 2  2 1000 5000 3750  2500
#> 3  3 1500 5000 3750  2500
#> 4  4  300  100  250   500
#> 5  5  500 2500 5000 10000
library(tidyverse)
dfgive %>% 
  mutate(gift_closest = {tmp <- str_detect(names(.), 'ask'); names(.[tmp])[max.col(-1 * abs(gift - cur_data()[tmp]))]}) %>%
  mutate(across(starts_with('ask'), ~ gift - .,
                .names = 'gift_diff_{str_remove(.col,"ask")}')) %>%
  rowwise() %>%
  mutate(mindiff = min(c_across(starts_with('gift_diff'))))
#> # A tibble: 5 x 10
#> # Rowwise: 
#>      id  gift  ask1  ask2  ask3 gift_closest gift_diff_1 gift_diff_2 gift_diff_3
#>   <dbl> <dbl> <dbl> <dbl> <dbl> <chr>              <dbl>       <dbl>       <dbl>
#> 1     1    20    50   100   250 ask1                 -30         -80        -230
#> 2     2  1000  5000  3750  2500 ask3               -4000       -2750       -1500
#> 3     3  1500  5000  3750  2500 ask3               -3500       -2250       -1000
#> 4     4   300   100   250   500 ask2                 200          50        -200
#> 5     5   500  2500  5000 10000 ask1               -2000       -4500       -9500
#> # ... with 1 more variable: mindiff <dbl>

Created on 2021-06-10 by the reprex package (v2.0.0)

user_28848590
Related