如何在R中使用map函数创建新列?

juud5qan  于 2023-07-31  发布在  其他
关注(0)|答案(4)|浏览(113)

下面的代码创建了一个函数和一个向量

library(tidyverse) 

multiply_column <- function(data, column_name, lambda) {
    new_column_name <- paste0(column_name, "_multiplied_", lambda)
    
    data <- data %>%
        mutate(!!new_column_name := !!sym(column_name) * lambda)
    
    return(data)
}

lambda_values <- c(0.5, 0.75, 0.9)

字符串
这是我想要的输出-

mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb mpg_0.5 mpg_0.75 mpg_0.9
   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>   <dbl>    <dbl>   <dbl>
 1  21       6  160    110  3.9   2.62  16.5     0     1     4     4   10.5      15.8    18.9
 2  21       6  160    110  3.9   2.88  17.0     0     1     4     4   10.5      15.8    18.9
 3  22.8     4  108     93  3.85  2.32  18.6     1     1     4     1   11.4      17.1    20.5
 4  21.4     6  258    110  3.08  3.22  19.4     1     0     3     1   10.7      16.0    19.3
 5  18.7     8  360    175  3.15  3.44  17.0     0     0     3     2    9.35     14.0    16.8
 6  18.1     6  225    105  2.76  3.46  20.2     1     0     3     1    9.05     13.6    16.3
 7  14.3     8  360    245  3.21  3.57  15.8     0     0     3     4    7.15     10.7    12.9
 8  24.4     4  147.    62  3.69  3.19  20       1     0     4     2   12.2      18.3    22.0
 9  22.8     4  141.    95  3.92  3.15  22.9     1     0     4     2   11.4      17.1    20.5
10  19.2     6  168.   123  3.92  3.44  18.3     1     0     4     4    9.6      14.4    17.3


如何使用R中purrr包中的任何map变体来实现这一点?本质上,我想根据向量中的lambda值来改变新列。

cgyqldqp

cgyqldqp1#

这是它的功能,已更正。

suppressPackageStartupMessages(
  library(tidyverse) 
)

multiply_column <- function(data, column_name, lambda) {
  
  data <- data %>%
    bind_cols(
      lambda %>%
        map_dfc(\(l) {
          new_column_name <- paste(column_name, l, sep = "_")
          data %>%
            select(!!sym(column_name)) %>%
            mutate(!!new_column_name := !!sym(column_name) * l) %>%
            select(!!new_column_name)
        }) 
    )

  return(data)
}

lambda_values <- c(0.5, 0.75, 0.9)
df1 <- mtcars

multiply_column(df1, "mpg", lambda_values)
#>                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb mpg_0.5 mpg_0.75 mpg_0.9
#> Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4   10.50   15.750   18.90
#> Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4   10.50   15.750   18.90
#> Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1   11.40   17.100   20.52
#> Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1   10.70   16.050   19.26
#> Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2    9.35   14.025   16.83
#> Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1    9.05   13.575   16.29
#> Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4    7.15   10.725   12.87
#> Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2   12.20   18.300   21.96
#> Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2   11.40   17.100   20.52
#> Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4    9.60   14.400   17.28
#> Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4    8.90   13.350   16.02
#> Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3    8.20   12.300   14.76
#> Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3    8.65   12.975   15.57
#> Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3    7.60   11.400   13.68
#> Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4    5.20    7.800    9.36
#> Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4    5.20    7.800    9.36
#> Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4    7.35   11.025   13.23
#> Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1   16.20   24.300   29.16
#> Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2   15.20   22.800   27.36
#> Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1   16.95   25.425   30.51
#> Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1   10.75   16.125   19.35
#> Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2    7.75   11.625   13.95
#> AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2    7.60   11.400   13.68
#> Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4    6.65    9.975   11.97
#> Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2    9.60   14.400   17.28
#> Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1   13.65   20.475   24.57
#> Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2   13.00   19.500   23.40
#> Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2   15.20   22.800   27.36
#> Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4    7.90   11.850   14.22
#> Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6    9.85   14.775   17.73
#> Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8    7.50   11.250   13.50
#> Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2   10.70   16.050   19.26

