使用映射或函數在數據框中創建新列

Question

我有以下代碼從我已有的匯率中得出新的匯率：

df %>% 
  mutate(ER_AUD_USD = ER_GBP_USD / ER_GBP_AUD, 
         ER_CAD_USD = ER_GBP_USD / ER_GBP_CAD, 
         ER_EUR_USD = ER_GBP_USD / ER_GBP_EUR
  )

我可能需要更多，所以我想要一個函數來從貨幣列表中創建我需要的所有貨幣。 匯率被適當地命名，因此名稱的一部分可以固定。

例如 ER_GBP_USD 是 GBP/USD 所以：

英鎊/美元÷英鎊/歐元= 英鎊 /美元×歐元/ 英鎊 =歐元/美元

即 ER_***_USD <- ER_GBP_USD / ER_GBP_***

樣本匯率df：

         date ER_GBP_CAD ER_GBP_AUD ER_GBP_EUR
1  2016-01-01       2.02       2.07       1.11
2  2016-02-01       1.99       2.10       1.14
3  2016-03-01       1.91       2.06       1.17
4  2016-04-01       1.87       2.04       1.13

我在想一些事情：

to_currency <- 'USD'
from_currency <- c('AUD', 'EUR','CAD')

paste('ER', to_currency, from_currency, sep = '_') = paste('ER', GBP, to_currency, sep = '_')/paste('ER', from_currency,GBP, sep = '_')

但我不確定如何映射它。

Answer 1

使用您的示例數據，我將首先創建一個基於貨幣符號創建新列的函數。

library(tidyverse)
library(rlang)

column_new <- function(data, to_cur, from_cur, mid_cur){
  num = sym(paste('ER', mid_cur, to_cur, sep = '_'))
  denom = sym(paste('ER', mid_cur, from_cur, sep = '_'))
  data = data%>%mutate(!!paste('ER', from_cur, to_cur, sep = '_') := !!num/!!denom)
  return(data%>%select(!!sym(paste('ER', from_cur, to_cur, sep = '_'))))
}

我會拿你提供的樣本數據。

> df
        date ER_GBP_CAD ER_GBP_AUD ER_GBP_EUR
1 2016-01-01       2.02       2.07       1.11
2 2016-02-01       1.99       2.10       1.14
3 2016-03-01       1.91       2.06       1.17
4 2016-04-01       1.87       2.04       1.13

並使用purrr::map_dfc循環遍歷我的貨幣以創建新列

> from_currencies = c('AUD','EUR')
> to_currency = 'CAD'
> df%>%bind_cols(map_dfc(from_currencies, ~column_new(df, to_currency, .x, "GBP")))

        date ER_GBP_CAD ER_GBP_AUD ER_GBP_EUR ER_AUD_CAD ER_EUR_CAD
1 2016-01-01       2.02       2.07       1.11  0.9758454   1.819820
2 2016-02-01       1.99       2.10       1.14  0.9476190   1.745614
3 2016-03-01       1.91       2.06       1.17  0.9271845   1.632479
4 2016-04-01       1.87       2.04       1.13  0.9166667   1.654867

注意：如果要將所有貨幣作為一個向量循環，請執行以下操作：

currencies = c('AUD','EUR', 'CAD')

valid_column = function(x){
  ifelse(is.numeric(x), sum(x) != length(x), TRUE)
}

> df%>%bind_cols(lapply(currencies, function(y) map_dfc(currencies, ~column_new(df,y,.x, "GBP")))%>%bind_cols())%>%select_if(valid_column)

            date ER_GBP_CAD ER_GBP_AUD ER_GBP_EUR ER_EUR_AUD ER_CAD_AUD ER_AUD_EUR
    1 2016-01-01       2.02       2.07       1.11   1.864865   1.024752  0.5362319
    2 2016-02-01       1.99       2.10       1.14   1.842105   1.055276  0.5428571
    3 2016-03-01       1.91       2.06       1.17   1.760684   1.078534  0.5679612
    4 2016-04-01       1.87       2.04       1.13   1.805310   1.090909  0.5539216
      ER_CAD_EUR ER_AUD_CAD ER_EUR_CAD
    1  0.5495050  0.9758454   1.819820
    2  0.5728643  0.9476190   1.745614
    3  0.6125654  0.9271845   1.632479
    4  0.6042781  0.9166667   1.654867

您還可以使用expand.grid循環遍歷所有貨幣：

currencies = c('AUD','EUR', 'CAD')

par_ams <- expand.grid(from_cur = currencies, to_cur = currencies, KEEP.OUT.ATTRS = F, stringsAsFactors = F)%>%filter(from_cur != to_cur)

> df%>%bind_cols(map2(par_ams$from_cur, par_ams$to_cur, ~column_new(df, .x,.y, 'GBP')))

        date ER_GBP_CAD ER_GBP_AUD ER_GBP_EUR ER_AUD_EUR ER_AUD_CAD ER_EUR_AUD
1 2016-01-01       2.02       2.07       1.11  0.5362319  0.9758454   1.864865
2 2016-02-01       1.99       2.10       1.14  0.5428571  0.9476190   1.842105
3 2016-03-01       1.91       2.06       1.17  0.5679612  0.9271845   1.760684
4 2016-04-01       1.87       2.04       1.13  0.5539216  0.9166667   1.805310
  ER_EUR_CAD ER_CAD_AUD ER_CAD_EUR
1   1.819820   1.024752  0.5495050
2   1.745614   1.055276  0.5728643
3   1.632479   1.078534  0.6125654
4   1.654867   1.090909  0.6042781