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

Question

我是R的新手。我希望写一个函数，可以缩放数据框中除特定数字列之外的所有数字列(在下面的示例中，我不想缩放列"estimate"(。由于使用此函数的特定上下文，我实际上想使用另一个数据帧来缩放数据。下面是一个没有成功的尝试。在这种尝试中，original.df表示需要缩放的数据帧，scaling.data表示用于缩放的数据。我试图将数值original.df列集中在相应的scaling.data列的平均值上，并除以scaling.data行的2个标准偏差。

可能对工作解决方案不重要的附加信息：

此函数将嵌套在一个较大的函数中。在较大的函数中，有一个称为预测器的参数，它表示需要包含在新数据帧中的列名，也可以在缩放数据帧中找到。这可以是用于迭代缩放函数的向量，尽管这不一定是必需的。(注意：这个向量包括引用字符和数字列的列名，同样，我希望函数只缩放数字列。最终产品应该包括original.df中未缩放的"估计"列(。

> 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)

我需要的结果是完整的新的缩放数据帧。

非常感谢您抽出时间和思考。

Answer 1

代码中的注释。谢谢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

Answer 2

我们可以执行以下操作(我使用的是dplyr1.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列，并且需要排除某些列，我们可以使用比contains更灵活的matches，例如

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

以上内容将按比例缩放，但不包括估计值或高度。一个人可以和RegEx一起玩。

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)