字符串
创建于2023-07-14带有reprex v2.0.2

py49o6xq

py49o6xq2#

一个简单的方法:

mtcars[paste0("mpg_", lambda_values)] <- map(lambda_values, ~mtcars$mpg * .x)

字符串

tjrkku2a

tjrkku2a3#

或者请检查下面的代码

lambda_values <- c(0.5, 0.75, 0.9)

multiply_column <- function(data, col, lamb){

  var <- enquo(col) 
  new_column_name <- sapply(lamb, \(x) paste0(as_label(var),'_',as_label(x), collapse ='_'))

df1 <- map2(lamb, new_column_name, \(x,y) data %>% mutate(!!y := !!var*x) %>% rownames_to_column('cars') %>% 
             select(cars, y) 
             )

return(cbind(data,reduce(df1, full_join, by='cars')[-1]))

}

dff <- multiply_column(mtcars, mpg, lambda_values)

字符串
创建于2023-07-14带有reprex v2.0.2

mpg cyl  disp  hp drat    wt  qsec vs am gear
Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4
Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4
Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4
Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3
Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3
Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3
Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3
Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4
Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4
Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4
Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4
Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3
Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3
Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3
Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3
Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3
Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3
Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4
Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4
Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4
Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3
Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3
AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3
Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3
Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3
Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4
Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5
Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5
Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5
Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5
Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5
Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4
                    carb mpg_0.5 mpg_0.75 mpg_0.9
Mazda RX4              4   10.50   15.750   18.90
Mazda RX4 Wag          4   10.50   15.750   18.90
Datsun 710             1   11.40   17.100   20.52
Hornet 4 Drive         1   10.70   16.050   19.26
Hornet Sportabout      2    9.35   14.025   16.83
Valiant                1    9.05   13.575   16.29
Duster 360             4    7.15   10.725   12.87
Merc 240D              2   12.20   18.300   21.96
Merc 230               2   11.40   17.100   20.52
Merc 280               4    9.60   14.400   17.28
Merc 280C              4    8.90   13.350   16.02
Merc 450SE             3    8.20   12.300   14.76
Merc 450SL             3    8.65   12.975   15.57
Merc 450SLC            3    7.60   11.400   13.68
Cadillac Fleetwood     4    5.20    7.800    9.36
Lincoln Continental    4    5.20    7.800    9.36
Chrysler Imperial      4    7.35   11.025   13.23
Fiat 128               1   16.20   24.300   29.16
Honda Civic            2   15.20   22.800   27.36
Toyota Corolla         1   16.95   25.425   30.51
Toyota Corona          1   10.75   16.125   19.35
Dodge Challenger       2    7.75   11.625   13.95
AMC Javelin            2    7.60   11.400   13.68
Camaro Z28             4    6.65    9.975   11.97
Pontiac Firebird       2    9.60   14.400   17.28
Fiat X1-9              1   13.65   20.475   24.57
Porsche 914-2          2   13.00   19.500   23.40
Lotus Europa           2   15.20   22.800   27.36
Ford Pantera L         4    7.90   11.850   14.22
Ferrari Dino           6    9.85   14.775   17.73
Maserati Bora          8    7.50   11.250   13.50
Volvo 142E             2   10.70   16.050   19.26

oyxsuwqo

oyxsuwqo4#

我已经为这个用例做了一个名为'dplyover'的包(它不在CRAN上)。其中一个核心函数是over(),它的行为与dplyr::across()类似,但用于向量。.names参数使您可以完全控制如何命名新列:

library(dplyr)
library(dplyover) # https://timteafan.github.io/dplyover/

lambda_values <- c(0.5, 0.75, 0.9)

mtcars %>% 
  mutate(over(lambda_values,
              \(lambda) mpg * lambda,
              .names = "mpg_{x}")) %>% 
  glimpse() # <- for better printing

