r中的选择性缩放函数使用不同的数据框进行缩放

selective scaling function in r using a different data frame to scale

我是 R 的新手。我希望编写一个函数来缩放数据框中除特定数字列之外的所有数字列(在下面的示例中,我不想缩放列 'estimate').由于使用此函数的特定上下文,我实际上想使用另一个数据框来缩放数据。下面是一个没有奏效的尝试。本次尝试中original.df表示需要缩放的数据框,scaling.data表示用于缩放的数据。我正在尝试将数字 original.df 列置于相应 scaling.data 列的平均值上,并除以 scaling.data 列的 2 个标准差。

对于工作解决方案可能不是必需的其他信息:

这个函数将嵌套在一个更大的函数中。在较大的函数中有一个称为预测器的参数,它表示需要包含在新数据框中的列名,并且也可以在缩放数据框中找到。这可能是用于迭代缩放函数的向量,但这不一定是必需的。 (注意:此向量包含引用字符和数字列的列名,我再次希望该函数仅缩放数字列。最终产品应包括 original.df 中未缩放的 'estimate' 列)。

> predictors
[1] "color"  "weight" "height" "length"
    
>original.df
    color weight height length estimate
    1    red     10     66     40        5
    2    red     12     60     41        7
    3 yellow     12     67     48        9
    4   blue     15     55     36       10
    5 yellow     21     54     48        7
    6    red     12     54     43        5
    7    red     11     38     36        6
            
     
  >scale.data
     color weight height length estimate
    1    red     11     55     41        7
    2    red     13     67     39        9
    3 yellow     12     67     46       11
    4   blue     16      8     37        5
    5 yellow     23     10     47        9
    6    red     17     11     41       10
    7    red     16     13     37       13
                
 

    scale2sd<-function(variable){
         original.df[[variable]]<-((original.df[[variable]]) - mean(scaling.data[[variable]],na.rm=TRUE))/(2*sd(scaling.data[[variable]], na.rm=TRUE))
                            return(original.df[[variable]])
                          }
        
     new.df<-original.df %>%mutate_at((!str_detect(names(.),"estimate")&is.numeric),scale)

我需要结果是全新的缩放数据框。

非常感谢您的时间和想法。

我们可以执行以下操作(我使用的是 dplyr 1.0.7,但任何 >= 1.0.0 的版本都可以):

创建一个可缩放的函数

scale_to_sd <- function(other_df, target){
      
      mean(other_df[,target], na.rm=TRUE) / 
        (2*sd(other_df[, target], na.rm=TRUE))  
    }

如果您只需要严格的 numeric 列并需要排除某些列,我们可以使用 matches,它比 contains 提供更多的灵活性,例如

df %>% 
   mutate(across(!matches("estimate|height") & where(is.numeric),
                 ~  .x - scale_to_sd(scale_df,cur_column()))) 
  

以上将缩放除估计值或高度之外的任何内容。可以玩正则表达式。

    color    weight height   length estimate
1    red  8.088421     66 34.87995        5
2    red 10.088421     60 35.87995        7
3 yellow 10.088421     67 42.87995        9
4   blue 13.088421     55 30.87995       10
5 yellow 19.088421     54 42.87995        7
6    red 10.088421     54 37.87995        5
7    red  9.088421     38 30.87995        6

原创

df %>% 
  mutate(across(contains("estimate") & where(is.numeric),
                ~  .x - scale_to_sd(scale_df,cur_column()))) 

跨目标列应用函数

 df %>% 
       mutate(across(contains("estimate"),
                     ~  .x - scale_to_sd(scale_df,cur_column()))) 

结果

        color weight height length estimate
    1    red     10     66     40 3.248164
    2    red     12     60     41 5.248164
    3 yellow     12     67     48 7.248164
    4   blue     15     55     36 8.248164
    5 yellow     21     54     48 5.248164
    6    red     12     54     43 3.248164
    7    red     11     38     36 4.248164

使用的数据:


df <- read.table(text="color weight height length estimate
    1    red     10     66     40        5
    2    red     12     60     41        7
    3 yellow     12     67     48        9
    4   blue     15     55     36       10
    5 yellow     21     54     48        7
    6    red     12     54     43        5
    7    red     11     38     36        6", head=T)

scale_df <- read.table(text=" color weight height length estimate
    1    red     11     55     41        7
    2    red     13     67     39        9
    3 yellow     12     67     46       11
    4   blue     16      8     37        5
    5 yellow     23     10     47        9
    6    red     17     11     41       10
    7    red     16     13     37       13", head=T)

一种使用基础 R 的方法。代码中的注释。感谢 Nelson 提供的数据 +1

df <- read.table(text="color weight height length estimate
    1    red     10     66     40        5
    2    red     12     60     41        7
    3 yellow     12     67     48        9
    4   blue     15     55     36       10
    5 yellow     21     54     48        7
    6    red     12     54     43        5
    7    red     11     38     36        6", head=T)

scale_df <- read.table(text=" color weight height length estimate
    1    red     11     55     41        7
    2    red     13     67     39        9
    3 yellow     12     67     46       11
    4   blue     16      8     37        5
    5 yellow     23     10     47        9
    6    red     17     11     41       10
    7    red     16     13     37       13", head=T)

## add reference and scaling df as arguments
scale2sd <- function(ref, scale_by, variable) {
  ((ref[[variable]]) - mean(scale_by[[variable]], na.rm = TRUE)) / (2 * sd(scale_by[[variable]], na.rm = TRUE))
}
predictors <- c("color", "weight", "height", "length")
## this is to get all numeric columns that are part of your predictor variables
df_to_scale <- Filter(is.numeric, df[predictors])
## create a named vector. This is a bit awkward but it makes it easier to select
## the corresponding items in the two data frames, 
## and then replace the original columns 
num_vars <- setNames(names(df_to_scale), names(df_to_scale))                      

## this is the actual scaling job - 
## use the named vector for looping over the selected columns 
## then assign it back to the selected columns
df[num_vars] <- lapply(num_vars, function(x) scale2sd(df, scale_df, x))

df
#>    color      weight     height      length estimate
#> 1    red -0.67259271 0.58130793 -0.14222363        5
#> 2    red -0.42479540 0.47561558 -0.01777795        7
#> 3 yellow -0.42479540 0.59892332  0.85334176        9
#> 4   blue -0.05309942 0.38753862 -0.64000632       10
#> 5 yellow  0.69029252 0.36992323  0.85334176        7
#> 6    red -0.42479540 0.36992323  0.23111339        5
#> 7    red -0.54869405 0.08807696 -0.64000632        6