#> Rows: 32
#> Columns: 14
#> $ mpg      <dbl> 21.0, 21.0, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, 19.2, 1…
#> $ cyl      <dbl> 6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 6, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4…
#> $ disp     <dbl> 160.0, 160.0, 108.0, 258.0, 360.0, 225.0, 360.0, 146.7, 140.8…
#> $ hp       <dbl> 110, 110, 93, 110, 175, 105, 245, 62, 95, 123, 123, 180, 180,…
#> $ drat     <dbl> 3.90, 3.90, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3…
#> $ wt       <dbl> 2.620, 2.875, 2.320, 3.215, 3.440, 3.460, 3.570, 3.190, 3.150…
#> $ qsec     <dbl> 16.46, 17.02, 18.61, 19.44, 17.02, 20.22, 15.84, 20.00, 22.90…
#> $ vs       <dbl> 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1…
#> $ am       <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0…
#> $ gear     <dbl> 4, 4, 4, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3…
#> $ carb     <dbl> 4, 4, 1, 1, 2, 1, 4, 2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1…
#> $ mpg_0.5  <dbl> 10.50, 10.50, 11.40, 10.70, 9.35, 9.05, 7.15, 12.20, 11.40, 9…
#> $ mpg_0.75 <dbl> 15.750, 15.750, 17.100, 16.050, 14.025, 13.575, 10.725, 18.30…
#> $ mpg_0.9  <dbl> 18.90, 18.90, 20.52, 19.26, 16.83, 16.29, 12.87, 21.96, 20.52…

字符串
当使用'purrr'包时,我们可以使用被取代的函数map_dfc()来模拟这种行为。但是,我们必须提前根据输入向量的名称手动命名新列,使用set_names()

library(purrr)

lambda_cols <- lambda_values %>% 
  set_names(paste0("mpg_", .))

mtcars %>% 
  mutate(map_dfc(lambda_cols,
                 \(lambda) mpg * lambda)) %>% 
  glimpse() # <- for better printing

#> Rows: 32
#> Columns: 14
#> $ mpg      <dbl> 21.0, 21.0, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, 19.2, 1…
#> $ cyl      <dbl> 6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 6, 8, 8, 8, 8, 8, 8, 4, 4, 4, 4…
#> $ disp     <dbl> 160.0, 160.0, 108.0, 258.0, 360.0, 225.0, 360.0, 146.7, 140.8…
#> $ hp       <dbl> 110, 110, 93, 110, 175, 105, 245, 62, 95, 123, 123, 180, 180,…
#> $ drat     <dbl> 3.90, 3.90, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3…
#> $ wt       <dbl> 2.620, 2.875, 2.320, 3.215, 3.440, 3.460, 3.570, 3.190, 3.150…
#> $ qsec     <dbl> 16.46, 17.02, 18.61, 19.44, 17.02, 20.22, 15.84, 20.00, 22.90…
#> $ vs       <dbl> 0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1…
#> $ am       <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0…
#> $ gear     <dbl> 4, 4, 4, 3, 3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3…
#> $ carb     <dbl> 4, 4, 1, 1, 2, 1, 4, 2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1…
#> $ mpg_0.5  <dbl> 10.50, 10.50, 11.40, 10.70, 9.35, 9.05, 7.15, 12.20, 11.40, 9…
#> $ mpg_0.75 <dbl> 15.750, 15.750, 17.100, 16.050, 14.025, 13.575, 10.725, 18.30…
#> $ mpg_0.9  <dbl> 18.90, 18.90, 20.52, 19.26, 16.83, 16.29, 12.87, 21.96, 20.52…


创建于2023-07-15带有reprex v2.0.2
在这两种情况下,我认为一个单独的自定义函数multiply_columns()是没有必要的给予代码已经很干净了。

相关问题